PPML Update: Largely rewritten PPML module with test permutor and new suite of test...
[openmx:openmx.git] / models / passing / PPML_100days.R
1 # One hundred days model\r
2 # Each manifest represents a single variable as measured on a different day, days 1-100\r
3 # Three predicting latents. Over the trial, one represents a constant part,\r
4 # one represents a linear part, and one an exponential part\r
5 \r
6 require(OpenMx)\r
7 require(MASS)\r
8 \r
9 # Random covariance matrix\r
10 #dataTest <- matrix(rnorm(100*100), 100, 100)\r
11 #dataTest <- dataTest %*% t(dataTest)\r
12 \r
13 manifests <- unlist(lapply(1:100, function(n) { paste("Day",n, sep="") } ))\r
14 latents <- c('Const', 'Lin', 'Exp')\r
15 \r
16 amtT <- 100\r
17 amtStep <- amtT / 99\r
18 ConstLoadings <- rep(1,100)\r
19 LinLoadings <- unlist(lapply(1:100, function (n) { n*amtStep/(amtT-1) } ))\r
20 EXPFACTOR <- 0.22\r
21 ExpLoadings <- unlist(lapply(1:100, function (n) { -exp(-EXPFACTOR*n*amtStep) } ))\r
22 \r
23 lambda <- cbind(ConstLoadings, LinLoadings, ExpLoadings)\r
24 dataLatents <- matrix(rnorm(3*3), 3, 3)\r
25 dataTest <- lambda %*% dataLatents %*% t(dataLatents) %*% t(lambda) + diag(rep(1,100))\r
26 dataTest <- (dataTest + t(dataTest)) / 2\r
27 \r
28 dataRaw <- mvrnorm(n=5000, rep(0,100), dataTest)\r
29 colnames(dataRaw) <- manifests\r
30 \r
31 colnames(dataTest) <- manifests\r
32 rownames(dataTest) <- manifests\r
33 \r
34 factorModel <- mxModel("One Hundred Days Model",\r
35       type="RAM",\r
36           # Vars\r
37       manifestVars = manifests,\r
38       latentVars = latents,\r
39       # A\r
40           mxPath(from='Const',  to=manifests,value=ConstLoadings,       free=FALSE),\r
41           mxPath(from='Lin',    to=manifests,value=LinLoadings,         free=FALSE),\r
42           mxPath(from='Exp',    to=manifests,value=ExpLoadings,         free=FALSE),\r
43       # S\r
44           mxPath(from=manifests, arrows=2,value=rep(1.0, 100), labels=rep("Res", 100)),\r
45           #mxPath(from=latents, arrows=2,values=1.0),\r
46           mxPath(from="Const", to=latents, arrows=2,values=1.0),\r
47           mxPath(from="Lin", to=latents, arrows=2,values=1.0),\r
48           mxPath(from="Exp", to=latents, arrows=2,values=1.0),\r
49           \r
50           # Means\r
51           mxPath(from="one", to=latents, values=0, free=TRUE),\r
52           \r
53           # Data\r
54       #mxData(dataTest, type="cov", numObs=100))\r
55           mxData(dataRaw, type="raw", numObs=5000)\r
56         )\r
57 \r
58 imxPPML.Test.Test(factorModel)\r