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

Posted 2023-03-24

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

【英文标题】：Issues in replicating a plot from rmarkdown to Shiny with selectInput based dynamic Parameter

【发布时间】：2021-07-08 19:44:34

【问题描述】：

我在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 参数设置为动态的。

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

用户界面：

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

更新用户界面：

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

【问题讨论】：

我认为在aes 中为ggplot，符号！不存在，即!! rlang::sym(input$id_vaccination_top_country) 也在fct_reorder 中，即它将是ggplot(aes(x = !! rlang::sym(input$id_vaccination_top_country), y = fct_reorder(location, !! rlang::sym(input$id_vaccination_top_country)), col = continent))

感谢@akrun，但即使在此之后它仍然给出相同的结果

你能显示完整的ui代码吗

是的，我会更新

我已经添加了 ui 部分的相关部分，因为完整的 ui 相当冗长。如果你还想让我展示，那么我会更新完整的 ui 代码。

【参考方案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)

-输出

【讨论】：

非常感谢@akrun 提供如此详细的解释。真的非常感谢您的详细努力。而且我总是对这些 rlang 字符串和符号概念感到困惑。如果您遇到任何关于这些概念的良好链接或制作任何视频，请分享。再次感谢:)