###### load(url("http://bayes.acs.unt.edu:8083/BayesContent/marcy.RData")) # Omega Coefficient on each subscale loadings<-c(1,.843,.847) loadings.sum<-sum(loadings) loadings.sum.sq<-loadings.sum^2 loadings.sq<-loadings^2 uniques<-1-loadings.sq sum.uniques<-sum(uniques) loadings.sum.sq/(loadings.sum.sq+sum.uniques) loadings<-c(.840,.999,.816) loadings.sum<-sum(loadings) loadings.sum.sq<-loadings.sum^2 loadings.sq<-loadings^2 uniques<-1-loadings.sq sum.uniques<-sum(uniques) loadings.sum.sq/(loadings.sum.sq+sum.uniques) loadings<-c(.895,.809,.807) loadings.sum<-sum(loadings) loadings.sum.sq<-loadings.sum^2 loadings.sq<-loadings^2 uniques<-1-loadings.sq sum.uniques<-sum(uniques) loadings.sum.sq/(loadings.sum.sq+sum.uniques) # loadings<-c(.836,.872,.333,.316,.827) loadings.sum<-sum(loadings) loadings.sum.sq<-loadings.sum^2 loadings.sq<-loadings^2 uniques<-1-loadings.sq sum.uniques<-sum(uniques) loadings.sum.sq/(loadings.sum.sq+sum.uniques) # loadings<-c(.648,.780,.509,.693) loadings.sum<-sum(loadings) loadings.sum.sq<-loadings.sum^2 loadings.sq<-loadings^2 uniques<-1-loadings.sq sum.uniques<-sum(uniques) loadings.sum.sq/(loadings.sum.sq+sum.uniques) # Omega Coefficient on all subscales (appropriate to use) loadings<-c(1,.843,.847,.648,.840,.999,.816,.895,.809,.807,.780,.509,.693) loadings.sum<-sum(loadings) loadings.sum.sq<-loadings.sum^2 loadings.sq<-loadings^2 uniques<-1-loadings.sq sum.uniques<-sum(uniques) loadings.sum.sq/(loadings.sum.sq+sum.uniques) ### Using Cronbach's Alpha (inappropriate to use ...really...) # Linking Objects # Keptobjects # HaveNotKept # Gaveawayll # Living Legacy # Carryoutwishes # Findselfdoing # Trytothink # Ongoing Expressions of Love # Lovewilltransce # Tellchild # Expresslove # Reminiscing About the Deceased # Talkaboutchild # MemorComfort # Talkwhenmiss attach(marcy) marcy2.dat<-cbind(KEPTOBJE,HAVENOTK , GAVEAWAY , CARRYOUT , FINDSELF , TRYTOTHI,LOVEWILL , TELLCHIL , EXPRESSL , TALKABOU , MEMORCOM,TALKWHEN) marcy2.dat<-ifelse(marcy2.dat==999,NA,marcy2.dat) marcy2.dat<-data.frame(marcy2.dat) marcy2.dat library(car) marcy2.dat$GAVEAWAY <- recode(marcy2.dat$GAVEAWAY, '7=1; 6=2; 5=3; 1=7; 2=6; 3=5', as.factor.result=FALSE) marcy2.dat$HAVENOTK <- recode(marcy2.dat$HAVENOTK, '7=1; 6=2; 5=3; 1=7; 2=6; 3=5', as.factor.result=FALSE) marcy2.dat library(sem) library(Hmisc) library(MASS) library(rrcov) library(e1071) marcy3.dat<-impute(marcy2.dat, what="median") marcy3.dat<-data.frame(marcy3.dat) apply(marcy3.dat, 2, stem) library(Hmisc) marcy3b.optimal.dat<-areg.boot(as.matrix(marcy3.dat)) marcy3.optimal.df<-data.frame(marcy3.optimal.dat) scatterplot.matrix(~jitter(CARRYOUT)+jitter(EXPRESSL)+ jitter(FINDSELF) +jitter(GAVEAWAY)+jitter(HAVENOTK)+jitter(KEPTOBJE), reg.line=lm, smooth=TRUE, span=1.5, diagonal = 'density', data=marcy3.optimal.df) scatterplot.matrix(~jitter(LOVEWILL)+jitter(MEMORCOM)+jitter(TALKABOU) +jitter(TALKWHEN)+jitter(TELLCHIL)+jitter(TRYTOTHI), reg.line=lm, smooth=TRUE, span=1.5, diagonal = 'density', data=marcy3.optimal.df) scatterplot.matrix(~jitter(CARRYOUT)+jitter(EXPRESSL)+ jitter(FINDSELF) +jitter(GAVEAWAY)+jitter(HAVENOTK)+jitter(KEPTOBJE) +jitter(LOVEWILL)+jitter(MEMORCOM)+jitter(TALKABOU) +jitter(TALKWHEN)+jitter(TELLCHIL)+jitter(TRYTOTHI), reg.line=lm, smooth=TRUE, span=1.5, diagonal = 'density', data=marcy3.optimal.df) marcy3.optimal.dat<-data.frame(marcy3.optimal.dat) detach(package:Hmisc) apply(marcy3.optimal.dat, 2, stem) marcy3.cor<-cor(marcy3.optimal.dat, method="kendall") marcy3.cor # Comment Section: # Arbitrary Path Loading Name # Factor Path for Items | Item 1 on Factor 1 to Item 6 on Factor 2 # | | # | | Fix variance of path loading # Model Setup: | | | NA means not used # V V V model.f1<-matrix(c('F1->KEPTOBJ' , 'lam11' , 1, 'F1->HAVENOTK' , 'lam12' ,NA, 'F1->GAVEAWAY' , 'lam13' ,NA, 'F2->CARRYOUT' , 'lam21' ,1, 'F2->FINDSELF' , 'lam22' ,NA, 'F2->TRYTOTHI' , 'lam23' ,NA, 'F3->LOVEWILL' , 'lam31' ,1, 'F3->TELLCHIL' , 'lam32' ,NA, 'F3->EXPRESSL' , 'lam33' ,NA, 'F4->TALKABOU' , 'lam41' ,1, 'F4->MEMORCOM' , 'lam42' ,NA, 'F4->TALKWHEN ' , 'lam43' ,NA, 'KEPTOBJ<->KEPTOBJ', 'th1' ,NA, 'HAVENOTK<->HAVENOTK', 'th2' ,NA, 'GAVEAWAY<->GAVEAWAY', 'th3' ,NA, 'CARRYOUT<->CARRYOUT', 'th4' ,NA, 'FINDSELF<->FINDSELF', 'th5' ,NA, 'TRYTOTHI<->TRYTOTHI', 'th6' ,NA, 'LOVEWILL<->LOVEWILL', 'th7' ,NA, 'TELLCHIL<->TELLCHIL', 'th8' ,NA, 'EXPRESSL<->EXPRESSL', 'th9' ,NA, 'TALKABOU<->TALKABOU', 'th10' ,NA, 'MEMORCOM<->MEMORCOM', 'th11' ,NA, 'TALKWHEN<->TALKWHEN', 'th12' ,NA, 'F1<->F1', NA , 1, 'F2<->F2', NA , 1, 'F3<->F3', NA , 1, 'F4<->F4', NA , 1), ncol=3, byrow=T) # Print the model that is to be estimated: model.f1 # Names for Items obs.vars.f1<-c('KEPTOBJ','HAVENOTK','GAVEAWAY','CARRYOUT','FINDSELF','TRYTOTHI','LOVEWILL', 'TELLCHIL','EXPRESSL','TALKABOU','MEMORCOM','TALKWHEN') # Estimate the Confirmatory Factor Analysis (CFA) sem.f1<-sem(model.f1, marcy3.cor, 47, obs.vars.f1, maxiter=2000, par.size="startvalues") summary(sem.f1) stem(normalized.residuals(sem.f1)) # Calculate Reliability of the Inventory using Omega and Cronbach Alpha # Omega is both a reliability coefficient and a validity coefficient # Cronbach technically shouldn't be used on a multdimensional inventory # But Omega can be used on a multidimensional inventory since the # errors and loadings are estimated seperately loadings<-summary(sem.f1)$coeff[1:12,1] loadings.sum<-sum(loadings) loadings.sum.sq<-loadings.sum^2 uniqueness<-1-loadings^2 unique.sum<-sum(uniqueness) omega<-loadings.sum.sq/(loadings.sum.sq+unique.sum) omega library(psy) cronbach(marcy3.optimal.dat) ####################################################################### # Continuing Bond marcy3.optimal.dat<-data.frame(marcy3.optimal.dat) cont.bond.f<-factanal(~KEPTOBJE+HAVENOTK+GAVEAWAY+CARRYOUT+FINDSELF+ TRYTOTHI+LOVEWILL+TELLCHIL+EXPRESSL+ TALKABOU+MEMORCOM+TALKWHEN, cov.mat=marcy3.cor, factors=4, rotation="varimax", scores="regression", data=marcy3.optimal.dat) living.legacy.f1<-cont.bond.f$scores[,1] ongoing.express.f2<-cont.bond.f$scores[,2] linking.objects.f3<-cont.bond.f$scores[,3] reminisc.f4<-cont.bond.f$scores[,4] cont.bond.scale<-cbind(living.legacy.f1, ongoing.express.f2, linking.objects.f3, reminisc.f4) cont.bond.scale<-data.frame(cont.bond.scale) cont.bond.scale.sum<-apply(cont.bond.scale, 1, sum) cont.bond.scale.sum ########################################################################## marcy.f1<-factanal(~CLEARGOA+DISCOVPU+EXCITING+FULFILLE+FUTUREDI +MISSIONI+PASTACHI, factors=1, rotation="varimax", scores="regression", data=marcy) marcy.f1 marcy.f2<-factanal(~LIFEMEAN+CONSUMPU+PHILOSOF+REASONFO +LIFEFRAM+UNIFIEDL+ULTIMATE+EXISTENC, factors=1, rotation="varimax", scores="regression", data=marcy) marcy.f2 marcy.f3<-factanal(~OWNEFFOR+DETERMWH+FREEDOMT +DOWHATIW+LIFEINMY+MAKEOWND, factors=1, rotation="varimax", scores="regression", data=marcy) marcy.f3 marcy.f4<-factanal(~LESSCONC+DEATHLIT+UNCNCERN+NEITHRFE +NOSENSEW+UNAFRAID+DTHTHOUG, factors=1, rotation="varimax", scores="regression", data=marcy) marcy.f4 marcy.f5<-factanal(~CHNGMAIN+ELEMENTM+LACKMEAN +UNCERTAI+DAYDRMNE+DONTCARE+BORNGUNE, factors=1, rotation="varimax", scores="regression", data=marcy) marcy.f5 marcy.f6<-factanal(~NEWTHNGS+NEEDFORN +NEWCHALL+EAGERMOR+ACHIEVEN, factors=1, rotation="varimax", scores="regression", data=marcy) marcy.f6 life.attitude.scale.1.4<-cbind(marcy.f1$scores,marcy.f2$scores,marcy.f3$scores, marcy.f4$scores) life.attitude.scale.5.6<-cbind(marcy.f5$scores,marcy.f6$scores) life.1.4.sum<-apply(life.attitude.scale.1.4, 1, sum) life.5.6.sum<-apply(life.attitude.scale.5.6, 1, sum) life.attitude.scale.sum<-life.1.4.sum-life.5.6.sum life.attitude.scale.sum contbond.lifeatt<-data.frame(cont.bond.scale.sum, life.attitude.scale.sum) contbond.lifeatt ######################################################################### library(car) marcy$STILLCRY <- recode(marcy$STILLCRY, '7=1; 6=2; 5=3; 1=7; 2=6; 3=5', as.factor.result=FALSE) marcy$PREOCCUP <- recode(marcy$PREOCCUP, '7=1; 6=2; 5=3; 1=7; 2=6; 3=5', as.factor.result=FALSE) grief<-factanal(~INTENSDE+PREOCCUP+STILLCRY+ THINKWIT, factors=1, rotation="varimax", scores="regression", data=marcy) grief.scale<-apply(grief$scores,1,print) grief.scale ############################################################################ marcy.all.dat<-data.frame(grief.scale,cont.bond.scale.sum, life.attitude.scale.sum) library(MASS) marcy.all.dat.cor<-cov.rob(marcy.all.dat, cor=TRUE, nsamp="exact") marcy.all.dat.cor marcy.all.robust.fit<-rlm(cont.bond.scale.sum ~ grief.scale + life.attitude.scale.sum, data=marcy.all.dat) summary(aov(marcy.all.robust.fit))