OpasnetUtils/Update
From Testiwiki
This page is a method.
The page identifier is Op_en5739 |
---|
Moderator:Nobody (see all) Click here to sign up. |
This page is a stub. You may improve it into a full page, and then a rating bar will appear here. |
Upload data
|
Contents
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)
# EvalOutput #################### evaluates the output slot of ovariables ##### Marginals should be also checked and updated here or elsewhere EvalOutput <- function(variable, ...) { #if (nrow(variable@data) > 0) { # if interpret can handle zero rows, no problem a <- interpret(variable@data, ...) #} b <- variable@formula(variable@dependencies) if (b == 0 & nrow(variable@data) == 0) { stop(paste("No proper data nor formula defined for ", variable@name, "!\n", sep = "")) } if (b == 0) { a$Source <- "Data" return(a) } if (nrow(variable@data) == 0) { b$Source <- "Formula" return(b) } colnames(a)[colnames(a) == "Result"] <- "Data" colnames(b)[colnames(b) == "Result"] <- "Formula" return( melt( merge(a, b, all = TRUE, ...), measure.vars = c("Data", "Formula"), variable.name = "Source", value.name = "Result", ... ) ) } |