Bug fixes to path models. Adding paths now works.
[openmx:openmx.git] / R / MxPath.R
1 mxCreatePath <- function(from, to, all = FALSE, free = NULL, 
2         arrows = NULL, startVal = NULL, 
3         endVal = NULL, algebra = NULL,
4         name = NULL, label = NULL,
5         boundMax = NULL, boundMin = NULL,
6         ciUpper = NULL, ciLower = NULL) {
7         if(length(from) == 1 && length(to) == 1) {
8                 return(mxSinglePath(from, to, free, 
9                         arrows, startVal, endVal, 
10                         algebra, name, label, boundMax, 
11                         boundMin, ciUpper, ciLower))
12         } else {
13                 from <- as.list(from)
14                 to <- as.list(to)
15                 if (all) {
16                         from <- rep(from, each=length(to))      
17                 }
18                 result <- mapply(mxSinglePath, from, to,
19                         free, arrows, startVal, endVal,
20                                 algebra, name, label, boundMax,
21                                 boundMin, ciUpper, ciLower, SIMPLIFY=FALSE)
22                 return(result)                  
23         }
24 }
25
26 mxSinglePath <- function(from, to, free = NULL, 
27         arrows = NULL, startVal = NULL, 
28         endVal = NULL, algebra = NULL,
29         name = NULL, label = NULL,
30         boundMax = NULL, boundMin = NULL,
31         ciUpper = NULL, ciLower = NULL) {
32         result <- list()
33         result[['from']] <- from
34         result[['to']] <- to
35         result[['free']] <- free
36         result[['arrows']] <- arrows
37         result[['startVal']] <- startVal
38         result[['endVal']] <- endVal
39         result[['algebra']] <- algebra
40         result[['name']] <- name
41         result[['label']] <- label              
42         result[['boundMax']] <- boundMax
43         result[['boundMin']] <- boundMin        
44         result[['ciUpper']] <- ciUpper
45         result[['ciLower']] <- ciLower
46         return(result)
47 }
48
49 isMxPath <- function(value) {
50         return(is.list(value) && !is.null(value[['from']]) && !is.null(value[['to']]))
51 }