R SHINY - 条件面板输出偏移？答案

【问题标题】：R SHINY - Conditional panel output shifted?R SHINY - 条件面板输出偏移？
【发布时间】：2022-01-24 11:58:18
【问题描述】：

这篇文章与R shiny - Checkbox and conditional panels issues相关。我在这里设法创建了该问题的 MRE。

再次总结一下，当同时单击第二个复选框或第一个和第二个复选框时，数据框输出会发生偏移...我希望它显示在与时相同的位置你点击第一个复选框。

library(shiny)
library(ggplot2)

ui <- shinyUI(fluidPage(
     
     titlePanel("Construction"),
         
         sidebarLayout(
             sidebarPanel(
                 checkboxInput("EF", "Efficient Frontier"),
                 checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
                 
                 fluidRow(
                     align = "center",
                     actionButton("Gow", "Go!")),
                 
             ),
             
             mainPanel(
                 column(12,
                        br(),
                        align = "left",
                        splitLayout(cellWidths = c("70%", "30%"),
                                    plotOutput("Graphw"),
                                    conditionalPanel(condition = "input.EF == true && input.MonteCarlo == false", tableOutput("EFWeightsTable")),
                                    conditionalPanel(condition = "input.MonteCarlo == true && input.EF == false", tableOutput("MCWeightsTable")),
                                    conditionalPanel(condition = "input.MonteCarlo == true && input.EF == true", tableOutput("EFMCWeightsTable")))),
                 column(12,
                        align = "center",
                        conditionalPanel(condition = "input.EF == true && input.MonteCarlo == false", plotOutput("GraphEF")),
                        conditionalPanel(condition = "input.MonteCarlo == true && input.EF == false", plotOutput("GraphMC")),
                        conditionalPanel(condition = "input.MonteCarlo == true && input.EF == true", plotOutput("GraphEFMC"))
                 )
             )
         )
     )
)


#Server
server <- shinyServer(function(input, output) {

    OPw <- reactiveValues()
    observeEvent(input$Gow, {
        
        OPw$PC <- Run(1,2,3)
        
        if(input$EF == TRUE && input$MonteCarlo == FALSE){
            showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
            OPw$LIST1 <- Run2(1,2,3)
        }
        removeModal() 
        
        if(input$MonteCarlo == TRUE && input$EF == FALSE){
            showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
            OPw$LIST2 <- Run3(1,2,3)
        }
        removeModal() 
        
        if(input$MonteCarlo == TRUE && input$EF == TRUE){
            showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
            OPw$LIST3 <- Run4(1,2,3)
        }
        removeModal() 
    })
    
    #Output Variables
    output$Graphw <- renderPlot({ 
        OPw$PC}, height = 400, width = 400)
    
    output$GraphEF <- renderPlot({ 
        OPw$LIST1[[1]]
    },height = 550, width = 700)
    
    output$EFWeightsTable <- renderTable({ 
        OPw$LIST1[[2]]}, colnames = TRUE
    )
    
    output$GraphMC <- renderPlot({ 
        OPw$LIST2[[1]]
    },height = 550, width = 700)
    
    output$MCWeightsTable <- renderTable({ 
        OPw$LIST2[[2]]}, colnames = TRUE
    )
    
    output$GraphEFMC <- renderPlot({ 
        OPw$LIST3[[1]]
    },height = 550, width = 700)
    
    output$EFMCWeightsTable <- renderTable({ 
        OPw$LIST3[[2]]}, colnames = TRUE
    )
    
    #FUNCTIONS
    Run <- function(a, b, c){
        
        Plot <- ggplot(as.data.frame(cbind(c(1,2,3),c(2,3,4))), aes(c(1,2,3), c(2,3,4))) +
            geom_line() 
        
        return(Plot)
    }
    
    Run2 <- function(a,b,c){
        
        eweights <- data.frame(cbind(seq(1,9),seq(1,9),seq(1,9)))
        
        MYPLOT <- ggplot(as.data.frame(cbind(c(10,7,4),c(5,6,7))), aes(c(10,7,4), c(5,6,7))) +
            geom_line() 
            
        return(list(MYPLOT, eweights))
    }
    
    Run3 <- function(a,b,c){
        
        eweights <- data.frame(cbind(seq(2,10),seq(2,10),seq(2,10)))
        
        MYPLOT <- ggplot(as.data.frame(cbind(c(4,5,6),c(7,8,9))), aes(c(4,5,6),c(7,8,9))) +
            geom_line() 
        
        return(list(MYPLOT, eweights))
    }
    
    Run4 <- function(a,b,c){
        Run3(a,b,c)
    }
})

shinyApp (ui = ui, server = server)

谢谢

【问题讨论】：

标签： r shiny

【解决方案1】：

我看到你已经接受了一个答案，但我已经投入了工作。我使用list() 对象作为条件，这似乎有效。您可以通过将简单对象作为占位符来减少大部分服务器代码。

library(shiny)

ui <- shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation")
    ),
    mainPanel(
      column(12, # if these are supposed to stack, I'd use `fluidRow()`
        align = "left",
        splitLayout(
          cellWidths = c("70%", "30%"),
          plotOutput("Graphw"),
          list(  # I made this a list object
            conditionalPanel(condition = "input.EF == true && input.MonteCarlo == false", tableOutput("EFWeightsTable")),
            conditionalPanel(condition = "input.MonteCarlo == true && input.EF == false", tableOutput("MCWeightsTable")),
            conditionalPanel(condition = "input.MonteCarlo == true && input.EF == true", tableOutput("EFMCWeightsTable"))
          )
        )
      ),
      column(12,
        align = "center",
        conditionalPanel(condition = "input.EF == true && input.MonteCarlo == false", plotOutput("GraphEF")),
        conditionalPanel(condition = "input.MonteCarlo == true && input.EF == false", plotOutput("GraphMC")),
        conditionalPanel(condition = "input.MonteCarlo == true && input.EF == true", plotOutput("GraphEFMC"))
      )
    )
  )
))

server <- function(input, output, session) {  
  # dummy tables
  df <- mtcars[1:3, 1:3]
  output$tablew <- renderTable(df)
  output$EFWeightsTable <- renderTable(df)
  output$MCWeightsTable <- renderTable(df)
  output$EFMCWeightsTable <- renderTable(df)
  # dummy plots
  output$GraphEF <- renderPlot(plot(1, 1, main = "Efficient Frontier"))
  output$GraphMC <- renderPlot(plot(1, 1, main = "Monte Carlo"))
  output$GraphEFMC <- renderPlot(plot(1, 1, main = "Both"))
  output$Graphw <- renderPlot(plot(1, 1, main = "Graph W"))
}

shinyApp(ui, server)

【讨论】：

我更喜欢这种基于 UI 的解决方案。但是，我会使用tagList() 而不是list()，因为conditionalPanel 的结果是div-tag - 但这只是养眼。

【解决方案2】：

使用renderUI() 应该会对您有所帮助。试试这个

library(shiny)
library(ggplot2)

ui <- shinyUI(fluidPage(
  
  titlePanel("Construction"),
  
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
      
      fluidRow(
        align = "center",
        actionButton("Gow", "Go!")),
      
    ),
    
    mainPanel(
      column(12,
             br(),
             align = "left",
             splitLayout(cellWidths = c("70%", "30%"),
                         plotOutput("Graphw"), uiOutput("mytable")
                         )),
      column(12,
             align = "center",
             conditionalPanel(condition = "input.EF == true && input.MonteCarlo == false", plotOutput("GraphEF")),
             conditionalPanel(condition = "input.MonteCarlo == true && input.EF == false", plotOutput("GraphMC")),
             conditionalPanel(condition = "input.MonteCarlo == true && input.EF == true", plotOutput("GraphEFMC"))
      )
    )
  )
)
)

#Server
server <- shinyServer(function(input, output) {
  
  OPw <- reactiveValues()
  observeEvent(input$Gow, {
    
    OPw$PC <- Run(1,2,3)
    
    if(input$EF == TRUE && input$MonteCarlo == FALSE){
      showModal(modalDialog("Loading... Please Wait 1", footer=NULL)) 
      OPw$LIST1 <- Run2(1,2,3)
    }
    removeModal() 
    
    if(input$MonteCarlo == TRUE && input$EF == FALSE){
      showModal(modalDialog("Loading... Please Wait 2", footer=NULL)) 
      OPw$LIST2 <- Run3(1,2,3)
    }
    removeModal() 
    
    if(input$MonteCarlo == TRUE && input$EF == TRUE){
      showModal(modalDialog("Loading... Please Wait 3", footer=NULL)) 
      OPw$LIST3 <- Run4(1,2,3)
    }
    removeModal() 
  })
  
  #Output Variables
  output$Graphw <- renderPlot({ 
    OPw$PC}, height = 400, width = 400)
  
  output$GraphEF <- renderPlot({ 
    OPw$LIST1[[1]]
  },height = 550, width = 700)
  
  output$EFWeightsTable <- renderTable({ 
    OPw$LIST1[[2]]}, colnames = TRUE
  )
  
  output$GraphMC <- renderPlot({ 
    OPw$LIST2[[1]]
  },height = 550, width = 700)
  
  output$MCWeightsTable <- renderTable({ 
    OPw$LIST2[[2]]}, colnames = TRUE
  )
  
  output$GraphEFMC <- renderPlot({ 
    OPw$LIST3[[1]]
  },height = 550, width = 700)
  
  output$EFMCWeightsTable <- renderTable({ 
    OPw$LIST3[[2]]}, colnames = TRUE
  )
  
  output$mytable <- renderUI({
    if (input$EF & !input$MonteCarlo) {tableOutput("EFWeightsTable")
    } else if (!input$EF & input$MonteCarlo){tableOutput("MCWeightsTable")
    } else if (input$EF & input$MonteCarlo){tableOutput("EFMCWeightsTable")
    } else return(NULL)
  })
  
  #FUNCTIONS
  Run <- function(a, b, c){
    
    Plot <- ggplot(as.data.frame(cbind(c(1,2,3),c(2,3,4))), aes(c(1,2,3), c(2,3,4))) +
      geom_line() 
    
    return(Plot)
  }
  
  Run2 <- function(a,b,c){
    
    eweights <- data.frame(cbind(seq(1,9),seq(1,9),seq(1,9)))
    
    MYPLOT <- ggplot(as.data.frame(cbind(c(10,7,4),c(5,6,7))), aes(c(10,7,4), c(5,6,7))) +
      geom_line() 
    
    return(list(MYPLOT, eweights))
  }
  
  Run3 <- function(a,b,c){
    
    eweights <- data.frame(cbind(seq(2,10),seq(2,10),seq(2,10)))
    
    MYPLOT <- ggplot(as.data.frame(cbind(c(4,5,6),c(7,8,9))), aes(c(4,5,6),c(7,8,9))) +
      geom_line() 
    
    return(list(MYPLOT, eweights))
  }
  
  Run4 <- function(a,b,c){
    Run3(a,b,c)
  }
})

shinyApp (ui = ui, server = server)

【讨论】：

你是个野兽:)
嘿@YBS，actionButton 的情况也可以通过conditionalPanel 解决。我留下了答案here。当然，这仅在应用程序增长时才重要，renderUI 仍然是解决此问题的合理方法。
@ismirsehregal，同意。我的观点是，如果复杂性不断增长......
另一种基于 UI（因此速度很快）的方法是使用隐藏的 tabsetPanel 和 updateTabsetPanel。这可能比conditionalPanel 更易读。请参阅this example。