esquisserUI widgets gets dislocated with autoscaling of uiOutput in Shiny

Viewed 106

@lz100 helped me with auto-scaling of uiOutput() when I toggle to show/hide sidepanel. However, when I implement esquisserUI(), the widgets associated with it get displaced when you switch back and forth between radiobuttons in the sidepanel.

Another problem- in the reference page of esquisse (https://dreamrs.github.io/esquisse/articles/shiny-usage.html) they have the plots rendered at UI level, but how can it do it through server?

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)

#Credit: @lz100 helped with auto uiOutput() scaling when sidebar is collapsed. Thank you.

#ui.r
ui <- fluidPage(
  
  useShinyjs(),
  
  # a switch for toggles
  dropdownButton(
    
    tags$h3("Toggle"),
    
    materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
                   value = TRUE, status = "success"),
    
    circle = TRUE, status = "info",
    icon = icon("gear"), width = "300px",
    
    tooltip = tooltipOptions(title = "Choose for more options!")
  ),
  
  
  
  # Sidebar layout with input and output definitions 
  sidebarLayout(
    div( id ="Sidebar",
         # Sidebar panel for inputs
         sidebarPanel(
           uiOutput("rad")
         )),
    
    # Main panel for displaying outputs
    mainPanel(
      id = "main_panel",
      uiOutput("tabers")
    )
  )
)
#server.r

server <- function(input, output) {
  
  data_sets <- list(df1 = data.frame(), 
                    df2= iris, 
                    df3 = mtcars, 
                    df4= ToothGrowth)
  
  # an oberserevent for toggle given by @lz100
  observeEvent(input$toggleSidebar, {
    shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
    if(!isTRUE(input$toggleSidebar)) {
      shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
    } else {
      shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
    }
    
  })
  
  
  output$rad<-renderUI({
    radioButtons("radio", label = "",
                 choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3), 
                 selected = character(0))
  })
  
  
  observeEvent(input$tabs, {
    callModule(module = esquisserServer,id = "esquisse", 
               data_table = reactive(data_sets[[as.integer(input$radio)]]),
               data_name = reactive(names(data_sets[paste0("df",input$radio)])))
  })
  
  
  output$tabers<- renderUI({
    if(is.null(input$radio)) {
      tabsetPanel(
        id="tabC",
        type = "tabs",
        tabPanel("Welcome!")
      )
    }
    else if(input$radio==1){
      tabsetPanel(
        id="tabA",
        type = "tabs",
        tabPanel("Navigation...")
      )
    }
    else if(input$radio==2){
      tabsetPanel(
        id="tabA",
        type = "tabs",
        tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                             options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
        tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
        tabPanel(
          title = "Plot",
          esquisserUI(
            id = "esquisse",
            header = FALSE, 
            choose_data = FALSE
          )
        )
      ) 
    }
    else if(input$radio==3){
      tabsetPanel(
        id="tabA",
        type = "tabs",
        tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                             options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
        tabPanel(
          title = "Plot",
          esquisserUI(
            id = "esquisse",
            header = FALSE, 
            choose_data = FALSE
          )
        )
      ) 
    }
  })
}

shinyApp(ui, server)


enter image description here enter image description here enter image description here

If I can get some help in these two matter, I will immensely appreciate it.

1 Answers

The UI is easy to fix: just add this

        mainPanel(
            id = "main_panel",
            tags$style('.sw-dropdown {display: inline-block};'),
            uiOutput("tabers")
        )

The problem is from renderUI when it creates new UI, it didn't load the required CSS. I don't know why but We can force it by adding our style.

For the plot problem, here are a few problems:

  1. Input for esquisserServer, data must be a reactiveValues object, so your data_sets is a list and will not work.
  2. Why do you observe for input$tabs, I don't see a place you have something with ID 'tabs'.
  3. for the esquisserUI and esquisserServer, ID argument must one-to-one match and you cannot have duplicates. You have all your IDs to be "esquisse".
  4. Since you are using renderUI to render new UI each time, and this is an async function. Then it will call the server callModule immediately. However, the UI is not prepared when the server is called. You will face the same problem I just posted to the shiny team: https://github.com/rstudio/shiny/issues/3348

I tried to fix your server with the fixed dataset df1 but still have the problem No.4. You should consider if renderUI is really needed. Fixing it can be very tricky.

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)

#Credit: @lz100 helped with auto uiOutput() scaling when sidebar is collapsed. Thank you.

#ui.r
ui <- fluidPage(
    
    useShinyjs(),
    
    # a switch for toggles
    dropdownButton(
        
        tags$h3("Toggle"),
        
        materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
                       value = TRUE, status = "success"),
        
        circle = TRUE, status = "info",
        icon = icon("gear"), width = "300px",
        
        tooltip = tooltipOptions(title = "Choose for more options!")
    ),
    
    
    
    # Sidebar layout with input and output definitions 
    sidebarLayout(
        div( id ="Sidebar",
             # Sidebar panel for inputs
             sidebarPanel(
                 uiOutput("rad")
             )),
        
        # Main panel for displaying outputs
        mainPanel(
            id = "main_panel",
            tags$style('.sw-dropdown {display: inline-block};'),
            uiOutput("tabers")
        )
    )
)
#server.r

server <- function(input, output) {
    
    data_sets <- list(df1 = data.frame(), 
                      df2= iris, 
                      df3 = mtcars, 
                      df4= ToothGrowth)
    data_rea <- reactiveValues(df1 = data.frame(), 
                               df2= iris, 
                               df3 = mtcars, 
                               df4= ToothGrowth)
    # an oberserevent for toggle given by @lz100
    observeEvent(input$toggleSidebar, {
        shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
        if(!isTRUE(input$toggleSidebar)) {
            shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
        } else {
            shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
        }
        
    })
    
    
    output$rad<-renderUI({
        radioButtons("radio", label = "",
                     choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3), 
                     selected = character(0))
    })
    
    
    observeEvent(input$radio, {
        callModule(module = esquisserServer,id = "esquisse1", 
                   data = data_rea[['df1']])
    })
    
    
    output$tabers<- renderUI({
        if(is.null(input$radio)) {
            tabsetPanel(
                id="tabC",
                type = "tabs",
                tabPanel("Welcome!")
            )
        }
        else if(input$radio==1){
            tabsetPanel(
                id="tabA",
                type = "tabs",
                tabPanel("Navigation...")
            )
        }
        else if(input$radio==2){
            tabsetPanel(
                id="tabA",
                type = "tabs",
                tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                                     options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
                tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
                tabPanel(
                    title = "Plot",
                    esquisserUI(
                        id = "esquisse1",
                        header = FALSE, 
                        choose_data = FALSE
                    )
                )
            ) 
        }
        else if(input$radio==3){
            tabsetPanel(
                id="tabA",
                type = "tabs",
                tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top', 
                                                     options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
                tabPanel(
                    title = "Plot",
                    esquisserUI(
                        id = "esquisse2",
                        header = FALSE, 
                        choose_data = FALSE
                    )
                )
            ) 
        }
    })
}

shinyApp(ui, server)

updates

Try this:

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)

ui <- fluidPage(
    useShinyjs(),
    # a switch for toggles
    dropdownButton(
        tags$h3("Toggle"),
        materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
                       value = TRUE, status = "success"),
        circle = TRUE, status = "info",
        icon = icon("gear"), width = "300px"
    ),
    sidebarLayout(
        sidebarPanel(
            id = "Sidebar",
            radioButtons("controller", "Controller", 1:3, 1)
        ),
        mainPanel(
            id = "main_panel",
            
            tabsetPanel(
                id = "hidden_tabs",
                type = "hidden",
                tabPanelBody(
                    "panel1", "navigation"
                ),
                tabPanelBody(
                    "panel2", 
                    tabsetPanel(
                        tabPanel("Data", DT::dataTableOutput('panel1_data')),
                        tabPanel("Summary", verbatimTextOutput("panel1_sum")),
                        tabPanel(
                            "Plot",
                            esquisserUI(
                                id = "esquisse2",
                                header = FALSE, 
                                choose_data = FALSE
                            )
                        )
                    )
                ),
                tabPanelBody(
                    "panel3",
                    tabsetPanel(
                        tabPanel("Data", DT::dataTableOutput('panel3_data')),
                        tabPanel("Summary", verbatimTextOutput("panel3_sum")),
                        tabPanel(
                            "Plot",
                            esquisserUI(
                                id = "esquisse3",
                                header = FALSE, 
                                choose_data = FALSE
                            )
                        )
                    )
                )
            )
        )
        )
    )
)

server <- function(input, output, session) {
    observeEvent(input$toggleSidebar, {
        shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
        if(!isTRUE(input$toggleSidebar)) {
            shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
        } else {
            shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
        }
        
    })
    
    data_sets <- list(df1 = data.frame(), 
                     df2= iris, 
                     df3 = mtcars, 
                     df4= ToothGrowth)
    # store current dataset
    data_to_use <- reactiveValues(name = "df", data = data.frame())
    
    # modules only needto be called it once
    callModule(
        module = esquisserServer,
        id = "esquisse2",
        data = data_to_use
    )
    callModule(
        module = esquisserServer,
        id = "esquisse3",
        data = data_to_use
    )
    
    observeEvent(input$controller, {
        updateTabsetPanel(session, "hidden_tabs", selected = paste0("panel", input$controller))
        # skip first panel since it is used to display navigation
        req(input$controller)
        # get current data and df name
        data_to_use$data <- data_sets[[as.numeric(input$controller)]]
        data_to_use$name <- names(data_sets[as.numeric(input$controller)])
        # update table and sum
        output[[paste0('panel',  input$controller, '_data')]] <-
            DT::renderDataTable(data_to_use$data)
        output[[paste0('panel',  input$controller, '_sum')]] <-
            renderPrint(summary(data_to_use$data))
    })
    
    
}

shinyApp(ui, server)

?tabsetPanel gives a very nice example how you can hide content with the type = "hidden" and you can nest tabsetPanel inside a tabsetPanel. So all UI elements are sent to client on start, they are just hidden, and been displayed at a certain click. It is fundamentally different from renderUI where you load UI dynamically. And for modules, you only need to call it once on server. So they go outside of observer.

Related