r - RShiny:为什么 ggplot geom_rect 因反应刻面而失败?
问题描述
我正在尝试使用 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.
我假设我的分面功能做错了,但我在第 2 周无法解决这个问题,所以是时候寻求帮助了!
这是该应用程序的简化模型。我可以添加两个方面,或者我可以添加温度垫,但是尝试这两种方法都会导致上述错误。
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)
解决方案
这是我的看法(我用过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)
推荐阅读
- git - 如何进行提交到错误分支的相同更改并应用于正确的分支?
- css - 似乎无法在 wordpress 中更改我的 CSS 代码
- android - 我的 android 移动应用无法在 android 电视上运行
- ffmpeg - 如何在“宽”视频输出中从右到左平移到 1080p?
- api - Axios POST 导致 NULL
- c++ - 为什么使用 istream 迭代器会出现段错误?
- python - Python自动单击鼠标而不“使用”我的鼠标
- bootstrap-4 - 如何像图片一样在 bootstrap 4 中创建行和列?
- imagemagick - 使用 ImageMagick 的蒙太奇将多张图像合并为一张后质量不佳
- node.js - 如何使用 TypeScript 和 Sequelize