You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
799 lines
28 KiB
Plaintext
799 lines
28 KiB
Plaintext
*! 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é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
|