simul_confusion/Modules/ado/personal/r/raschlongitudinal2.ado

* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
************************************************************************************************************/

program define raschlongitudinal2,rclass
syntax [varlist] [, n(int 100)  diff(string) Mu(string) Sigma(string) Nodes(int 12) fast]
version 11
tempfile raschlongitudinalfile
capture qui save "`raschlongitudinalfile'",replace

if "`diff'"=="" {
   tempname diff
   *matrix `diff'=[-1\0\1]
   matrix `diff'=[-1\-.5\0\.5\1]
}

if "`mu'"=="" {
   tempname mu
   matrix `mu'=[0,0]
}
if "`sigma'"=="" {
   tempname sigma
   matrix `sigma'=[1,0\0,1]
}

local nbitems=rowsof(`diff')
*local J=rowsof(`diff')+1
*local Nbit=rowsof(`diff')*2
di in gr "Number of individuals in the study:  " in ye `n'
di in gr "Number of items: " in ye  `nbitems'
di in green "Difficulties parameters of the items: " _c
tempname dt
matrix `dt'=`diff' ' ''
matrix list `dt',noblank nohalf nonames noheader
di in green "mean of the latent traits: " _c
matrix list `mu',noblank nohalf nonames noheader
di in green "variance matrix of the latent traits: " _c
di
matrix list `sigma',noblank nohalf nonames noheader


if "`data'"=="" {
   clear
   local temp=2^(`nbitems'*2)
   qui range x1 0 `=`temp'-1' `temp'
   qui g t=x1
   qui g x2=x1
   qui g x=x2
   loc i=1
   qui count if t>0
   loc z=r(N)
   qui while `z'>0 {
      qui g item`i'=mod(t,2^`i')==2^`=`i'-1'
      qui replace t=t-item`i'*2^`=`i'-1'
      qui count if t>0
      loc z=r(N)
      loc i=`i'+1
   }
}
drop t
*edit

if "`fast'"=="" {
      qui gen proba=.
      *qui gen proba2=.
      forvalues i=1/`temp' {
         local int1=1
         local int2=1
         forvalues j=1/`nbitems' {
              qui su item`j' in `i'
              local rep=r(mean)
              local diffic=`diff'[`j',1]
              local int1 "`int1'*exp(`rep'*(x1-`diffic'))/(1+exp(x1-`diffic'))"
              *di `j'
              *di `int1'
           }
           *qui gausshermite `int1', mu(1) sigma(2) display
          * di r(int)
           *qui replace proba=r(int)  in `i'
           
           forvalues k=`=`nbitems'+1' /`=2*`nbitems'' {
              qui su item`k' in `i'
              local rep=r(mean)
              local diffic=`diff'[`=`k'-`nbitems'',1]
              local int2 "`int2'*exp(`rep'*(x2-`diffic'))/(1+exp(x2-`diffic'))"
         }
           *di `i'
           *di "`int1'"
           *di "`int2'"
           local int "`int1'*`int2'"
           qui gausshermite2 `int', mu(`mu') sigma(`sigma') display
           qui replace proba=r(int)  in `i' 
           *di proba[`i']
         }
         }
         
   gen eff=proba 
   keep item*  proba   eff 
   *gen eff2=`n'*proba2 
   *keep item*  proba  proba2 eff1 eff2 
   
   edit
   local p=1/`n'     
   qui gen eff2=floor(eff/`p')   
   *list eff2 eff    
   qui replace eff=eff-eff2*(`p') 
   qui su eff2 
   local aff=r(sum)
   
   local unaff=`n'-`aff'
   di `aff'
   di `unaff'
   gen efftmp=eff2
   qui gsort - eff
   qui replace eff2=eff2+1 in 1/`unaff'
  
   qui drop if eff2==0
   gsort  item*
   *gen res=proba*50
  * keep item*  proba   eff eff2 aff unaff
  
  * Matrice complete qui ne tient pas compte des effectifs dans l'analyse 
  
   qui expand eff2
   *qui drop proba eff eff2
   *keep item*  proba   eff eff2 
   *}


   forvalues j=1/`nbitems' {
      rename item`j' T1reponse`j'
   }

 forvalues j=`=1+`nbitems''/`=2*`nbitems'' {
      rename item`j' T2reponse`=`j'-`nbitems'' 
   }
rename eff2 Eff
keep T1reponse* T2reponse*  Eff

gen id=_n
forvalues i=1/`nbitems'{
	local list="`list' T@reponse`i'"
}
reshape long `list', i(id) j(temps)
reshape long Treponse, i(id temps) j(item)
forvalues i=1/`nbitems'{
	gen item`i'=0
	replace item`i'=-1 if item==`i'
}
gen temps1=temps==1
gen temps2=temps==2
*gen W1=0
*gen W2=0
*replace  W1=Eff if temps1==1
*replace W2=Eff if temps2==1

qui gen  offset=0
forvalues i=1/`nbitems' {
    qui replace offset=-`diff'[`i',1] if item==`i'
}

matrix C=cholesky(`sigma')

*constraint define 1  `sigma'[1,1]-C[1,1]^2=0
*constraint define 2  `sigma'[2,2]-C[2,1]^2-C[2,2]^2=0
*constraint define 3  `sigma'[2,1]-C[1,1]*C[2,1]=0

*constraint define 1 id_1:temps1=`=sqrt(`sigma'[1,1])'
*constraint define 2 id_2:temps2=`=sqrt(`sigma'[2,2]-`sigma'[2,1]^2/`sigma'[1,1])'
*constraint define 3 id1_2_1:_cons=`=`sigma'[2,1]/sqrt(`sigma'[1,1])'

*constraint define 1 var(1): =`=`sigma'[1,1]'
*constraint define 2  cov(2,1): =`=`sigma'[1,2]'    
*constraint define 3 var(2): =`=`sigma'[2,2]'     



constraint define 1 id1_1:temps1=`=C[1,1]'
constraint define 2  id1_2:temps2=`=C[2,2]'
constraint define 3  id1_2_1:_cons=`=C[2,1]'

/*CODE JBH*/
gen Treponse1=Treponse if temps1
replace Treponse1=0 if Treponse1==.
gen Treponse2=Treponse if temps2
replace Treponse2=0 if Treponse2==.

constraint define 1 Treponse1=`=C[1,1]'
constraint define 2 Treponse2=`=C[2,2]'
constraint define 3 _cons=`=C[2,1]'

eq b1:Treponse1
eq b2:Treponse2
/*FIN CODE JBH*/
gllamm Treponse temps1 temps2, offset(offset) i(id) link(logit) nocons fam(bin) nrf(2) constraints(1 2 3) eqs(b1 b2)  iterate(20) trace

capture qui use `raschlongitudinalfile',clear

end