+ Show code- Hide code
########### update updates the sample of an ovariable based on data and function.
setMethod(
f = "update",
signature = "ovariable",
definition = function(object) {
dat <- data.frame(Source = "Data", interpret(object@data))
dep <- object@dependencies
for(i in 1:length(dep)) {
if(class(dep[[i]]) == "ovariable") {
dep[[i]] <- dep[[i]]@sample
} else {
if(length(grep("Op_(en|fi)", dep[[i]])) > 0) {
dep[[i]] <- op_baseGetData("opasnet_base", dep[[i]])}
else {
if(class(dep[[i]]) != "data.frame" & !is.numeric(dep[[i]])) {
dep[[i]] <- get(dep[[i]])
}
}
}
}
form <- data.frame(Source = "Formula", make.ovariable(object@formula(dep))@sample)
object@sample <- orbind(dat, form)@sample
return(object)
}
)
########### make.ovariable takes a vector or data.frame and makes an ovariable out of it.
make.ovariable <- function(
data,
formula = function(dependencies){return(dependencies)},
dependencies = list(x = 0)
) {
if(class(data) == "ovariable") {
out <- data}
else {
if(is.vector(data)) {data <- data.frame(Result = data)}
sample <- interpret(data)
out <- new("ovariable",
sample = sample,
data = data,
marginal = ifelse(colnames(sample) %in% c("Result", "Unit"), FALSE, TRUE),
formula = formula,
dependencies = dependencies)
# out <- update(out)
}
return(out)
}
setGeneric("make.ovariable") # Makes make.ovariable a generic S4 function.
setMethod(
f = "make.ovariable",
signature = signature(data = "data.frame"),
definition = function(
data,
formula = function(dependencies){return(dependencies)},
dependencies = list(x = 0)
) {
data <- movariable(data)
return(data)
}
)
########### movariable takes a vector or data.frame and makes an ovariable out of it. It is a
#####copy of make.ovariable that prevents infinite recursion of S4 methods.
movariable <- function(
data,
formula = function(dependencies){return(dependencies)},
dependencies = list(x = 0)
) {
if(class(data) == "ovariable") {
out <- data}
else {
if(is.vector(data)) {data <- data.frame(Result = data)}
sample <- interpret(data)
out <- new("ovariable",
sample = sample,
data = data,
marginal = ifelse(colnames(sample) %in% c("Result", "Unit"), FALSE, TRUE),
formula = formula,
dependencies = dependencies)
# out <- update(out)
}
return(out)
}
setMethod(
f = "make.ovariable",
signature = signature(data = "list"),
definition = function(
data,
formula = function(dependencies){return(dependencies)},
dependencies = list(x = 0)
) {
for(i in 1:length(data)) {
cat("Data[[i]] ", i, "\n")
print(class(data[[i]]))
data[[i]] <- make.ovariable(data[[i]])
}
return(data)
}
)
#################### Math defines basic mathematical operations (log, exp, abs, ...) for ovariables
setMethod(
f = "Math",
signature = signature(x = "ovariable"),
definition = function(x) {
x@sample$Result <- callGeneric(x@sample$Result)
return(x)
}
)
############ tapply of ovariables applies a function to each cell of a ragged array, that is to each (non-empty) group of
############ values given by a unique combination of the levels of certain factors.
### parameters (other parameters are as in generic tapply):
### X an ovariable
setMethod(f = "tapply",
signature = signature(X = "ovariable"),
definition = function(X, INDEX, FUN = NULL, ..., simplify = TRUE) {
out <- as.data.frame(as.table(tapply(X@sample$Result, INDEX, FUN, ..., simplify = TRUE)))
colnames(out)[colnames(out) == "Freq"] <- "Result"
X@sample <- out
return(X)
}
)
dependencies.Op_en5675 <- list(
exposure = "Op_en5674", # formula.Op_en5674(dependencies.Op_en5674), # Training exposure
erf = data.frame(Unit = "RR per ug/m3", Result = 1.5),
population = population,
background = 100 / 100000 # cases per 100000 person-years
)
formula.Op_en5675 <- function(x) {
population <- make.ovariable(x$population)
background <- make.ovariable(x$background)
exposure <- make.ovariable(x$exposure)
erf <- make.ovariable(x$erf)
cases <- population * background * exp(exposure * log(erf))
return(cases)
}
###########################################################################################
cat("Initiation successful. Now starting the model.\n")
library(xtable)
out <- make.ovariable(
data = "0 - 100000",
formula = formula.Op_en5675,
dependencies = dependencies.Op_en5675)
cat("Computing training health impact.\n")
make.ovariable(dependencies.Op_en5675)
print(out)
out <- update(out)
print(out)
| |
