From noreply at r-forge.r-project.org  Mon May  3 20:17:27 2010
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  3 May 2010 20:17:27 +0200 (CEST)
Subject: [Sem-additions-commits] r8 - in pkg: . R man
Message-ID: <20100503181728.023769C90A@r-forge.r-project.org>

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}
  }
 }