使用基于 selectInput 的动态参数将绘图从 rmarkdown 复制到 Shiny 的问题

问题描述

我在 rmarkdown 中创建了一个绘图,我试图通过使用 shinyselectInPut 中使用 动态参数 重新创建它。由于字符串和非字符串类型,我遇到了一些问题,我想我无法弄清楚。

数据可在:https://raw.githubusercontent.com/johnsnow09/covid19-df_stack-code/main/vaccination_data.csv

rmarkdown 代码和绘图:

vaccination_data %>% 
  filter(date == max(date)) %>%  
  slice_max(order_by = total_vaccinations,n = 20) %>% 
   
  ggplot(aes(x = total_vaccinations,y = fct_reorder(location,total_vaccinations),col = continent)) +
  geom_point() +
  geom_errorbarh(height=0,size=1,aes(xmin=total_vaccinations,xmax=0)) +
  scale_x_continuous(labels = unit_format(scale = 1e-6,unit = "M")) +
  geom_vline(xintercept = 0,col = "midnightblue",lty = 2,size = 1) +
  
  theme(
        panel.grid.major = element_blank(),legend.position = "NULL") 

在上面的代码中,我试图将 total_vaccinations 参数设置为动态的闪亮。

enter image description here

server.R:

    output$top_vaccinating_countries <- renderPlot({
        req(input$id_vaccination_top_country)
        
        vaccination_data %>% 
            filter(date == max(date)) %>% 
            slice_max(order_by = input$id_vaccination_top_country,n = 20) %>% 
            
            ggplot(aes(x = input$id_vaccination_top_country,input$id_vaccination_top_country),col = continent)) +
            geom_point() +
            geom_errorbarh(height=0,aes(xmin=as.numeric(!! sym(input$id_vaccination_top_country)),xmax=0)) +
            # scale_x_continuous(labels = unit_format(scale = 1e-6,unit = "M")) +
            geom_vline(xintercept = 0,size = 1) +
            scale_color_tableau() +
            
            theme(
                panel.grid.major = element_blank(),legend.position = "top",legend.direction = "horizontal")  
    })

用户界面:

 column(4,style = "border: 1px solid gray;",selectInput(inputId = "id_vaccination_top_country",label = "Select Vaccination Parameter",choices = c("total_vaccinations","total_vaccinations_per_hundred","people_vaccinated","people_vaccinated_per_hundred"),selected = "total_vaccinations"),plotOutput("top_vaccinating_countries",height = "570px")
                 )

enter image description here

我尝试了 (!! sym(input$)) 的各种组合,但没有奏效。甚至尝试过 varSelectInput 但如果我这样做会产生另一个错误

varSelectInput(
data = (vaccination_data %>% select(total_vaccinations,people_vaccinated))

新用户界面:


library(shiny)
library(shinydashboard)
library(shinythemes)
library(highcharter)
library(streamgraph)
# library(thematic)
# 
# thematic_shiny(font = "auto")

# Define UI for application 
shinyUI(fluidPage(
    theme=shinytheme("lumen"),themeSelector(),navbarPage(
       title = "Covid19 Dashboard",id = "Covid19_Dashboard",tabPanel("Global Cases Status",# Application title
             titlePanel("Global level"),fluidRow(
             style = "border: 1px solid gray;",column(4,plotOutput("top_CFR_countries",height = "650px")),plotOutput("top_testing_countries",height = "650px")
             ),height = "570px")
             )
             
         )
 
    ) # navbarpage      
    ) # fluid page
) # shiny ui

解决方法

有几个地方应该将字符串更改为 symbol 并求值 (!!)

library(shiny)
library(dplyr)
library(readr)
library(ggplot2)
library(ggthemes)
library(forcats)
library(scales)

-ui

# Define UI
vaccination_data <- read_csv("https://raw.githubusercontent.com/johnsnow09/covid19-df_stack-code/main/vaccination_data.csv")
ui <- fluidRow(
  style = "border: 1px solid gray;",h3("Vaccination to Cases Correlation Analysis"),column(4,style = "border: 1px solid gray;",selectInput(inputId = "id_vaccination_top_country",label = "Select Vaccination Parameter",choices = c("total_vaccinations","total_vaccinations_per_hundred","people_vaccinated","people_vaccinated_per_hundred"),selected = "total_vaccinations"),plotOutput("top_vaccinating_countries",height = "570px")
  )
)

-服务器

server <- function(input,output) {
  output$top_vaccinating_countries <- renderPlot({
    req(input$id_vaccination_top_country)
    
    vaccination_data %>% 
      filter(date == max(date)) %>% 
      slice_max(order_by = !! rlang::sym(input$id_vaccination_top_country),n = 20) %>% 
      
      ggplot(aes(x = !! rlang::sym(input$id_vaccination_top_country),y = fct_reorder(location,!! rlang::sym(input$id_vaccination_top_country)),col = continent)) +
      geom_point() +
      geom_errorbarh(height=0,size=1,aes(xmin=as.numeric(!! sym(input$id_vaccination_top_country)),xmax=0)) +
       scale_x_continuous(labels = unit_format(scale = 1e-6,unit = "M")) +
      geom_vline(xintercept = 0,col = "midnightblue",lty = 2,size = 1) +
      scale_color_tableau() +
      
      theme(
        panel.grid.major = element_blank(),legend.position = "top",legend.direction = "horizontal")  
  })
  
  
}
  

-运行应用程序

shinyApp(ui = ui,server = server)

-输出

enter image description here