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
|
##' @export
"intervention<-" <- function(object, ..., value)
UseMethod("intervention<-")
##' @export
`intervention` <-
function(object, ...) UseMethod("intervention")
##' Define intervention
##'
##' Define intervention in a `lvm` object
##' @param object lvm object
##' @param to String defining variable or formula
##' @param value function defining intervention
##' @param dist Distribution
##' @param ... Additional arguments to lower level functions
##' @aliases intervention<- intervention intervention.lvm intervention<-.lvm
##' @seealso regression lvm sim
##' @examples
##' m <- lvm(y ~ a + x, a ~ x)
##' distribution(m, ~a+y) <- binomial.lvm()
##' mm <- intervention(m, "a", value=3)
##' sim(mm, 10)
##' mm <- intervention(m, a~x, function(x) (x>0)*1)
##' sim(mm, 10)
##' @export
intervention.lvm <- function(object, to, value, dist=none.lvm(), ...) {
if (!is.numeric(value))
regression(object, to, ...) <- value
y <- to
if (inherits(to, "formula")) {
y <- getoutcome(to)
if (length(y)==0)
y <- attr(y, "x")
}
parents <- parents(object, y)
if (length(parents)>0)
cancel(object) <- toformula(y, parents)
if (is.numeric(value)) {
distribution(object, y) <- constant.lvm(value)
} else {
distribution(object, y) <- dist
}
return(object)
}
##' @export
"intervention<-.lvm" <- function(object, to, ..., value) {
object <- intervention(object, to, value, ...)
return(object)
}
|
