根据闪亮的小部件选择创建具有动态轨迹数的绘图折线图

Question

我有下面这个闪亮的应用程序，我在其中 select 一个来自小部件的国家/地区以在绘图中可视化。我希望能够 select 并可视化多个国家，并且每次都用不同的颜色为每个国家的线条着色，并在旁边加上相关的图例。现在我看不到传说和不同的国家 selected。请注意，真实数据集比这个大，所以国家的数量会更多。

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

df<-structure(list(Year = c(1951, 1951, 1951, 1951, 1951, 1951, 1954, 
                            1954, 1955, 1955, 1957, 1957, 1957, 1957, 1957, 1957, 1958, 1958, 
                            1958, 1958, 1958, 1958, 1960, 1960, 1960, 1960, 1960, 1960, 1960, 
                            1960, 1960, 1960, 1961, 1961, 1962, 1962, 1962, 1962, 1962, 1962, 
                            1962, 1962, 1962, 1963, 1963, 1963, 1963, 1963, 1963, 1963), 
                   Country = c("Belgium", "France", "Germany", "Italy", "Luxembourg", 
                               "Netherlands", "Canada", "Portugal", "France", "Tunisia", 
                               "Belgium", "France", "Germany", "Italy", "Luxembourg", "Netherlands", 
                               "Costa Rica", "El Salvador", "EU", "Guatemala", "Honduras", 
                               "Nicaragua", "Chile", "EFTA", "El Salvador", "Guatemala", 
                               "Honduras", "MERCOSUR", "Mexico", "Nicaragua", "Peru", "Portugal", 
                               "EU", "Greece", "Algeria", "Egypt", "Ghana", "Guinea", "Iraq", 
                               "Jordan", "Mali", "Morocco", "Syria", "Benin", "Burkina Faso", 
                               "Burundi", "Cameroon", "Central African Republic", "Chad", 
                               "Congo - Brazzaville"), Scope = c(4, 4, 4, 4, 4, 4, 3, 3, 
                                                                 5, 5, 14, 14, 14, 14, 14, 14, 3, 3, 3, 3, 3, 3, 4, 6, 3, 
                                                                 3, 3, 4, 4, 1, 4, 6, 6, 6, 2, 6, 2, 2, 4, 4, 2, 2, 4, 2, 
                                                                 2, 2, 2, 2, 2, 2)), class = c("grouped_df", "tbl_df", "tbl", 
                                                                                               "data.frame"), row.names = c(NA, -50L), groups = structure(list(
                                                                                                 Year = c(1951, 1954, 1955, 1957, 1958, 1960, 1961, 1962, 
                                                                                                          1963), .rows = structure(list(1:6, 7:8, 9:10, 11:16, 17:22, 
                                                                                                                                        23:32, 33:34, 35:43, 44:50), ptype = integer(0), class = c("vctrs_list_of", 
                                                                                                                                                                                                   "vctrs_vctr", "list"))), class = c("tbl_df", "tbl", "data.frame"
                                                                                                                                                                                                   ), row.names = c(NA, -9L), .drop = TRUE))


ui <- dashboardPage(title="ScopeDashboard",
                    dashboardHeader(title = span("Scope Dashboard")),
                    
                    dashboardSidebar(
                      selectInput(
                        "cou","Country",choices=c(unique(df$Country)),
                        selected = c(unique(df$Country))[1],
                        multiple = T
                      )
                    ),
                    
                    dashboardBody(
                      plotlyOutput("timetrend")
                      
                    )
)

server <- function(input, output) {
  plot_data <- reactive({
    as.data.frame(
      subset(df, df$Country %in% input$cou)
    ) 
  })
  
  output$timetrend<-renderPlotly({

    fig <- plot_ly(
      data = plot_data(),
      x = ~ Year,
      y = ~ Scope,
      mode = "lines+markers",
      marker = list(
        size = 10,
        color = 'rgba(255, 182, 193, .9)',
        line = list(color = 'rgba(152, 0, 0, .8)',
                    width = 2)
      ),
      text = paste(
        "Year :",
        plot_data()$Year,
        "<br> Count of Scopes :",
        plot_data()$Scope
      ),
      hoverinfo = "text"
    )%>%
      add_trace(
        mode = 'lines+markers') %>% layout(
          title = paste("Count of Scope per country and year",
                        "<br>","-",input$cou,"-"),font=t,
          xaxis = list(
            tickangle=45,
            
            dtick = 2
          ),
          yaxis = list(
            dtick = 1,
            tick0 = 0,
            rangemode = "nonnegative"
            
          )
        )
    
    fig
  })
}

shinyApp(ui, server)

Answer 1

您必须为绘图数据使用反应值，并将国家/地区作为颜色传递给 plotly 函数。注意，不要使用“df”作为变量名，因为你会运行进入命名空间问题

server <- function(input, output) {
  # use reactive value for data frame
  plot_data <- reactive({
    as.data.frame(
      subset(df, df$Country %in% input$cou)
    ) 
  })
  
  output$timetrend<-renderPlotly({
    
    fig <- plot_ly(
      data = plot_data(),
      x = ~ Year,
      y = ~ Scope,
      color = ~Country, # <-------------------- Color according to selected Country
      mode = "lines+markers",
      marker = list(
        size = 10       # <------------------- Remove the color argument 
      ), [...]

将产生这个输出

根据闪亮的小部件选择创建具有动态轨迹数的绘图折线图

Create a plotly line chart with dynamic number of traces based on shiny widget selection

r

shiny

plotly