OpasnetUtils/Decisions.apply

This page is a method. The page identifier is Op_en5720
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 Show results

Similar to

Apply.decisions

Description

decisions.apply 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.

Code

+ Show code- Hide code library(OpasnetBaseUtils) library(xtable) n <- 5 # DECISIONS.APPLY ############## decisions.apply 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.apply <- 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) }

See also

• OpasnetBaseUtils
• Object-oriented programming in Opasnet
• Decision