|
|
| (2 intermediate revisions by one other user not shown) |
| Line 8: |
Line 8: |
| ==Code== | | ==Code== |
|
| |
|
| <rcode
| | https://www.opasnet.org/svn/opasnet_utils/trunk/R/CheckInput.r |
| label="Initiate functions"
| |
| showcode="1"
| |
| >
| |
| CheckInput <- function(variable, substitute = FALSE, ...) { # e.g for na.rm
| |
| if (nrow(variable@output) == 0) stop(paste(variable@name, "output not evaluated yet!"))
| |
| if (exists(paste("Inp", variable@name, sep = ""))) {
| |
| inputvar <- get(paste("Inp", variable@name, sep = ""))
| |
| if (substitute) {
| |
| colnames(inputvar@output)[colnames(inputvar@output) == "Result"] <- "InpVarRes" # Should probably be changed to something
| |
| colnames(variable@output)[colnames(variable@output) == "Result"] <- "VarRes" # that would never be used in any data.
| |
| finalvar <- merge(variable, inputvar)
| |
| finalvar@output$Result <- ifelse(
| |
| is.na(finalvar@output$InpVarRes),
| |
| finalvar@output$VarRes,
| |
| finalvar@output$InpVarRes
| |
| )
| |
| finalvar@output[,paste(variable@name, "Source", sep = "_")] <- ifelse(
| |
| is.na(finalvar@output$InpVarRes),
| |
| finalvar@output[,paste(variable@name, "Source", sep = "_")],
| |
| "Input"
| |
| )
| |
| return(finalvar[!colnames(finalvar) %in% c("InpVarRes", "VarRes")])
| |
| }
| |
| #variable@output[variable@output$Source,]
| |
| j <- levels(variable@output[,paste(variable@name, "Source", sep = "_")])
| |
| temp <- j[1]
| |
| for (i in j[!j == j[1]]) {
| |
| temp <- merge(
| |
| temp,
| |
| variable@output[
| |
| variable@output[,paste(variable@name, "Source", sep = "_")] == i,
| |
| !colnames(variable@output) %in% paste(variable@name, "Source", sep = "_")
| |
| ]
| |
| )
| |
| }
| |
| colnames(temp)[colnames(temp) %in% "Result"] <- i
| |
| return(
| |
| melt(
| |
| temp,
| |
| measure.vars = levels(variable@output[,paste(variable@name, "Source", sep = "_")]),
| |
| variable.name = paste(variable@name, "Source", sep = "_"),
| |
| value.name = "Result",
| |
| ...
| |
| )
| |
| )
| |
| }
| |
| return(variable@output)
| |
| }
| |
| </rcode>
| |
|
| |
|
| ==See also== | | ==See also== |