Training assessment

This page is a knowledge crystal of subtype assessment. The page identifier is Op_en5677
Moderator:Jouni (see all)
This page is a stub. You may improve it into a full page.
Upload data {{#opasnet_base_link:Op_en5677}}

This is a training assessment about an imaginary, simple case. The purpose is to illustrate assessment functionalities.

Scope

Question

What decisions are worth implementing in the training assessment?

Boundaries

Time: Year 2012 - 2020

Scenarios

Factory can reduce emissions, or continue business as usual.
School can increase health education, decrease it to save money, or continue business as usual.

Intended users

Anyone who wants to learn to make open assessments.

Participants

Main participants:
- YMAL,
- Summer workers of YMAL in 2012,
- Participants of Decision analysis and risk management 2013

Answer

Conclusions

Results

Not yet available.

Rationale

Assessment-specific data

Decisions

Decisions(-)
Obs	Decisionmaker	Decision	Option	Variable	Cell	Change	Unit	Amount
1	Factory	Cleaning_policy	BAU	exposure	Year:2020	Multiply	-	1
2	Factory	Cleaning_policy	Reduce emissions	exposure	Year:2020	Multiply	-	0.5
3	Factory	Cleaning_policy	BAU	costs		Add	€	0
4	Factory	Cleaning_policy	Reduce emissions	costs	Year:2020;Expenditure:Cleaning equipment use	Add	€	50000
5	City of Kuopio	Health_promotion	BAU	health_impact		Multiply	-	1
6	City of Kuopio	Health_promotion	Increase health education	health_impact		Multiply	-	0.9
7	City of Kuopio	Health_promotion	BAU	costs		Add	€	0
8	City of Kuopio	Health_promotion	Increase health education	costs	Year:2020;Expenditure:Health promotion campaign	Add	€	10000

Variables

exposure: Training exposure
health_impact: Training health impact
costs: Training costs

Analyses

Decision analysis on each policy: Which option minimises the health risks?
Value of information (VOI) analysis for each policy about the major variables in the model and the total VOI.

Calculations

+ Show code - Hide code


library(OpasnetUtils)
library(ggplot2)

DecisionTableParser(opbase.data("Op_en5677", subset = "Decisions")) # [[Training assessment]]

objects.latest("Op_en5675", code_name = "initiate") # [[Training health impact]] health_impact
objects.latest("Op_en5871", code_name = "initiate") # [[Training cost]] costs

unitcost <- Ovariable("unitcost", data = data.frame(Result = unitcost))

costs <- EvalOutput(costs)

oprint(summary(health_impact))

colnames(exposure@output)
colnames(health_impact@output)
colnames(costs@output)

ggplot(exposure@output, aes(x = exposureResult, colour = Year)) + geom_density() +
	theme_gray(base_size = 24) +
	facet_grid(Cleaning_policy ~ .)

ggplot(health_impact@output, aes(x = health_impactResult, colour = Year)) + geom_density() +
	theme_gray(base_size = 24) +
	facet_grid(Cleaning_policy ~ Health_promotion)

costs2 <- oapply(costs, cols ="Expenditure", FUN = sum)

ggplot(subset(costs2@output, Year = 2020), aes(x = costsResult, colour = Payer)) + geom_density() +
	theme_gray(base_size = 24) +
	facet_grid(Cleaning_policy ~ Health_promotion)

+ Show code - Hide code

dectable <- data.frame(
	Stakeholder = rep(c("School", "City of Kuopio"), 4),
	Variable = rep(c("health.impact", "exposure"), each = 2),
	Cell = c("Year:2012,2014,2020", "Year:2012"),
	Result = 2
)

health.impact <- data.frame(Year = 2011:2010, Result = 1:10)

exposure <- data.frame(Year = 2012, Result = 100:110)

#	temp <- tempovar@output[tempovar@output$health.impactSource == "Formula", ]

dectable <- dectable[dectable$Stakeholder == "School" & dectable$Variable == "health.impact", ]

#####################
##### SelectCond takes conditions and slices a data.frame leaving rows that fulfil the conditions.
##### SelectCond can be used for ovariables as well, then ovariable@output is taken as the data.frame.
##### Parameters: conditions: a data.frame with conditions for slicing. It must contain columns Variable and Cell.
###### Result and Stakeholder are optional but they are typically needed for further use.
###### Stakeholder and Variable columns must have the same values at each row, 
###### i.e. the Stakeholder-Variable pair must be unique. 
###### There must exist a data.frame or ovariable with the name found in the Variable column.

SelectCond <- function(conditions, ...) {

	temp <- get(as.character(dectable[1, "Variable"]))
	if(class(temp) == "ovariable") {temp <- temp@output}

	for (j in 1:nrow(dectable)) { 
		
		# In the decision table format conditions are given in the "Cell"-column separated by ";".
					
		sel1 <- strsplit(as.character(dectable[j, "Cell"]), split = ";")[[1]] 
					
		# ":" defines index - location matches as a condition.
					
		sel2 <- strsplit(sel1, split = ":") # No need for lapply, since strsplit is a vectorized function and current list depth is 1.
					
		# Create a list of conditions which the decision and option specific condition vector consists of. 
					
		for (k in 1:length(sel1)) { # For each condition separated by ";"

			if (length(sel2[[k]]) > 1) { # If ":" has been used for condition k
				locs <- strsplit(sel2[[k]][2], split = ",")[[1]] # Split by "," for multiple locs per given index
				temp <- temp[temp[, sel2[[k]][1]] %in% locs , ] # Match our data.frame to the condition
				temp <- temp[, colnames(temp) != sel2[[k]][1] ] # Remove all indices that were  used in selecting rows, because otherwise they cannot be merged.

	cat(j, k, "\n")


			} 
		}
	}
	return(temp)
}

SelectCond(dectable)

+ Show code - Hide code

library(OpasnetUtils)
library(xtable)
library(ggplot2)

# List of decisions to be included in the ovariables as scenarios.

decisions <- tidy(opbase.data("Op_en5677.decisions"))

# The next row should happen inside tidy but it doesn't. Why?
decisions <- decisions[ , colnames(decisions) != "Obs"]

# BAU options are added to each combination Decisionmaker - Decision - Variable. This should be included in the DecisionTableParser.
BAUs <- decisions[!duplicated(decisions[c("Decisionmaker", "Decision", "Variable")]), ]
BAUs$Change <- "Add"
BAUs$Result <- 0
BAUs$Option <- "BAU"
decisions <- rbind(BAUs, decisions)

DecisionTableParser(decisions)

Fetch2(data.frame(Name = c("health.impact", "exposure", "training.costs"), Key = c("goTWH6nQtdO97JxD", "m22i7AfzxByOBaaG", "axwlfkG0w4RYJsAi")))

# Evaluate ovariables and add decisions to them. This part should be put inside ComputeDependencies.

exposure <- EvalOutput(exposure)
exposure <- CheckDecisions(exposure)
health.impact <- EvalOutput(health.impact)
health.impact <- CheckDecisions(health.impact)
training.costs <- EvalOutput(training.costs)
training.costs <- CheckDecisions(training.costs)

summary(exposure)
summary(health.impact)
summary(training.costs)

# Stakeholder probabilities are not implemented yet.

########### Graphs about health impacts by different decision options or source of estimates.

ggplot(health.impact@output, aes(x = Year, y = health.impactResult, colour = Health.promotion)) + 
	geom_boxplot() + 
	theme_grey(base_size = 24)

ggplot(health.impact@output, aes(x = Year, y = health.impactResult, colour = Cleaning.policy)) + 
	geom_boxplot() + 
	theme_grey(base_size = 24)

ggplot(health.impact@output, aes(x = Year, y = health.impactResult, colour = health.impactSource)) + 
	geom_boxplot() + 
	theme_grey(base_size = 24)

######################### Calculate endpoints of interest for each stakeholder.

endpoints <- tidy(opbase.data("Op_en5677.endpoints")) # List of stakeholders' endpoints.

# Remove these redundant columns from intermediate results:
removals <- c("exposureUnit", "exposureDescription", "exposureSource", "health.impactDescription", "health.impactSource",
	"health.impactUnit", "exposureResult", "health.impactResult")

endpoint <- list() # Initiate a list for collecting stakeholder-specific endpoints.

for(i in unique(endpoints$Stakeholder)) {

	dectable <- endpoints[endpoints$Stakeholder == i, ]

	# Initiate an endpoint ovariable for the next stakeholder. Results will come later.
	endpoint[[i]] <- new("ovariable", name = "endpoint", output = data.frame(Result = 0))

	for (j in 1:nrow(dectable)) { 
		
		# In the decision table format conditions are given in the "Cell"-column separated by ";".
					
		sel1 <- strsplit(as.character(dectable[j, "Cell"]), split = ";")[[1]] 
					
		# ":" defines index - location matches as a condition.
					
		sel2 <- strsplit(sel1, split = ":") # No need for lapply, since strsplit is a vectorized function and current list depth is 1.
					
		# Create a list of conditions which the decision and option specific condition vector consists of. 
					
		tempovar <- get(as.character(dectable[j, "Variable"]))
		temp <- tempovar@output

		for (k in 1:length(sel1)) { # For each condition separated by ";"

			if (length(sel2[[k]]) > 1) { # If ":" has been used for condition k
				locs <- strsplit(sel2[[k]][2], split = ",")[[1]] # Split by "," for multiple locs per given index
				temp <- temp[temp[, sel2[[k]][1]] %in% locs , ] # Match our data.frame to the condition
				temp <- temp[, colnames(temp) != sel2[[k]][1] ] # Remove all indices that were  used in selecting rows, because otherwise they cannot be merged.
			}
		}

		# Make an ovariable out of the rows matching the condition.
		tempovar@output <- temp

		# Multiply by the weight and add to previous stakeholder endpoint.

		tempovar <- tempovar * as.numeric(as.character(dectable[j, "Result"]))

		# Remove columns that are not needed but may confuse merge.
		tempovar@output <- tempovar@output[ , !colnames(tempovar@output) %in% removals]
		endpoint[[i]] <- endpoint[[i]] + tempovar

	}
}

names(endpoint)[1]
summary(endpoint[[1]])

# names(endpoint)[2]
# summary(endpoint[[2]]) # This row causes in unidentified error even if the ovariable is OK.



############### Make graphs about the endpoint by decision options

ggplot(endpoint[[1]]@output, aes(x = Cleaning.policy, y = Result, colour = Health.promotion)) + 
	geom_boxplot() + 
	theme_grey(base_size = 24) +
	labs( # label names
		title 	= names(endpoint)[1], 
		y 	= "Euro",
		x 	= "Cleaning policy decision"
	)

ggplot(endpoint[[2]]@output, aes(x = Health.promotion, y = Result, colour = Cleaning.policy)) + 
	geom_boxplot() + 
	theme_grey(base_size = 24) +
	labs( # label names
		title 	= names(endpoint)[2], 
		y 	= "Euro",
		x 	= "Health promotion decision"
	)

References

Related files

Help pages	Wiki editing • How to edit wikipages • Quick reference for wiki editing • Drawing graphs • Opasnet policies • Watching pages • Writing formulae • Word to Wiki • Wiki editing Advanced skills
Training assessment (examples of different objects)	Training assessment • Training exposure • Training health impact • Training costs • Climate change policies and health in Kuopio • Climate change policies in Kuopio
Methods and concepts	Assessment • Variable • Method • Question • Answer • Rationale • Attribute • Decision • Result • Object-oriented programming in Opasnet • Universal object • Study • Formula • OpasnetBaseUtils • Open assessment • PSSP
Terms with changed use	Scope • Definition • Result • Tool

Training assessment

Contents

Scope

Question

Boundaries

Scenarios

Intended users

Participants

Answer

Conclusions

Results

Rationale

Assessment-specific data

Calculations

See also

References

Related files

Navigation menu