Implemented omxRAMtoML() function.
[openmx:openmx.git] / R / MxRAMModel.R
1 #
2 #   Copyright 2007-2011 The OpenMx Project
3 #
4 #   Licensed under the Apache License, Version 2.0 (the "License");
5 #   you may not use this file except in compliance with the License.
6 #   You may obtain a copy of the License at
7
8 #        http://www.apache.org/licenses/LICENSE-2.0
9
10 #   Unless required by applicable law or agreed to in writing, software
11 #   distributed under the License is distributed on an "AS IS" BASIS,
12 #   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 #   See the License for the specific language governing permissions and
14 #   limitations under the License.
15
16 setClass(Class = "MxRAMModel",
17         representation = representation(),
18         contains = "MxModel")
19
20 imxModelTypes[['RAM']] <- "MxRAMModel"
21
22 # Define generic functions
23
24 setMethod("imxTypeName", "MxRAMModel", 
25         function(model) { "RAM" }
26 )
27
28 setMethod("imxInitModel", "MxRAMModel", 
29         function(model) {
30                 if (is.null(model[['A']])) {
31                         model[['A']] <- createMatrixA(model)
32                 }
33                 if (is.null(model[['S']])) {
34                         model[['S']] <- createMatrixS(model)
35                 }
36                 if (is.null(model[['objective']])) {
37                         model[['objective']] <- mxRAMObjective('A', 'S', 'F')
38                 }
39                 model[['F']] <- createMatrixF(model)
40                 return(model)
41         }
42 )
43
44 setMethod("imxModelBuilder", "MxRAMModel", 
45         function(model, lst, name, 
46                 manifestVars, latentVars, remove, independent) {
47                 model <- variablesArgumentRAM(model, manifestVars, latentVars, remove)
48                 model <- listArgumentRAM(model, lst, remove)
49                 notPathOrData <- getNotPathsOrData(lst)
50                 callNextMethod(model, notPathOrData, name, character(), 
51                         character(), remove, independent)
52         }
53 )
54
55 setMethod("imxVerifyModel", "MxRAMModel",
56         function(model) {
57                 if ((length(model$A) == 0) ||
58                         (length(model$S) == 0) ||
59                         (length(model$F) == 0)) {
60                                 msg <- paste("The RAM model", omxQuotes(model@name),
61                 "does not contain any paths.")
62                                 stop(msg, call. = FALSE)
63                 }
64                 objective <- model$objective
65                 if (!is.null(objective) && is(objective, "MxRAMObjective")) {
66                         if (!is.null(model@data) && model@data@type == "raw" &&
67                 is.null(model$M)) {
68                                 msg <- paste("The RAM model", omxQuotes(model@name),
69                        "contains raw data but has not specified any means paths.")
70                                 stop(msg, call. = FALSE)
71                         }
72                         if (!is.null(model@data) && !single.na(model@data@means) &&
73                                 is.null(model$M)) {
74                                 msg <- paste("The RAM model", omxQuotes(model@name),
75                                         "contains an observed means vector",
76                                         "but has not specified any means paths.")
77                                 stop(msg, call. = FALSE)                
78                         }
79                 }
80                 if (length(model@submodels) > 0) {
81                         return(all(sapply(model@submodels, imxVerifyModel)))
82                 }
83                 return(TRUE)
84         }
85 )
86
87
88 setReplaceMethod("[[", "MxRAMModel",
89         function(x, i, j, value) {
90                 return(replaceMethodRAM(x, i, value))
91         }
92 )
93
94 setReplaceMethod("$", "MxRAMModel",
95         function(x, name, value) {
96                 return(replaceMethodRAM(x, name, value))
97         }
98 )
99
100 # Helper functions used by the generic functions
101
102 variablesArgumentRAM <- function(model, manifestVars, latentVars, remove) {
103         if (single.na(manifestVars)) {
104                 manifestVars <- character()
105         }
106         if (single.na(latentVars)) {
107                 latentVars <- character()
108         }
109         if (remove == TRUE) {
110                 if (length(latentVars) + length(manifestVars) > 0) {
111                         model <- removeVariablesRAM(model, latentVars, manifestVars)
112                 }
113         } else if (length(manifestVars) + length(latentVars) > 0) {
114                 latentVars <- as.character(latentVars)
115                 manifestVars <- as.character(manifestVars)
116                 checkVariables(model, latentVars, manifestVars)
117                 model <- addVariablesRAM(model, latentVars, manifestVars)
118         }
119         return(model)
120 }
121
122 removeVariablesRAM <- function(model, latent, manifest) {
123         missingLatent <- setdiff(latent, model@latentVars)
124         missingManifest <- setdiff(manifest, model@manifestVars)
125         if (length(missingLatent) > 0) {
126                 stop(paste("The latent variable(s)", omxQuotes(missingLatent),
127                         "are not present in the model.",
128                         "They cannot be deleted"), call. = FALSE)
129         } else if (length(missingManifest) > 0) {
130                 stop(paste("The manifest variable(s)", omxQuotes(missingManifest),
131                         "are not present in the model.",
132                         "They cannot be deleted"), call. = FALSE)
133         } else if (length(unique(latent)) != length(latent)) {
134                 stop("The latent variables list contains duplicate elements",
135                         call. = FALSE)
136         } else if (length(unique(manifest)) != length(manifest)) {
137                 stop("The manifest variables list contains duplicate elements",
138                         call. = FALSE)
139         }
140         model@latentVars <- setdiff(model@latentVars, latent)
141         model@manifestVars <- setdiff(model@manifestVars, manifest)
142         A <- model[['A']]
143         S <- model[['S']]
144         A <- removeVariablesAS(A, latent)
145         A <- removeVariablesAS(A, manifest)
146         S <- removeVariablesAS(S, latent)
147         S <- removeVariablesAS(S, manifest)
148         model[['F']] <- createMatrixF(model)
149         model[['A']] <- A
150         model[['S']] <- S
151         return(model)
152 }
153
154 addVariablesRAM <- function(model, latent, manifest) {
155         newLatent   <- setdiff(latent, model@latentVars)
156         newManifest <- setdiff(manifest, model@manifestVars)
157         model@latentVars <- c(model@latentVars, newLatent)
158         model@manifestVars <- c(model@manifestVars, newManifest)
159         A <- model[['A']]
160         S <- model[['S']]
161         M <- model[['M']]
162         if (is.null(A)) {
163                 A <- createMatrixA(model)
164         } else {
165                 A <- addVariablesAS(A, model, newLatent, newManifest)
166         }
167         if (is.null(S)) {
168                 S <- createMatrixS(model)
169         } else {
170                 S <- addVariablesAS(S, model, newLatent, newManifest)
171         }
172         if (!is.null(M)) {
173                 M <- addVariablesM(M, model, newLatent, newManifest)
174         }
175         model[['A']] <- A
176         model[['S']] <- S
177         model[['M']] <- M
178         model[['F']] <- createMatrixF(model)
179         return(model)
180 }
181
182
183 listArgumentRAM <- function(model, lst, remove) {
184         if(remove == TRUE) {
185                 model <- removeEntriesRAM(model, lst)
186         } else {
187                 model <- addEntriesRAM(model, lst)
188         }
189         return(model)
190 }
191
192 addEntriesRAM <- function(model, entries) {
193         if (length(entries) == 0) {
194                 return(model)
195         }
196         filter <- sapply(entries, is, "MxPath")
197         paths <- entries[filter]
198         checkPaths(model, paths)
199         if (length(paths) > 0) {
200                 model <- insertAllPathsRAM(model, paths)
201         }
202         filter <- sapply(entries, is, "MxData")
203         data <- entries[filter]
204         if (length(data) > 0) {
205                 if (length(data) > 1) {
206                         warning("Multiple data sources specified.  Only one will be chosen.")
207                 }
208                 data <- data[[1]]
209                 model$data <- data
210         }
211         return(model)
212 }
213
214 requireMeansVector <- function(data) {
215         return(!is.null(data) && ((data@type == 'raw') ||
216                 ((data@type == 'cov' || data@type == 'cor') &&
217                  !(length(data@means) == 1 && is.na(data@means)))))
218 }
219
220 removeEntriesRAM <- function(model, entries) {
221         if (length(entries) == 0) {
222                 return(model)
223         }
224         filter <- sapply(entries, is, "MxPath")
225         paths <- entries[filter]
226         if (length(paths) > 0) {
227                 model <- removeAllPathsRAM(model, paths)
228         }
229         return(model)
230 }
231
232 getNotPathsOrData <- function(lst) {
233         if (length(lst) == 0) {
234                 return(lst)
235         }
236         pathfilter <- sapply(lst, is, "MxPath")
237         datafilter <- sapply(lst, is, "MxData")
238         retval <- lst[!(pathfilter | datafilter)]
239         return(retval)
240 }
241
242 checkPaths <- function(model, paths) {
243         variables <- c(model@manifestVars, model@latentVars)
244         fromNames <- unlist(sapply(paths, slot, 'from'))
245         toNames <- unlist(sapply(paths, slot, 'to'))
246         if(is.null(fromNames)) { fromNames <- character() }
247         if(is.null(toNames)) { toNames <- character() }
248         if (any(is.na(fromNames)) || any(is.na(toNames))) {
249                 stop("The \'from\' field or the \'to\' field contains an NA", call. = FALSE)
250         }
251         missingSource <- setdiff(fromNames, variables)
252         missingSink   <- setdiff(toNames, variables)
253         missingSource <- setdiff(missingSource, "one")
254         if(length(missingSource) > 0) {
255                 stop(paste("The following are neither manifest nor latent variables:",
256                         omxQuotes(missingSource)), call. = FALSE)
257         }
258         if(length(missingSink) > 0) {
259                 stop(paste("The following are neither manifest nor latent variables:",
260                         omxQuotes(missingSink)), call. = FALSE)
261         }
262 }
263
264 objectiveIsMissingMeans <- function(model) {
265         objective <- model@objective
266         return(!is.null(objective) &&
267                 is(objective, "MxRAMObjective") &&
268                 is.na(objective@M))
269 }
270
271 insertAllPathsRAM <- function(model, paths) {
272         A <- model[['A']]
273         S <- model[['S']]
274         M <- model[['M']]
275         if (is.null(A)) { A <- createMatrixA(model) }
276         if (is.null(S)) { S <- createMatrixS(model) }
277         for(i in 1:length(paths)) {
278                 path <- paths[[i]]
279                 if (length(path@from) == 1 && (path@from == "one")) {
280                         if (is.null(M)) {
281                                 M <- createMatrixM(model) 
282                                 if(objectiveIsMissingMeans(model)) {
283                                         model@objective@M <- "M"
284                                 }
285                         }
286                         M <- insertMeansPathRAM(path, M)
287                 } else {
288                         retval <- insertPathRAM(path, A, S)
289                         A <- retval[[1]]
290                         S <- retval[[2]]
291                 }
292         }
293         model[['A']] <- A
294         model[['S']] <- S
295         if (!is.null(M)) {
296                 model[['M']] <- M
297         }
298         return(model)
299 }
300
301 removeAllPathsRAM <- function(model, paths) {
302         A <- model[['A']]
303         S <- model[['S']]
304         M <- model[['M']]
305         if (is.null(A)) { A <- createMatrixA(model) }
306         if (is.null(S)) { S <- createMatrixS(model) }
307         for(i in 1:length(paths)) {
308                 path <- paths[[i]]
309                 if (length(path@from) == 1 && (path@from == "one")) {
310                         M <- removeMeansPathRAM(path, M)
311                 } else {
312                         retval <- removePathRAM(path, A, S)
313                         A <- retval[[1]]
314                         S <- retval[[2]]
315                 }
316         }
317         model[['A']] <- A
318         model[['S']] <- S
319         if (!is.null(M)) {
320                 model[['M']] <- M
321         }
322         return(model)
323 }
324
325
326 insertPathRAM <- function(path, A, S) {
327         allfrom <- path@from
328         allto <- path@to
329         allarrows <- path@arrows
330         allfree <- path@free
331         allvalues <- path@values
332         alllabels <- path@labels
333         alllbound <- path@lbound
334         allubound <- path@ubound
335         excludeself <- path@excludeself
336         maxlength <- max(length(allfrom), length(allto))
337         A_free <- A@free
338         A_values <- A@values
339         A_labels <- A@labels
340         A_lbound <- A@lbound
341         A_ubound <- A@ubound
342         S_free   <- S@free
343         S_values <- S@values
344         S_labels <- S@labels
345         S_lbound <- S@lbound
346         S_ubound <- S@ubound
347         for(i in 0:(maxlength - 1)) {
348                 from <- allfrom[[i %% length(allfrom) + 1]]
349                 to <- allto[[i %% length(allto) + 1]]
350                 arrows <- allarrows[[i %% length(allarrows) + 1]]
351                 nextvalue <- allvalues[[i %% length(allvalues) + 1]]
352                 nextfree <- allfree[[i %% length(allfree) + 1]]
353                 nextlabel <- alllabels[[i %% length(alllabels) + 1]]
354                 nextubound <- allubound[[i %% length(allubound) + 1]]
355                 nextlbound <- alllbound[[i %% length(alllbound) + 1]]
356                 if (excludeself && identical(from, to)) next
357                 if (arrows == 1) {
358                         A_free[to, from] <- nextfree
359                         A_values[to, from] <- nextvalue
360                         A_labels[to, from] <- nextlabel
361                         A_ubound[to, from] <- nextubound
362                         A_lbound[to, from] <- nextlbound
363                         S_values[to, from] <- 0
364                         S_labels[to, from] <- as.character(NA)
365                         S_free[to, from] <- FALSE
366                         S_values[from, to] <- 0
367                         S_labels[from, to] <- as.character(NA)
368                         S_free[from, to] <- FALSE                       
369                 } else if (arrows == 2) {
370                         S_free[to, from] <- nextfree
371                         S_values[to, from] <- nextvalue
372                         S_labels[to, from] <- nextlabel
373                         S_ubound[to, from] <- nextubound
374                         S_lbound[to, from] <- nextlbound
375                         S_free[from, to] <- nextfree
376                         S_values[from, to] <- nextvalue
377                         S_labels[from, to] <- nextlabel
378                         S_ubound[from, to] <- nextubound
379                         S_lbound[from, to] <- nextlbound
380                         A_values[to, from] <- 0
381                         A_labels[to, from] <- as.character(NA)
382                         A_free[to, from] <- FALSE
383                         A_values[to, from] <- 0
384                         A_labels[to, from] <- as.character(NA)
385                         A_free[to, from] <- FALSE
386                 } else {
387                         stop(paste("Unknown arrow type", arrows, 
388                                         "with source", omxQuotes(from), 
389                                 "and sink", omxQuotes(to)),
390                                 call. = FALSE)
391                 }
392         }
393         A@free <- A_free
394         A@values <-     A_values 
395         A@labels <-     A_labels 
396         A@lbound <-     A_lbound 
397         A@ubound <-     A_ubound 
398         S@free <- S_free   
399         S@values <-     S_values 
400         S@labels <-     S_labels 
401         S@lbound <- S_lbound 
402         S@ubound <- S_ubound 
403         return(list(A, S))
404 }
405
406 removeMeansPathRAM <- function(path, M) {
407         if(is.null(M)) {
408                 return(NULL)
409         }
410         allto <- path@to
411         for(i in 0:(length(allto) - 1)) {
412                 to <- allto[[i %% length(allto) + 1]]
413                 M@free[1, to] <- FALSE
414                 M@values[1, to] <- 0
415                 M@labels[1, to] <- as.character(NA)
416         }
417         return(M)
418 }
419
420 insertMeansPathRAM <- function(path, M) {
421         allto <- path@to
422         arrows <- path@arrows
423         allfree <- path@free
424         allvalues <- path@values
425         alllabels <- path@labels
426         alllbound <- path@lbound
427         allubound <- path@ubound        
428         if (any(arrows != 1)) {
429                 stop(paste('The means path to variable', omxQuotes(to),
430                         'does not contain a single-headed arrow.'), call. = FALSE)
431         }
432         for(i in 0:(length(allto) - 1)) {
433                 to <- allto[[i %% length(allto) + 1]]
434                 nextvalue <- allvalues[[i %% length(allvalues) + 1]]
435                 nextfree <- allfree[[i %% length(allfree) + 1]]
436                 nextlabel <- alllabels[[i %% length(alllabels) + 1]]
437                 nextubound <- allubound[[i %% length(allubound) + 1]]
438                 nextlbound <- alllbound[[i %% length(alllbound) + 1]]
439                 M@free[1, to] <- nextfree
440                 M@values[1, to] <- nextvalue
441                 M@labels[1, to] <- nextlabel
442                 M@ubound[1, to] <- nextubound
443                 M@lbound[1, to] <- nextlbound
444         }
445         return(M)
446 }
447
448 removePathRAM <- function(path, A, S) {
449         allfrom <- path@from
450         allto <- path@to
451         allarrows <- path@arrows
452         excludeself <- path@excludeself
453         maxlength <- max(length(allfrom), length(allto))
454         A_free <- A@free
455         A_values <- A@values
456         A_labels <- A@labels
457         S_free   <- S@free
458         S_values <- S@values
459         S_labels <- S@labels
460         for(i in 0:(maxlength - 1)) {
461                 from <- allfrom[i %% length(allfrom) + 1]
462                 to <- allto[i %% length(allto) + 1]
463                 arrows <- allarrows[i %% length(allarrows) + 1]
464                 if (excludeself && identical(from, to)) next
465                 if (arrows == 1) {
466                         A_values[to, from] <- 0
467                         A_labels[to, from] <- as.character(NA)
468                         A_free[to, from] <- FALSE               
469                 } else if (arrows == 2) {
470                         S_values[to, from] <- 0
471                         S_labels[to, from] <- as.character(NA)
472                         S_free[to, from] <- FALSE               
473                         S_values[from, to] <- 0
474                         S_labels[from, to] <- as.character(NA)
475                         S_free[from, to] <- FALSE                                       
476                 } else {
477                         stop(paste("Unknown arrow type", arrows, 
478                                         "with source", omxQuotes(from), 
479                                         "and sink", omxQuotes(to)),
480                                         call. = FALSE)
481                 }
482         }
483         A@free <- A_free
484         A@values <-     A_values 
485         A@labels <-     A_labels 
486         S@free <- S_free   
487         S@values <-     S_values 
488         S@labels <-     S_labels        
489         return(list(A, S))
490 }
491
492 createMatrixM <- function(model) {
493         variables <- c(model@manifestVars, model@latentVars)
494         len <- length(variables)
495         names <- list(NULL, variables)
496         values <- matrix(0, 1, len)
497         labels <- matrix(as.character(NA), 1, len)
498         free <- matrix(c(rep.int(FALSE, length(model@manifestVars)),
499                 rep.int(FALSE, length(model@latentVars))), 1, len)
500         retval <- mxMatrix("Full", values = values, free = free, labels = labels, name = "M")
501         dimnames(retval) <- names
502         return(retval)
503 }
504
505 createMatrixA <- function(model) {
506         variables <- c(model@manifestVars, model@latentVars)
507         len <- length(variables)
508         names <- list(variables, variables)
509         values <- matrix(0, len, len)
510         free <- matrix(FALSE, len, len)
511         labels <- matrix(as.character(NA), len, len)
512         retval <- mxMatrix("Full", values = values, free = free, labels = labels, name = "A")
513         dimnames(retval) <- names
514         return(retval)
515 }
516
517 createMatrixS <- function(model) {
518         variables <- c(model@manifestVars, model@latentVars)
519         len <- length(variables)
520         names <- list(variables, variables)
521         values <- matrix(0, len, len)
522         free <- matrix(FALSE, len, len)
523         labels <- matrix(as.character(NA), len, len)
524         retval <- mxMatrix("Symm", values = values, free = free, labels = labels, name = "S")
525         dimnames(retval) <- names
526         return(retval)
527 }
528
529 createMatrixF <- function(model) {
530         variables <- c(model@manifestVars, model@latentVars)
531         len <- length(variables)
532         names <- list(model@manifestVars, variables)
533         values <- diag(nrow = length(model@manifestVars), ncol = len)
534         free <- matrix(FALSE, length(model@manifestVars), len)
535         labels <- matrix(as.character(NA), length(model@manifestVars), len)
536         retval <- mxMatrix("Full", values = values, free = free, labels = labels, name = "F")
537         dimnames(retval) <- names
538         return(retval)
539 }
540
541 addVariablesAS <- function(oldmatrix, model, newLatent, newManifest) {
542         newLatent <- length(newLatent)
543         newManifest <- length(newManifest)
544         oldmatrix@values <- addVariablesMatrix(oldmatrix@values, 0, 
545                 model, newLatent, newManifest)
546         oldmatrix@free <- addVariablesMatrix(oldmatrix@free, FALSE, 
547                 model, newLatent, newManifest)
548         oldmatrix@labels <- addVariablesMatrix(oldmatrix@labels, as.character(NA), 
549                 model, newLatent, newManifest)
550         oldmatrix@lbound <- addVariablesMatrix(oldmatrix@lbound, as.numeric(NA), 
551                 model, newLatent, newManifest)
552         oldmatrix@ubound <- addVariablesMatrix(oldmatrix@ubound, as.numeric(NA), 
553                 model, newLatent, newManifest)          
554         variables <- c(model@manifestVars, model@latentVars)
555         dimnames(oldmatrix) <- list(variables, variables)
556         return(oldmatrix)
557 }
558
559 addVariablesM <- function(oldmatrix, model, newLatent, newManifest) {
560         oldmatrix@values <- addVariablesMatrixM(oldmatrix@values, 0, 0, model, newLatent, newManifest)
561         oldmatrix@free   <- addVariablesMatrixM(oldmatrix@free, FALSE, TRUE, model, newLatent, newManifest)
562         oldmatrix@labels <- addVariablesMatrixM(oldmatrix@labels, as.character(NA), as.character(NA),
563                 model, newLatent, newManifest) 
564         oldmatrix@lbound <- addVariablesMatrixM(oldmatrix@lbound, as.numeric(NA), as.numeric(NA), 
565                 model, newLatent, newManifest)
566         oldmatrix@ubound <- addVariablesMatrixM(oldmatrix@ubound, as.numeric(NA), as.numeric(NA), 
567                 model, newLatent, newManifest)
568         dimnames(oldmatrix) <- list(NULL, c(model@manifestVars, model@latentVars))
569         return(oldmatrix)
570 }
571
572 removeVariablesAS <- function(oldmatrix, variables) {
573         if (length(variables) > 0) {
574                 for (i in 1:length(variables)) {
575                         index <- match(variables[[i]], dimnames(oldmatrix)[[1]])
576                         oldmatrix@values <- oldmatrix@values[-index, -index]
577                         oldmatrix@free <- oldmatrix@free[-index, -index]
578                         oldmatrix@labels <- oldmatrix@labels[-index, -index]
579                         oldmatrix@lbound <- oldmatrix@lbound[-index, -index]
580                         oldmatrix@ubound <- oldmatrix@ubound[-index, -index]
581                 }
582         }
583         return(oldmatrix)
584 }
585
586
587 addVariablesMatrix <- function(oldmatrix, value, model, newLatent, newManifest) {
588         currentManifest <- length(model@manifestVars) - newManifest
589         currentLatent <- length(model@latentVars) - newLatent
590         newSize <- length(model@manifestVars) + length(model@latentVars)
591         if (currentManifest > 0) {
592                 manifestXmanifest <- oldmatrix[1 : currentManifest, 1 : currentManifest]
593         } else {
594                 manifestXmanifest <- matrix(value, 0, 0)
595         }
596         if (currentLatent > 0) {
597                 latentStart <- currentManifest + 1
598                 latentEnd <- currentManifest + currentLatent
599                 manifestXlatent <- oldmatrix[1 : currentManifest, latentStart : latentEnd]
600                 latentXmanifest <- oldmatrix[latentStart : latentEnd, 1 : currentManifest]
601                 latentXlatent <- oldmatrix[latentStart : latentEnd, latentStart : latentEnd]
602         } else {
603                 manifestXlatent <- matrix(value, 0, 0)
604                 latentXmanifest <- matrix(value, 0, 0)
605                 latentXlatent <- matrix(value, 0, 0)
606         }
607         newtop <- cbind(manifestXmanifest, matrix(value, currentManifest, newManifest),
608                                         manifestXlatent, matrix(value, currentManifest, newLatent)) 
609         newtop <- rbind(newtop, matrix(value, newManifest, newSize))
610         newbottom <- cbind(latentXmanifest, matrix(value, currentLatent, newManifest),
611                                         latentXlatent, matrix(value, currentLatent, newLatent)) 
612         newbottom <- rbind(newbottom, matrix(value, newLatent, newSize))
613         newmatrix <- rbind(newtop, newbottom)
614         return(newmatrix)
615 }
616
617 addVariablesMatrixM <- function(oldmatrix, newLatentValue, newManifestValue, model, newLatent, newManifest) {
618         newManifest <- length(newManifest)
619         newLatent <- length(newLatent)
620         currentManifest <- length(model@manifestVars) - newManifest
621         currentLatent <- length(model@latentVars) - newLatent
622         values <- c(oldmatrix[1, 1:currentManifest], 
623                 rep.int(newManifestValue, newManifest),
624                 oldmatrix[1, (currentManifest + 1) : (currentLatent + currentManifest)],
625                 rep.int(newLatentValue, newLatent))
626         newmatrix <- matrix(values, 1, length(model@manifestVars) + length(model@latentVars))
627         return(newmatrix)
628 }
629
630 replaceMethodRAM <- function(model, index, value) {
631         pair <- imxReverseIdentifier(model, index)
632         namespace <- pair[[1]]
633         name <- pair[[2]]
634         if (namespace == model@name && name == "data") {
635                 model@data <- value
636                 if (requireMeansVector(value)) {
637                         model@objective@M <- "M"
638                 }
639         } else {
640                 model <- imxReplaceMethod(model, index, value)
641         }
642         return(model)
643 }