D2_gmod_decision_tree.Rmdgmod is build on the Grammar of Modeling, and meant to allow for building decision trees and Markov models using a concise and flexible syntax. This introductory example illustrates a simple decision tree that we will gradually build on in other vignettes.
If you haven’t already, install gmod using devtools. Also, make sure to enable use_vignettes so that vignettes render correctly.
#library(devtools)
#install_github("hjalal/gmod", use_vignettes = TRUE, force = TRUE)
rm(list = ls())
library(gmod)
#> Please note that active development of gmod is now moved to twig. Please install twig https://hjalal.github.io/twig/ and review the vignettes for the latest features.First, we define the gmod object by defining its layers.
mygmod <- gmod() +
decisions("A", "B") +
event(name = "get_infection",
scenarios = c(T, F),
probs = c(pSick(decision), Inf),
outcomes = c("Sick", "Healthy")) +
payoffs(life_expectancy = compute_le(final_outcome))The gmod() function creates a gmod object of type
“Decision” standing for a decision tree.
For a Markov model, please see the Markov model Vignette.
The decision() function describes the decision options.
These can later be referred to with the special keyword (decision)
below. There should be only one decisions layer per gmod object. The
event_mapping() describes a single event “get_infection”.
This event takes two values TRUE or FALSE. [Below we expand this to use
more than two values.] If TRUE the person ends up with the “Sick”
final_outcome, otherwise they end up with the “Healthy” final_outcome.
The probs argument defines the probability of getting sick. Notice that
we are using an external function pSick (that we will
define next). This function returns a different value depending on the
decision. The Inf is a place holder computes the
complementary probbility (i.e., 1-pSick()) and reduces the
amount of typing required. The payoffs layer defines the payoffs. Here
we use a single payoff life_expectancy the value of which is computed
using the compute_LE() function by taking the special
keyword final_outcome defined below. final_outcomes are the outcomes of
the final events in the gmod object.
pSick <- function(decision){
if (decision == "A") 0.5 else 0.7
}pSick is a simple function here that will return 0.5 if the decision=“A”, otherwise 0.7. Later we will show how to create more complex probabilities that can take into account the value of prior events which will help us keep the code concise.
compute_le <- function(final_outcome){
if (final_outcome == "Sick") 20 else 40
}Similar to pSick above, we define the
compute_le() as a function of the final_outcome. If Sick,
it returns 20 years, if Healthy, it returns 40 years.
NOTE: R is case sensitivie, so you have to make sure that all the
oucomes, payoffs, values, decisions follow the same case. For example,
if we use final_outcome=="sick" that is not the same as
final_outcome=="Sick".
Then, we can build the gmod object by calling
gmod_build() function which returns the formulae of our
decision tree as a list
model_struc <- gmod_build(mygmod)
model_struc
#> $decisions
#> [1] "A" "B"
#>
#> $n_decisions
#> [1] 2
#>
#> $n_events
#> [1] 1
#>
#> $final_outcomes
#> [1] "Sick" "Healthy"
#>
#> $n_final_outcomes
#> [1] 2
#>
#> $events
#> [1] "get_infection"
#>
#> $payoffs
#> $payoffs$life_expectancy
#> compute_le(final_outcome)
#>
#>
#> $payoff_names
#> [1] "life_expectancy"
#>
#> $n_payoffs
#> [1] 1
#>
#> $final_outcome_formulae
#> # A tibble: 4 × 6
#> # Groups: decision, final_outcome [4]
#> decision final_outcome path_id probs get_infection life_expectancy
#> <chr> <chr> <dbl> <chr> <chr> <chr>
#> 1 A Healthy 2 (1-(pSick('A'))) FALSE compute_le('Hea…
#> 2 A Sick 1 (pSick('A')) TRUE compute_le('Sic…
#> 3 B Healthy 2 (1-(pSick('B'))) FALSE compute_le('Hea…
#> 4 B Sick 1 (pSick('B')) TRUE compute_le('Sic…
#>
#> $summary_formulae
#> # A tibble: 2 × 2
#> decision life_expectancy
#> <chr> <chr>
#> 1 A (1-(pSick('A')))*compute_le('Healthy')+(pSick('A'))*compute_le('Sick…
#> 2 B (1-(pSick('B')))*compute_le('Healthy')+(pSick('B'))*compute_le('Sick…
#>
#> attr(,"class")
#> [1] "gmod_decision"
gmod_gen_model_function(model_struc)
#> Warning in gmod_gen_model_function.gmod_decision(model_struc): Model function my_decision_model is generated. It can be run by calling it directly:
#> my_decision_model(params)
#> $decisions
#> [1] "A" "B"
#>
#> $n_decisions
#> [1] 2
#>
#> $n_events
#> [1] 1
#>
#> $final_outcomes
#> [1] "Sick" "Healthy"
#>
#> $n_final_outcomes
#> [1] 2
#>
#> $events
#> [1] "get_infection"
#>
#> $payoffs
#> $payoffs$life_expectancy
#> compute_le(final_outcome)
#>
#>
#> $payoff_names
#> [1] "life_expectancy"
#>
#> $n_payoffs
#> [1] 1
#>
#> $final_outcome_formulae
#> # A tibble: 4 × 6
#> # Groups: decision, final_outcome [4]
#> decision final_outcome path_id probs get_infection life_expectancy
#> <chr> <chr> <dbl> <chr> <chr> <chr>
#> 1 A Healthy 2 (1-(pSick('A'))) FALSE compute_le('Hea…
#> 2 A Sick 1 (pSick('A')) TRUE compute_le('Sic…
#> 3 B Healthy 2 (1-(pSick('B'))) FALSE compute_le('Hea…
#> 4 B Sick 1 (pSick('B')) TRUE compute_le('Sic…
#>
#> $summary_formulae
#> # A tibble: 2 × 2
#> decision life_expectancy
#> <chr> <chr>
#> 1 A (1-(pSick('A')))*compute_le('Healthy')+(pSick('A'))*compute_le('Sick…
#> 2 B (1-(pSick('B')))*compute_le('Healthy')+(pSick('B'))*compute_le('Sick…
#>
#> attr(,"class")
#> [1] "gmod_decision"
my_decision_model(model_struc)
#> life_expectancy
#> A 30
#> B 26This list returns information about our tree. For example, the final_outcomes and the payoffs. It also returns two tables the first one lists the expanded form of the tree and the formulae by decision and final_outcome and each path that leads to the final_outcome. The second is a summary table for the formulae involved in the payoffs. Let’s take a look at the payoff summary table.
model_struc$summary_formulae
#> # A tibble: 2 × 2
#> decision life_expectancy
#> <chr> <chr>
#> 1 A (1-(pSick('A')))*compute_le('Healthy')+(pSick('A'))*compute_le('Sick…
#> 2 B (1-(pSick('B')))*compute_le('Healthy')+(pSick('B'))*compute_le('Sick…This table will return two formuale for life expectancy, one per
decision. For example life expectancy of A equals
(1-(pSick('A')))*compute_le('Healthy')+(pSick('A'))*compute_le('Sick').
This is a meaningful formula as it describes the life expectancy of
decision A as a weighted sum of probability of getting sick given A and
life expectancy given each final_outcome Sick and Healthy. We can also
evaluate this formula directly of gmod
(1-(pSick('A')))*compute_le('Healthy')+(pSick('A'))*compute_le('Sick')
#> [1] 30This returns 30 years on average for treatment A.
We can formally evaluate our gmod object by calling the function
gmod_evaluate():
model_res <- gmod_evaluate(model_struc)
#> Warning in gmod_evaluate.gmod_decision(model_struc): No parameters were provided. Will use the parameters from the global environment.
#> If instead you want to evaluate the model with specific parameter values, please provide
#> them here as list.
model_res
#> $summary_results
#> # A tibble: 2 × 2
#> decision life_expectancy
#> <chr> <chr>
#> 1 A 30
#> 2 B 26
#>
#> attr(,"class")
#> [1] "gmod_decision"The main output is a table containing the values of the payoffs. We can see the 30 years for A, and also we can see that the life expectancy for B is 26 years. Which we can double check by examing the formula for B:
(1-(pSick('B')))*compute_le('Healthy')+(pSick('B'))*compute_le('Sick')
#> [1] 26In other vignette, we show other features, including: