Difference between revisions of "Mori/Codetest"
From Testiwiki
m |
|||
Line 77: | Line 77: | ||
data <- data[colnames(data) != "Unit"] | data <- data[colnames(data) != "Unit"] | ||
data | data | ||
− | data <- decisions.apply(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. | ||
+ | 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 | ||
+ | } | ||
+ | out | ||
</rcode> | </rcode> | ||
Revision as of 11:03, 28 June 2012
Old R-code
Test code
⇤# : Why does the var2 outcome show row 3 OptB A E 50, because the decision should be applied only for row 1 OptB A D 4 ? There is a bug somewhere. --Jouni 16:12, 16 May 2012 (EEST)