## -----------------------------------------------------------------------------
library("rdecision")

## -----------------------------------------------------------------------------
s_well <- MarkovState$new(name = "Well")
s_disabled <- MarkovState$new(name = "Disabled")
s_dead <- MarkovState$new(name = "Dead")

## -----------------------------------------------------------------------------
E <- list(
  Transition$new(s_well, s_well),
  Transition$new(s_dead, s_dead),
  Transition$new(s_disabled, s_disabled),
  Transition$new(s_well, s_disabled),
  Transition$new(s_well, s_dead),
  Transition$new(s_disabled, s_dead)
)

## -----------------------------------------------------------------------------
m <- SemiMarkovModel$new(V = list(s_well, s_disabled, s_dead), E)

## -----------------------------------------------------------------------------
local({
  # name of SVG file
  svgfile <- tempfile(fileext = ".svg")
  # save the graph as a GML file
  gml <- m$as_gml()
  gmlfile <- tempfile(fileext = ".gml")
  writeLines(gml, con = gmlfile)
  # import it to DiagrammeR
  g <- DiagrammeR::import_graph(gmlfile, file_type = "gml")
  # set global attributes
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "layout",
    value = "neato",
    attr_type = "graph"
  )
  # set global attributes
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "fontsize",
    value = 8L,
    attr_type = "node"
  )
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "shape",
    value = "circle",
    attr_type = "node"
  )
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "color",
    value = "black",
    attr_type = "node"
  )
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "fillcolor",
    value = "white",
    attr_type = "node"
  )
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "fontcolor",
    value = "black",
    attr_type = "node"
  )
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "color",
    value = "black",
    attr_type = "edge"
  )
  g <- DiagrammeR::add_global_graph_attrs(
    g,
    attr = "penwidth",
    value = 0.5,
    attr_type = "edge"
  )
  # get the node ids
  nodes <- DiagrammeR::get_node_attrs(g, node_attr = "label")
  nwell <- which(nodes == "Well")
  ndisabled <- which(nodes == "Disabled")
  ndead <- which(nodes == "Dead")
  # set layout
  g <- DiagrammeR::set_node_position(g, node = nwell, x = 1L, y = 3L)
  g <- DiagrammeR::set_node_position(g, node = ndisabled, x = 3L, y = 3L)
  g <- DiagrammeR::set_node_position(g, node = ndead, x = 2L, y = 1L)
  # set loop directions
  g <- DiagrammeR::set_edge_attrs(
    g,
    edge_attr = "tailport",
    values = "nw",
    from = nwell,
    to = nwell
  )
  g <- DiagrammeR::set_edge_attrs(
    g,
    edge_attr = "tailport",
    values = "ne",
    from = ndisabled,
    to = ndisabled
  )
  g <- DiagrammeR::set_edge_attrs(
    g,
    edge_attr = "tailport",
    values = "sw",
    from = ndead,
    to = ndead
  )
  # render it as an svg file
  DiagrammeR::export_graph(
    g,
    file_name = svgfile,
    file_type = "svg",
    width = 480L
  )
  knitr::include_graphics(path = svgfile, rel_path = FALSE)
})

## -----------------------------------------------------------------------------
s_disabled$set_utility(0.7)
s_dead$set_utility(0.0)

## -----------------------------------------------------------------------------
snames <- c("Well", "Disabled", "Dead")
pt <- matrix(
  data = c(NA, 0.2, 0.2, 0.0, NA, 0.4, 0.0, 0.0, NA),
  nrow = 3L, byrow = TRUE,
  dimnames = list(source = snames, target = snames)
)
m$set_probabilities(pt)

## -----------------------------------------------------------------------------
with(data = as.data.frame(pt), expr = {
  data.frame(
    Well = round(Well, digits = 3L),
    Disabled = round(Disabled, digits = 3L),
    Dead = round(Dead, digits = 3L),
    row.names = row.names(pt),
    stringsAsFactors = FALSE
  )
})

## -----------------------------------------------------------------------------
local({
  ptc <- m$transition_probabilities()
  with(data = as.data.frame(ptc), expr = {
    data.frame(
      Well = round(Well, digits = 3L),
      Disabled = round(Disabled, digits = 3L),
      Dead = round(Dead, digits = 3L),
      row.names = row.names(ptc),
      stringsAsFactors = FALSE
    )
  })
})

## -----------------------------------------------------------------------------
m$reset(populations = c(Well = 10000L, Disabled = 0L, Dead = 0L))

## -----------------------------------------------------------------------------
mt <- m$cycles(25L, hcc.pop = FALSE, hcc.cost = FALSE, hcc.QALY = FALSE)

## -----------------------------------------------------------------------------
t2 <- with(data = mt, expr = {
  data.frame(
    Cycle = Cycle,
    Well = round(Well, digits = 2L),
    Disabled = round(Disabled, digits = 2L),
    Dead = round(Dead, digits = 2L),
    QALY = round(QALY, digits = 4L),
    cQALY = round(cumsum(QALY), digits = 4L),
    stringsAsFactors = FALSE
  )
})
t2

