Training assessment: Difference between revisions

From Opasnet
Jump to navigation Jump to search
(→‎Calculations: updated code works)
Line 88: Line 88:
costs <- EvalOutput(costs)
costs <- EvalOutput(costs)


oprint(summary(health_impact))
costs2 <- oapply(unkeep(costs, sources = TRUE), cols ="Expenditure", FUN = sum)


colnames(exposure@output)
cat("Summary of health impacts\n")
colnames(health_impact@output)
 
colnames(costs@output)
oprint(summary(health_impact), digits = 0)
 
cat("Summary of all costs\n")
 
oprint(summary(costs2), digits = 0)


ggplot(exposure@output, aes(x = exposureResult, colour = Year)) + geom_density() +
ggplot(exposure@output, aes(x = exposureResult, colour = Year)) + geom_density() +
Line 102: Line 106:
facet_grid(Cleaning_policy ~ Health_promotion)
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() +
 
ggplot(subset(costs2@output, Year = 2020), aes(x = costsResult, colour = Payer)) + geom_density() +
theme_gray(base_size = 24) +
theme_gray(base_size = 24) +
facet_grid(Cleaning_policy ~ Health_promotion)
facet_grid(Cleaning_policy ~ Health_promotion)
</rcode>
<rcode label="testcode">
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)
</rcode>
<rcode
name="answer"
graphics="1"
include="page:OpasnetUtils/Summary|name:summary"
>
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"
)


</rcode>
</rcode>

Revision as of 11:38, 24 March 2015



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

Answer

Conclusions

Results

Not yet available.

Rationale

The causal diagram for the training assessment.

Assessment-specific data

Decisions
Decisions(-)
ObsDecisionmakerDecisionOptionVariableCellChangeUnitAmountDescription
1FactoryCleaning_policyBAUexposureYear:2020Multiply-1
2FactoryCleaning_policyReduce emissionsexposureYear:2020Multiply-0.5
3FactoryCleaning_policyBAUcostsAdd0
4FactoryCleaning_policyReduce emissionscostsYear:2020;Expenditure:Cleaning equipment useAdd50000
5City of KuopioHealth_promotionBAUhealth_impactMultiply-1
6City of KuopioHealth_promotionIncrease health educationhealth_impactMultiply-0.9
7City of KuopioHealth_promotionBAUcostsAdd0
8City of KuopioHealth_promotionIncrease health educationcostsYear:2020;Expenditure:Health promotion campaignAdd10000


Variables
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

What is the unit cost of one case of disease?:

+ Show code

See also

Materials and examples for training in Opasnet and open assessment
Help pages Wiki editingHow to edit wikipagesQuick reference for wiki editingDrawing graphsOpasnet policiesWatching pagesWriting formulaeWord to WikiWiki editing Advanced skills
Training assessment (examples of different objects) Training assessmentTraining exposureTraining health impactTraining costsClimate change policies and health in KuopioClimate change policies in Kuopio
Methods and concepts AssessmentVariableMethodQuestionAnswerRationaleAttributeDecisionResultObject-oriented programming in OpasnetUniversal objectStudyFormulaOpasnetBaseUtilsOpen assessmentPSSP
Terms with changed use ScopeDefinitionResultTool


  • Descriptions of a previous structure
  • ----#: . Päätöksenteon sokea piste: se mitä ihmiset eivät näe mutta eivät myöskään huomaa etteivät näe. Kuitenkin tutkimalla sitä mitä mitä ihmiset eivät näe saadaan selville asioita sokeasta pisteesta. Ymmärtämällä sokeaa pistettä voidaan keksiä asioita jotka järjestelmällisesti jäävät huomaamatta ja asioita, joilla voidaan korjata järjestelmällisiä puutteita. Avoin arviointi on tämmöinen päätöksenteon järjestelmällisten puutteiden korjausmekanismi. --Jouni 08:55, 1 May 2012 (EEST) (type: truth; paradigms: science: comment)

References


Related files

<mfanonymousfilelist></mfanonymousfilelist>