在Shiny ui.R和server.R中使用conditionalPanel:基于条件的不同selectInput

时间:2014-10-17 17:22:53

标签: r shiny

我已经查看了大量的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})

但这也没有解决问题。

感谢您提供的任何帮助!

1 个答案:

答案 0 :(得分:3)

我可以看到selectInput中每个conditionPanel使用相同ID的诱惑,但通常你不应该这样。最好有明确定义的输入ID。此外,您的switch语句完全没有必要,就像它只返回完全相同的值一样。更改selectInput ID之后,有一个switch语句更有意义。您还有太多不必要的reactive语句。除非您计划在整个server.R文件中的其他函数中使用这些语句,否则无需将它们放在那里,它们应该只在任何地方组合使用(即renderPlot语句)。这就是yr被动反应的原因,因为它将在renderTextrenderPlot中使用。以下代码适用。

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") 
  })
})
相关问题