Difference between revisions of "User:Mori"

From Opasnet
Jump to: navigation, search
(Replaced content with "Tuukka Hämynen, A.K.A. Mori THL")
Line 3: Line 3:
  
 
THL
 
THL
 
==Kooditestausta==
 
[[Category:Open assessment]]
 
[[Category:Opasnet]]
 
[[Category:Glossary term]]<section begin=glossary />
 
:'''Decision'''
 
 
<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
 
 
<rcode include="page:Decision|name:answer">
 
library(xtable)
 
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.applyx(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')
 
 
library(OpasnetUtils)
 
data <- tidy(op_baseGetData("opasnet_base", "Op_en5466"), direction = "wide")
 
data <- data[colnames(data) != "Unit"]
 
data
 
data <- decisions.applyx(data)
 
 
</rcode>
 
 
{{attack|# |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. |--[[User:Jouni|Jouni]] 16:12, 16 May 2012 (EEST)}}
 

Revision as of 08:38, 28 June 2012

Tuukka Hämynen, A.K.A. Mori

THL