Attachment | Size |
---|---|
dsetA.txt | 192.76 KB |
I have a question. I looked at the package sem and lavaan.survey for the factor analysis but sem doesn't support weights and lavaan.survey doesn't have FIML. Without FIML, lavaan.survey was still able to do the job of getting the expected graphs (smooth curves) but with OpenMx, it does not work. I get straight lines.
The code is below and the data set is in the attachment. I don't know if the weights are calculated with the data in the analysis.
dsetA <- read.table("dsetA.txt",sep="")
Possible values of the weighting variable
valm <- seq(21,40,by=1/10)
Weight matrix: Use radial basis function
library(kernlab)
matx <- as.matrix(valm)
rbf <- rbfdot(sigma = 1)
kerm <- kernelMatrix(rbf, matx)
vali <- seq(1,191,by=10) #indices of the valm in the matrix
matn <- kerm[vali,]
wmat <- matrix(NA,nrow=nrow(dsetA),ncol=191)
Size per value of weighting variable
ws <- c(199,258,289,316,414,230,225,213,225,278,316,345,321,193,332,317,326,228,297,311)
for(i in 1:191){wmat[,i] <- rep(matn[,i],ws)} #kernel weights
wmat[wmat < 0.0001] <- 0
Data per value of the weighting variable
dataNeo <- replicate(191,list())
for(i in 1:191){dataNeo[[i]] <- data.frame(dsetA[,c("neo1","neo2","neo3","neo4","neo5","neo6","neo7","neo8")],wmat[,i])
names(dataNeo[[i]]) <- c("neo1","neo2","neo3","neo4","neo5","neo6","neo7","neo8","weight")}
Item names
neodim <- c("neo1","neo2","neo3","neo4","neo5","neo6","neo7","neo8")
require(OpenMx)
FNeo <- mxModel("neoanal",
mxMatrix( type="Full", nrow=8, ncol=1, values=rep(1,8), free=c(T,T,F,rep(T,5)),lbound = c(NA,rep(0.01,7)), name="facneo" ),
mxMatrix( type="Symm", nrow=1, ncol=1, values=2, free=T, lbound=0.01,name="fvarneo" ),
mxMatrix( type="Diag", nrow=8, ncol=8, free=T, values=rep(1,8), lbound = rep(0.01,8),
name="resneo" ),
mxMatrix( type="Full", nrow=1, ncol=8, values=c(2,2,0,rep(2,5)), free=c(T,T,F,rep(T,5)), lbound = c(-5,-5,NA,rep(-5,5)), name="intneo" ),
mxMatrix( type="Full", nrow=1, ncol=1, values=4, free=T, lbound = 0.01,name="fmeanneo" ),
mxAlgebra( expression= facneo %&% fvarneo + resneo,
name="covneo" ),
mxAlgebra(expression= intneo + t(facneo %*% fmeanneo),
name="meanneo" ),
mxFIMLObjective( covariance="covneo", means="meanneo", dimnames=neodim,vector=TRUE)
)
neoms <- replicate(191,list())
for(i in 1:191){neoms[[i]] <- mxModel(paste("neofactor",i,sep=""),FNeo,mxData(dataNeo[[i]], type="raw"),
mxAlgebra(-2 * sum(data.weight %x% log(neoanal.objective)), name = "neoobj"),mxAlgebraObjective("neoobj"))}
parneo <- list()
for(i in 1:191) {parneo[[i]] <- omxGetParameters(mxRun(neoms[[i]]))}
Example graph
parplot <- numeric(191)
for(i in 1:191){parplot[i] <- parneo[[i]][1]}
plot(parplot,type="l",col=6,lwd=1.5,ylim=c(0.60,0.70)
The graph is not a smooth curve?
Thanks.
Anyone has an idea why the weights are not calculated in the analysis? Thanks for the input.
Your current script weights the entire likelihood vector by a single number, data.weight. The use of the %x% operator indicates this. I suspect you wanted to weight each row of the likelihood function by elements of data.weight.
Replace
with
And you get the "modified" plot that is attached. I think that's what you want.
Cheers,
Mike Hunter
This works! Thanks for the input.
I've conducted different factor extraction methods using a considerably small dataset (low-level features extracted from image content). The problem is with the interpretation of factor scores obtained, which ranges from negative to positive integer number of unknown minimum/maximum. I read some handbooks but usually highlighted on how to conduct factor analysis and very rarely discuss about how to interpret the output