|
|
| Line 1: |
Line 1: |
| | ===Old R-code=== | | ===Old R-code=== |
| − |
| |
| − | <rcode name="answer" label="Initialise functions" include="page:OpasnetBaseUtils|name:generic">
| |
| − |
| |
| − | ############### decisions.applyx takes a decision table and applies that to an assessment.
| |
| − | ## dec is a decision data.frame that must have columns Decision, Option, Variable, Cell, Change, Result. It can have several variables.
| |
| − | decisions.applyx <- function(dec, assessment = NULL) {
| |
| − | out <- as.list(unique(dec$Variable))
| |
| − | names(out) <- as.character(unique(dec$Variable))
| |
| − |
| |
| − | for(variables in unique(dec$Variable)) { # Take one variable at a time.
| |
| − | dec.var <- dec[dec$Variable == variables, ] # dec.var = variable-specific decisions
| |
| − | scenarios <- data.frame(temp = 1)
| |
| − |
| |
| − | for(decisions in unique(dec.var$Decision)) { # Add BAU option to each decision and merge decisions.
| |
| − | temp <- as.character(dec.var[dec.var$Decision == decisions, "Option"])
| |
| − | temp <- data.frame(Options = c(temp, "BAU"))
| |
| − | colnames(temp) <- decisions
| |
| − | scenarios <- merge(scenarios, temp)
| |
| − | }
| |
| − |
| |
| − | if(!is.null(assessment)) {
| |
| − | var <- assessment@vars[[as.character(dec.var$Variable[1])]]
| |
| − | } else {
| |
| − | if(exists(as.character(dec.var$Variable[1])))
| |
| − | {var <- get(as.character(dec.var$Variable[1]))
| |
| − | } else {
| |
| − | stop()
| |
| − | }
| |
| − | }
| |
| − | var <- merge(scenarios[colnames(scenarios) != "temp"], var)
| |
| − |
| |
| − | for(s in 1:nrow(dec.var)) { # Each row in decision handled separately
| |
| − | cell <- gsub("^[ \t]+|[ \t]+$", "", as.character(dec$Cell[s])) # Leading and trailing whitespaces removed.
| |
| − | cell <- gsub(":[ \t]+", ":", cell) # Whitespaces removed after :
| |
| − | cell <- gsub(";[ \t]+", ";", cell) # Whitespaces removed after ;
| |
| − | cell <- gsub("[ \t]+:", ":", cell) # Whitespaces removed before :
| |
| − | cell <- gsub("[ \t]+;", ";", cell) # Whitespaces removed before ;
| |
| − | cell <- strsplit(cell, split = ";") # Separate cell identifiers (indices and locations)
| |
| − | cell <- strsplit(cell[[1]], split = ":")
| |
| − | cond <- as.character(dec.var$Decision[s])
| |
| − | cond <- var[, cond] == as.character(dec.var$Option[s]) # Only the rows with the relevant option.
| |
| − | for(r in 1:length(cell)) { # All Cell conditions extracted and combined with AND.
| |
| − | cond <- cond * (var[, cell[[r]][1]] == cell[[r]][2])
| |
| − | }
| |
| − | cond <- as.logical(cond)
| |
| − | if(dec.var$Change[s] == "Replace" ) {var[cond, "Result"] <- dec.var$Result[s]}
| |
| − | if(dec.var$Change[s] == "Add" ) {var[cond, "Result"] <- dec.var$Result[s] + var[cond, "Result"]}
| |
| − | if(dec.var$Change[s] == "Multiply") {var[cond, "Result"] <- dec.var$Result[s] * var[cond, "Result"]}
| |
| − | }
| |
| − |
| |
| − | out[[variables]] <- var
| |
| − | }
| |
| − | return(out)
| |
| − | }
| |
| − |
| |
| − | </rcode>
| |
| − |
| |
| | | | |
| | '''Test code | | '''Test code |
| Line 82: |
Line 25: |
| | out <- as.list(unique(dec$Variable)) | | out <- as.list(unique(dec$Variable)) |
| | names(out) <- as.character(unique(dec$Variable)) | | names(out) <- as.character(unique(dec$Variable)) |
| − | for(variables in unique(dec$Variable)) { # Take one variable at a time. | + | # for(variables in unique(dec$Variable)) { # Take one variable at a time. |
| | + | variables <- unique(dec$Variable)[1] |
| | dec.var <- dec[dec$Variable == variables, ] # dec.var = variable-specific decisions | | dec.var <- dec[dec$Variable == variables, ] # dec.var = variable-specific decisions |
| | scenarios <- data.frame(temp = 1) | | scenarios <- data.frame(temp = 1) |
| Line 99: |
Line 43: |
| | {var <- get(as.character(dec.var$Variable[1])) | | {var <- get(as.character(dec.var$Variable[1])) |
| | } else { | | } else { |
| − | stop() | + | stop(paste(variables, " not defined, aborting...")) |
| | } | | } |
| | } | | } |
| Line 124: |
Line 68: |
| | | | |
| | out[[variables]] <- var | | out[[variables]] <- var |
| − | }
| + | # } |
| − | out | + | return(out) |
| | </rcode> | | </rcode> |
| | | | |
+ Show code- Hide code
library(xtable)
library(OpasnetUtils)
var1 <- data.frame(c = c("A", "A", "C"), d = c("D", "E", "E"), Result = 4:6)
var2 <- var1
dec <- data.frame(Decision = rep(c("Decision 1", "Decision 2"), each = 2), Option = c("OptA", "OptB"), Variable = c("var1", "var1", "var1", "var2"), Cell = c(" c: A; d: E", " d: D"), Change = c("Replace", "Multiply"), Result = 7:10)
var1
dec
out <- decisions.apply(dec)
cat("Variable", names(out)[1], "\n")
print(xtable(out[[1]]), type = 'html')
cat("Variable", names(out)[2], "\n")
print(xtable(out[[2]]), type = 'html')
data <- tidy(op_baseGetData("opasnet_base", "Op_en5466"), direction = "wide")
data <- data[colnames(data) != "Unit"]
data
# data <- decisions.apply(data)
dec <- data
assessment = NULL
out <- as.list(unique(dec$Variable))
names(out) <- as.character(unique(dec$Variable))
# for(variables in unique(dec$Variable)) { # Take one variable at a time.
variables <- unique(dec$Variable)[1]
dec.var <- dec[dec$Variable == variables, ] # dec.var = variable-specific decisions
scenarios <- data.frame(temp = 1)
for(decisions in unique(dec.var$Decision)) { # Add BAU option to each decision and merge decisions.
temp <- as.character(dec.var[dec.var$Decision == decisions, "Option"])
temp <- data.frame(Options = c(temp, "BAU"))
colnames(temp) <- decisions
scenarios <- merge(scenarios, temp)
}
if(!is.null(assessment)) {
var <- assessment@vars[[as.character(dec.var$Variable[1])]]
} else {
if(exists(as.character(dec.var$Variable[1])))
{var <- get(as.character(dec.var$Variable[1]))
} else {
stop(paste(variables, " not defined, aborting..."))
}
}
var <- merge(scenarios[colnames(scenarios) != "temp"], var)
for(s in 1:nrow(dec.var)) { # Each row in decision handled separately
cell <- gsub("^[ \t]+|[ \t]+$", "", as.character(dec$Cell[s])) # Leading and trailing whitespaces removed.
cell <- gsub(":[ \t]+", ":", cell) # Whitespaces removed after :
cell <- gsub(";[ \t]+", ";", cell) # Whitespaces removed after ;
cell <- gsub("[ \t]+:", ":", cell) # Whitespaces removed before :
cell <- gsub("[ \t]+;", ";", cell) # Whitespaces removed before ;
cell <- strsplit(cell, split = ";") # Separate cell identifiers (indices and locations)
cell <- strsplit(cell[[1]], split = ":")
cond <- as.character(dec.var$Decision[s])
cond <- var[, cond] == as.character(dec.var$Option[s]) # Only the rows with the relevant option.
for(r in 1:length(cell)) { # All Cell conditions extracted and combined with AND.
cond <- cond * (var[, cell[[r]][1]] == cell[[r]][2])
}
cond <- as.logical(cond)
if(dec.var$Change[s] == "Replace" ) {var[cond, "Result"] <- dec.var$Result[s]}
if(dec.var$Change[s] == "Add" ) {var[cond, "Result"] <- dec.var$Result[s] + var[cond, "Result"]}
if(dec.var$Change[s] == "Multiply") {var[cond, "Result"] <- dec.var$Result[s] * var[cond, "Result"]}
}
out[[variables]] <- var
# }
return(out)
| |
