[Sem-additions-commits] r8 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 3 20:17:27 CEST 2010
Author: jebyrnes
Date: 2010-05-03 20:17:27 +0200 (Mon, 03 May 2010)
New Revision: 8
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/delta_matrix.R
pkg/R/robust_summary.R
pkg/R/update.model.r
pkg/man/rmsea.power.Rd
Log:
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2010-04-24 21:41:19 UTC (rev 7)
+++ pkg/ChangeLog 2010-05-03 18:17:27 UTC (rev 8)
@@ -1,3 +1,7 @@
+2010-05-02 JEB
+ - changed delta_matrix to accomodate parameter constraints
+2010-04-24 JEB
+ - fixed latent variable and fixed value bugs in model.to.ram
2010-04-20 JEB
- added anova.adjchisq which uses the SB corrected ANOVA for nested model comparison
- now correct the forth moment by n instead of n-1 (suggestion from Yves Rosseel)
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2010-04-24 21:41:19 UTC (rev 7)
+++ pkg/DESCRIPTION 2010-05-03 18:17:27 UTC (rev 8)
@@ -1,6 +1,6 @@
Package: sem.additions
-Version: 0.1-10
-Date: 2010-04-20
+Version: 0.1-13
+Date: 2010-05-02
Title: Additional Methods for Structural Equation Modelling
Author: Jarrett Byrnes <byrnes at msi.ucsb.edu>
Maintainer: Jarrett Byrnes <byrnes at msi.ucsb.edu>
Modified: pkg/R/delta_matrix.R
===================================================================
--- pkg/R/delta_matrix.R 2010-04-24 21:41:19 UTC (rev 7)
+++ pkg/R/delta_matrix.R 2010-05-03 18:17:27 UTC (rev 8)
@@ -4,69 +4,43 @@
# Adapted from SPSS code by Peter Bentler
#
# Changelog
+#5/2/10 - updated by John Fox for efficiency
+# 4/28/10 - modified to look at paramters instead of individual paths
# 3/5/10 - fixed bug of not adjusting for correlated disturbance on both parts of P matrix
# 2/8/10 - fixed bug of using fixed params
# 9/1/08 - fixed matrix selection bug
##
-delta_matrix<-function(sem.object, adj=1e-04){
- p.star<-sem.object$n*(sem.object$n+1)/2
- #nparams<-length(sem.object$ram[,1])
- #only use free parameters
- par.idx<-which(sem.object$ram[,"parameter"]>0)
- nparams<-length(par.idx)
- delta.mat<-matrix(0,nparams, p.star)
- rownames(delta.mat)<-rep(NA, nparams)
- colnames(delta.mat)<-vech(matrix.names(sem.object$C))
- vars<-sem.object$var.names
-
- C.vect<-vech(sem.object$C)
- J<-sem.object$J
- m<-sem.object$m
-
- #iterate through the ram
- #but only look at free params
- for (i in 1:nparams){
- A<-sem.object$A
- P<-sem.object$P
- from<-sem.object$ram[par.idx[i],2]
- to<-sem.object$ram[par.idx[i],3]
- path_type <-sem.object$ram[par.idx[i],1]
- if(path_type==1){
- A[from, to] <-
- A[from, to] + adj
- }else{
- P[from, to]<- P[from,to]+adj
-
-
- #symmetric P matrix
- P[to, from]<- P[to,from]
+delta_matrix <- function (sem.object, adj = 1e-04) {
+ p.star <- sem.object$n * (sem.object$n + 1)/2
+ pars <- names(sem.object$coeff)
+ nparms <- length(pars)
+ delta.mat <- matrix(0, nparms, p.star)
+ rownames(delta.mat) <- pars
+ vars <- sem.object$var.names
+ J <- sem.object$J
+ m <- sem.object$m
+ for (j in 1:nparms) {
+ A <- sem.object$A
+ P <- sem.object$P
+ i <- which(rownames(sem.object$ram) == pars[j])
+ from <- sem.object$ram[i, 2]
+ to <- sem.object$ram[i, 3]
+ path_type <- sem.object$ram[i, 1][1]
+ if (path_type == 1){
+ AA <- A[cbind(from, to)][1]
+ adjust <- abs(AA) * adj
+ A[cbind(from, to)] <- AA + adjust
+ }
+ else {
+ PP <- P[cbind(to, from)][1]
+ adjust <- PP * adj
+ P[cbind(from, to)] <- P[cbind(to, from)] <- PP +
+adjust
+ }
+ I.Ainv <- solve(diag(m) - A)
+ C <- J %*% I.Ainv %*% P %*% t(I.Ainv) %*% t(J)
+ delta.mat[j, ] <- (vech(C) - vech(sem.object$C))/adjust
}
-
- I.Ainv <- solve(diag(m) - A)
-
- #calculate fitted covarianve matrix from RAM form
- #C= J(Im A) 1P[(Im A) 1]J using the RAM formulation
- C <- J %*% I.Ainv %*% P %*% t(I.Ainv) %*% t(J)
- C.vech<-vech(C)
-
- #get difference with model cov matrix / adj
- #linearize, and put into delta matrix
- delta.mat[i,]<-(C.vech - C.vect)/adj
- rownames(delta.mat)[i] <-rownames(sem.object$ram)[par.idx[i]]
- if(rownames(delta.mat)[i] ==""){
- rownames(delta.mat)[i] <-
- paste(vars[sem.object$ram[par.idx[i],3]],
- vars[sem.object$ram[par.idx[i],2]],
- sep="-")
- }
-
-
- }
-
- #whoops! reversed rows and cols - here's a quick fix
- delta.mat<-t(delta.mat)
-
- return(delta.mat)
-
-}
\ No newline at end of file
+ t(delta.mat)
+}
Modified: pkg/R/robust_summary.R
===================================================================
--- pkg/R/robust_summary.R 2010-04-24 21:41:19 UTC (rev 7)
+++ pkg/R/robust_summary.R 2010-05-03 18:17:27 UTC (rev 8)
@@ -6,15 +6,18 @@
if (is.na(adj.obj[1])) {
adj.obj <- sbchisq(sem.obj, data.obj, useFit = useFit, useGinv= useGinv)
}
- ses <- robust_se(sem.obj, adj.obj = adj.obj, useGinv=adj.obj$ginvFlag)
- se <- rep(NA, length(ses))
- index<-0
- for (i in 1:length(sem.obj$ram[, 1])) {
- if (sem.obj$ram[i, 4] > 0) {cat(rownames(sem.obj$ram[i]))
- index<-index+1
- se[index] <- ses[index]
- }
- }
+ se <- robust_se(sem.obj, adj.obj = adj.obj, useGinv=adj.obj$ginvFlag)
+ #se <- rep(NA, length(ses))
+
+ #deals with fixed parameters
+ #taken out with new delta matrix
+# index<-0
+# for (i in 1:length(sem.obj$ram[, 1])) {
+# if (sem.obj$ram[i, 4] > 0) {cat(rownames(sem.obj$ram[i]))
+# index<-index+1
+# se[index] <- ses[index]
+# }
+# }
z <- sem.obj$coef/se
p <- 2 * (1 - pnorm(abs(z)))
Modified: pkg/R/update.model.r
===================================================================
--- pkg/R/update.model.r 2010-04-24 21:41:19 UTC (rev 7)
+++ pkg/R/update.model.r 2010-05-03 18:17:27 UTC (rev 8)
@@ -51,6 +51,7 @@
#now, run through the old model, and change things as needed
old.model<-split.model(old.model)
newmodel<-""
+ changedlines<-vector()
for(i in 1:length(old.model)){
#first, see if anything in the list matches
newline<-old.model[i]
@@ -58,6 +59,7 @@
if(!is.na(op)){
a.formula<-clean.modline(old.model[i])
lookup<-changelist[[paste(response(a.formula), op, sep="")]]
+ changedlines<-c(changedlines, paste(response(a.formula), op, sep=""))
if(!is.null(lookup)){
#OK, now, update the formula
a.formula<-update(a.formula, paste(response(a.formula),"~", lookup, sep=""))
@@ -77,6 +79,16 @@
newmodel<-paste(newmodel, newline, "\n", sep="")
}
+ #now see if there are any newlines for the new model
+ newEqns<-which(!(names(changelist) %in% changedlines))
+ if(length(newEqns>0)){
+ for(i in newEqns){
+ newmodel<-paste(newmodel, names(changelist)[i], changelist[[i]], "\n", sep="")
+
+ }
+
+ }
+
return(newmodel)
}
#
Modified: pkg/man/rmsea.power.Rd
===================================================================
--- pkg/man/rmsea.power.Rd 2010-04-24 21:41:19 UTC (rev 7)
+++ pkg/man/rmsea.power.Rd 2010-05-03 18:17:27 UTC (rev 8)
@@ -25,9 +25,9 @@
MacCallum et al. (1996) suggest three typical and meaningful tests:
\describe{
- \item{Test of close fit: rmsea.ha = 0.08, rmsea.h0 = 0.05}
- \item{Test of not-close fit: rmsea.ha = 0.01, rmsea.h0 = 0.05}
- \item{Test of exact fit: rmsea.ha = 0.05, rmsea.h0 = 0.00}
+ \item{1}{Test of close fit: rmsea.ha = 0.08, rmsea.h0 = 0.05}
+ \item{2}{Test of not-close fit: rmsea.ha = 0.01, rmsea.h0 = 0.05}
+ \item{3}{Test of exact fit: rmsea.ha = 0.05, rmsea.h0 = 0.00}
}
}
More information about the Sem-additions-commits
mailing list