Learn R Programming

MDP2 (version 2.1.2)

plotHypergraph: Plot parts of the state expanded hypergraph (experimental).

Description

The plot is created based on a grid (rows, cols). Each grid point is numbered from bottom to top and left to right (starting from 1), i.e. given grid point with coordinates (r, c) (where (1,1) is the top left corner and (rows, cols) is the bottom right corner) the grid id is `(c

      • rows + r`. You must assign a node to the hypergraph to a grid point (see below).

Usage

plotHypergraph(
  hgf,
  gridDim,
  showGrid = FALSE,
  radx = 0.03,
  rady = 0.05,
  cex = 1,
  marX = 0.035,
  marY = 0.15,
  ...
)

Value

No return value (NULL invisible), called for side effects (plotting).

Arguments

hgf

A list with the hypergraph containing two data frames, normally found using getHypergraph(). The data frame nodes must have columns: sId (state id), gId (grid id) and label (node label). The data frame hyperarcs must have columns sId (head node), trans<n> (tail nodes), aIdx (action index), label (action label), lwd (hyperarc line width), lty (hyperarc line type) and col (hyperarc color).

gridDim

A 2-dim vector (rows, cols) representing the size of the grid.

showGrid

If true show the grid points (good for debugging).

radx

Horizontal radius of the box.

rady

Vertical radius of the box.

cex

Relative size of text.

marX

Horizontal margin.

marY

Vertical margin.

...

Graphical parameters passed to textempty.

See Also

getHypergraph() and plot.HMDP().

Examples

Run this code
## Set working dir
wd <- setwd(system.file("models", package = "MDP2"))

#### A finite-horizon replacement problem ####
mdp<-loadMDP("machine1_")
plot(mdp)
plot(mdp, hyperarcColor = "label")  # colors based on labels
plot(mdp, hyperarcColor = "label", nodeLabel = "sId:label")  # node labels are 'sId: label'
plot(mdp, nodeLabel = "sIdx:label", radx = 0.02)  # adjust radx in nodes
scrapValues <- c(30, 10, 5, 0)  # scrap values (the values of the 4 states at stage 4)
runValueIte(mdp, "Net reward" , termValues = scrapValues)
plot(mdp, hyperarcColor = "policy")  # highlight optimal policy
plot(mdp, hyperarcShow = "policy", nodeLabel = "weight")  # show only optimal policy


#### An infinite-horizon maintenance problem ####
mdp<-loadMDP("hct611-1_")
plot(mdp)  # plot the first two stages
plot(mdp, hyperarcColor = "label")  # colors based on labels
plot(mdp, hyperarcColor = "label", nodeLabel = "sId:label")  # node labels are 'sId: label'
runPolicyIteAve(mdp,"Net reward","Duration")
plot(mdp, hyperarcColor = "policy")  # highlight optimal policy
plot(mdp, hyperarcShow = "policy")  # show only optimal policy


#### An infinite-horizon hierarchical replacement problem ####
library(magrittr)
mdp<-loadMDP("cow_")
hgf <- getHypergraph(mdp)
# modify labels
dat <- hgf$nodes %>% 
   dplyr::mutate(label = dplyr::case_when(
      label == "Low yield" ~ "L",
      label == "Avg yield" ~ "A",
      label == "High yield" ~ "H",
      label == "Dummy" ~ "D",
      label == "Bad genetic level" ~ "Bad",
      label == "Avg genetic level" ~ "Avg",
      label == "Good genetic level" ~ "Good",
      TRUE ~ "Error"
   ))
# assign nodes to grid ids
dat$gId[1:3]<-85:87
dat$gId[43:45]<-1:3
getGId<-function(process,stage,state) {
   if (process==0) start=18
   if (process==1) start=22
   if (process==2) start=26
   return(start + 14 * stage + state)
}
idx<-43
for (process in 0:2)
   for (stage in 0:4)
      for (state in 0:2) {
         if (stage==0 & state>0) break
         idx<-idx-1
         #cat(idx,process,stage,state,getGId(process,stage,state),"\n")
         dat$gId[idx]<-getGId(process,stage,state)
      }
hgf$nodes <- dat
# modify labels
dat <- hgf$hyperarcs %>% 
   dplyr::mutate(label = dplyr::case_when(
      label == "Replace" ~ "R",
      label == "Keep" ~ "K",
      label == "Dummy" ~ "D",
      TRUE ~ "Error"
   ),
   col = dplyr::case_when(
      label == "R" ~ "deepskyblue3",
      label == "K" ~ "darkorange1",
      label == "D" ~ "black",
      TRUE ~ "Error"
   ),
   lwd = 0.5,
   label = ""
   ) 
hgf$hyperarcs <- dat
# plot hypergraph
oldpar <- par(mai = c(0, 0, 0, 0))
plotHypergraph(gridDim = c(14, 7), hgf, cex = 0.8, radx = 0.02, rady = 0.03)
par(oldpar)

## Reset working dir
setwd(wd)

Run the code above in your browser using DataLab