An up-to-date method for plotting a transition probability matrix?

Question

I'm trying to find an easy, up-to-date way to plot transition matrices. Could someone please recommend a method or package? I found advice on Stack, but the posts are very old, or the referenced packages no longer exist (such as in the Oct 23, 2015 answer to post R transition plot).

Note that my transition matrices are dynamic: depending on user inputs, the number of states and the to/from periods vary based on the composition of the underlying data. So going into the code and manually adjusting box/arrow sizes won't help much.

I've been leaning towards the Apr 20, 2013 answer to Graph flow chart of transition from states, using the Diagram package, but I wonder if there's a more up-to-date method.

I don't need anything too complicated. I like the type of plot shown in this image (I believe generated via the package that no longer exists in the above referenced post, "MmgraphR"):

Or this simpler form works for me too:

Below is a stripped-down version of code I've been using to generate transitions:

library(DT)
library(shiny)
library(dplyr)
library(htmltools)
library(data.table)

data <- 
  data.frame(
    ID = c(1,1,1,2,2,2,3,3,3),
    Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
    State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X9")
  )

numTransit <- function(x, from=1, to=3){
  setDT(x)
  unique_state <- unique(x$State)
  all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
  dcast(x[, .(from_state = State[from], 
              to_state = State[to]), 
          by = ID]
        [,.N, c("from_state", "to_state")]
        [all_states,on = c("from_state", "to_state")], 
        to_state ~ from_state, value.var = "N"
  )
}

ui <- fluidPage(
  tags$head(tags$style(".datatables .display {margin-left: 0;}")), 
  h4(strong("Base data frame:")), 
  tableOutput("data"),
  h4(strong("Transition table inputs:")),
  numericInput("transFrom", "From period:", 1, min = 1, max = 3),
  numericInput("transTo", "To period:", 2, min = 1, max = 3),
  h4(strong("Output transition table:")), 
  DTOutput("resultsDT"),
)

server <- function(input, output, session) {
  results <- 
    reactive({
      results <- numTransit(data, input$transFrom, input$transTo) %>% 
        replace(is.na(.), 0) %>%
        bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Sum")))
      results <- cbind(results, Sum = rowSums(results[,-1]))
      
    # Express results as percentages:
      results %>% 
        mutate(across(-1, ~ .x / .x[length(.x)])) %>% 
        replace(is.na(.), 0) %>% 
        mutate(across(-1, scales::percent_format(accuracy = 0.1)))
    })
 
  output$data <- renderTable(data)
  
  output$resultsDT <- renderDT(server=FALSE, {
    datatable(
      data = results(),
      rownames = FALSE,
      container = tags$table(
        tags$thead(
          tags$tr(
            tags$th(rowspan = 2,sprintf('To state where end period = %s', input$transTo)),
            tags$th(colspan = 10,sprintf('From state where initial period = %s',input$transFrom))),
          tags$tr(mapply(tags$th, colnames(results())[-1], SIMPLIFY = FALSE))
        )
      ),
    )
  })
  
}

shinyApp(ui, server)

score 0 · Accepted Answer · answered Apr 26 '22 at 19:54

After researching the options, all I could find were the Gmisc and diagram packages for plotting transition matrices. The Gmisc package is very visually appealing though it doesn't facilitate the showing of transit values. Diagram package is less visually appealing but easily facilitates the showing of transition values - though to show the From states on the left-side of the plot and the To states on the right-side of the plot, I had to use a for-loop and other code gyrations to double the size of the matrix and fill in the matrix values skipping rows/columns. Since the transition matrices this code is intended for measure 8 x 8 or more, there would be too many numbers to present in a plot. Therefore I'll use Gmisc in the fuller code this post is intended for; the arrows thicken/narrow to represent transition volumes and the user can easily access the transition matrix table with it's >= 64 values. BTW I spent no time making these plots prettier.

Here's the OP code modified to show both plots:

library(DT)
library(shiny)
library(dplyr)
library(htmltools)
library(data.table)
# Add two packages for plotting transitions in different manners:
  library(diagram)
  library(Gmisc)

data <- 
  data.frame(
    ID = c(1,1,1,2,2,2,3,3,3),
    Period = c(1, 2, 3, 1, 2, 3, 1, 2, 3),
    Values = c(5, 10, 15, 0, 2, 4, 3, 6, 9),
    State = c("X0","X1","X2","X0","X2","X0", "X2","X1","X9")
  )

numTransit <- function(x, from=1, to=3){
  setDT(x)
  unique_state <- unique(x$State)
  all_states <- setDT(expand.grid(list(from_state = unique_state, to_state = unique_state)))
  dcast(x[, .(from_state = State[from], 
              to_state = State[to]), 
          by = ID]
        [,.N, c("from_state", "to_state")]
        [all_states,on = c("from_state", "to_state")], 
        to_state ~ from_state, value.var = "N"
  )
}

ui <- fluidPage(
  tags$head(tags$style(".datatables .display {margin-left: 0;}")), 
  h4(strong("Transition table inputs:")),
  numericInput("transFrom", "From period:", 1, min = 1, max = 3),
  numericInput("transTo", "To period:", 2, min = 1, max = 3),
  h4(strong("Output transition table:")), 
  DTOutput("resultsDT"),
  h4(strong("Transition plot using Gmisc package:")), 
  plotOutput("resultsPlot1"),
  h4(strong("Transition plot using diagram package:")),
  plotOutput("resultsPlot2")
)

server <- function(input, output, session) {
  
  results <- 
    reactive({
      results <- numTransit(data, input$transFrom, input$transTo) %>% 
        replace(is.na(.), 0) %>%
        bind_rows(summarise_all(., ~(if(is.numeric(.)) sum(.) else "Sum")))
      results <- cbind(results, Sum = rowSums(results[,-1]))
      results %>% 
        mutate(across(-1, ~ .x / .x[length(.x)])) %>% 
        replace(is.na(.), 0) %>% 
        mutate(across(-1, scales::percent_format(accuracy = 0.1)))
    })
 
# extractResults below used for both Gmisc and diagram plots:
  extractResults <- 
    reactive({
      extractResults <- 
        data.frame(lapply(results()[1:nrow(results())-1,2:nrow(results())], 
                          function(x) as.numeric(sub("%", "", x))/100))
      row.names(extractResults) <- colnames(extractResults) 
      t(as.matrix(extractResults))
      })
  
# M below used only for diagram plots; extractResults matrix must be doubled in size
  M <-
    reactive({
      M <- matrix(nrow = nrow(extractResults())*2, ncol = ncol(extractResults())*2, byrow = TRUE, data = 0)
      
      for (i in 1:(nrow(extractResults()))){
        for (j in 1: ncol(extractResults()))
        {M[i*2-1,j*2] <- extractResults()[i,j]
        }}
      
      t(M)
    })
  
  output$resultsDT <- renderDT(server=FALSE, {
    datatable(
      data = results(),
      rownames = FALSE,
      container = tags$table(
        tags$thead(
          tags$tr(
            tags$th(rowspan = 2,sprintf('To state where end period = %s', input$transTo)),
            tags$th(colspan = 10,sprintf('From state where initial period = %s',input$transFrom))),
          tags$tr(mapply(tags$th, colnames(results())[-1], SIMPLIFY = FALSE))
        )
      ),
    )
  })
  
  output$resultsPlot1 <- # transition plot using Gmisc package
    renderPlot({
      suppressWarnings(
        transitionPlot(extractResults(),
                       tot_spacing = 0.01,
                       fill_start_box = "#8DA0CB",
                       fill_end_box = "#FFFF00",
                       txt_end_clr ="#000000"
        )
      )  
    })
    
  output$resultsPlot2 <- # transition plot using diagram package
    renderPlot({
      plotmat(M(), 
              pos = rep(2,times = nrow(extractResults())),
              name = rep(colnames(extractResults()), each = 2),
              curve = 0, # the closer to 1 the more arced the curve
              arr.width = 0.3, # the greater the nbr the larger the arrowhead
              lwd = 1, 
              box.lwd = 2, 
              cex.txt = 0.8, 
              box.size = 0.1, 
              box.type = "square", 
              box.prop = 0.25
      )
    })
  
}

shinyApp(ui, server)

And in the image below you can see the two types of transition plots rendered by the above code:

An up-to-date method for plotting a transition probability matrix?

1 Answers1

Linked