RShiny:为什么ggplot geom_rect会因为反应式刻面而失败？
RShiny:为什么ggplot geom_rect会因为反应式刻面而失败？
提问于 2020-05-02 14:04:59
我正在尝试使用Shiny创建交互式绘图，其中用户可以选择刻面变量。我还想在点/线数据下绘制温度数据。这一切都很好，直到我尝试合并一个反应式分面函数并添加一个geom_rect调用，当我收到错误时：
Warning: Error in : Assigned data `layout$PANEL[match(keys$x, keys$y)]` must be compatible with existing data.
x Existing data has 1094 rows.
x Assigned data has 32 rows.
i Only vectors of size 1 are recycled.我假设我的刻面函数做错了什么，但是我在第二周无法解决这个问题，所以是时候寻求帮助了！
以下是该应用程序的简化模型。我可以添加两个面，或者我可以添加温度参考底图，但尝试这两个都会导致上面的错误。
library(shiny)
library(shinydashboard)
library(lubridate)
library(tidyr)
library(readr)
{ # Setup ----
# Create a dummy data frame
sitename <- rep(c("A", "B", "C", "D", "E", "F", "G", "H"), times = 4)
region <- rep(c("North", "South", "East", "West"), times = 8)
elevation <- rep(c("High", "Low"), each = 4, length.out = 32)
date <- as.Date(rep(c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01"), each = 8))
affected <- runif(32, min = 0, max = 1)
sitedata <- data.frame(date, sitename, region, elevation, affected)
# Load and process external temperature data
noaacrw <- read_table2("http://coralreefwatch.noaa.gov/product/vs/data/guam.txt", skip = 21)
noaacrw <- noaacrw %>%
mutate(DateStart = as.Date(ISOdate(noaacrw$YYYY, noaacrw$MM, noaacrw$DD))) %>%
mutate(DateEnd = as.Date(DateStart + (as.Date(DateStart) - lag(as.Date(DateStart), default = first(DateStart))))) %>%
mutate(SST_AVG = `SST@90th_HS`) %>%
select(DateStart, DateEnd, SST_AVG) %>%
filter(DateStart > as.Date("2015-01-01")) %>%
filter(DateEnd < as.Date("2018-01-01"))
}
# UI ----
ui <- fluidPage(
fluidRow(
box(
title = "Choose your data", width = 3, solidHeader = TRUE,
selectInput("facet_select", "Select faceting variable:",
choices = list("None" = "none",
"Region" = "region",
"Elevation" = "elevation"),
selected = c("None")),
selectInput("facet2_select", "Select second faceting variable",
choices = list("None" = "none",
"Region" = "region",
"Elevation" = "elevation")),
checkboxInput("show_temp", "Show temperature data", FALSE)
),
box(
title = "See your data output", width = 9, solidHeader = TRUE,
plotOutput("siteplot", height = 500)
)
)
)服务器端：
server <- function(input, output) {
facet1 <- reactive({
if(input$facet_select == "region"){return(region)}
if(input$facet_select == "elevation"){return(elevation)}
})
facet2 <- reactive({
if(input$facet_select == "region"){return(region)}
if(input$facet_select == "elevation"){return(elevation)}
})
faceter <- reactive({
if(input$facet_select == "none"){return(NULL)}
else if(input$facet_select != "none" & input$facet2_select == "none")
{return(list(facet_grid(facet1() ~ .)))}
else if(input$facet_select != "none" & input$facet2_select != "none")
{return(list(facet_grid(facet1() ~ facet2())))}
})
temperature <- reactive({
if(input$show_temp == FALSE){return(NULL)}
else if(input$show_temp == TRUE){return(list(
geom_rect(data = noaacrw,
aes(xmin = DateStart, xmax = DateEnd, ymin = 0, ymax = Inf, fill = SST_AVG),
position = "identity", show.legend = TRUE, alpha = 0.5),
scale_fill_gradient2(high = "red3", mid = "white", low = "blue3", midpoint = 28)))}
})
output$siteplot <- renderPlot({
ggplot()+
temperature()+
geom_point(data = sitedata, aes(x = date, y = affected, group = sitename, color = sitename), size = 3)+
geom_line(data = sitedata, aes(x = date, y = affected, group = sitename, color = sitename), size = 3)+
#facet_grid(elevation ~ region) <-- this works!
faceter() # <- but this does not!
})
}
# Run the application
shinyApp(ui = ui, server = server)回答 1
Stack Overflow用户
发布于 2020-05-03 02:40:48
这是我的观点(我使用了syms(...))。它可以在R4.0下运行，至少：
library(shiny)
library(shinydashboard)
library(lubridate)
library(tidyr)
library(readr)
library(ggplot2)
library(dplyr)
{ # Setup ----
# Create a dummy data frame
sitename <- rep(c("A", "B", "C", "D", "E", "F", "G", "H"), times = 4)
region <- rep(c("North", "South", "East", "West"), times = 8)
elevation <- rep(c("High", "Low"), each = 4, length.out = 32)
date <- as.Date(rep(c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01"), each = 8))
affected <- runif(32, min = 0, max = 1)
sitedata <- data.frame(date, sitename, region, elevation, affected)
# Load and process external temperature data
noaacrw <- read_table2("http://coralreefwatch.noaa.gov/product/vs/data/guam.txt", skip = 21)
noaacrw <- noaacrw %>%
mutate(DateStart = as.Date(ISOdate(noaacrw$YYYY, noaacrw$MM, noaacrw$DD))) %>%
mutate(DateEnd = as.Date(DateStart + (as.Date(DateStart) - lag(as.Date(DateStart), default = first(DateStart))))) %>%
mutate(SST_AVG = `SST@90th_HS`) %>%
select(DateStart, DateEnd, SST_AVG) %>%
filter(DateStart > as.Date("2015-01-01")) %>%
filter(DateEnd < as.Date("2018-01-01"))
}
# UI ----
ui <- fluidPage(
fluidRow(
box(
title = "Choose your data", width = 3, solidHeader = TRUE,
selectInput("facet_select", "Select faceting variable:",
choices = list("None" = NULL,
"Region" = "region",
"Elevation" = "elevation"),
selected = c("None"),
multiple = TRUE),
checkboxInput("show_temp", "Show temperature data", FALSE)
),
box(
title = "See your data output", width = 9, solidHeader = TRUE,
plotOutput("siteplot", height = 500)
)
)
)
server <- function(input, output) {
temperature <- reactive({
if(!input$show_temp){return(NULL)}
else if(input$show_temp){return(list(
geom_rect(data = noaacrw,
aes(xmin = DateStart, xmax = DateEnd, ymin = 0, ymax = Inf, fill = SST_AVG),
position = "identity", show.legend = TRUE, alpha = 0.5),
scale_fill_gradient2(high = "red3", mid = "white", low = "blue3", midpoint = 28)))}
})
makePlot <- function(...){
p <- ggplot()+
temperature()+
geom_point(data = sitedata, aes(x = date, y = affected, group = sitename, color = sitename), size = 3)+
geom_line(data = sitedata, aes(x = date, y = affected, group = sitename, color = sitename), size = 3)
if(length(eval(substitute(alist(...)))) > 0){
p <- p + facet_grid(syms(...))
}
return(p)
}
output$siteplot <- renderPlot({
makePlot(input$facet_select)
})
}
# Run the application
shinyApp(ui = ui, server = server)页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/61555175
复制相关文章
相似问题
腾讯云开发者
