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

Question

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

数据位于：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 参数在 shiny 中成为动态的。

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, 
                       y = fct_reorder(location, 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")  
    })

ui:

 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")
                 )

我尝试了 (!! sym(input$)) 的各种组合，但都没有用。甚至尝试过 varSelectInput 但如果我这样做会给出另一个错误：

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

更新ui:


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, style = "border: 1px solid gray;",
                    plotOutput("top_CFR_countries", height = "650px")),
             column(4, style = "border: 1px solid gray;",
                    plotOutput("top_testing_countries", height = "650px")
             ),
             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")
             )
             
         )
 
    ) # navbarpage      
    ) # fluid page
) # shiny ui

Answer 1

有几个地方应该将字符串更改为 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)

-输出

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

Issues in replicating a plot from rmarkdown to Shiny with selectInput based dynamic Parameter

r

shiny

selectinput