Можно ли использовать блестящую условную панель горизонтально? - PullRequest
1 голос
/ 07 июня 2019

Я разрабатываю блестящее приложение, используя sidebarLayout (), и я хочу показать один или два графика рядом в mainPanel (), основываясь на значении ввода в sidebarPanel ().

Если должен отображаться только один график, я бы хотел, чтобы этот график занимал 100% горизонтального пространства mainPanel (). Однако, если нужно показать оба графика, я бы хотел, чтобы каждый занимал 50% пространства mainPanel ().

Мне также хотелось бы, чтобы содержимое каждого конкретного столбца занимало все доступное горизонтальное пространство в пределах его собственного столбца.

Я пробовал несколько вещей.

  1. Наличие liquidRow (), содержащее столбец и условную панель ()

    • Однако я не мог заставить это работать, потому что liquidRow () желает, чтобы каждый элемент предоставлял аргумент ширины, а conditionalPanel () не кажется совместимым.
  2. conditionalPanel () в правой части splitLayout ()

    • Это скрывает только правую сторону и не позволяет левому графику занимать все пространство mainPanel ().
  3. Условная панель () внутри правого элемента с отображением: ячейка таблицы

    • Но это тот же результат, что и выше 1
library(ggplot2)
library(shiny)

ui <- fluidPage(
  tags$head(
    tags$style("
               #my_container {
                 display: table;
                 width: 100%;
               }

               .col {
                 display: table-cell;
               }

               #col_left {
                 background-color: #ffa;
               }

               #col_right {
                 background-color: #faf;
               }
               ")
  ), 

  sidebarPanel(
    checkboxInput("checkbox", 
                  "View Both", 
                  value = TRUE), 
    width = 2
  ), 

  mainPanel(
    div(id = "my_container", 
        div(id = "col_left", 
            class ="col", 
            plotOutput("plot_output_1")),
        div(id = "col_right", 
            class = "col", 
            conditionalPanel("input.checkbox == 1", 
                             plotOutput("plot_output_2")))
    ), 
    width = 10
  )
)

server <- shinyServer(function(input, output) {
  output$plot_output_1 <- renderPlot({
    ggplot(
      data.frame(x = runif(3), y = rnorm(3)), 
      aes(x = x, y = y)) + 
      geom_point()
  })

  output$plot_output_2 <- renderPlot({
    ggplot(
      data.frame(x = runif(3), y = rnorm(3)), 
      aes(x = x, y = y)) + 
      geom_point()
  })
})

shinyApp(ui, server)
  1. Я также попытался добавить обмен сообщениями javascript, чтобы изменить ширину div.
    • похоже, это работает в том смысле, что правый столбец скрыт, а затем показан левый столбец (пример на желтом фоне). Однако график в левом столбце не перерисовывается, чтобы занять новое пространство, несмотря на то, что он перерисовывается из-за зависимости от ввода.
library(ggplot2)
library(shiny)

ui <- fluidPage(
  tags$head(
    tags$style("
               #my_container {
                 display: table;
                 width: 100%;
               }

               .my_col {
                 display: table-cell;
               }

               #col_left {
                 background-color: #ffa;
               }

               #col_right {
                 background-color: #faf;
               }
               "
    ), 

    tags$script("
      Shiny.addCustomMessageHandler('n_show.onchange', function(value) {
        var col_left = document.getElementById('col_left');
        var col_right = document.getElementById('col_right');

        if(value == 'one') {
          col_left.style.width = '100%';
          col_right.style.width = '0%';
        } else {
          col_left.style.width = '50%'; 
          col_right.style.width = '50%';
        }
      });
      "
    )
  ), 

  sidebarPanel(
    selectInput(inputId = "n_show", label = "Number of Plots", choices = c("one", "two"), selected = "two"), 
    width = 2
  ), 

  mainPanel(
    div(id = "my_container", 
        div(id = "col_left", 
            class = "my_col", 
            plotOutput("plot_output_1")),
        div(id = "col_right", 
            class = "my_col", 
            conditionalPanel("input.n_show == 'two'", 
                             plotOutput("plot_output_2")))
    ), 
    width = 10
  )
)

server <- shinyServer(function(input, output, session) {
  output$plot_output_1 <- renderPlot({
    input$n_show

    ggplot(
      data.frame(x = runif(3), y = rnorm(3)), 
      aes(x = x, y = y)) + 
      geom_point()
  })

  output$plot_output_2 <- renderPlot({
    input$n_show

    ggplot(
      data.frame(x = runif(3), y = rnorm(3)), 
      aes(x = x, y = y)) + 
      geom_point()
  })

  observeEvent(input$checkbox, {
    session$sendCustomMessage("n_show.onchange", input$n_show)
  })
})

shinyApp(ui, server)

Я подозреваю, что это не так сложно, как я это делаю, но мои знания / навыки в области css не соответствуют задаче - по крайней мере, в контексте блестящего.

1 Ответ

0 голосов
/ 07 июня 2019

Решение с renderUI:

library(ggplot2)
library(shiny)

ui <- fluidPage(
  tags$head(
    tags$style("
               #col_left {
                 background-color: #ffa;
               }
               #col_right {
                 background-color: #faf;
               }
               ")
    ), 

  sidebarPanel(
    checkboxInput("checkbox", 
                  "View Both", 
                  value = TRUE), 
    width = 2
  ), 

  mainPanel(
    uiOutput("plots"), 
    width = 10
  )
    )

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

  output$plot_output_1 <- renderPlot({
    ggplot(
      data.frame(x = runif(3), y = rnorm(3)), 
      aes(x = x, y = y)) + 
      geom_point(size = 6)
  })

  output$plot_output_2 <- renderPlot({
    ggplot(
      data.frame(x = runif(3), y = rnorm(3)), 
      aes(x = x, y = y)) + 
      geom_point(size = 6)
  })

  output$plots <- renderUI({
    if(input$checkbox){
      fluidRow(
        column(6, div(id="col_left", plotOutput("plot_output_1"))),
        column(6, div(id="col_right", plotOutput("plot_output_2")))
      )
    }else{
      fluidRow(
        column(12, div(id="col_left", plotOutput("plot_output_1")))
      )
    }
  })
})

shinyApp(ui, server)

enter image description here

...