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