Search code examples
rshinyshinydashboardrpivottable

Enabling a scrollbar in rpivotTable using shiny services


I am using R-3.2.0 hosted on Red Hat Linux version 6.5 with shiny package (version 0.12.0). I am trying to utilize shinydashboard functionality to design a few reports. The RStudio version is 0.98.1103

I have successfully setup ui.R and server.R ui.R - :

ibrary(shinydashboard)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)

dashboardPage(
  dashboardHeader(title="Reports",
                  dropdownMenu(type = "task",
                               messageItem(
                                 from = "Download",
                                 message = "test",
                                 icon = icon("gear")
                               ),
                               messageItem(
                                 "Download",
                                 message = "TEST",
                                 icon = icon("life-ring"),
                                 href= "http://www.google.com"
                               )
                  )

    ),

  dashboardSidebar(
    sidebarMenu(
     menuItem("Srts", tabName = "ServiceItems", icon = icon("dashboard"))
    )
    ),

  dashboardBody(
                tags$head(tags$style(
                type = 'text/css',
                '#test{ overflow-x: scroll; }')),
                rpivotTableOutput('PivotTable')
               )
             )

server.R -:

library(shiny)
library(ggplot2)
library(wordcloud)
library(devtools)
library(htmlwidgets)
library(rpivotTable)
library(leaflet)

shinyServer(function(input, output) {
  PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
  output$PivotTable <- rpivotTable::renderRpivotTable({
  rpivotTable(PivotTable, rows="Ar", col="DTM", aggregatorName="Count",
              vals="Ar", rendererName="Table")})
  tableFirst<-as.data.frame(sort(table(PivotTable$Area),decreasing=TRUE))
})

The following code to enable scrolling in the dashboard body was taken from https://github.com/smartinsightsfromdata/rpivotTable/issues/19 :-

        tags$head(tags$style(
        type = 'text/css',
        '#test{ overflow-x: scroll; }')),
        rpivotTableOutput('PivotTable')

The issue I face is that the code added to help scrolling does not work. I have stripped my code of all tabs , layouts etc but I am still enable to get scrolling to work.

I have observed that if I remove the dashboardPage command, scrolling does work but the display is very awkward and not really presentable.


However, when I combine the codes as follows (in RStudio) and run the scrolling works just fine.

library(shiny)
library(shinydashboard)
library(rpivotTable)
library(ggplot2)

PivotTable <- read.csv("Book2.csv",head=TRUE,sep= ',')
header <-   dashboardHeader(title="Reports",
                  dropdownMenu(type = "task",
                               messageItem(
                                 from = "Download",
                                 message = "test",
                                 icon = icon("gear")
                               ),
                               messageItem(
                                 "Download",
                                 message = "TEST",
                                 icon = icon("life-ring"),
                                 href= "http://www.google.com"
                               )
                  )

    )

sidebar <- dashboardSidebar()
body <- dashboardBody(
                      tags$head(tags$style(HTML('
                      .skin-blue.main-header .logo {
                      background-color: #3c8dbc;
                     }
                     .skin-blue .main-header .logo:hover {
                     background-color: #3c8dbc;
                     }
                   '))
                     ),
                     tags$head(tags$style(type = 'text/css',
                    '#test{ overflow-x: scroll; }')),
                     rpivotTableOutput("test")
                     )            

                     shinyApp(
                     ui = dashboardPage(header, sidebar, body),
                     server = function(input, output) {
                     output$test <- rpivotTable::renderRpivotTable({
                     rpivotTable(PivotTable, rows="Ar", col="DTM",                     aggregatorName="Count",vals="Ar", rendererName="Table")})
                })

However, I cannot provide this as a final solution because the business users that need this are not adept at copying and pasting code on RStudio (If there is a possible way that I can use the combined code just like the usual one I can consider that as well).


Can someone please help me understand the issue with my original code that prevents scrolling.

Thanks a lot !


Solution

  • The problem is your CSS selector otherwise everything looks OK. Your setting the scroll-property on a element with ID test but I can't find a element with this ID in your example. Try something like this:

    library(shinydashboard)
    
    ui <- dashboardPage(
      dashboardHeader(title = "Basic dashboard"),
      dashboardSidebar(),
      dashboardBody(
        tags$head(
          tags$style(
            HTML("
                #myScrollBox{ 
                  overflow-y: scroll; 
                  overflow-x: hidden; 
                  height:120px;
                }
                 ")
          )
        ),
        # Boxes need to be put in a row (or column)
        fluidRow(
          div(id="myScrollBox",
            plotOutput("plot1", height = 250)),
    
          box(
            title = "Controls",
            sliderInput("slider", "Number of observations:", 1, 100, 50)
          )
        )
      )
    )
    
    server <- function(input, output) {
      set.seed(122)
      histdata <- rnorm(500)
    
      output$plot1 <- renderPlot({
        data <- histdata[seq_len(input$slider)]
        hist(data)
      })
    }
    
    shinyApp(ui, server)
    

    You need to change the CSS selector to the element you want to put the scroll on, in the example this is "myScrollBox".