Difference between revisions of "Mori/Codetest"

From Testiwiki
Jump to: navigation, search
m ("Selvemmät" printit)
m
Line 31: Line 31:
 
:{{comment|# |Itsekin ajattelin samaa, mutta en ole vielä ymmärtänyt miksi se toimii niin.. Minulla meni pari päivää jahdatessa tuon yhden virheilmoituksen syytä, kunnes Teemu selvensi minulle että se on tarkoituskin tulla, joskin virheilmoituksessa on kuulemma parantamisen varaa. Nyt vasta alan ymmärtää paremmin miten tuo decisions.apply oikein toimii.|--[[User:Mori|Mori]] 17:06, 3 July 2012 (EEST)}}
 
:{{comment|# |Itsekin ajattelin samaa, mutta en ole vielä ymmärtänyt miksi se toimii niin.. Minulla meni pari päivää jahdatessa tuon yhden virheilmoituksen syytä, kunnes Teemu selvensi minulle että se on tarkoituskin tulla, joskin virheilmoituksessa on kuulemma parantamisen varaa. Nyt vasta alan ymmärtää paremmin miten tuo decisions.apply oikein toimii.|--[[User:Mori|Mori]] 17:06, 3 July 2012 (EEST)}}
  
<rcode showcode = "1">
+
<rcode>
 
library(xtable)
 
library(xtable)
 
library(OpasnetUtils)
 
library(OpasnetUtils)
Line 39: Line 39:
 
print(xtable(var1), type = "html")
 
print(xtable(var1), type = "html")
  
var2 <- var1
+
var2 <- data.frame(c = c("A", "A", "C"), d = c("D", "E", "E"), Result = 4:6)
 
cat("var2\n")
 
cat("var2\n")
 
print(xtable(var2), type = "html")
 
print(xtable(var2), type = "html")
  
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)
+
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)
  
 
cat("Decision\n")
 
cat("Decision\n")
 
print(xtable(dec), type = "html")
 
print(xtable(dec), type = "html")
  
out <- decisions.apply(dec)
+
#out <- decisions.apply(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)
 +
 
 +
print(xtable(dec.var), type = 'html')
 +
print(xtable(var), type = 'html')
 +
 
 +
for(s in 1:nrow(dec.var)) {cat(s)}
 +
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
 +
}
  
 
cat("Variable", names(out)[1], "output\n")
 
cat("Variable", names(out)[1], "output\n")
Line 55: Line 114:
 
cat("Variable", names(out)[2], "output\n")
 
cat("Variable", names(out)[2], "output\n")
 
print(xtable(out[[2]]), type = 'html')
 
print(xtable(out[[2]]), type = 'html')
 +
  
 
</rcode>
 
</rcode>
  
 
===New R-code===
 
===New R-code===

Revision as of 06:07, 6 July 2012

Old R-code

Test code

+ Show 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)

"Selvemmät" printit

--# : Oletko saanut bugin selville? Luulen, että decisions.apply jossain vaiheessa sekoittaa rivit niin, että ensimmäiselle riville tarkoitettu kertolasku kohdistuukin kolmannelle riville. Mutta miksi? --Jouni 08:53, 29 June 2012 (EEST)

--# : Itsekin ajattelin samaa, mutta en ole vielä ymmärtänyt miksi se toimii niin.. Minulla meni pari päivää jahdatessa tuon yhden virheilmoituksen syytä, kunnes Teemu selvensi minulle että se on tarkoituskin tulla, joskin virheilmoituksessa on kuulemma parantamisen varaa. Nyt vasta alan ymmärtää paremmin miten tuo decisions.apply oikein toimii. --Mori 17:06, 3 July 2012 (EEST)

+ Show code

New R-code