ROSALI-SIM/Modules/ado/personal/c/clv29.ado

*! Version 2.9 9December2005
*! Jean-Benoit Hardouin
************************************************************************************************************
* Stata program : clv
* Clustering of variables around latent variables
* Version 2.9 : December 9, 2005 /*save the latent variables*/
*
* Historic
* Version 1 (2005-06-11): Jean-Benoit Hardouin
* Version 1.1 (2005-07-07): Jean-Benoit Hardouin /*small bug in the consolidation process with cluster of only one variable*/
* Version 1.2 (2005-07-08): Jean-Benoit Hardouin /*Bug in the consolidation procedure when there is negative correlation*/
* Version 2 (2005-09-03): Jean-Benoit Hardouin /*Horizontal dendrograms (with Stata 9)*/
* Version 2.1 (2005-09-08): Jean-Benoit Hardouin /*More flexibility to abbreviate the names of the variables (with Stata 9)*/
* Version 2.1.1 (2005-09-08): Jean-Benoit Hardouin /*Integration of some requests of Ronan Conroy*/
* Version 2.1.2 (2005-09-08): Jean-Benoit Hardouin /*Possibility to give a title and an X/Y caption*/
* Version 2.2 (2005-09-11): Jean-Benoit Hardouin /*Kernel option*/
* Version 2.3 (2005-09-12): Jean-Benoit Hardouin /*Polychoric option*/
* Version 2.4 (2005-09-13): Jean-Benoit Hardouin /*v2 option*/
* Version 2.5 (2005-09-21): Jean-Benoit Hardouin /*corrections*/
* Version 2.6 (2005-10-02): Jean-Benoit Hardouin /*centroid method, biplot*/
* Version 2.7 (2005-10-06): Jean-Benoit Hardouin /*return, multiple graphs, polychoric+consolidation*/
* Version 2.8 (2005-10-06): Jean-Benoit Hardouin /*fweights*/
*
* Jean-benoit Hardouin, Regional Health Observatory of Orl<72>ans - France
* jean-benoit.hardouin@orscentre.org
*
* News about this program : http://anaqol.free.fr
* FreeIRT Project : http://freeirt.free.fr
*
* Copyright 2005 Jean-Benoit Hardouin
*
* 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 clv,rclass
version 9.0
syntax [varlist(default=none)] [if] [in] [fweight] [, CUTnumber(int 30) bar CONSolidation(int 0) noDENdro noSTANDardized deltaT HORizontal SHOWcount ABBrev(int 14) TITle(string) CAPtion(string) KERnel(numlist) METHod(string) noBIPlot ADDvar genlv(string)]
preserve
tempfile clvfile
qui save `clvfile',replace
local matsize=c(matsize)
local none=0
if "`varlist'"=="" {
   capture confirm matrix r(vp)
   if _rc==0 {
      capture confirm matrix r(matclus)
      if _rc ==0 {
         local none=1
      }
   }
   if `none'==0 {
      di in red "You cannot use the {hi:clv} command without {hi:varlist} if you have not already run {hi:clv}"
      error 198
      exit
   }
}

tempname matclus vp

if `none'==1 {
   matrix `vp'=r(vp)
   matrix `matclus'=r(matclus)
   local varlist `r(varlist)'
   tokenize `varlist'
   local nbitems=rowsof(`matclus')
   if "`method'"!="" {
      di in green "The {hi:method} option can not be modified without specification of the varlist. {hi:method} is omitted."
   }
   local method `r(method)'
   local kernel `r(kernel)'
}
if "`method'"=="" {
   local method classical
}
if ("`method'"=="polychoric"|"`method'"=="polychoricv2")&"`standardized'"!="" {
   di in green "Initial variables are used with the {hi:polychoric} methods"
   di in green "But the procedure is based on the matrix of the polychoric correlations"
   di
}
if "`method'"!="classical"&"`method'"!="v2"&"`method'"!="centroid"&"`method'"!="polychoric"&"`method'"!="polychoricv2" {
   di in red "The {hi:method} `method' is unknown"
   error 198
   exit
}

tokenize `varlist'
local nbitems : word count `varlist'
marksample touse
qui keep if `touse'

local mat=max(`matsize',`=`nbitems'*2')
qui set matsize `mat'

if `nbitems'<3&`none'!=1 {
   di in red "You need at least 3 variables"
   error 198
   exit
}
forvalues i=1/`nbitems'{
   local label`i':variable label ``i''
   if "`label`i''"=="" {
      local label`i' ``i''
   }
   if "`method'"!="polychoric"&"`method'"!="polychoricv2" {
      qui su ``i'' [`weight'`exp']
      local mean=r(mean)
      if "`standardized'"=="" {
         local sd=r(sd)
      }
      else {
         local sd=1
      }
      qui replace ``i''=(``i''-`mean')/`sd'
   }
}

tempfile clvfiletmp
qui save `clvfiletmp',replace

qui su `1' [`weight'`exp']
local nbind=r(sum_w)


local cons=`consolidation'

if "`method'"!="polychoric"&"`method'"!="polychoricv2" {
   local totvar=0
   forvalues i=1/`nbitems' {
      qui su ``i'' [`weight'`exp']
      local totvar=`totvar'+`r(Var)'
   }
}
else {
   local totvar `nbitems'
}
local nbkerk=0
local nbkerg=0

if "`kernel'"!="" {
   local nbkerg:word count `kernel'
   local fin0=0
   forvalues i=1/`nbkerg' {
      local nbi`i':word `i' of `kernel'
      local nbkerk=`nbkerk'+`nbi`i''
      local deb`i'=`fin`=`i'-1''+1
      local fin`i'=`deb`i''+`nbi`i''-1
      local list`i'
      forvalues j=`deb`i''/`fin`i'' {
         local list`i' `list`i'' ``j''
      }
   }
   tempname kerclus
   matrix `kerclus'=J(`=`nbkerk'-`nbkerg'',3,0)
   local ligne=1
   forvalues g=1/`nbkerg' {
       matrix `kerclus'[`ligne',1]=`nbitems'+`ligne'
       matrix `kerclus'[`ligne',2]=`deb`g''
       matrix `kerclus'[`ligne',3]=`deb`g''+1
       local clus`g'=`nbitems'+`ligne'
       local ligne=`ligne'+1
       if `nbi`g''>2 {
          forvalues i=2/`=`nbi`g''-1' {
             matrix `kerclus'[`ligne',1]=`nbitems'+`ligne'
             matrix `kerclus'[`ligne',2]=`deb`g''+`i'
             matrix `kerclus'[`ligne',3]=`nbitems'+`ligne'-1
             local clus`g'=`nbitems'+`ligne'
             local ligne=`ligne'+1
          }
      }
   }
}
if `nbitems'<`nbkerk' {
   di in red "You cannot define more variables in the {hi:kernel} option than items in the {hi:varlist}"
   error 198
   exit
}
di
di in green "{hline 30}"
di in green "TOTAL VARIANCE: " in ye %14.3f `totvar'
di in green "NUMBER OF INDIVIDUALS: " in ye %7.0f `nbind'
di in green "METHOD:" in ye _col(`=31-length("`method'")') "`=upper("`method'")'"
di in green "{hline 30}"
di
if "`kernel'"!="" {
   forvalues i=1/`nbkerg' {
      di in green "The kernel numbered " in ye `clus`i'' in green " is composed of `nbi`i'' variables: " in ye "`list`i''"
      di
   }
}
else {
   local nbkerk=0
   local nbkerg=0
}
tempname Ev
if `none'!=1 {
   matrix `matclus'=J(`nbitems',`nbitems',0)
   matrix `vp'=J(`=2*`nbitems'-1',10,0)
   forvalues i=1/`nbitems' {
      matrix `matclus'[`i',1]=`i'
      if "`method'"!="polychoric"&"`method'"!="polychoric" {
         qui su ``i'' [`weight'`exp']
         matrix `vp'[`i',1]=r(Var)
      }
      else {
         matrix `vp'[`i',1]=1
      }
      matrix `vp'[`i',8]=`i'
      matrix `vp'[`i',9]=`totvar'
      matrix `vp'[`i',10]=100
   }
   matrix `vp'[`nbitems',3]=`nbitems'
   if "`method'"=="centroid" {
      local crit G
      di in green "{hline 89}"
      di in green _col(7) "Number of" _col(69) "`crit'" _col(71) "Explained" _col(82) "Relative"
      di in green "Step" _col(8) "clusters" _col(20) "Child 1" _col(33) "Child 2" _col(46) "Parent" _col(53) "`crit' value" _col(61) "variation" _col(72) "Variance"  _col(81) "Variation"
      di in green "{hline 89}"
   }
   else {
      local crit T
      di in green "{hline 100}"
      if "`method'"=="v2"|"`method'"=="polychoricv2" {
         di in green _col(84) "Maximal"
      }
      else {
         di in green _col(84) "Current"
      }
      di in green _col(7) "Number of" _col(69) "`crit'" _col(71) "Explained" _col(85) "Second" _col(93) "Relative"
      di in green "Step" _col(8) "clusters" _col(20) "Child 1" _col(33) "Child 2" _col(46) "Parent" _col(53) "`crit' value" _col(61) "variation" _col(72) "Variance" _col(81) "Eigenvalue" _col(92) "Variation"
      di in green "{hline 100}"
   }
   tempname threshold
   matrix `threshold'=J(`nbitems',3,0)
   forvalues i=1/`=`nbitems'-1' {
      local clus=`nbitems'+`i'
      local minegenval=999999
      local minegenval2=999999
      forvalues k=1/`=`clus'-1' {
         local list`k'
         local numlist`k'
         forvalues j=1/`clus' {
            if (`matclus'[`j',`i']==`k') {
               local list`k' `list`k'' ``j''
               local numlist`k' `numlist`k'' `j'
            }
         }
      }
      if `clus'>`nbitems'+`nbkerk'-`nbkerg' {
         if "`method'"=="centroid" {
            tempname centrj centrk diffjk
         }
         forvalues j=1/`clus' {
            local nblistj:word count `list`j''
            forvalues k=`=`j'+1'/`clus' {
               local nblistk:word count `list`k''
               if `nblistj'!=0&`nblistk'!=0 {
                  if "`method'"=="centroid" {
                     qui genscore `list`j'',score(`centrj') mean
                     qui su `centrj' [`weight'`exp']
                     local Varj=r(Var)
                     qui genscore `list`k'',score(`centrk') mean
                     qui su `centrk' [`weight'`exp']
                     local Vark=r(Var)
                     qui gen `diffjk'=`centrk'-`centrj'
                     qui su `diffjk' [`weight'`exp']
                     local Varjk=r(Var)
                     drop `centrj' `centrk' `diffjk'
                     local ev=(`nblistj'*`nblistk')/(`nblistj'+`nblistk')*`Varjk'
                     if `ev'<`minegenval' {
                        local minegenval=`ev'
                        local minj `j'
                        local mink `k'
                        local eigen=0
                        local eigen2=0
                     }
                  }
                  else {
                     if "`method'"=="classical"|"`method'"=="v2" {
                        qui pca `list`j'' `list`k'' [`weight'`exp'] ,cov
                        matrix `Ev'=e(Ev)
                     }
                     else if "`method'"=="polychoric"|"`method'"=="polychoricv2" {
                        qui polychoricpca `list`j'' `list`k'' [`weight'`exp']
                        matrix `Ev'=r(eigenvalues)
                     }
                     local lambda1=`Ev'[1,1]
                     local lambda2=`Ev'[1,2]
                     local ev=`vp'[`j',1]+`vp'[`k',1]-`lambda1'
                     local ev2=max(`vp'[`j',5],`vp'[`k',5],`lambda2')
                     if ("`method'"=="v2"|"`method'"=="polychoricv2")&`ev'<`minegenval' {
                        local eigen2=`lambda2'
                        local minegenval=`ev'
                        local eigen=`lambda1'
                        local minj `j'
                        local mink `k'
                     }
                     else if ("`method'"=="classical"|"`method'"=="polychoric")&`ev2'<`minegenval2' {
                        local minegenval2=`ev2'
                        local eigen2=`ev2'
                        local minegenval=`ev'
                        local eigen=`lambda1'
                        local minj `j'
                        local mink `k'
                     }
                  }
               }
            }
         }
      }
      else {
         local ligne=`clus'-`nbitems'
         local j=`kerclus'[`ligne',2]
         local k=`kerclus'[`ligne',3]
         if "`method'"!="centroid" {
            if "`method'"=="classical"|"`method'"=="v2" {
               qui pca `list`j'' `list`k'' [`weight'`exp'],cov
               matrix `Ev'=e(Ev)
            }
            else if "`method'"=="polychoric"|"`method'"=="polychoricv2"{
               qui polychoricpca `list`j'' `list`k''  [`weight'`exp']
               matrix `Ev'=r(eigenvalues)
            }
            local lambda1=`Ev'[1,1]
            local lambda2=`Ev'[1,2]
            local ev=`vp'[`j',1]+`vp'[`k',1]-`lambda1'
            local minegenval=`ev'
            local eigen=`lambda1'
            local minj `j'
            local mink `k'
            local eigen2=`lambda2'
         }
         else if "`method'"=="centroid" {
            local nblistj:word count `list`j''
            local nblistk:word count `list`k''
            tempname v1 v2 v12
            qui genscore `list`j'',score(`v1') mean
            qui genscore `list`k'',score(`v2') mean
            qui gen `v12'=`v1'-`v2'
            qui su `v12' [`weight'`exp']
            local varj=r(Var)
            local minegenval=(`nblistj'*`nblistk')/(`nblistj'+`nblistk')*`varj'
            local minj `j'
            local mink `k'
         }
      }
      if `minj'<=`nbitems' {
         local nomj=abbrev("``minj''",14)
      }
      else {
         local nomj `minj'
      }
      *set trace off
      if `mink'<=`nbitems' {
         local nomk=abbrev("``mink''",14)
      }
      else {
         local nomk `mink'
      }
      forvalues j=1/`nbitems' {
         matrix `matclus'[`j',`=`i'+1']=`matclus'[`j',`i']
      }
      if "`method'"!="centroid" {
         matrix `vp'[`clus',1]=`eigen'                            /*FIRST EIGEN VALUE OF THE NEW CLUSTER*/
         matrix `vp'[`clus',2]=`minegenval'                       /*VARIATION OF THE T CRITERION*/
         matrix `vp'[`clus',3]=`vp'[`=`clus'-1',3]-`vp'[`clus',2] /*T CRITERION*/
         matrix `vp'[`clus',4]=`vp'[`clus',2]/`vp'[`=`clus'-1',3] /*RELATIVE VARIATION OF THE T CRITERION*/
         matrix `vp'[`clus',5]=`eigen2'                           /*SECOND EIGEN VALUE OF THE NEW CLUSTER*/
         matrix `vp'[`clus',6]=`minj'                             /*CHILD 1*/
         matrix `vp'[`clus',7]=`mink'                             /*CHILD 2*/
         matrix `vp'[`clus',8]=`nbitems'+`i'                      /*NUMBER OF THE NEW CLUSTER*/
         matrix `vp'[`clus',9]=`vp'[`=`clus'-1',9]-`minegenval'   /*EXPLAINED VARIANCE*/
         matrix `vp'[`clus',10]=`vp'[`clus',9]/`totvar'*100       /*% OF EXPLAINED VARIANCE*/
      }
      else {
         matrix `vp'[`clus',1]=0                                  /*FIRST EIGEN VALUE OF THE NEW CLUSTER*/
         matrix `vp'[`clus',2]=`minegenval'                       /*VARIATION OF THE G CRITERION*/
         matrix `vp'[`clus',3]=`vp'[`=`clus'-1',3]-`vp'[`clus',2] /*G CRITERION*/
         matrix `vp'[`clus',4]=`vp'[`clus',2]/`vp'[`=`clus'-1',3] /*RELATIVE VARIATION OF THE T CRITERION*/
         matrix `vp'[`clus',5]=0                                  /*SECOND EIGEN VALUE OF THE NEW CLUSTER*/
         matrix `vp'[`clus',6]=`minj'                             /*CHILD 1*/
         matrix `vp'[`clus',7]=`mink'                             /*CHILD 2*/
         matrix `vp'[`clus',8]=`nbitems'+`i'                      /*NUMBER OF THE NEW CLUSTER*/
         matrix `vp'[`clus',9]=`vp'[`=`clus'-1',9]-`minegenval'   /*EXPLAINED VARIANCE*/
         matrix `vp'[`clus',10]=`vp'[`clus',9]/`totvar'*100       /*% OF EXPLAINED VARIANCE*/
      }
      foreach j of numlist `numlist`minj'' `numlist`mink''  {
         matrix `matclus'[`j',`=`i'+1']=`clus'
      }
      if "`kernel'"!=""&`i'==`=`nbkerk'-`nbkerg'+1' {
         local T=`vp'[`=`clus'-1',9]
         di _col(0) in ye "init" _col(12) %4.0f `=`nbitems'-`nbkerk'+`nbkerg'' _col(52) %8.4f `T' _col(62) %8.4f `=`totvar'-`T'' _col(72) %7.3f `=`T'/`totvar'*100' "%"
      }
      if `clus'>`nbitems'+`nbkerk'-`nbkerg' {
         if  `clus'==`nbitems'+`nbkerk'-`nbkerg'+1 {
            local relv
            local percent
         }
         else {
            local relv=(`minegenval'-`vp'[`=`clus'-1',2])/`vp'[`=`clus'-1',3]*100
            local percent %
            matrix `threshold'[`=`nbitems'-`i'+1',1]=`relv'
            matrix `threshold'[`=`nbitems'-`i'+1',3]=`minegenval'
            if `i'>1 {
               matrix `threshold'[`=`nbitems'-`i'+1',2]=`relv'-`threshold'[`=`nbitems'-`i'+2',1]
            }
         }
         if "`method'"=="centroid" {
            di _col(0) in ye %4.0f `=`i'-`nbkerk'+`nbkerg'' _col(12) %4.0f `=`nbitems'-`i'' _col(20) "`nomj'" _col(33) "`nomk'" _col(45) %7.0f `=`i'+`nbitems'' _col(52) %8.4f `vp'[`clus',9] _col(62) %8.4f `minegenval' _col(72) %7.3f `vp'[`clus',10] "%" _col(83) _col(84) %5.2f `relv' "`percent'"
         }
         else {
            di _col(0) in ye %4.0f `=`i'-`nbkerk'+`nbkerg'' _col(12) %4.0f `=`nbitems'-`i'' _col(20) "`nomj'" _col(33) "`nomk'" _col(45) %7.0f `=`i'+`nbitems'' _col(52) %8.4f `vp'[`clus',9] _col(62) %8.4f `minegenval' _col(72) %7.3f `vp'[`clus',10] "%" _col(83) %8.4f `vp'[`clus',5] _col(95) %5.2f `relv' "`percent'"
         }
      }
   }
   local i=2*`nbitems'-1
   local relv=(`vp'[`i',3]-`vp'[`i',2])/`vp'[`i',3]*100
   if "`method'"=="centroid" {
      di in ye _col(84) %5.2f `relv' "`percent'"
   }
   else {
      di in ye _col(95) %5.2f `relv' "`percent'"
   }
   matrix `threshold'[1,1]=`relv'
   matrix `threshold'[1,2]=`relv'-`threshold'[2,1]
   matrix `threshold'[1,3]=`vp'[`i',3]
   *matrix list `threshold'
   local best=0
   local maxbest=0
   local best2=0
   local maxbest2=0
   forvalues i=1/`nbitems' {
      if `threshold'[`i',3]>`maxbest2' {
         if `threshold'[`i',3]>`maxbest' {
            local maxbest2=`maxbest'
            local best2=`best'
            local maxbest=`threshold'[`i',3]
            local best=`i'
         }
         else {
            local maxbest2=`threshold'[`i',3]
            local best2=`i'
         }
      }
   }
   di in green "{hline 100}"
   di 
   di in green "{hline 24}"
   di in green "PROPOSED BEST PARTITIONS"
   di in green "{hline 24}"
   di
   di in yellow _col(4) "Based on the variation of the T criterion"
   di in green _col(10) "1. Partitions in " in ye `best' in green " clusters"
   di in green _col(10) "2. Partitions in " in ye `best2' in green " clusters"
   return local bestvariation `best' `best2'
   local bestt=0
   local bestt2=0
   local var=0
   local var2=0
   forvalues i=1/`nbitems' {
       if `threshold'[`i',2]>`var2'&`i'<`nbitems'-1 {
           if `threshold'[`i',2]>`var' {
              local bestt2=`bestt'
              local var2=`var'
              local var=`threshold'[`i',2]
              local bestt=`i'
           }
           else {
              local var2=`threshold'[`i',2]
              local bestt2=`i'
           }
       }
   }
   di in yellow _col(4) "Based on the research of a threshold"
   di in green _col(10) "1. Partitions in " in ye `bestt' in green " clusters"
   di in green _col(10) "2. Partitions in " in ye `bestt2' in green " clusters"
   forvalues i=`=`nbitems'+1'/`=`nbitems'+`nbkerk'-`nbkerg'' {
      matrix `vp'[`i',2]=`totvar'-`T'
      matrix `vp'[`i',9]=`T'
      matrix `vp'[`i',10]=`T'/`nbitems'*100
   }
   return local bestthresold `bestt' `bestt2'
}

if "`bar'"!="" {
   drop _all
   qui set obs `nbitems'
   qui svmat `vp' ,names(v)
   qui drop in 1/`nbitems'
   qui gen id=`nbitems'-_n
   qui drop if id>`nbitems'-`nbkerk'+`nbkerg'-1
   label variable id "Number of clusters"
   label variable v2 "T variation"
   graph twoway bar v2 id, name(bar,replace) vert ,ylabel(0(0.5)2) xlabel(1(1)`=`nbitems'-`nbkerk'+`nbkerg'-1')
}

drop _all
qui set obs `nbitems'
qui svmat `matclus' ,names(v)
local listorder
forvalues i=`nbitems'(-1)1 {
   local listorder `listorder' v`i'
}
qui gen id=_n
qui sort `listorder'

capture cluster delete clv,zap
qui cluster complete v* ,name(clv)

qui replace clv_id=_n
qui replace clv_ord=id
qui replace clv_hgt=.

qui  gen fait=0
qui gen clus=0
forvalues i=2/`nbitems' {
   local ligne=`nbitems'+`i'-1
   if (`vp'[`ligne',6]<=`nbitems') {
      local first=`vp'[`ligne',6]
      gsort +fait -v`i'  +clv_id
   }
   else {
      local first=`vp'[`ligne',7]
      gsort +fait -v`i'  +clv_id
   }
   if "`deltaT'"!="" {
      qui replace clv_hgt=`vp'[`ligne',2] in 1
   }
   else {
      qui replace clv_hgt=100-`vp'[`ligne',10] in 1
   }
   qui replace fait=1 in 1
   qui replace clus=`vp'[`ligne',8] in 1
}
qui gen label=""
forvalues i=1/`nbitems' {
   qui replace label=abbrev("`label`i''",`abbrev') if clv_id==`i'
}
sort clv_id
if `nbitems'>`cutnumber' {
   local var "Groups of variables"
   local cut cutnumber(`cutnumber') /*labcutn*/
}
else {
   local var "Variables"
   local cut label(label)
}
qui su clv_hgt
local tmp=r(max)
local max=floor(`tmp')+.5
if `tmp'>`max' {
   local max=`max'+.5
}
local maxvar=`max'+5
if "`dendro'"=="" {
   if "`title'"=="" {
      local title "Clustering around Latent Variables (CLV)"
   }
   if "`caption'"!="" {
      local var "`caption'"
   }
   if "`deltaT'"!="" {
      local titleL "Variation of the T criterion"
      local yl "0(.5)`max'"
   }
   else {
      local titleL "% Unexplained Variance"
      local yl "0(25)`maxvar'"
   }
   if "`horizontal'"!="" {
      cluster dendro clv,  name (dendrogram,replace) hor ytitle("`var'") `showcount' xtitle("`titleL'") title("`title'",span) xlabel(`yl') ylabel(,angle(0)) `cut'
   }
   else {
      cluster dendro clv, name(dendrogram,replace)  xtitle("`var'") `showcount' ytitle("`titleL'") title("`title'",span) ylabel(`yl') `cut'
   }
}

if `cons'>`nbitems'-`nbkerk'+`nbkerg' {
   di in ye "The {hi:consolidation} is not possible for a number of clusters superior to the initial number of clusters"
   local cons=0
}

if `cons'!=0 {
   sort v`=`nbitems'-`cons'+1'
   gen cut`cons'=1
   local g=1
   forvalues i=2/`nbitems' {
      if v`=`nbitems'-`cons'+1'[`i']!=v`=`nbitems'-`cons'+1'[`=`i'-1'] {
         local g=`g'+1
      }
      qui replace cut`cons'=`g' in `i'
   }
   sort id
   tempname group
   mkmat cut`cons',matrix(`group')

   *cluster generate cut = groups(2/9) , name(clv)
   use `clvfiletmp',replace

   local n=1
   local env=1
   while (`env'==1) {
      forvalues g=1/`cons' {
         local list`g'
         forvalues i=1/`nbitems' {
            if `group'[`i',1]==`g' {
               local list`g' `list`g'' ``i''
            }
         }
      }
      di
      if `n'==1 {
         di in green "{hline 30}"
         di in green "PARTITION BEFORE CONSOLIDATION"
         di in green "{hline 30}"
      }
      di
      local col=1
      local max=0
      local critT=0
      forvalues g=1/`cons' {
         di _col(`col') in green "GROUP " %2.0f `g' _c
         local col=`col'+10
         local tmp`g':word count `list`g''
         if `tmp`g''>`max' {
            local max `tmp`g''
         }
         tempvar f1`g'
         if "`method'"=="centroid" {
               qui genscore `list`g'',score(`f1`g'') mean
               qui su `f1`g'' [`weight'`exp']
               local var=r(Var)
               local critT=`critT'+`tmp`g''*`var'
         }
         else {
            if `tmp`g''>1 {
               if "`method'"=="classical"|"`method'"=="v2" {
                  qui pca `list`g'' [`weight'`exp'] ,cov
                  matrix `Ev'=e(Ev)
                  qui predict `f1`g''
               }
               else if "`method'"=="polychoric"|"`method'"=="polychoric" {
                  qui polychoricpca `list`g'' [`weight'`exp'] ,score(`f1`g'') nscore(1)
                  matrix `Ev'=r(eigenvalues)
                  rename `f1`g''1 `f1`g''
               }
               local lambda1=`Ev'[1,1]
               local critT=`critT'+`lambda1'
            }
            else {
               qui gen `f1`g''=`list`g''
               if "`standardized'"=="" {
                   local critT=`critT'+1
               }
               else  {
                  qui su [`weight'`exp']
                  local critT=`critT'+`r(Var)'
               }
            }
         }
      }
      di
      forvalues i=1/`max' {
         local col=1
         forvalues g=1/`cons' {
            local tmpv:word `i' of `list`g''
            local tmpv=abbrev("`tmpv'",8)
            di _col(`col') in ye %8s "`tmpv'"  _c
            local col= `col'+10
         }
         di
      }
      di
      di in green "Variance Explained : " in ye %6.3f  `=`critT'/`totvar'*100' in green "%"
      di in green "T criterion : " in ye %6.4f  `critT'
      di
      di in green "{hline 21}"
      di in green "CONSOLIDATION: STEP `n'"
      di in green "{hline 21}"
      local n=`n'+1
      local env=0
      if "`method'"=="polychoric"|"`method'"=="polychoricv2" {
         local command polychoric
      }
      else {
         local command corr
      }
      forvalues i=1/`nbitems' {
         local env`i'=0
         local gr=`group'[`i',1]
         qui `command' ``i'' `f1`gr'' [`weight'`exp']
         local corr`i'=r(rho)
         local corrs`i'=r(rho)
         forvalues g=1/`cons' {
            qui `command' ``i'' `f1`g'' [`weight'`exp']
            local tmpcorr=r(rho)
            if `g'!=`gr'&(((`corr`i'')<(`tmpcorr')&"`method'"=="centroid")|((`corr`i'')^2<(`tmpcorr')^2& "`method'"!="centroid")) {
               local env=1
               local env`i'=1
               matrix `group'[`i',1]=`g'
               local corr`i'=`tmpcorr'
            }
         }
         if `env`i''==1 {
            local g=`group'[`i',1]
            di in green  "The variable " in ye "``i'' " in green "is assigned to the `g'th group" _c
            if "`method'"!="centroid" {
               di in green " (corr^2=" %6.4f in ye  (`corr`i'')^2 in green " vs " in ye %6.4f (`corrs`i'')^2 in green ")"
            }
            else {
               di in green " (corr=" %6.4f in ye  (`corr`i'') in green " vs " in ye %6.4f (`corrs`i'') in green ")"
            }

         }
      }
      if `env'==0 {
         local latent
         forvalues g=1/`cons' {
             label variable `f1`g'' "Latent variable `g'"
             if "`genlv'"!="" {
                gen `genlv'`g'=`f1`g''
             }
             local latent `latent' `f1`g''
             return local cluster`g' `list`g''
         }
         matrix `group'=`group''
         matrix colnames `group'=`varlist'
         return matrix affect=`group'
         di in ye "Stability of the partition is achieved"
         if `cons'<=7 {
            di
            di in green "{hline 42}"
            di in green "CORRELATION MATRIX OF THE LATENT VARIABLES"
            di in green "{hline 42}"
            di
            di in green "{hline `=(`cons')*13+15'}"
            forvalues g=1/`cons' {
               di _col(`=13*(`g'-1)+23') in green "Latent" _c
            }
            di
            forvalues g=1/`cons' {
               di _col(`=13*(`g'-1)+19') in green "variable `g'" _c
            }
            di
            di in green "{hline `=(`cons')*13+15'}"
            forvalues g=1/`cons' {
               di in green "Latent variable `g'" _c
               forvalues h=1/`g' {
                  local loc=13*`h'+10
                  qui corr `f1`g'' `f1`h'' [`weight'`exp']
                  local rho=r(rho)
                  di _col(`loc') in ye %6.4f `rho' _c
               }
               di
            }
            di in green "{hline `=(`cons')*13+15'}"
            di
         }
         if `nbind'<=800&"`biplot'"==""&"`weight'"=="" {
            local max=max(`matsize',`nbind')
            set matsize `max'
            if "`addvar'"!="" {
               local add `varlist'
            }
            qui biplotvlab `latent' `add', name(biplot,replace) norow colopts(name(latent variables)) alpha(0) title(Biplot of the latent variables) labdes(size(vsmall) color(blue)) stretch(1)
         }
         else if `nbind'>800&"`biplot'"==""&"`weight'"==""{
            di in green "There is more than 800 individuals, so the {hi:biplot} option is disabled"
         }
         else if "`weight'"!=""&&"`biplot'"==""{
            di in green "The {hi:biplot} option is disabled because you use weights"
         }
      }
      forvalues g=1/`cons' {
         drop `f1`g''
      }
   }
}
set matsize `matsize'
use `clvfile',replace
capture cluster delete clv,zap
return matrix vp=`vp'
return matrix matclus=`matclus'
return local varlist `varlist'
return local method `method'
return local kernel `kernel'
end