Difference between revisions of "Mori/Codetest"

library(xtable)
library(OpasnetUtils)

var1 <- data.frame(c = c("A", "A", "C"), d = c("D", "E", "E"), Result = 4:6)
cat("var1\n")
print(xtable(var1), type = "html")

var2 <- data.frame(c = c("A", "A", "C"), d = c("D", "E", "E"), Result = 4:6)
cat("var2\n")
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)

cat("Decision\n")
print(xtable(dec), type = "html")

out <- decisions.apply(dec)

cat("Variable", names(out)[1], "output\n")
print(xtable(out[[1]]), type = 'html')

cat("Variable", names(out)[2], "output\n")
print(xtable(out[[2]]), type = 'html')

library(xtable)
library(OpasnetUtils)

var1 <- data.frame(c = c("A", "A", "C"), d = c("D", "E", "E"), Result = 4:6)
cat("var1\n")
print(xtable(var1), type = "html")

var2 <- data.frame(c = c("A", "A", "C"), d = c("D", "E", "E"), Result = 4:6)
cat("var2\n")
print(xtable(var2), type = "html")

dec <- data.frame(
                  Decision = rep(c("Decision 1", "Decision 2"), each = 2), 
                  Option = c("OptA", "OptB"), 
                  Variable = c("var2", "var1", "var1", "var2"), 
                  Cell = c(" c: A; d: E", " d: D"), 
                  Change = c("Replace", "Multiply"), 
                  Result = 7:10)

cat("Decision\n")
print(xtable(dec), type = "html")

#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")
print(xtable(out[[1]]), type = 'html')

cat("Variable", names(out)[2], "output\n")
print(xtable(out[[2]]), type = 'html')

library(OpasnetUtils)
library(xtable)

data <- op_baseGetData("opasnet_base", "Op_fi3016")
data <- tidy(data)

emfBoilerit <- new("ovariable",
	name = "emfBoilerit",
	data = data, direction = "wide", objname = "emfBoilerit")
)

objects.put(emfBoilerit)

print(xtable(emfBoilerit@data), type = 'html')
cat("Muuttuja alustettu. Kopioi ajosivun osoitteen avain talteen tulevaa käyttöä varten.\n")

library(OpasnetUtils)
library(xtable)

riippuvuudet <- data.frame(
   Name = c("EFs", "Sa", "S")
)

funktio <- function(dependencies, ...) {
	data <- op_baseGetData("opasnet_base", "Op_fi3016")
	data <- tidy(data)

	out$Result <- as.numeric(out$Result) * EFs / Sa * S
	out <- dropall(out)
	return(out)
}

emfBoilerit <- new("ovariable",
	name = "emfBoilerit",
	data = data,
	dependencies = riippuvuudet,
	formula = funktio
)

objects.put(emfBoilerit)
temp <- EvalOutput(emfBoilerit)

out <- temp@output

print(xtable(emfBoilerit@data), type = 'html')
cat("Muuttuja alustettu. Kopioi ajosivun osoitteen avain talteen tulevaa käyttöä varten.\n")