|
|
(2 intermediate revisions by 2 users not shown) |
Line 5: |
Line 5: |
| | | |
| ==Similar to== | | ==Similar to== |
− | [[Decisions.apply]] | + | |
| + | Functions apply.decisions and decisions.apply are depreciated. Consider using '''[[OpasnetUtils/CheckDecisions]]''' instead. |
| | | |
| ==Description== | | ==Description== |
Line 15: |
Line 16: |
| ==Code== | | ==Code== |
| | | |
− | <rcode
| + | The R code for this can be found here: |
− | name="answer"
| |
− | label="Initiate functions"
| |
− | graphics="1"
| |
− | >
| |
− | # APPLY.DECISIONS ############## apply.decisions 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.
| |
− | apply.decisions <- function(assessment) {
| |
− | dec <- merge(assessment@decisions, assessment@dependencies, by.x = "Variable", by.y = "Name")
| |
− | colnames(dec)[colnames(dec) == "Result.x"] <- "Result"
| |
− | colnames(dec)[colnames(dec) == "Result.y"] <- "Name"
| |
− | | |
− | for(variables in unique(dec$Name)) { # Take one variable at a time.
| |
− | dec.var <- dec[dec$Name == 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.
| + | https://www.opasnet.org/svn/opasnet_utils/trunk/R/ApplyDecisions.r |
− | temp <- as.character(dec.var[dec.var$Decision == decisions, "Option"])
| |
− | temp <- data.frame(Options = c(temp, "BAU"))
| |
− | colnames(temp) <- decisions
| |
− | scenarios <- merge(scenarios, temp)
| |
− | }
| |
− | var <- assessment@vars[[variables]]# as.character(dec$Name[1])]]
| |
− | var@output <- merge(scenarios[colnames(scenarios) != "temp"], var@output)
| |
− | for(s in 1:nrow(dec.var)) { # Each option row handled separately
| |
− | cell <- gsub("^[ \t]+|[ \t]+$", "", as.character(dec.var$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@output[, 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@output[, cell[[r]][1]] == cell[[r]][2])
| |
− | }
| |
− | cond <- as.logical(cond)
| |
− | if(dec.var$Change[s] == "Replace" )
| |
− | {var@output[cond, "Result"] <- dec.var$Result[s]}
| |
− | if(dec.var$Change[s] == "Add" )
| |
− | {var@output[cond, "Result"] <- as.numeric(dec.var$Result[s]) + var@output[cond, "Result"]}
| |
− | if(dec.var$Change[s] == "Multiply")
| |
− | {var@output[cond, "Result"] <- as.numeric(dec.var$Result[s]) * var@output[cond, "Result"]}
| |
− | }
| |
− | assessment@vars[[variables]] <- var
| |
− | }
| |
− | return(assessment)
| |
− | }
| |
− | </rcode>
| |
| | | |
| ==See also== | | ==See also== |
apply.decisions takes a decision table and applies that to an assessment.