r - 使用基于 selectInput 的动态参数将绘图从 rmarkdown 复制到 Shiny 的问题
问题描述
我创建了一个图rmarkdown
,我试图在其中使用动态参数重新创建它。由于字符串和非字符串类型,我面临一些问题,我想我无法弄清楚。shiny
selectInPut
数据可在: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
参数在闪亮中成为动态的。
服务器.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
解决方案
有几个地方应该将字符串更改为sym
bol 并评估 ( !!
)
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)
-输出
推荐阅读
- rest - 如何通过 JIRA rest API 向问题添加“标志”
- javascript - 如何使上下按钮不同的照片js
- ruby - Ruby zlib deflate 方法正在生成无效字符
- javascript - 在可变参数 JavaScript 函数中,什么时候会使用 arguments 对象而不是 rest 参数?
- flutter - TextButton 宽度大小与文本不同
- html - 将孩子表示为父母的分数背景宽度
- r - R:用来自不同行的值填充单元格
- sql - 为什么我的 WHERE 子句没有按预期工作?
- python - 处理大于 24 小时的时间格式
- python - Django Nested Serializer - 如果条件已满,则返回 Null 字段