Question

请运行下面的脚本，使用bupaR库中的患者数据集创建两个图表，左边的图表显示一个sankey图表，显示资源（＆＃34;员工＆＃34;）和活动之间的关系（＆＃34;处理＆＃34;）和右边的图表显示我们执行＆＃34;点击＆＃34;时资源和活动之间的链接的详细信息。基本上，我们看到具有相应值的数据子集说＆＃34; r1＆＃34;和＃34;注册＆＃34;当我们点击链接连接＆＃34; r1＆＃34;到＆＃34;注册＆＃34;等等。但是，当我使用任何其他资源和活动列运行代码时，不会创建sankey图表，并且我得到以下错误＆＃34;二进制运算符＆＃34;的非数字参数。请使用简单的数据集和帮助尝试脚本：

a1 = c("A","B","C","A","B","B")
a2 = c("D","E","D","E","D","F")
a12 = data.frame(a1,a2)   

library(shiny)
library(shinydashboard)
library(devtools)
library(ggplot2)
library(plotly)
library(proto)
library(RColorBrewer)
library(gapminder)
library(stringr)
library(broom)
library(mnormt)
library(DT)
library(bupaR)
library(dplyr)

ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader = 
T,
    plotlyOutput("sankey_plot")),

box( title = "Case Summary", status = "primary", height = "455",solidHeader 
= T, 
     dataTableOutput("sankey_table"))
 )
 )
 server <- function(input, output) 
 { 
 sankeyData <- reactive({
 sankeyData <- patients %>% 
  group_by(employee,handling) %>% 
  count()
  sankeyNodes <- list(label = c(sankeyData$employee,sankeyData$handling))
  trace2 <- list(
  domain = list(
    x = c(0, 1), 
    y = c(0, 1)
   ), 
   link = list(
    label = paste0("Case",1:nrow(sankeyData)), 
    source = sapply(sankeyData$employee,function(e) {which(e == 

    sankeyNodes$label) }, USE.NAMES = FALSE) - 1, 
    target = sapply(sankeyData$handling,function(e) {which(e == 

    sankeyNodes$label) }, USE.NAMES = FALSE) - 1, 
    value = sankeyData$n
    ), 
    node = list(label = sankeyNodes$label), 
     type = "sankey"
     )
     trace2
      })
    output$sankey_plot <- renderPlotly({
    trace2 <- sankeyData()
    p <- plot_ly()
    p <- add_trace(p, domain=trace2$domain, link=trace2$link, 
               node=trace2$node, type=trace2$type)
    p
    })
    output$sankey_table <- renderDataTable({
    d <- event_data("plotly_click")
    req(d)
    trace2 <- sankeyData()
    sIdx <-  trace2$link$source[d$pointNumber+1]
    Source <- trace2$node$label[sIdx + 1 ]
    tIdx <- trace2$link$target[d$pointNumber+1]
    Target <- trace2$node$label[tIdx+1]
    patients %>% filter(employee == Source & handling == Target)
    })
    }
    shinyApp(ui, server)

Answer 1

为了使用任何数据集制作这个“现成的解决方案”，我认为对于a列的每个字符，你需要b列的一个字符（使用$this->createQueryBuilder('alias')->addSelect('alias.id') ->where(...) ->orderBy(...)将剪切和颜色变成字符）。例如，在患者数据集中，r1只有一种可能性（注册）;对于r2到r7也是如此。您的应用无法使用完整的as.character()数据集。但是使用相同的逻辑，应用程序可以运行。

diamonds

现在使用diamonds_d数据集运行闪亮的应用程序：

diamonds_b <- diamonds %>% filter(cut == "Ideal" & color == "D")
diamonds_c <- diamonds %>% filter(cut == "Fair" & color == "E")
diamonds_d <- rbind(diamonds_b, diamonds_c)
diamonds_d$cut <- as.character(diamonds_d$cut)
diamonds_d$color <- as.character(diamonds_d$color)

R闪亮的sankey绘图变量出错

1 个答案: