|
|
| Line 9: |
Line 9: |
| | | | |
| | ==Code== | | ==Code== |
| − | <rcode
| |
| − | name="setmethod.update"
| |
| − | label="Initiate functions"
| |
| − | graphics="1"
| |
| − | showcode="1"
| |
| − | >
| |
| − | # SETMETHOD UPDATE ########## update updates the output of an ovariable based on data and function.
| |
| − | ####### The function assumes that object@data is always available, but object@dependencies may be empty.
| |
| − | temp <- setMethod(
| |
| − | f = "update",
| |
| − | signature = "ovariable",
| |
| − | definition = function(object) {
| |
| − | dat <- data.frame(Source = "Data", interpret(object@data))
| |
| − | if(ncol(object@dependencies) == 0 & nrow(object@dependencies) == 0) {
| |
| − | object@output <- dat
| |
| − | } else {
| |
| − | form <- object@formula(object@dependencies)
| |
| − | if(is.vector(form)) {form <- data.frame(Result = form)}
| |
| − | if(class(form) == "ovariable") {form <- form@output}
| |
| − | form <- data.frame(Source = "Formula", form)
| |
| − | object@output <- orbind(dat, form)
| |
| − | }
| |
| − | colnames(object@output)[colnames(object@output) == "Source"] <- paste("Source", object@name, sep = ".")
| |
| − | object@marginal <- c(TRUE, object@marginal) # This alone is not enough; orbind must operate with marginals as well.
| |
| − | return(object)
| |
| − | }
| |
| − | )
| |
| | | | |
| − | | + | https://www.opasnet.org/svn/opasnet_utils/trunk/R/Update.r |
| − | #### This code was taken out of update. It is still needed somewhere but not here.
| |
| − | # dep <- object@dependencies
| |
| − | # for(i in 1:length(dep)) {
| |
| − | # if(class(dep[[i]]) == "ovariable") {
| |
| − | # dep[[i]] <- dep[[i]]@output
| |
| − | # } 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]])
| |
| − | # }
| |
| − | # }
| |
| − | # }
| |
| − | # }
| |
| − | </rcode>
| |
| − | | |
| − | === Alternative ===
| |
| − | {{comment|# |To be able to control, when variables are evaluated we need functions EvalOutput and CheckMargins. Which determine the values of the output and margin of an ovariable. |--[[User:Teemu R|Teemu R]] 13:06, 15 June 2012 (EEST)}}
| |
| − | | |
| − | <rcode
| |
| − | name="setmethod.update"
| |
| − | label="Initiate functions"
| |
| − | graphics="1"
| |
| − | showcode="1"
| |
| − | >
| |
| − | # EvalOutput #################### evaluates the output slot of ovariables
| |
| − | ##### Marginals should be also checked and updated here or elsewhere
| |
| − | | |
| − | EvalOutput <- function(variable, ...) { # ... for e.g na.rm
| |
| − | if (nrow(variable@data) > 0) {
| |
| − | rescol <- ifelse(
| |
| − | "Result" %in% colnames(variable@data),
| |
| − | "Result",
| |
| − | paste(variable@name, "Result", sep = ":")
| |
| − | )
| |
| − | if (!is.numeric(variable@data[[rescol]])) {
| |
| − | a <- interpret(variable@data, rescol = rescol, ...)
| |
| − | } else a <- variable@data
| |
| − | } else a <- variable@data
| |
| − | b <- variable@formula(variable@dependencies)
| |
| − | if (is.numeric(b) & nrow(variable@data) == 0) {
| |
| − | stop(paste("No proper data nor formula defined for ", variable@name, "!\n", sep = ""))
| |
| − | }
| |
| − | if (is.numeric(b)) {
| |
| − | a[,paste(variable@name, "Source", sep = ":")] <- "Data"
| |
| − | variable@output <- a
| |
| − | return(variable)
| |
| − | }
| |
| − | if (nrow(variable@data) == 0) {
| |
| − | b[,paste(variable@name, "Source", sep = ":")] <- "Formula"
| |
| − | variable@output <- b
| |
| − | return(variable)
| |
| − | }
| |
| − | colnames(a)[colnames(a) == rescol] <- "FromData"
| |
| − | colnames(b)[colnames(b) %in% c(paste(variable@name, "Result", sep = ":"), "Result")] <- "FromFormula" # *
| |
| − | # <variablename>: prefix not necessitated for "Result" column of formula output
| |
| − | temp <- melt(
| |
| − | merge(a, b, all = TRUE, ...), # Will cause problems if dependencies contain non-marginal indices that match with -
| |
| − | # marginal indeces in data. Or maybe not.
| |
| − | measure.vars = c("FromData", "FromFormula"),
| |
| − | variable.name = paste(variable@name, "Source", sep = ":"),
| |
| − | value.name = paste(variable@name, "Result", sep = ":"),
| |
| − | ...
| |
| − | )
| |
| − | levels(
| |
| − | temp[[paste(variable@name, "Source", sep = ":")]]
| |
| − | ) <- gsub("^From", "",
| |
| − | levels(
| |
| − | temp[[paste(variable@name, "Source", sep = ":")]]
| |
| − | )
| |
| − | )
| |
| − | variable@output <- temp
| |
| − | return(variable)
| |
| − | }
| |
| − | </rcode>
| |
| | | | |
| | ==See also== | | ==See also== |
Updates the output of an ovariable based on data and function.
The function assumes that object@data is always available, but object@dependencies may be empty.
