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