OpasnetUtils/Update
| Moderator:Nobody (see all) Click here to sign up. |
| This page is a stub. You may improve it into a full page. |
| Upload data
|
Description
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.
Code
# 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)
}
)
#### 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]])
# }
# }
# }
# }
|
Alternative
----#: . 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. --Teemu R 13:06, 15 June 2012 (EEST) (type: truth; paradigms: science: comment)
# 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)
}
|