*! version 2.2.1  Philip Ryan June 20, 1999  STB-50 sxd1.1
*! program to allocate treatments to subjects at random in blocks
* simpler notes handling compared to original ralloc
* optional user defined treatment names
* allow 1 to 7 block sizes
* specify wide or long output
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"
               "TR1lab(string) TR2lab(string)" 
               "TR3lab(string) TR4lab(string)"
               "SHAPe(string)";
#delimit cr
parse "`*'"
parse "`varlist'", parse(" ")

**** 1 = BlockID         2 = BlockSize         3 = Treat

***** 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' <1 | `osize' > 7) {
 #delimit ;
 display in r "number of different block sizes must be"
              " 1, 2, 3, 4, 5, 6 or 7";
 #delimit cr
 exit
}

if ("`shape'" =="") {
local shape = "long"
} 

else {
if ("`shape'" != "long" & "`shape'" != "wide") {
di in r "shape must be either " in ye "wide " in re "or " in ye "long"
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
}

*****************
* set up labels
*****************
if (`ntreat' == 2) {
if ("`tr1lab'" == "") {
local tr1lab = "A"
}
if ("`tr2lab'" == "") {
local tr2lab = "B"
}
}

if (`ntreat' == 3) {
if ("`tr1lab'" == "") {
local tr1lab = "A"
}
if ("`tr2lab'" == "") {
local tr2lab = "B"
}
if ("`tr3lab'" == "") {
local tr3lab = "C"
}
}

if (`ntreat' == 4) {
if ("`tr1lab'" == "") {
local tr1lab = "A"
}
if ("`tr2lab'" == "") {
local tr2lab = "B"
}
if ("`tr3lab'" == "") {
local tr3lab = "C"
}
if ("`tr4lab'" == "") {
local tr4lab = "D"
}
}
local tr1lab = substr("`tr1lab'",1,8)
local tr2lab = substr("`tr2lab'",1,8)
local tr3lab = substr("`tr3lab'",1,8)
local tr4lab = substr("`tr4lab'",1,8)
*************************************************************


*****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
 }
}
*************************************************************

** not a whole lot of sense using Pascal's triangle on only 1 or 2
** block sizes; force frequency to be equal

if ((`osize' == 1) | (`osize' == 2)) & ("`equal'" == "") {
local equal = "equal"
}


quietly replace `1' =_n

if "`equal'" != "" | `osize' ==1 | `osize' == 2 {
*****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"

if `ntreat' == 4 {
label define treat 1 "`tr1lab'" 2 "`tr2lab'" 3 "`tr3lab'" 4 "`tr4lab'"
}
if `ntreat' == 3 {
label define treat 1 "`tr1lab'" 2 "`tr2lab'" 3 "`tr3lab'"
}
if `ntreat' == 2 {
label define treat 1 "`tr1lab'" 2 "`tr2lab'"
}
*************************************************************

sort `1'
qui by `1':gen SeqInBlk = _n
* sort Order
 

/* Essentially the randomisation task is over.  Now to
   document the process in notes to be stored with the
   data set to be saved.  
*/



*****
note: Randomisation schema created on TS using ralloc.ado v2.2.1
*****

*****
note: seed used = `seed'
*****

*****
note: There were `ntreat' treatments defined
*****

*****
if `ntreat' ==2 {
note: The treatments were allocated in the ratio 1 : `ratio'
 }
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
 }
*****

*****
#delimit ;
if `ntreat' == 4 {;
note: Treatments are labelled: " `tr1lab';  " "`tr2lab';  " 
 "`tr3lab';  "  "`tr4lab'";
};
#delimit cr
if `ntreat' == 3 {
note: Treatments are labelled: " `tr1lab';  " "`tr2lab';  "  "`tr3lab' "
}
if `ntreat' == 2 {
note: Treatments are labelled: " `tr1lab';  " "`tr2lab' " 
}
*****

*****
local crit = `1'[`nsubj']
note: There were `crit' blocks of `osize' different sizes generated
*****

*****
local final=`init'+(`numt'*(`osize'-1))
note: The minimum block size is `init' maximum is `final' 
*****

*****
if (`osize' > 1) {

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
*************************************************************


*****
note: There were `nsubj' allocations requested
*****

*****
note: There were `actual' allocations provided
*****

*****
if (`nsubj' != `actual') {
local extra = `actual'-`nsubj' 
#delimit ;
note: `extra' extra allocations were provided to
         maintain integrity of final block;
#delimit cr
}
*****


*****
note: Sequence within block is stored in the variable 'SeqInBlk'
*****

if "`shape'" == "wide" {
*****
note: Recover 'SeqInBlk' by issuing <reshape long> command
*****
}
******************************************************************



*****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***********************************************

qui keep `1' `2' `3' SeqInBlk
qui reshape wide `3', i(`1') j(SeqInBlk)

if ("`shape'" == "wide") {
sort `1'
order `1' `2'
}

if ("`shape'" == "long") {
qui reshape long
qui drop if `3' == .
sort `1' SeqInBlk
qui label var SeqInBlk "sequence number within block"
order `1' `2' SeqInBlk `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