绘制过渡概率矩阵的最新方法？

Question

我正在尝试找到一种简单，最新的方法来绘制过渡矩阵。有人可以推荐方法或包装吗？我在堆栈上找到了建议，但是帖子很旧，或者不再存在引用的软件包（例如，在2015年10月23日，post r过渡图）。

请注意，我的过渡矩阵是动态的：取决于用户输入，状态数量和TO/来自周期的构成因基础数据的组成而异。因此，进入代码并手动调整框/箭头尺寸无济于事。

我一直倾向于2013年4月20日回答从状态，使用图表包，但是我想知道是否有更多最新方法。

我不需要任何太复杂的东西。我喜欢此图像中显示的绘图类型（我相信通过以上引用的帖子中不再存在的软件包生成的帖子“ mmgraphr”）：

或此简单表单也对我有用：

<<< a href =“ https://i.sstatic.net/u0yni.png” rel =“ nofollow noreferrer”>

以下是我一直使用的代码的剥离版本，以生成过渡：

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)

Answer 1

研究选项后，我所能找到的是gmisc和图用于绘制过渡矩阵的软件包。 GMISC软件包在视觉上非常吸引人，尽管它不促进过境值的显示。 图软件包的视觉吸引力较小，但很容易促进过渡值的显示 - 尽管显示从显示在地图的左侧和到< /strong>状态在图的右侧，我必须使用循环和其他代码回图将矩阵的大小加倍，并填充矩阵值跳过行/列。由于过渡矩阵此代码旨在用于8 x 8或更高的措施，因此图中有太多的数字要出现。因此，我将在本文旨在的fuller代码中使用gmisc；箭头变厚/窄以表示过渡量，用户可以轻松地使用它的＆gt; = 64个值访问过渡矩阵表。顺便说一句，我不花时间使这些剧情更漂亮。

这是对两个图的修改的OP代码：

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)

在下面的图像中，您可以看到以上代码呈现的两种类型的过渡图：