OpasnetUtils/CheckInput: Difference between revisions
Jump to navigation
Jump to search
(luettavuutta parannettu ja source muutettu muuttujakohtaiseksi) |
(Observation column names are now variable specific) |
||
| Line 12: | Line 12: | ||
showcode="1" | showcode="1" | ||
> | > | ||
CheckInput <- function(variable, substitute = FALSE, ...) { # e.g for na.rm | # CheckInput ################# checks and uses outside input (user inputs in models or decision variables) | ||
# takes an ovariable as argument | |||
# returns an ovariable | |||
CheckInput <- function(variable, substitute = FALSE, ...) { # ... e.g for na.rm | |||
if (nrow(variable@output) == 0) stop(paste(variable@name, "output not evaluated yet!")) | if (nrow(variable@output) == 0) stop(paste(variable@name, "output not evaluated yet!")) | ||
if (exists(paste("Inp", variable@name, sep = ""))) { | if (exists(paste("Inp", variable@name, sep = ""))) { | ||
inputvar <- get(paste("Inp", variable@name, sep = "")) | inputvar <- get(paste("Inp", variable@name, sep = "")) | ||
if (substitute) { | if (substitute) { | ||
colnames(inputvar@output)[colnames(inputvar@output) == "Result"] <- "InpVarRes" | colnames(inputvar@output)[colnames(inputvar@output) == paste(inputvar@name, "Result", sep = ":")] <- "InpVarRes" | ||
colnames(variable@output)[colnames(variable@output) == "Result"] <- "VarRes" | colnames(variable@output)[colnames(variable@output) == paste(variable@name, "Result", sep = ":")] <- "VarRes" | ||
finalvar <- merge(variable, inputvar) | finalvar <- merge(variable, inputvar) | ||
finalvar@output | finalvar@output[[paste(variable@name, "Result", sep = ":")]] <- ifelse( | ||
is.na(finalvar@output$InpVarRes), | is.na(finalvar@output$InpVarRes), | ||
finalvar@output$VarRes, | finalvar@output$VarRes, | ||
finalvar@output$InpVarRes | finalvar@output$InpVarRes | ||
) | ) | ||
finalvar@output[ | finalvar@output[[paste(variable@name, "Source", sep = ":")]] <- ifelse( | ||
is.na(finalvar@output$InpVarRes), | is.na(finalvar@output$InpVarRes), | ||
finalvar@output[ | finalvar@output[[paste(variable@name, "Source", sep = ":")]], | ||
"Input" | "Input" | ||
) | ) | ||
| Line 33: | Line 37: | ||
} | } | ||
#variable@output[variable@output$Source,] | #variable@output[variable@output$Source,] | ||
j <- levels(variable@output[,paste(variable@name, "Source", sep = " | j <- levels(variable@output[[paste(variable@name, "Source", sep = ":")]]) | ||
temp <- j[1] | temp <- variable@output[ | ||
variable@output[,paste(variable@name, "Source", sep = ":")] == j[1], | |||
!colnames(variable@output) %in% paste(variable@name, "Source", sep = ":") | |||
] | |||
colnames(temp)[colnames(temp) %in% "Result"] <- j[1] | |||
for (i in j[!j == j[1]]) { | for (i in j[!j == j[1]]) { | ||
temp <- merge( | temp <- merge( | ||
temp, | temp, | ||
variable@output[ | variable@output[ | ||
variable@output[,paste(variable@name, "Source", sep = " | variable@output[,paste(variable@name, "Source", sep = ":")] == i, | ||
!colnames(variable@output) %in% paste(variable@name, "Source", sep = " | !colnames(variable@output) %in% paste(variable@name, "Source", sep = ":") | ||
] | ] | ||
) | ) | ||
colnames(temp)[colnames(temp) %in% "Result"] <- i | |||
} | } | ||
return( | return( | ||
melt( | melt( | ||
temp, | temp, | ||
measure.vars = levels(variable@output[,paste(variable@name, "Source", sep = " | measure.vars = levels(variable@output[,paste(variable@name, "Source", sep = ":")]), | ||
variable.name = paste(variable@name, "Source", sep = " | variable.name = paste(variable@name, "Source", sep = ":"), | ||
value.name = "Result", | value.name = paste(variable@name, "Result", sep = ":"), | ||
... | ... | ||
) | ) | ||
) | ) | ||
} | } | ||
#cat("No input found for ", variable@name, ". Continuing...\n") | |||
return(variable@output) | return(variable@output) | ||
} | } | ||
Revision as of 10:39, 20 June 2012
| 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
Checks if an input variable (with the "Inp" -prefix) of the same name as the given argument (ovariable) exists. If input exists appends or substitutes it to the output and marks the source as "Input". Returns a data.frame.
Code
# CheckInput ################# checks and uses outside input (user inputs in models or decision variables)
# takes an ovariable as argument
# returns an ovariable
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) == paste(inputvar@name, "Result", sep = ":")] <- "InpVarRes"
colnames(variable@output)[colnames(variable@output) == paste(variable@name, "Result", sep = ":")] <- "VarRes"
finalvar <- merge(variable, inputvar)
finalvar@output[[paste(variable@name, "Result", sep = ":")]] <- 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 <- variable@output[
variable@output[,paste(variable@name, "Source", sep = ":")] == j[1],
!colnames(variable@output) %in% paste(variable@name, "Source", sep = ":")
]
colnames(temp)[colnames(temp) %in% "Result"] <- 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 = paste(variable@name, "Result", sep = ":"),
...
)
)
}
#cat("No input found for ", variable@name, ". Continuing...\n")
return(variable@output)
}
|