在带有闪亮 returns 空图的散点图中设置 X 轴和 Y 轴

Setting X and Y axes in plotly scatter plot with shiny returns an empty plot

我试图通过使用 shiny selectInput() 设置下方图表的 xy 轴,但我得到的是一个空图表。

## app.R ##
library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)


df<-structure(list(year = c("2016", "2016", "2016", "2016", "2016", 
                            "2016", "2016", "2016", "2017", "2017", "2017", "2017", "2017", 
                            "2017", "2017", "2017", "2017", "2018", "2018", "2018", "2018", 
                            "2018", "2018", "2018", "2018", "2018", "2019", "2019", "2019", 
                            "2019", "2019", "2019", "2019", "2020", "2020", "2020", "2020", 
                            "2020", "2020", "2020", "2020"), accident.description = c("left and center lane blocked", 
                                                                                      "one lane blocked", "right and center lane blocked", "right hand shoulder blocked", 
                                                                                      "right lane blocked", "shoulder blocked", "three lanes blocked", 
                                                                                      "two lanes blocked", "left and center lane blocked", "one lane blocked", 
                                                                                      "right and center lane blocked", "right hand shoulder blocked", 
                                                                                      "right lane blocked", "road closed", "shoulder blocked", "three lanes blocked", 
                                                                                      "two lanes blocked", "left and center lane blocked", "one lane blocked", 
                                                                                      "right and center lane blocked", "right hand shoulder blocked", 
                                                                                      "right lane blocked", "road closed", "shoulder blocked", "three lanes blocked", 
                                                                                      "two lanes blocked", "one lane blocked", "right and center lane blocked", 
                                                                                      "right hand shoulder blocked", "right lane blocked", "road closed", 
                                                                                      "shoulder blocked", "two lanes blocked", "left and center lane blocked", 
                                                                                      "one lane blocked", "right and center lane blocked", "right hand shoulder blocked", 
                                                                                      "right lane blocked", "road closed", "shoulder blocked", "two lanes blocked"
                            ), severity = c(8, 68, 5, 206, 142, 6, 2, 25, 32, 77, 30, 309, 
                                            285, 8, 2, 6, 89, 19, 58, 13, 224, 245, 8, 8, 2, 119, 77, 12, 
                                            34, 178, 28, 2, 61, 15, 42, 6, 34, 182, 32, 3, 122), traffic.sp = c(116, 
                                                                                                                670, 82, 2550, 1394, 82, 32, 235, 283, 651, 341, 3996, 3053, 
                                                                                                                0, 23, 71, 772, 239, 592, 174, 2967, 2748, 0, 128, 24, 1181, 
                                                                                                                990, 133, 505, 1972, 0, 46, 654, 113, 379, 74, 519, 1658, 0, 
                                                                                                                29, 1116), distance.m = c(0.02, 0.06, 0.01, 0.44, 0.26, 0.01, 
                                                                                                                                          0.01, 0.03, 0.05, 5.84, 0.05, 0.67, 9.36, 1.299, 0.01, 0, 1.12, 
                                                                                                                                          4.22, 2.875, 0, 3.37, 18.379, 1.306, 0, 0, 2.017, 12.281, 0, 
                                                                                                                                          0, 21.872, 3.168, 0, 12.392, 0, 2.349, 0, 0, 21.76, 3.149, 0, 
                                                                                                                                          6.625), traffic._1 = c(250, 1980, 168, 7618, 4193, 214, 85, 735, 
                                                                                                                                                                 873, 2238, 976, 11436, 9022, 162, 76, 166, 2518, 582, 1868, 428, 
                                                                                                                                                                 8380, 7939, 162, 313, 83, 3496, 2696, 337, 1420, 5910, 546, 80, 
                                                                                                                                                                 1776, 412, 1231, 174, 1426, 5313, 659, 80, 3180)), class = c("grouped_df", 
                                                                                                                                                                                                                              "tbl_df", "tbl", "data.frame"), row.names = c(NA, -41L), groups = structure(list(
                                                                                                                                                                                                                                year = c("2016", "2017", "2018", "2019", "2020"), .rows = structure(list(
                                                                                                                                                                                                                                  1:8, 9:17, 18:26, 27:33, 34:41), ptype = integer(0), class = c("vctrs_list_of", 
                                                                                                                                                                                                                                                                                                 "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
                                                                                                                                                                                                                                                                                                 ), row.names = c(NA, -5L), .drop = TRUE))
ui <- dashboardPage(title="ScopeDashboard",
                    dashboardHeader(title = span("Scope Dashboard")),
                    
                    dashboardSidebar(
                      selectInput(
                        inputId = "varsx", 
                        label = "Choose X variable:",
                        choices = c("severity","traffic.sp","distance.m","traffic._1"),
                        multiple = F,
                        selected = "severity"
                      ),
                           selectInput(
                             inputId = "varsy", 
                             label = "Choose Y variable:",
                             choices = c("severity","traffic.sp","distance.m","traffic._1"),
                             multiple = F,
                             selected = "traffic.sp"
                           )
                    ),
                    
                    dashboardBody(
                      plotlyOutput("corrs")
                      
                    )
)

server <- function(input, output) {
  output$corrs<-renderPlotly({
    
    fig <- plot_ly(
      data = as.data.frame(df),
      x = .data[[input$varsx]],
      y = .data[[input$varsy]],
      color = ~accident.description,
      mode = "scatter",
      marker = list(
        size = 10,
        line = list(color = 'rgba(152, 0, 0, .8)',
                    width = 2)
      ),
      text = paste(
        "Accident Description:",~accident.description,
        "<br>Year :",
        df$year,
        "<br> Count  :",
        .data[[input$varsx]],
        "<br> Count :",
        .data[[input$varsy]]
      ),
      hoverinfo = "text"
    ) %>% layout(height=470,showlegend=T,
                 title = paste(" per year"
                 ),font=t,
                 xaxis = list(
                   
                   dtick = 10,
                   tick0=0,
                   rangemode = "nonnegative"
                   
                 ),
                 yaxis = list(
                   dtick = 10,
                   tick0 = 0,
                   rangemode = "nonnegative"
                   
                 ),
                 legend = list(title = list(text = "<b>Accident Description</b>"))
    )
    
    fig
  })
}

shinyApp(ui, server)   

在 R 中,波形符 ~ 用于将 data.frame 的变量传递给 plot_lydata 参数(在 R 中,波形符标记为变量作为公式)我们可以使用例如x = ~ get(input$varsx) 以编程方式访问变量:

library(shiny)
library(shinydashboard)
library(plotly)

DF <- structure(list(year = c("2016", "2016", "2016", "2016", "2016", "2016",
"2016", "2016", "2017", "2017", "2017", "2017", "2017", "2017", "2017",
"2017", "2017", "2018", "2018", "2018", "2018", "2018", "2018", "2018",
"2018", "2018", "2019", "2019", "2019", "2019", "2019", "2019", "2019",
"2020", "2020", "2020", "2020", "2020", "2020", "2020", "2020"),
accident.description = c("left and center lane blocked", "one lane blocked",
"right and center lane blocked", "right hand shoulder blocked", "right lane
blocked", "shoulder blocked", "three lanes blocked", "two lanes blocked",
"left and center lane blocked", "one lane blocked", "right and center lane
blocked", "right hand shoulder blocked", "right lane blocked", "road closed",
"shoulder blocked", "three lanes blocked", "two lanes blocked", "left and
center lane blocked", "one lane blocked", "right and center lane blocked",
"right hand shoulder blocked", "right lane blocked", "road closed", "shoulder
blocked", "three lanes blocked", "two lanes blocked", "one lane blocked",
"right and center lane blocked", "right hand shoulder blocked", "right lane
blocked", "road closed", "shoulder blocked", "two lanes blocked", "left and
center lane blocked", "one lane blocked", "right and center lane blocked",
"right hand shoulder blocked", "right lane blocked", "road closed", "shoulder
blocked", "two lanes blocked" ), severity = c(8, 68, 5, 206, 142, 6, 2, 25,
32, 77, 30, 309, 285, 8, 2, 6, 89, 19, 58, 13, 224, 245, 8, 8, 2, 119, 77, 12,
34, 178, 28, 2, 61, 15, 42, 6, 34, 182, 32, 3, 122), traffic.sp = c(116, 670,
82, 2550, 1394, 82, 32, 235, 283, 651, 341, 3996, 3053, 0, 23, 71, 772, 239,
592, 174, 2967, 2748, 0, 128, 24, 1181, 990, 133, 505, 1972, 0, 46, 654, 113,
379, 74, 519, 1658, 0, 29, 1116), distance.m = c(0.02, 0.06, 0.01, 0.44, 0.26,
0.01, 0.01, 0.03, 0.05, 5.84, 0.05, 0.67, 9.36, 1.299, 0.01, 0, 1.12, 4.22,
2.875, 0, 3.37, 18.379, 1.306, 0, 0, 2.017, 12.281, 0, 0, 21.872, 3.168, 0,
12.392, 0, 2.349, 0, 0, 21.76, 3.149, 0, 6.625), traffic._1 = c(250, 1980,
168, 7618, 4193, 214, 85, 735, 873, 2238, 976, 11436, 9022, 162, 76, 166,
2518, 582, 1868, 428, 8380, 7939, 162, 313, 83, 3496, 2696, 337, 1420, 5910,
546, 80, 1776, 412, 1231, 174, 1426, 5313, 659, 80, 3180)), class =
c("grouped_df", "tbl_df", "tbl", "data.frame"), row.names = c(NA, -41L),
groups = structure(list( year = c("2016", "2017", "2018", "2019", "2020"),
.rows = structure(list( 1:8, 9:17, 18:26, 27:33, 34:41), ptype = integer(0),
class = c("vctrs_list_of", "vctrs_vctr", "list"))), class = c("tbl_df", "tbl",
"data.frame" ), row.names = c(NA, -5L), .drop = TRUE))


ui <- dashboardPage(title="ScopeDashboard",
                    dashboardHeader(title = span("Scope Dashboard")),
                    
                    dashboardSidebar(
                      selectInput(
                        inputId = "varsx", 
                        label = "Choose X variable:",
                        choices = c("severity","traffic.sp","distance.m","traffic._1"),
                        multiple = F,
                        selected = "severity"
                      ),
                      selectInput(
                        inputId = "varsy", 
                        label = "Choose Y variable:",
                        choices = c("severity","traffic.sp","distance.m","traffic._1"),
                        multiple = F,
                        selected = "traffic.sp"
                      )
                    ),
                    
                    dashboardBody(
                      plotlyOutput("corrs")
                      
                    )
)

server <- function(input, output) {
  output$corrs <- renderPlotly({
    
    fig <- plot_ly(
      data = as.data.frame(DF),
      x = ~ get(input$varsx),
      y = ~ get(input$varsy),
      color = ~ accident.description,
      type = "scatter",
      marker = list(
        size = 10,
        line = list(color = 'rgba(152, 0, 0, .8)',
                    width = 2)
      ),
      text = ~ paste(
        "Accident Description:", ~ accident.description,
        "<br>Year :",
         year,
        "<br> Count  :",
        get(input$varsx),
        "<br> Count :",
        get(input$varsy)
      ),
      hoverinfo = "text",
      height = 470
    ) %>% layout(showlegend = TRUE,
                 title = paste("Something per year"),
                 xaxis = list(
                   title = input$varsx
                 ),
                 yaxis = list(
                   title =  input$varsy
                 ),
                 legend = list(title = list(text = "<b>Accident Description</b>"))
    )
    
    fig
  })
}

shinyApp(ui, server)