*! version 1.1.2  Philip Ryan  September 6,1997   STB-41 sxd1
*! program to allocate treatments to subjects at random in blocks
program define ralloc
version 5.0
clear
set more 1
local varlist "req new min(3) max(3)"
#delimit ;
local options "SEed(int 123456789) NSubj(int 100) NTreat(int 2)"
               "RAtio(int 1) SAVing(string)"
               "OSize(int 5) INIT(int 0) EQual";
#delimit cr
parse "`*'"
parse "`varlist'", parse(" ")


***** Must have a saving file *******************************

if ("`saving'"==""){
 display in r "a save file must be specified"
  exit
}

*************************************************************


*****Check for some errors in syntax*************************


if (`ntreat' != 2) & (`ntreat' != 3) & (`ntreat' != 4) {
 display in r "number of treatments must be 2, 3 or 4"
 exit
}

if (`osize' <3 | `osize' > 7) {
 #delimit ;
 display in r "number of different block sizes must be"
              " 3, 4, 5, 6 or 7";
 #delimit cr
 exit
}

if (`ratio' != 1) {
  if (`ntreat' != 2){
   #delimit ;
   display in r "number of treatments must be 2"
                " if" in y " ratio " in r "> 1 is specified";
   #delimit cr
   exit
   }
 if (`ratio' != 2) & (`ratio' != 3){
   display in r "ratio must be 2 or 3"
   exit
   }
}

if `init'==0 {
 local init = (`ntreat'+(`ratio'==2)+(2*(`ratio'==3)))
}

if mod(`init',(`ntreat'+(`ratio'==2)+(2*(`ratio'==3)))) != 0 {
 #delimit ;
 display in r "The " in y "init" in r "iating block size"
              " must be a multiple of the number of treatments,";
 display in r "or, in the case of a " in y "ratio " in
                r "> 1 specified for a 2 treatment trial, a";
 display in r "multiple of (" in y "ratio " in r "+ 1).";
 #delimit cr
 exit
}
*************************************************************


*****Declare temporary variables*****************************
tempvar propn shuffle numt ratx crit schem k low high
*************************************************************


/* Maximum number of blocks required is if all blocks are
   minimum size. Initially, number of obs will be the number
   of blocks required, not the number of subjects.  Also, 
   if a ratio of 1:2 or 1:3 is required the number of treatments
   is effectively 3 or 4 respectively.
*/

*****Set obs, seed and number of treatments*****************
quietly {
  local nb = int((`nsubj'/`ntreat') + 1)
  set obs `nb'
  set seed `seed'

  gen `numt'=`ntreat'
  gen `ratx' = `ratio'
}

quietly {
if (`ratio' != 1) {
 replace `numt'=`ratx' + 1
 }
}
*************************************************************

quietly replace `1' =_n

if "`equal'" != "" {
*****Set up block sizes with equal probability***************

quietly {
 gen `propn'=int((uniform()*100)+1)
 gen `schem'=autocode(`propn',`osize',1,100)
 egen `k' = group(`schem')
 replace `2'=(`numt'*(`k'-1))+`init'
 }
}

else {
*****Set up block sizes in random order with unequal prob****
*****Probabilities are based on Pascal's triangle************
*****This segment is open to change at user's discretion*****

quietly {
 gen `propn'=int((uniform()*256)+1)
}

local scal=`osize'-1

quietly {
 local i=1
 gen `low' = 0
 gen `high' = 0
 while `i' <= `scal' {
  replace `high' = 256*(1-Binomial(`scal',`i',0.5))
  #delimit ;
  replace `2' = (`numt'*(`i'-1)) + `init' if
                 `propn' >`low' & `propn' <= `high';
  #delimit cr
  replace `low'=`high'
  local i=`i'+1
  }
  #delimit ;
  replace `2'= (`numt'*(`osize'-1))+`init'
                if `propn' >=`low' & `propn' <=256;
  #delimit cr
 }
 }
*************************************************************


*****Expand block size var to give nsubjs at least***********
quietly expand `2'
*************************************************************



*****Fill block with equal numbers of treats then shuffle****
sort `1'

quietly {
 by `1': replace `3' = (autocode(_n,`numt',0,_N))*(`numt'/_N)
 by `1': gen `shuffle' = uniform()
 sort `1' `shuffle'
}

gen Order = _n
label var Order "allocation order"
label var `1' "block number"
label var `2' "block size"
label var `3' "treatment allocated"
label define treat 1 "A" 2 "B" 3 "C" 4 "D"
*************************************************************



/* Essentially the randomisation task is over.  Now to
   document the process in notes to be stored with the
   data set to be saved.  Some notes can just use the
   standard notes.ado command.  Mostly, however, the info
   must be taken from options supplied by the user on the
   command line.  These are placed in global macros so they
   can be read by a fragment of notes.ado (called mynotes.ado)
   which appears below ralloc.ado in this file.
*/


*****Stuff info into notes using global macros**************

*****
note: Randomisation schema created on TS using ralloc.ado v1.1.2
*****

*****
global mynote1 "`seed'"
mynote: Seed used = seed
*****

*****
global mynote2 "`ntreat'"
mynote: There were nrx treatments defined
*****

*****
if ("`ratio'" != "") {
global mynote3 "`ratio'"
 if `ntreat' ==2 {
  mynote: The treatments were allocated in the ratio 1 : rtx
 }
 if `ntreat'==3 {
  note: The treatments were allocated in the ratio 1:1:1
 }
 if `ntreat'==4 {
  note: The treatments were allocated in the ratio 1:1:1:1
 }
}
*****

*****
sort Order
local crit = `1'[`nsubj']
global mynote4 "`crit'"
global mynote7 "`osize'"
mynote: There were nbl blocks of osi different sizes generated
*****

*****
local final=`init'+(`numt'*(`osize'-1))
global mynote8 "`init'"
global mynote9 "`final'"
mynote: The minimum block size is ini maximum is fin 
*****

*****
if ("`equal'" != "") {
 note: Block sizes were allocated in equal proportions
}

else {
 #delimit ;
 note: Block sizes were allocated proportional to
        elements of Pascal's triangle;
 #delimit cr
}
*****


*****Drop excess subjs but preserve complete final block*****

quietly drop if (_n >= `nsubj') & (`1'[_n] > `crit')
local actual = _N
*************************************************************


*****
global mynote5 "`nsubj'"
mynote: There were nsub allocations requested
*****

*****
if (`nsubj' != `actual') {
 global mynote6 "`actual'"
 #delimit ;
 mynote: There were nall allocations provided to
          maintain integrity of final block;
 #delimit cr
}
*****

*****
note: Original allocation order is stored in the variable 'Order'
*****


*************************************************************



*****If allocation ratio not 1:1, fix up treatment names*****
quietly {
if (`numt' - `ntreat' == 1) {recode `3' 3=2}
if (`numt' - `ntreat' == 2) {recode `3' 3=2 4=2}
}
label val `3' treat
*************************************************************


*****Save data***********************************************
order Order `1' `2' `3'
quietly capture save `saving',replace
*************************************************************


*****Useful table********************************************
sort `1'
quietly by `1':keep if _n==1
display
display in b "Frequency of block sizes:"
tab `2'

*************************************************************

use $S_FN, clear

*****Closing messages to user********************************
displ " "
#delimit ;
displ in w "  Randomisation data is saved to " in y "$S_FN"
               in w " and is now in memory.";
displ in w "  Issue the " in y "notes" in w " command to review"
              " your protocol.";
#delimit cr
end
*************************************************************



*************************************************************
*************************************************************
*************************************************************

program define mynotes
	version 4.0

	if "`1'"==":" {
		mac shift
		xmknote _dta "`*'"
		exit
	}
	if substr("`1'",-1,1)==":" {
		local vn = substr("`1'",1,length("`1'")-1)
		mac shift
		xmknote `vn' "`*'"
		exit
	}
	if "`2'"==":" {
		local vn "`1'"
		mac shift 2
		xmknote `vn' "`*'"
		exit
	}

end

**********	
program define mynote
	mynotes `*'
end
**********

program define xmknote /* name text */
	version 4.0
	local vn "`1'"
	local text "`2'"

	if "`text'"=="" { error 198 }

	local n : char `vn'[note0]
	if "`n'"=="" {
		local n 1
	}
	else	local n = `n' + 1

	parse "`text'", parse(" ")
	local i 1
	while "``i''" != "" {
		if "``i''" == "seed" {
			local ts = "$mynote1"
  			local `i' "`ts'"
		}
                if "``i''" == "nrx" {
			local ts = "$mynote2"
  			local `i' "`ts'"
		}
                if "``i''" == "nbl" {
			local ts = "$mynote4"
  			local `i' "`ts'"
		}
                if "``i''" == "nsub" {
			local ts = "$mynote5"
  			local `i' "`ts'"
		}
                if "``i''" == "nall" {
			local ts = "$mynote6"
  			local `i' "`ts'"
		}
                if "``i''" == "rtx" {
			local ts = "$mynote3"
  			local `i' "`ts'"
		}
                if "``i''" == "osi" {
			local ts = "$mynote7"
  			local `i' "`ts'"
		}
                if "``i''" == "ini" {
			local ts = "$mynote8"
  			local `i' "`ts'"
		}
                if "``i''" == "fin" {
			local ts = "$mynote9"
  			local `i' "`ts'"
		}
                local i=`i'+1
	}
	local text "`*'"
	char `vn'[note0] `n'
	char `vn'[note`n'] "`text'"
end