1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
## * initVarLink (Documentation)
#' @title Normalize var1 and var2
#' @name initVarLink
#' @description Convert var1 and var2 from formula or covariance to character.
#'
#' @param var1 [character or formula] the exogenous variable of the new link or a formula describing the link.
#' @param var2 [character] the endogenous variable of the new link.
#' Disregarded if the argument \code{var1} is a formula.
#' @param rep.var1 [logical] should var1 be duplicated to match var2 length.
#' Only active if \code{format = "list"}.
#' @param format [character] should the name of the variable be returned (\code{format = "list"}),
#' a vector of character formula (\code{format = "txt.formula"}),
#' or a list of formula (\code{format = "formula"}).
#' @param Slink [character] the symbol for regression link.
#' @param Scov [character] the symbol for covariance link.
#' @param ... argument to be passed to \code{initVarLink}.
#'
#' @return See argument \code{format}.
#'
#' @examples
#' initVarLink(y ~ x1)
#' initVarLink("y ~ x1")
#' initVarLink(y ~ x1 + x2)
#' initVarLink("y ~ x1 + x2")
#' initVarLink(y ~ x1 + x2, rep.var1 = TRUE)
#' initVarLink(y ~ x1 + x2, rep.var1 = TRUE, format = "formula")
#' initVarLink(y ~ x1 + x2, rep.var1 = TRUE, format = "txt.formula")
#' initVarLink("y", "x1", format = "formula")
#'
#' initVarLink("y ~ x1:0|1")
#'
#' initVarLinks(y ~ x1)
#' initVarLinks("y ~ x1")
#' initVarLinks(c("y ~ x1","y~ x2"))
#' initVarLinks(c(y ~ x1,y ~ x2))
#' initVarLinks(c("y ~ x1","y ~ x2"), format = "formula")
#' initVarLinks(c(y ~ x1,y ~ x2), format = "formula")
#' initVarLinks(c("y ~ x1","y~ x2"), format = "txt.formula")
#' initVarLinks(c(y ~ x1,y ~ x2), format = "txt.formula")
## * initVarLink
#' @rdname initVarLink
#' @export
initVarLink <- function(var1, var2, rep.var1 = FALSE, format = "list",
Slink = c(lava.options()$symbols[1],"~"),
Scov = lava.options()$symbols[2]){
format <- match.arg(format, c("list","txt.formula","formula"))
test.formula <- (class(var1) == "formula")
test.covariance <- sapply(Scov,grepl,x=var1,fixed=TRUE)
test.regression <- sapply(Slink,grepl,x=var1,fixed=TRUE)
if(missing(var2)){
if(test.formula){
var2 <- selectRegressor(var1, format = "vars")
var1 <- selectResponse(var1, format = "vars")
sep <- if(format == "formula"){"~"}else{Slink}
}else if(any(test.covariance)){ ## covariance
Scov <- Scov[test.covariance][1]
varSplit <- strsplit(var1, split = Scov)[[1]]
var1 <- trimws(varSplit[1])
var2 <- trimws(varSplit[2])
sep <- if(format == "formula"){"~"}else{Scov}
} else if(any(test.regression)){ ## regression
Slink <- Slink[test.regression][1]
varSplit <- strsplit(var1, split = Slink)[[1]]
var1 <- trimws(varSplit[1])
var2 <- trimws(varSplit[2])
sep <- if(format == "formula"){"~"}else{Slink}
} else {
var1 <- var1
var2 <- NA
}
}else{
if(!is.character(var1) || !is.character(var2)){
stop("\'var1\' and \'var2\' must be characters when both are specified \n")
}
sep <- if(format == "formula"){"~"}else{Slink}
}
#### convert to format
if(format == "formula"){
n.var2 <- length(var2)
var1 <- rep(var1, times = n.var2)
res <- sapply(1:n.var2, function(i){
stats::as.formula(paste(var1[i], var2[i], sep = sep))
})
}else if(format == "txt.formula"){
n.var2 <- length(var2)
var1 <- rep(var1, times = n.var2)
res <- sapply(1:n.var2, function(i){paste(var1[i], var2[i], sep = sep)})
}else if(format == "list"){
if(rep.var1 && !missing(var1)){var1 <- rep(var1, length(var2))}
res <- list(var1 = var1,
var2 = if(!missing(var2)){var2}else{NULL}
)
}
## export
return(res)
}
## * initVarLinks
#' @rdname initVarLink
#' @export
initVarLinks <- function(var1, format = "list",...){
if("formula" %in% class(var1)){
res <- initVarLink(var1, rep.var1 = TRUE, format = format,
...)
}else {
res <- sapply(var1, function(x){
initVarLink(x, rep.var1 = TRUE, format = format,
...)
})
if(format == "list"){
res <- list(var1 = unname(unlist(res["var1",])),
var2 = unname(unlist(res["var2",])))
}else{
res <- unname(unlist(res))
}
}
return(res)
}
|
