#+SETUPFILE: https://fniessen.github.io/org-html-themes/org/theme-readtheorg.setup
# (setq org-html-validation-link nil) ;; local /usr/share/emacs/26.3/lisp/org/ox-html.el.gz: http://validate -> https://validate

#+title: Examples for the microsimulation package
#+author: Mark Clements

# +options: toc:nil
#+latex_header: \usepackage[margin=2.54cm]{geometry}

#+BEGIN_SRC R :session *R* :results none :exports none :eval yes
  library(ascii)
  options(asciiType="org")
#+end_src  

* Introduction

- Some examples in both R and C++.


* Tick-tock model

- This simple model includes three states and three transitions:

#+BEGIN_SRC plantuml :file tick_tock.png :eval no
skinparam monochrome true
skinparam ActivityBackgroundColor #FFFFFF
'skinparam shadowing false
Tick -r-> [μ] Tock
Tock -r-> [μ] Tick
Tick -d-> [μ/10] Stop
Tock -r-> [μ/10] Stop
#+END_SRC

#+attr_latex: :width 4cm
#+RESULTS:
[[file:tick_tock.png]]


** R version

- In this implementation, we model only for the events, where the states are implied by the transitions. Note that there are no simulation attributes. 
- Initially, a message is printed, and ="tick"= and ="stop"= events are scheduled.
- For each message or event:
  + A description of the event is printed
  + The response is defined in terms of ="tick"= \rightarrow ="tock"=, ="tock"= \rightarrow ="tick"= and ="stop"= \rightarrow =clear()=.
- Finally, we print a message and return the final time.
- To run this, we set the seed, get a new class instance, and =run()= the class twice.

#+BEGIN_SRC R :session *R* :results output :exports both :eval no
library(microsimulation, quietly=TRUE)
tick_tock =
    setRefClass("tick_tock",
                contains="BaseDiscreteEventSimulation",
                methods=list(
                    init = \() {
                        cat("Started\n")
                        scheduleAt(rexp(1,1), "tick")
                        scheduleAt(rexp(1,0.1), "stop")
                    },
                    handleMessage = \(msg) {
                        cat(sprintf("Time: %f; event: %s\n", now(), msg))
                        switch(msg, 
                               tick=scheduleAt(now()+rexp(1), "tock"),
                               tock=scheduleAt(now()+rexp(1), "tick"),
                               clear())
                    },
                    final = \() {cat("Finished\n"); now()} ))
set.seed(12345)
sim = new("tick_tock")
replicate(2, sim$run())
#+end_src

#+RESULTS:
#+begin_example

Attaching package: ‘microsimulation’

The following object is masked from ‘package:Rcpp’:

    LdFlags
Started
Time: 0.441808; event: tick
Time: 1.250275; event: tock
Time: 1.268724; event: tick
Time: 1.724134; event: tock
Time: 1.748072; event: tick
Time: 5.274728; event: stop
Finished
Started
Time: 1.257961; event: tick
Time: 3.075964; event: tock
Time: 3.302451; event: tick
Time: 3.749214; event: tock
Time: 5.001675; event: tick
Time: 5.398762; event: tock
Time: 5.486878; event: tick
Time: 7.209042; event: tock
Time: 9.621881; event: stop
Finished
[1] 5.274728 9.621881
#+end_example

** C++ version

- For the C++ code, we first show that the Rcpp and C++ code depends on the =microsimulation= package.
- For brevity, we use the =ssim= namespace.
- We define a class =tick_tock= that inherits from the =cProcess= class.
- We define a class field for the =finish_time=.
- We initialise the simulation using the =init()= function. In this case, we print out a message and schedule the ="tick"= and ="stop"= events.
- We handle each message or event by (a) printing a message for the event and (b) then schedule other events depending on the message =name=, which is a =std::string=.
- At the end of the process, we call the =stop()= method, which copies the final time to =finish_time= and print a message.
- We export the =call_tick_tock= function from C++ to C for calling from R. This function defines the =sim= process as an instance of =tick_tock=, inserts the process into the simulation using =create_process=, runs the simulation, clears the simulation queue, and returns =finish_time=.
- In R, we compile the function using the =sourceCpp= function, set the random seed, and call =call_tick_tock= function twice.
- The C++ model has the same output as the R version.

#+BEGIN_SRC R :session *R* :results output :exports both :eval no
library(microsimulation, quietly=TRUE)
sourceCpp(code="
  // [[Rcpp::depends(microsimulation)]]
  #include <microsimulation.h>
  using namespace ssim;
  // define a process
  class tick_tock : public cProcess
  {
  public:
    double finish_time;
    // initialise the simulation
    void init() {
      Rprintf(\"Started\\n\");
      scheduleAt(R::rexp(1.0), \"tick\");
      scheduleAt(R::rexp(10.0), \"stop\");
    }
    // handle the messages
    void handleMessage(const cMessage* msg) {
      Rprintf(\"Time: %f; event: %s\\n\", now(), msg->name.c_str());
      msg->name == \"tick\" ? scheduleAt(now()+R::rexp(1.0), \"tock\") :
        msg->name == \"tock\" ? scheduleAt(now()+R::rexp(1.0), \"tick\") :
        Sim::stop_process();
    }
    void stop() {
      finish_time = now();
      Rprintf(\"Finished\\n\");
    }
  };
  // Exported function: Run the simulation once and return the finish time
  // [[Rcpp::export]]
  double call_tick_tock() {
    tick_tock sim;
    Sim::create_process(&sim);
    Sim::run_simulation();
    Sim::clear();
    return sim.finish_time;
  }")
set.seed(12345)
replicate(2, call_tick_tock())
#+END_SRC

#+RESULTS:
#+begin_example
Started
Time: 0.441808; event: tick
Time: 1.250275; event: tock
Time: 1.268724; event: tick
Time: 1.724134; event: tock
Time: 1.748072; event: tick
Time: 5.274728; event: stop
Finished
Started
Time: 1.257961; event: tick
Time: 3.075964; event: tock
Time: 3.302451; event: tick
Time: 3.749214; event: tock
Time: 5.001675; event: tick
Time: 5.398762; event: tock
Time: 5.486878; event: tick
Time: 7.209042; event: tock
Time: 9.621881; event: stop
Finished
[1] 5.274728 9.621881
#+end_example


* Illness-death model with costs and QALYs

#+BEGIN_SRC plantuml :file illness_death.png :eval no
skinparam monochrome true
skinparam ActivityBackgroundColor #FFFFFF
'skinparam shadowing false
Healthy -r-> [onset] Illness
Illness -r-> [recovered] Healthy
Healthy -d-> [μ0] Death
Illness -r-> [μ1] Death
#+END_SRC

#+attr_latex: :width 4cm
#+RESULTS:
[[file:illness_death.png]]

** R version

#+BEGIN_SRC R :session *R* :results output :exports both :eval no
library(microsimulation, quietly=TRUE)
illness_death =
    setRefClass("illness_death",
                contains="BaseDiscreteEventSimulation",
                fields=list(utility="numeric", QALY="numeric",
                            cost="numeric", cumulative_costs="numeric",
                            debug="logical"),
                methods=list(
                    initialize = \(debug=TRUE) {debug <<- debug},
                    init = \() {
                        if (debug) cat("Individual:\n")
                        cumulative_costs <<- QALY <<- 0.0
                        toHealthy()
                    },
                    toHealthy = \() {
                        utility <<- 0.95
                        cost <<- 1000
                        scheduleAt(now()+rexp(1,1/30.0), "onset")
                        scheduleAt(now()+rexp(1,1/60.0), "death")
                    },
                    toIllness = \() {
                        utility <<- 0.95*0.8
                        cost <<- 10000
                        scheduleAt(now()+rexp(1,1/5.0), "recovered")
                        scheduleAt(now()+rexp(1,1/10.0), "death")
                    },
                    handleMessage = \(msg) {
                        if (debug) cat(sprintf("Time: %f; event: %s\n", now(), msg))
                        QALY <<- QALY + discountedInterval(utility, previous(), now(), 0.03)
                        cumulative_costs <<- cumulative_costs +
                            discountedInterval(cost, previous(), now(), 0.03)
                        clear()
                        if (msg == "onset")
                            toHealthy()
                        else if (msg == "recovered")
                            toIllness()
                        else
                            clear()
                    }))
set.seed(12345)
sim = new("illness_death")
replicate(5, {sim$run(); c(sim$QALY, sim$cumulative_costs)}) |>
    t() |> data.frame() |> "names<-"(c("QALY","cumulative_cost"))
#+END_SRC

#+RESULTS:
#+begin_example
Individual:
Time: 13.254234; event: onset
Time: 14.361154; event: death
Individual:
Time: 1.436288; event: death
Individual:
Time: 75.477631; event: death
Individual:
Time: 28.865643; event: onset
Time: 35.660268; event: onset
Time: 59.485505; event: death
Individual:
Time: 2.643472; event: onset
Time: 115.923108; event: death
       QALY cumulative_cost
1 11.117066       11702.175
2  1.335915        1406.227
3 28.686987       30196.829
4 26.600625       28000.658
5 31.094833       32731.403
#+end_example

** C++ version

#+BEGIN_SRC R :session *R* :results output :exports both :eval no
library(microsimulation, quietly=TRUE)
sourceCpp(code="
  // [[Rcpp::depends(microsimulation)]]
  #include <microsimulation.h>
  using namespace ssim;
  // define a process
  class illness_death : public cProcess
  {
  public:
    double QALY, utility, cumulative_costs, cost;
    bool debug;
    std::map<std::string,std::vector<double>> report;
    // initialise the simulation
    void init() {
      if (debug) Rprintf(\"Individual:\\n\");
      cumulative_costs = QALY = 0.0;
      this->toHealthy();
    }
    void toHealthy() {
      utility = 0.95;
      cost = 1000.0;
      this->scheduleAt(now()+R::rexp(30.0), \"onset\");
      this->scheduleAt(now()+R::rexp(60.0), \"death\");
    }
    void toIllness() {
      utility = 0.95*0.8;
      cost = 10000.0;
      this->scheduleAt(now()+R::rexp(5.0), \"recovered\");
      this->scheduleAt(now()+R::rexp(10.0), \"death\");
    }
    // handle the messages
    void handleMessage(const cMessage* msg) {
      if (debug) Rprintf(\"Time: %f; event: %s\\n\", now(), msg->name.c_str());
      QALY += discountedInterval(utility, previous(), now(), 0.03);
      cumulative_costs += discountedInterval(cost, previous(), now(), 0.03);
      this->cancel_events(); // in this case, we cancel all of the competing events
      if (msg->name == \"onset\")
        toHealthy();
      else if (msg->name == \"recovered\")
        toIllness();
      else
        Sim::stop_process();
    }
    void stop() {
      report[\"QALY\"].push_back(QALY);
      report[\"cumulative_costs\"].push_back(cumulative_costs);
    }
  };
  // Exported function: Run the simulation once
  // [[Rcpp::export]]
  Rcpp::DataFrame call_illness_death(int n = 5, bool debug = true) {
    illness_death sim;
    sim.debug = debug;
    for (int i=0; i<n; i++) {
      Sim::create_process(&sim);
      Sim::run_simulation();
      Sim::clear();
    }
    return wrap(sim.report);
  }")
set.seed(12345)
call_illness_death()
#+END_SRC

#+RESULTS:
#+begin_example
Individual:
Time: 13.254234; event: onset
Time: 14.361154; event: death
Individual:
Time: 1.436288; event: death
Individual:
Time: 75.477631; event: death
Individual:
Time: 28.865643; event: onset
Time: 35.660268; event: onset
Time: 59.485505; event: death
Individual:
Time: 2.643472; event: onset
Time: 115.923108; event: death
       QALY cumulative_costs
1 11.117066        11702.175
2  1.335915         1406.227
3 28.686987        30196.829
4 26.600625        28000.658
5 31.094833        32731.403
#+end_example

** Benchmark comparing R and C++

#+BEGIN_SRC R :session *R* :results output wrap :exports both :eval no
  microbenchmark::microbenchmark({
      set.seed(12345)
      sim = new("illness_death", debug=FALSE)
      for (i in 1:100) sim$run()
  }, {
      set.seed(12345)
      call_illness_death(100, debug=FALSE)
  },
  times=100) |> ascii()
#+end_src

#+RESULTS:
:RESULTS:
| Unit: microseconds |

|   | expr                                                                                                 | min      | lq       | mean      | median    | uq        | max       | neval  | cld |
|---+------------------------------------------------------------------------------------------------------+----------+----------+-----------+-----------+-----------+-----------+--------+-----|
| 1 | {     set.seed(12345)     sim = new("illness_death", debug = FALSE)     for (i in 1:100) sim$run() } | 81610.48 | 85125.80 | 111311.62 | 117356.17 | 132919.92 | 248876.28 | 100.00 | b   |
| 2 | {     set.seed(12345)     call_illness_death(100, debug = FALSE) }                                   | 426.57   | 544.48   | 655.30    | 690.66    | 809.72    | 859.15    | 100.00 | a   |
:END:


* Reporting using a data-frame

#+BEGIN_SRC plantuml :file reporting.png :eval no
skinparam monochrome true
skinparam ActivityBackgroundColor #FFFFFF
'skinparam shadowing false
Healthy -r-> [onset] Cancer
Healthy -r-> [μ0] OtherDeath
Cancer -d-> [μ0] OtherDeath
Cancer -r-> [μ1] CancerDeath
#+END_SRC

#+attr_latex: :width 6cm
#+RESULTS:
[[file:reporting.png]]


** R version

#+BEGIN_SRC R :session *R* :results output wrap :exports both :eval no
  library(ascii)
  options(asciiType="org")
  library(microsimulation, quietly=TRUE)
  simple_person =
    setRefClass("simple_person",
                contains="BaseDiscreteEventSimulation",
                fields=list(id="numeric", state="character", report="data.frame"),
                methods=list(
                    initialize = \() {id <<- -1L},
                    init = \() {
                        id <<- id + 1L
                        state <<- "Healthy"
                        scheduleAt(rweibull(1,8,85), "toOtherDeath")
                        scheduleAt(rweibull(1,3,90), "toCancer")
                    },
                    handleMessage = \(msg) {
                        report <<- dplyr::bind_rows(report,
                                             data.frame(id=id, startTime=previous(),
                                                        endTime=now(), state=state, event=msg))
                        if (msg == "toCancer") {
                            state <<- "Cancer"
                            if (runif(1)<0.5)
                                scheduleAt(now()+rweibull(1,2,10), "toCancerDeath")
                        } else clear()
                    }))
  set.seed(12345)
  sim = new("simple_person")
  for (i in 1:5) sim$run()
  ascii(sim$report)
#+END_SRC

#+RESULTS:
:RESULTS:
|   |   id | startTime | endTime | state   | event        |
|---+------+-----------+---------+---------+--------------|
| 1 | 0.00 |      0.00 |   45.90 | Healthy | toCancer     |
| 2 | 0.00 |     45.90 |   73.92 | Cancer  | toOtherDeath |
| 3 | 1.00 |      0.00 |   65.27 | Healthy | toOtherDeath |
| 4 | 2.00 |      0.00 |   91.44 | Healthy | toOtherDeath |
| 5 | 3.00 |      0.00 |   61.42 | Healthy | toCancer     |
| 6 | 3.00 |     61.42 |   80.92 | Cancer  | toOtherDeath |
| 7 | 4.00 |      0.00 |   98.92 | Healthy | toOtherDeath |
:END:


** C++ version

#+BEGIN_SRC R :session *R* :results output wrap :exports both :eval no
  sourceCpp(code = "
  // [[Rcpp::depends(microsimulation)]]
  #include <microsimulation.h>
  // utility to make a factor
  Rcpp::IntegerVector make_factor(std::vector<int> v, Rcpp::CharacterVector levels) {
    Rcpp::IntegerVector f(v.size());
    std::transform(v.begin(), v.end(), f.begin(), [](int i) {return 1+i; });
    f.attr(\"class\") = \"factor\";
    f.attr(\"levels\") = levels;
    return f;
  }
  enum state_t {Healthy,Cancer,Death};
  enum event_t {toOtherDeath, toCancer, toCancerDeath};
  class SimplePerson : public ssim::cProcess
  {
  public:
    int id;
    state_t state;
    std::vector<double> startTimes, endTimes;
    std::vector<int> states, events, ids;
    SimplePerson() : id(-1) {};
    void handleMessage(const ssim::cMessage*);
    void init();
  };
  /**
      Initialise a simulation run for an individual
  */
  void SimplePerson::init() {
    id++;
    state = Healthy;
    double tm = R::rweibull(8.0,85.0);
    this->scheduleAt(tm,toOtherDeath);
    this->scheduleAt(R::rweibull(3.0,90.0),toCancer);
  }
  /**
      Handle receiving self-messages
  */
  void SimplePerson::handleMessage(const ssim::cMessage* msg) {
    ids.push_back(id);
    startTimes.push_back(this->previous());
    endTimes.push_back(ssim::now());
    states.push_back(state);
    events.push_back(msg->kind);
    switch(msg->kind) {
    case toOtherDeath:
    case toCancerDeath:
      ssim::Sim::stop_process();
      break;
    case toCancer:
      state = Cancer;
      if (R::runif(0.0,1.0) < 0.5)
	this->scheduleAt(ssim::now() + R::rweibull(2.0,10.0), toCancerDeath);
      break;
    default:
      REprintf(\"No valid kind of event\\n\");
      break;
    } // switch
  } // handleMessage()
  // [[Rcpp::export]]
  Rcpp::DataFrame callSimplePersonB(int n = 5) {
    SimplePerson person;
    for (int i = 0; i < n; i++) {
      ssim::Sim::create_process(&person);
      ssim::Sim::run_simulation();
      ssim::Sim::clear();
    }
    Rcpp::DataFrame df;
    df.push_back(person.ids,\"id\");
    df.push_back(person.startTimes,\"startTime\");
    df.push_back(person.endTimes,\"endTime\");
    df.push_back(make_factor(person.states,{\"Healthy\",\"Ill\",\"Dead\"}), \"state\");
    df.push_back(make_factor(person.events,{\"toOtherDeath\", \"toCancer\", \"toCancerDeath\"}), 
                 \"event\");
    return Rcpp::wrap(df);
  }
")
  set.seed(12345)
  callSimplePersonB() |> ascii()
#+END_SRC

#+RESULTS:
:RESULTS:
|   |   id | startTime | endTime | state   | event        |
|---+------+-----------+---------+---------+--------------|
| 1 | 0.00 |      0.00 |   45.90 | Healthy | toCancer     |
| 2 | 0.00 |     45.90 |   73.92 | Ill     | toOtherDeath |
| 3 | 1.00 |      0.00 |   65.27 | Healthy | toOtherDeath |
| 4 | 2.00 |      0.00 |   91.44 | Healthy | toOtherDeath |
| 5 | 3.00 |      0.00 |   61.42 | Healthy | toCancer     |
| 6 | 3.00 |     61.42 |   80.92 | Ill     | toOtherDeath |
| 7 | 4.00 |      0.00 |   98.92 | Healthy | toOtherDeath |
:END:


** Benchmark comparing R and C++

#+BEGIN_SRC R :session *R* :results output wrap :exports both :eval no
  microbenchmark::microbenchmark({
      set.seed(12345)
      sim = new("simple_person")
      for (i in 1:100) sim$run()
  }, {
      set.seed(12345)
      callSimplePersonB(100)
  },
  times=10) |> ascii()
#+END_SRC

#+RESULTS:
:RESULTS:
| Unit: milliseconds |

|   | expr                                                                                  | min    | lq     | mean   | median | uq     | max    | neval | cld |
|---+---------------------------------------------------------------------------------------+--------+--------+--------+--------+--------+--------+-------+-----|
| 1 | {     set.seed(12345)     sim = new("simple_person")     for (i in 1:100) sim$run() } | 106.92 | 107.73 | 109.16 | 108.31 | 108.66 | 114.07 | 10.00 | b   |
| 2 | {     set.seed(12345)     callSimplePersonB(100) }                                    | 1.03   | 1.09   | 1.20   | 1.13   | 1.26   | 1.66   | 10.00 | a   |
:END:



** C++ using an EventReport

#+BEGIN_SRC R :session *R* :results output graphics :exports both :file "rates.png" :eval no
  library(microsimulation)
  sourceCpp(code = "
  // [[Rcpp::depends(microsimulation)]]
  #include <microsimulation.h>
  enum state_t {Healthy,Cancer};
  enum event_t {toOtherDeath, toCancer, toCancerDeath};
  using Report = ssim::EventReport<short,short,double>;
  class SimplePerson : public ssim::cProcess
  {
  public:
    state_t state;
    Report report;
    SimplePerson() { }
    void handleMessage(const ssim::cMessage*);
    void init();
  };
  /**
      Initialise a simulation run for an individual
  */
  void SimplePerson::init() {
    state = Healthy;
    double tm = R::rweibull(8.0,85.0);
    this->scheduleAt(tm,toOtherDeath);
    this->scheduleAt(R::rweibull(3.0,90.0),toCancer);
  }
  /**
      Handle receiving self-messages
  */
  void SimplePerson::handleMessage(const ssim::cMessage* msg) {
    report.add(state,msg->kind,previous(),ssim::now());
    switch(msg->kind) {
    case toOtherDeath:
    case toCancerDeath:
      ssim::Sim::stop_process();
      break;
    case toCancer:
      state = Cancer;
      if (R::runif(0.0,1.0) < 0.5)
	this->scheduleAt(ssim::now() + R::rweibull(2.0,10.0), toCancerDeath);
      break;
    default:
      REprintf(\"No valid kind of event\\n\");
      break;
    } // switch
  } // handleMessage()
  // [[Rcpp::export]]
  SEXP callSimplePersonC(int n = 10000) {
    SimplePerson person;
    for (int i = 0; i < n; i++) {
      ssim::Sim::create_process(&person);
      ssim::Sim::run_simulation();
      ssim::Sim::clear();
    }
    return person.report.wrap();
  }
  ")
  make_factor = function(x, labels)
      factor(as.integer(x)+1L,labels=labels)
  set.seed(12345)
  report = callSimplePersonC()
  rates = with(report, merge(pt,events,all.x=TRUE)) |>
      transform(rate=ifelse(is.na(number),0,number)/pt,
                Key=make_factor(Key,c("Healthy","Cancer")),
                event=make_factor(event,c("toOtherDeath", "toCancer", "toCancerDeath")))
  lattice::xyplot(rate~age|Key+event, data=rates, type="l")
#+END_SRC

#+attr_latex: :width 8cm
#+RESULTS:
[[file:rates.png]]


