我已经查看了大量的stackoverflow帖子在使用条件面板的闪亮,但仍然无法找到我的错误。
我似乎能够将“yr1”和“scen1”的参数从server.R传递给ui.R,但是conditionalPanel似乎没有工作。
在我的闪亮应用程序中,我有两个选择。根据第一个选择,应显示不同的第二组选择。以下是我目前正在测试的代码:
library(shiny)
library(httpuv)
shinyUI(pageWithSidebar(
headerPanel("Global Temperature"),
sidebarPanel(
checkboxGroupInput("scen1", label = h3("Select 1 Map #1 Scenario"),
choices = list("pre-2000" = "past", "post-2000: 850 ppm by 2100 (a2)"="a2","post-2000: 550 ppm by 2100 (b1)"="b1"), selected = "past"),
conditionalPanel(condition = "input.scen1 == 'past'",
selectInput("yearspred1", "Select Map #1 Years Hindcasted",choices = c("1920-1939", "1940-1959", "1960-1979", "1980-1999"), selected="1920-1939", multiple=FALSE)),
conditionalPanel(condition = "input.scen1 == 'a2'",
selectInput("yearspred1", "Select Map #1 Years Predicted",choices = c("2020-2039", "2040-2059","2060-2079", "2080-2099")), selected="2020-2039", multiple=FALSE),
conditionalPanel(condition = "input.scen1 == 'b1'",
selectInput("yearspred1", "Select Map #1 Years Predicted",choices = c("2020-2039", "2040-2059", "2060-2079", "2080-2099"), selected="2020-2039", multiple=FALSE)),
),
mainPanel(
h3(textOutput("add1")),
imageOutput("plot1")
)
)
)
(我在上面做了两个选择但只在这里显示一个)
Server.R(您需要填写kml选项的路径来运行它):
library(shiny)
library(httpuv)
library(rWBclimate)
library(ggplot2)
# get temperature data for ensembles
st=1900
en=2100
world <- c("USA")
options(kmlpath\="/Users/n....")
world_map_df <- create_map_df(world)
world_dat <- get_ensemble_temp(world, "annualavg", start=st, end=en)
world_dat$data <- as.numeric(as.character(world_dat$data))
world_dat<-subset(world_dat,world_dat$percentile==50) #subset to median percentile
world_dat$years=paste(world_dat$fromYear,world_dat$toYear, sep="-")
world_dat<-subset(world_dat, select=-c(percentile, fromYear, toYear))
shinyServer(function(input, output){
scenario1<-reactive({input$scen1})
yr1<-reactive({
switch(input$yearspred1,
"1920-1939" = "1920-1939",
"1940-1959" = "1940-1959",
"1960-1979" = "1960-1979",
"1980-1999" = "1980-1999",
"2020-2039" = "2020-2039",
"2040-2059" = "2040-2059",
"2060-2079" = "2060-2079",
"2080-2099" = "2080-2099")
})
dfyr1<-reactive({subset(world_dat, world_dat$scenario==scenario1())})
df1<-reactive({subset(dfyr1(), dfyr1()$years==yr1())})
output$add1 <- renderText({paste("Temperature prediction for years ", yr1(), " and ", scenario1(), " scenario") })
output$plot1<- renderPlot({
climate_map(world_map_df,df1(),return_map = T) + scale_fill_gradient2(limits=c(-20, 34), low="blue", mid="white", high = "red", space="rgb", guide="colourbar")
})
})
正在传递参数,但“yr1”的下拉菜单不符合conditionalPanel条件。我怀疑它是在代码的这一部分,但我不确定:
yr1<-reactive({
switch(input$yearspred1,
"1920-1939" = "1920-1939",
"1940-1959" = "1940-1959",
"1960-1979" = "1960-1979",
"1980-1999" = "1980-1999",
"2020-2039" = "2020-2039",
"2040-2059" = "2040-2059",
"2060-2079" = "2060-2079",
"2080-2099" = "2080-2099")
})
我尝试用以下行替换它:
yr1<-reactive({input$yearspred1})
但这也没有解决问题。
感谢您提供的任何帮助!
答案 0 :(得分:3)
我可以看到selectInput
中每个conditionPanel
使用相同ID的诱惑,但通常你不应该这样。最好有明确定义的输入ID。此外,您的switch
语句完全没有必要,就像它只返回完全相同的值一样。更改selectInput
ID之后,有一个switch语句更有意义。您还有太多不必要的reactive
语句。除非您计划在整个server.R文件中的其他函数中使用这些语句,否则无需将它们放在那里,它们应该只在任何地方组合使用(即renderPlot
语句)。这就是yr
被动反应的原因,因为它将在renderText
和renderPlot
中使用。以下代码适用。
ui.R
library(shiny)
library(httpuv)
shinyUI(pageWithSidebar(
headerPanel("Global Temperature"),
sidebarPanel(
checkboxGroupInput("scen1", label = h3("Select 1 Map #1 Scenario"),
choices = list("pre-2000" = "past", "post-2000: 850 ppm by 2100 (a2)"="a2","post-2000: 550 ppm by 2100 (b1)"="b1"), selected = "past"),
conditionalPanel(condition = "input.scen1 == 'past'",
selectInput("yearspred1", "Select Map #1 Years Hindcasted",choices = c("1920-1939", "1940-1959", "1960-1979", "1980-1999"), selected="1920-1939", multiple=FALSE)),
conditionalPanel(condition = "input.scen1 == 'a2'",
selectInput("yearspred2", "Select Map #1 Years Predicted",choices = c("2020-2039", "2040-2059","2060-2079", "2080-2099")), selected="2020-2039", multiple=FALSE),
conditionalPanel(condition = "input.scen1 == 'b1'",
selectInput("yearspred3", "Select Map #1 Years Predicted",choices = c("2020-2039", "2040-2059", "2060-2079", "2080-2099"), selected="2020-2039", multiple=FALSE))
),
mainPanel(
h3(textOutput("add1")),
imageOutput("plot1")
)
)
)
server.R
library(shiny)
library(httpuv)
library(rWBclimate)
library(ggplot2)
# get temperature data for ensembles
st=1900
en=2100
world <- c("USA")
options(kmlpath="/Users/n...")
world_map_df <- create_map_df(world)
world_dat <- get_ensemble_temp(world, "annualavg", start=st, end=en)
world_dat$data <- as.numeric(as.character(world_dat$data))
world_dat<-subset(world_dat,world_dat$percentile==50) #subset to median percentile
world_dat$years=paste(world_dat$fromYear,world_dat$toYear, sep="-")
world_dat<-subset(world_dat, select=-c(percentile, fromYear, toYear))
shinyServer(function(input, output){
yr <- reactive({switch(
input$scen1,
"past" = input$yearspred1,
"a2" = input$yearspred2,
"b1" = input$yearspred3
)})
output$add1 <- renderText({paste("Temperature prediction for years ", yr(), " and ", input$scen1, " scenario") })
output$plot1<- renderPlot({
dfyr1<-subset(world_dat, world_dat$scenario==input$scen1)
df1 <- subset(dfyr1, dfyr1$years==yr())
climate_map(map_df=world_map_df,data_df=df1,return_map = T) + scale_fill_gradient2(limits=c(-20, 34), low="blue", mid="white", high = "red", space="rgb", guide="colourbar")
})
})