Difference between revisions of "Training health impact"

cat("Initiation successful. Now starting the model.\n")

library(xtable)
out <- make.ovariable(
	data = 0,
	formula = formula.Op_en5675,
	dependencies = dependencies.Op_en5675)
cat("Computing training exposures.\n")
print(out)

########### 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 = "1-2", #"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)

out <- update(out)
print(out)