Graphviz interface that does not rely on Rgraphviz package.
[openmx:openmx.git] / R / MxPath.R
1 #
2 #   Copyright 2007-2009 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 # returns a list of paths
17 generatePath <- function(from, to, 
18                 all, arrows, values, free,
19                 labels, lbound, ubound) {
20                 if (single.na(to)) {
21                         to <- from
22                 }
23                 from <- as.list(from)
24                 to <- as.list(to)
25                 if (all) {
26                         from <- rep(from, each=length(to))      
27                 }
28                 if(!is.null(labels)) { 
29                         lapply(labels, omxVerifyReference)
30                 }
31                 result <- suppressWarnings(mapply(generateSinglePath, from, to, 
32                 arrows, values, free,
33                 labels, lbound, ubound, SIMPLIFY = FALSE))
34                 return(result)
35 }
36
37 generateSinglePath <- function(from, to, 
38                 arrows, values, free,
39                 labels, lbound, ubound) {
40         result <- list()
41         result[['from']] <- from
42         result[['to']] <- to
43         result[['arrows']] <- arrows[[1]]
44         result[['values']] <- values[[1]]       
45         result[['free']] <- free[[1]]
46         result[['labels']] <- labels[[1]]       
47         result[['lbound']] <- lbound[[1]]
48         result[['ubound']] <- ubound[[1]]
49         return(result)
50 }
51
52 omxIsPath <- function(value) {
53         return(is.list(value) && 
54                 !is.null(value[['from']]) &&
55                 !is.null(value[['to']]))
56 }
57
58 matrixToPaths <- function(mxMatrix, arrows = c(1,2)) {
59         values <- mxMatrix@values
60         select <- (values != 0)
61         if (length(select) > 0) {
62             rowFactors <- row(values, as.factor=TRUE)
63             colFactors <- col(values, as.factor=TRUE)   
64                 fromNames <- as.character(colFactors[select])
65                 toNames <- as.character(rowFactors[select])
66                 return(mxPath(from = fromNames, to = toNames, arrows = arrows))
67         } else {
68                 return(list())
69         }
70 }
71
72 mxPath <- function(from, to = NA, all = FALSE, arrows = 1, free = TRUE,
73         values = NA, labels = NA, lbound = NA, ubound = NA) {
74         if (length(values) == 1 && is.na(values)) values <- NULL
75         if (length(labels) == 1 && is.na(labels)) labels <- NULL
76         if (length(lbound) == 1 && is.na(lbound)) lbound <- NULL
77         if (length(ubound) == 1 && is.na(ubound)) ubound <- NULL
78         generatePath(from, to, all, arrows, 
79                 values, free, labels, 
80                 lbound, ubound)
81 }