条件输出图

时间:2017-09-05 12:03:49

标签: r shiny

假设我有一个条件面板

<dx:DXTabItem  Header="System" Margin="0" BackgroundColor="Red">

现在,根据一些选择输入值,我想显示fluidRow(column(12,selectInput("models", label = "Models",choices =list("choice 1"=1,"choice 2"=2)))) tabsetPanel(tabPanel(strong("plots"), plotOutput("plot 1"), plotOutput("plot 2"))) plot 1。在闪亮的应用程序中有没有办法实现这一目标?

1 个答案:

答案 0 :(得分:1)

第一个版本,在渲染中选择:

library(shiny)


ui <- fluidPage(fluidRow(column(12,selectInput("models", label = "Models",choices =list("A-Plots"=1,"B-Plots"=2)))),    

tabsetPanel(tabPanel(strong("plots"),
                     lapply(1:5, function(i) plotOutput(paste0("plot", i))))))

server <- function(session, input, output) {

 plotsA <- lapply(1:5, function(x) function(y) (plot(1:10, main=paste("Plot A", x))))

 plotsB <- lapply(1:5, function(x) function(y) (plot(1:10, main=paste("Plot B", x))))

 for (i in 1:5) local({
   my_i <- i
   output[[paste0("plot", my_i)]] <- renderPlot({
     switch(input$models, "1"=plotsA, "2"=plotsB)[[my_i]]()})
 })}

shinyApp(ui = ui, server = server)

版本2 conditionalPanel

库(有光泽)

ui <- fluidPage(fluidRow(column(12,selectInput(
  "models", label = "Models", choices =list("A-Plots"=1,"B-Plots"=2)))),    

tabsetPanel(tabPanel(strong("plots"),
                     conditionalPanel("input.models==1",
                       lapply(1:5, function(i) plotOutput(paste0("plot", i)))),
                     conditionalPanel("input.models==2",
                       lapply(6:10, function(i) plotOutput(paste0("plot", i)))))))

server <- function(session, input, output) {

  plotsA <- lapply(1:5, function(x) function(y) (plot(1:10, main=paste("Plot A", x))))

  plotsB <- lapply(1:5, function(x) function(y) (plot(1:10, main=paste("Plot B", x))))

  for (i in 1:5) local({
    my_i <- i
    output[[paste0("plot", my_i)]] <- renderPlot({plotsA[[my_i]]()})
  })

  for (i in 6:10) local({
    my_i <- i
    output[[paste0("plot", my_i)]] <- renderPlot({plotsB[[my_i-5]]()})
  })

}

shinyApp(ui = ui, server = server)

第三个选项,uiOutput

library(shiny)


ui <- fluidPage(fluidRow(column(12,selectInput(
  "models", label = "Models", choices =list("A-Plots"=1,"B-Plots"=2)))),    

tabsetPanel(tabPanel(strong("plots"),
                     uiOutput("plots"))))

server <- function(session, input, output) {

  plotsA <- lapply(1:5, function(x) function(y) (plot(1:10, main=paste("Plot A", x))))

  plotsB <- lapply(1:5, function(x) function(y) (plot(1:10, main=paste("Plot B", x))))

  output$plots <- renderUI(lapply(switch(input$models, "1"=1:5, "2"=6:10),
                                  function(y) plotOutput(paste0("plot", y))))

  for (i in 1:5) local({
    my_i <- i
    output[[paste0("plot", my_i)]] <- renderPlot({plotsA[[my_i]]()})
  })

  for (i in 6:10) local({
    my_i <- i
    output[[paste0("plot", my_i)]] <- renderPlot({plotsB[[my_i-5]]()})
  })

}

shinyApp(ui = ui, server = server)

在所有情况下,只有在您实际显示该图时才应准备该图。