Training assessment: Difference between revisions

From Opasnet
Jump to navigation Jump to search
(→‎Calculations: code cleaned)
Line 153: Line 153:
library(ggplot2)
library(ggplot2)


 
# List of decisions to be included in the ovariables as scenarios.
net.cost <- new("ovariable",
name = "net.cost",
dependencies = data.frame(
Name = c("health.impact", "costs", "endpoints"),
Key = c("", "", "")
),
formula = function(dependencies, ...) {
ComputeDependencies(dependencies, ...)
 
# Using weighted sum model
 
 
return(0)
}
)
 
endpoints <- new("ovariable",
name = "endpoints",
data = tidy(opbase.data("Op_en5677.endpoints"), objname = "endpoints")
)


decisions <- tidy(opbase.data("Op_en5677.decisions"))
decisions <- tidy(opbase.data("Op_en5677.decisions"))
Line 190: Line 170:


Fetch2(data.frame(Name = c("health.impact", "exposure"), Key = c("h796UrJF1UAVZp9H", "m22i7AfzxByOBaaG")))
Fetch2(data.frame(Name = c("health.impact", "exposure"), Key = c("h796UrJF1UAVZp9H", "m22i7AfzxByOBaaG")))
# Evaluate ovariables and add decisions to them. This part should be put inside ComputeDependencies.


exposure <- EvalOutput(exposure)
exposure <- EvalOutput(exposure)
Line 199: Line 181:
summary(health.impact)
summary(health.impact)


probabilities <- new("ovariable",
# Stakeholder probabilities are not implemented yet.
name = "probabilities",
 
data = tidy(opbase.data("Op_en5677.probabilities"), objname = "probabilities")
########### 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)) +  
ggplot(health.impact@output, aes(x = Year, y = health.impactResult, colour = Health.promotion)) +  
Line 216: Line 197:
theme_grey(base_size = 24)
theme_grey(base_size = 24)


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


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


# Conditions: Constructing a list of logical vectors which correspond to those rows of our new data.frame that we want to apply
# Remove these redundant columns from intermediate results:
# effects on.
# Build multiple condition vectors that correspond to a unique decision - option combination
 
endpoint <- list()
removals <- c("exposureUnit", "exposureDescription", "exposureSource", "health.impactDescription", "health.impactSource",
removals <- c("exposureUnit", "exposureDescription", "exposureSource", "health.impactDescription", "health.impactSource",
"health.impactUnit", "exposureResult", "health.impactResult")
"health.impactUnit", "exposureResult", "health.impactResult")
endpoint <- list() # Initiate a list for collecting stakeholder-specific endpoints.


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


print(i)
print(i)


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


endpoint[[i]] <- new("ovariable", name = "endpoint", output = data.frame(Result = 0))
# 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)) {  
for (j in 1:nrow(dectable)) {  
# In the decision table format conditions are given in the "Cell"-column separated by ";".
# In the decision table format conditions are given in the "Cell"-column separated by ";".
sel1 <- strsplit(as.character(dectable[j, "Cell"]), split = ";")[[1]]  
sel1 <- strsplit(as.character(dectable[j, "Cell"]), split = ";")[[1]]  
# ":" defines index - location matches as a condition.
# ":" 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.
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.  
# Create a list of conditions which the decision and option specific condition vector consists of.  
tempovar <- get(as.character(dectable[j, "Variable"]))
tempovar <- get(as.character(dectable[j, "Variable"]))
temp <- tempovar@output[tempovar@output$health.impactSource == "Formula", ]
# In this particular case, take only the results derived by Formula, because data is poor.
temp <- tempovar@output[tempovar@output$health.impactSource == "Formula", ]


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


if (length(sel2[[k]]) > 1) { # If ":" has been used for condition k
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
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[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.
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")
# 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"]))
}


# Make an ovariable out of the rows matching the condition.
# Remove columns that are not needed but may confuse merge.
tempovar@output <- temp
tempovar@output <- tempovar@output[ , !colnames(tempovar@output) %in% removals]
endpoint[[i]] <- endpoint[[i]] + tempovar


# Multiply by the weight and add to previous stakeholder endpoint.
}
 
}
tempovar <- tempovar * as.numeric(as.character(dectable[j, "Result"]))
endpoint
 
#print(xtable(tempovar@output[
# tempovar@output$Iter == 1 &
# tempovar@output$Health.promotion == "Increase health education" &
# tempovar@output$Cleaning.policy == "BAU", ]), type = 'html')
 
# Remove columns that are not needed but may confuse merge.
tempovar@output <- tempovar@output[ , !colnames(tempovar@output) %in% removals]


#cat("Tempovar\n")
############### Make graphs about the endpoint by decision options
#print(head(tempovar@output))
#print(nrow(tempovar@output))
 
endpoint[[i]] <- endpoint[[i]] + tempovar
 
#cat("Endpoint updated\n")
#print(head(endpoint[[i]]@output))
#print(nrow(endpoint[[i]]@output))
 
}}
endpoint


ggplot(endpoint[[1]]@output, aes(x = Cleaning.policy, y = Result, colour = Health.promotion)) +  
ggplot(endpoint[[1]]@output, aes(x = Cleaning.policy, y = Result, colour = Health.promotion)) +  

Revision as of 04:49, 4 January 2013



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

The causal diagram for the training assessment.

Assessment-specific data

Decisions
Decisions(-)
ObsDecisionmakerDecisionOptionVariableCellChangeUnitAmountDescription
1FactoryCleaning.policyReduce emissionsexposureYear:2020Multiply-0.5
2SchoolHealth.promotionIncrease health educationhealth.impactYear:2020Multiply-0.9
3SchoolHealth.promotionPromotion budget reducedhealth.impactYear:2020Multiply-1.1
Probabilities
Probabilities(P)
ObsStakeholderVariableCellProbabilityDescription
1City of KuopioexposureCleaning.policy: Reduce emissions0.8
2City of KuopioexposureCleaning.policy: BAU0.2
3Factoyhealth.impactHealth.promotion: Increase health education0.1
4Factoyhealth.impactHealth.promotion: Promotion budget reduced0.4
5Factoyhealth.impactHealth.promotion: BAU0.5
Endpoints
Endpoints(-)
ObsStakeholderVariableCellModelResultDescription
1City of Kuopiohealth.impactYear:2012Weighted sum1000
2City of Kuopiohealth.impactYear:2020Weighted sum1000
3Citizenshealth.impactYear:2012Weighted sum1000
4Citizenshealth.impactYear:2020Weighted sum2000Future years are twice as important.
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

+ Show code

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