pivottable does not work with login/logout module

[AndreasPhilippi]

Hi, Im trying to use your package in my app but unfortunally it seems there is a bug.
First a short introduction in the problem and my app:
The app uses an login interface for authentification. If the user input was valid the ui changes from login to dashboard view. One part of the dashboar is the pivottable. Up to here everythinkg works fine but if I click on the logout button and login again, the pivottable does not show up anymore. I'm trying to fix that issue since days. First I thought that my code is not working properly but if I replace the pivottable with some other reactive output everthing is working fine. Only when I include the pivottable in the server all reactive outputs are no longer displayed.
The following code is just a snipped of my app.

Would be very grateful for help!

if (!require("pacman")) install.packages("pacman")
pacman::p_load(shiny, shinyBS, shinydashboard, shinyjs, dplyr,RMySQL,pool,rpivotTable)

#devtools::install_github(c("ramnathv/htmlwidgets", "smartinsightsfromdata/rpivotTable"))


mydata <- data.frame(
  product = c('A','B','C','A','B','C','A','B','C'),
  sold = c(5, 10, 15, 7, 6, 5, 9, 3, 1),
  date = as.Date(c('2010-01-01','2010-01-01','2010-01-01','2010-01-02','2010-01-02','2010-01-02','2010-01-03','2010-01-03','2010-01-03'))
)

user_data <- data.frame(
  user = c("Andreas", "Sascha", "Tobias"),
  password = c("123","123","123"), 
  permissions = c("admin","admin","admin"),
  name = c("Andreas", "Sascha", "Tobias"),
  stringsAsFactors = FALSE,
  row.names = NULL
)

ui <- dashboardPage(
  
  # Dashboardheader
  dashboardHeader(uiOutput("header")),
  
  # Dashboardsidebar
  dashboardSidebar(collapsed = TRUE,
                   sidebarMenu(id = "sidebar", sidebarMenuOutput("sidebar"))),
  
  # Dashboardbody
  dashboardBody(
    
    # Turn shinyjs on
    shinyjs::useShinyjs(),
    
    uiOutput("body")
  )
)

server <- function(input, output) {
  values <- reactiveValues()
  # reactive value to trigger the body, sidebar, header of dashboard depending on the login-state 
  values$login <- FALSE
  
  # header of login-Module (nothing in it)
  login_header <- function(){
  }
  
  # header if user is logged in
  auth_header <- function(){
    fluidRow(
      column(12,actionButton("logout_button","Logout",class = "btn-danger", style = "color: white; border-color: #d73925; background: #dd4b39")))
  }
  
  # Sidebar of login-Module (empty)
  login_sidebar <- function(){
    sidebarMenu()
  }
  
  # Sidebar if user is logged in 
  admin_sidebar <- function(){
    
    sidebarMenu(
      menuItem("Home", tabName = "home", icon = icon("home"))
    )
  }
  
  # Body if user is logged in 
  admin_body <- function(){
    tabItems(
      # Body for "Startseite" menuItem  
      tabItem(tabName = "home",class = "active",
              dateRangeInput('dateRangeInput',
                             label = 'Date',
                             start = as.Date(max(mydata$date))-2, 
                             end = as.Date(max(mydata$date)),
                             min = as.Date(min(mydata$date)),
                             max = as.Date(max(mydata$date)),
                             format = "yyyy-mm-dd",
                             language = "de"),
              
              fluidRow(
                tabBox(width = 8,
                       tabPanel("Tabelle", rpivotTableOutput("pivotTable",width = "100%", height = "100%"))
                )
              )
      )
    )
  }
  
  # Body of login-Module
  login_body <- function(){
    div(id = "panel", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
        wellPanel(
          tags$h2("LogIn", class = "text-center", style = "padding-top: 0;"),
          
          textInput("user_name", shiny::tagList(shiny::icon("user"), "Username")),
          
          passwordInput("password", shiny::tagList(shiny::icon("unlock-alt"), "Password")),
          
          div(
            style = "text-align: center;",
            actionButton("login_button","LogIn"))
        ),
        
        shinyjs::hidden(
          div(id = "error",
              tags$p("Wrong Password or Username",
                     style = "color: red; font-weight: bold; padding-top: 5px;", class = "text-center"))
        )
    )
  }
  
  
  observeEvent(input$login_button,{
    username_input = input$user_name
    pw_input = input$password
    
    # get pw of user_name stored in user_data
    pw <- user_data%>%
      filter(user==username_input)%>%
      select(password)%>%
      as.character()
    
    # if input pw matches pw stored in db set login to true
    if(pw_input==pw){
      values$login <- TRUE
    }
    # else show error
    else{
      shinyjs::toggle(id = "error", anim = TRUE, time = 1, animType = "fade")
      shinyjs::delay(5000, shinyjs::toggle(id = "error", anim = TRUE, time = 1, animType = "fade"))
    }
  })
  
  
  observeEvent(values$login,{
    # if login-data was valid show dashboard
    if(values$login){
      output$header <- renderUI(auth_header())
      output$body <- renderUI(admin_body())
      output$sidebar <- renderMenu(admin_sidebar())
      shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
    }
    # else show login module
    else{
      output$body <- renderUI(login_body())
      output$header <- renderUI(login_header())
      output$sidebar <- renderMenu(login_sidebar())
      shinyjs::addClass(selector = "body", class = "sidebar-collapse")
    }
  })
  
  # set login to false if user clicks on logout -> go back to login module (see obsereEvent(values$login))
  observeEvent(input$logout_button,{
    values$login <- FALSE
  })
  
  # ----------------------------------------------------------------------
  #     Pivot Tabelle
  # ----------------------------------------------------------------------
  output$pivotTable <- renderRpivotTable({

  pivot_data <-mydata%>%
      filter(date >= input$dateRangeInput[1] & date <= input$dateRangeInput[2])%>%
      select(product,sold,date)

    rpivotTable(
      data = pivot_data, rows = "product",cols="date", vals = "sold",
      aggregatorName = "Sum", rendererName = "Table",
      subtotals = FALSE)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

[smartinsightsfromdata]

@AndreasPhilippi I think the problem is actually in your filtering code.

The following works. Please note that I added the ability to scroll (by design pivotable can add lots of columns or rows, depending on the files you are analysing.

library(shiny)
library(shinydashboard)
library(rpivotTable)
library(magrittr)
library(shinyjs)

mydata <- data.frame(
  product = c('A','B','C','A','B','C','A','B','C'),
  sold = c(5, 10, 15, 7, 6, 5, 9, 3, 1),
  date = as.Date(c('2010-01-01','2010-01-01','2010-01-01','2010-01-02','2010-01-02','2010-01-02','2010-01-03','2010-01-03','2010-01-03'))
)

user_data <- data.frame(
  user = c("Andreas", "Sascha", "Tobias"),
  password = c("123","123","123"), 
  permissions = c("admin","admin","admin"),
  name = c("Andreas", "Sascha", "Tobias"),
  stringsAsFactors = FALSE,
  row.names = NULL
)

ui <- dashboardPage(
  
  # Dashboardheader
  dashboardHeader(uiOutput("header")),
  
  # Dashboardsidebar
  dashboardSidebar(collapsed = FALSE,
                   sidebarMenu(id = "sidebar", sidebarMenuOutput("sidebar"))),
  
  # Dashboardbody
  dashboardBody(
    
    # Turn shinyjs on
    shinyjs::useShinyjs(),
    
    uiOutput("body")
  )
)

server <- function(input, output) {
  values <- reactiveValues()
  # reactive value to trigger the body, sidebar, header of dashboard depending on the login-state 
  values$login <- TRUE
  
  # header of login-Module (nothing in it)
  login_header <- function(){
  }
  
  # header if user is logged in
  auth_header <- function(){
    fluidRow(
      column(12,actionButton("logout_button","Logout",class = "btn-danger", style = "color: white; border-color: #d73925; background: #dd4b39")))
  }
  
  # Sidebar of login-Module (empty)
  login_sidebar <- function(){
    sidebarMenu()
  }
  
  # Sidebar if user is logged in 
  admin_sidebar <- function(){
    
    sidebarMenu(
      menuItem("Home", tabName = "home", icon = icon("home"))
    )
  }
  
  # Body if user is logged in 
  admin_body <- function(){
    tabItems(
      # Body for "Startseite" menuItem  
      tabItem(tabName = "home",class = "active",
              dateRangeInput('dateRangeInput',
                             label = 'Date',
                             start = as.Date(max(mydata$date))-2, 
                             end = as.Date(max(mydata$date)),
                             min = as.Date(min(mydata$date)),
                             max = as.Date(max(mydata$date)),
                             format = "yyyy-mm-dd",
                             language = "de"),
              
              fluidRow(
                tabBox(width = 8
                       , height= 20 #, status = "primary", solidHeader = TRUE
                       , tabPanel( tags$head(tags$style( type = 'text/css',  '#test{ overflow-x: scroll; }'))
                                   , rpivotTableOutput("pivotTable"))
                       # ,tabPanel("Tabelle", rpivotTableOutput("pivotTable"))
                )
              )
      )
    )
  }
  
  # Body of login-Module
  login_body <- function(){
    div(id = "panel", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
        wellPanel(
          tags$h2("LogIn", class = "text-center", style = "padding-top: 0;"),
          
          textInput("user_name", shiny::tagList(shiny::icon("user"), "Username")),
          
          passwordInput("password", shiny::tagList(shiny::icon("unlock-alt"), "Password")),
          
          div(
            style = "text-align: center;",
            actionButton("login_button","LogIn"))
        ),
        
        shinyjs::hidden(
          div(id = "error",
              tags$p("Wrong Password or Username",
                     style = "color: red; font-weight: bold; padding-top: 5px;", class = "text-center"))
        )
    )
  }
  
  
  observeEvent(input$login_button,{
    username_input = input$user_name
    pw_input = input$password
    
    # get pw of user_name stored in user_data
    pw <- user_data%>%
      filter(user==username_input)%>%
      select(password)%>%
      as.character()
    
    # if input pw matches pw stored in db set login to true
    if(pw_input==pw){
      values$login <- TRUE
    }
    # else show error
    else{
      shinyjs::toggle(id = "error", anim = TRUE, time = 1, animType = "fade")
      shinyjs::delay(5000, shinyjs::toggle(id = "error", anim = TRUE, time = 1, animType = "fade"))
    }
  })
  
  
  observeEvent(values$login,{
    # if login-data was valid show dashboard
    if(values$login){
      output$header <- renderUI(auth_header())
      output$body <- renderUI(admin_body())
      output$sidebar <- renderMenu(admin_sidebar())
      shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
    }
    # else show login module
    else{
      output$body <- renderUI(login_body())
      output$header <- renderUI(login_header())
      output$sidebar <- renderMenu(login_sidebar())
      shinyjs::addClass(selector = "body", class = "sidebar-collapse")
    }
  })
  
  # set login to false if user clicks on logout -> go back to login module (see obsereEvent(values$login))
  observeEvent(input$logout_button,{
    values$login <- FALSE
  })
  
  # ----------------------------------------------------------------------
  #     Pivot Tabelle
  # ----------------------------------------------------------------------
  output$pivotTable <- renderRpivotTable({
    
    # pivot_data <-mydata%>%
    #   filter(date >= input$dateRangeInput[1] & date <= input$dateRangeInput[2])%>%
    #   select(product,sold,date)
    # 
    rpivotTable(
      data = mydata
    )
      #   pivot_data, rows = "product",cols="date", vals = "sold",
      # aggregatorName = "Sum", rendererName = "Table",
      # subtotals = FALSE)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

[AndreasPhilippi]

Hi, thx for your answer and your time. I tried your code but it still does not work.
After a relog, the table is no longer displayed.

[smartinsightsfromdata]

@AndreasPhilippi This is a bit mysterious & odd.

Have you tried to run the example I've attached, exactly as it is?
As mentioned, it works fine with me. See here.

this is my session info(). Could you provide yours?

sessionInfo()
R version 3.6.1 (2019-07-05)
Platform: x86_64-apple-darwin18.7.0 (64-bit)
Running under: macOS Mojave 10.14.6

Matrix products: default
BLAS:   /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /usr/local/Cellar/openblas/0.3.7/lib/libopenblasp-r0.3.7.dylib

locale:
[1] en_GB.UTF-8/en_GB.UTF-8/en_GB.UTF-8/C/en_GB.UTF-8/en_GB.UTF-8

attached base packages:
[1] stats     graphics  grDevices
[4] utils     datasets  methods  
[7] base     

other attached packages:
[1] shinyjs_1.0         
[2] magrittr_1.5        
[3] rpivotTable_0.3.0   
[4] shinydashboard_0.7.1
[5] shiny_1.3.2         

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.2      packrat_0.5.0  
 [3] digest_0.6.21   later_0.8.0    
 [5] mime_0.7        R6_2.4.0       
 [7] jsonlite_1.6    xtable_1.8-4   
 [9] rlang_0.4.0     promises_1.0.1 
[11] tools_3.6.1     htmlwidgets_1.3
[13] yaml_2.2.0      httpuv_1.5.2   
[15] compiler_3.6.1  htmltools_0.3.6

[AndreasPhilippi]

@smartinsightsfromdata
Hi, sry for my late reply.
Exactly - I tried to run it as it is.
I also tried running it on a friend's PC, but the same turned out.

This is how it looks like when I run the app:

And that's what it looks like when I log out and in again

In addition here the sessionInfo()

R version 3.5.3 (2019-03-11)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)

Matrix products: default

locale:
[1] LC_COLLATE=German_Germany.1252  LC_CTYPE=German_Germany.1252    LC_MONETARY=German_Germany.1252
[4] LC_NUMERIC=C                    LC_TIME=German_Germany.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] dplyr_0.8.3          shinyjs_1.0.1.9004   magrittr_1.5         rpivotTable_0.3.0    shinydashboard_0.7.1
[6] shiny_1.3.2         

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.1       rstudioapi_0.10  tidyselect_0.2.5 xtable_1.8-4     R6_2.4.0         rlang_0.4.0      tools_3.5.3     
 [8] pool_0.1.4.2     DBI_1.0.0        dbplyr_1.4.2     htmltools_0.3.6  RMySQL_0.10.17   yaml_2.2.0       assertthat_0.2.0
[15] digest_0.6.19    tibble_2.1.3     crayon_1.3.4     purrr_0.3.2      later_0.8.0      htmlwidgets_1.4  promises_1.0.1  
[22] glue_1.3.1       mime_0.5         compiler_3.5.3   pillar_1.3.1     jsonlite_1.6     httpuv_1.5.1     pkgconfig_2.0.2 ```

[smartinsightsfromdata]

@AndreasPhilippi

I'm keeping investigating the issue. This is what I found:

There has been a regression of sort with the upgrade from htmlwidgets 1.3 to further releases.

Please try to install htmlwidgets 1.3 and confirm. It works for me.

Incidentally, now htmlwidgets 1.5 is out and I cannot test with 1.4 anymore.

There is another regression with the login: with htmlwidgets 1.5 it doesn't work anymore!

Please try to install htmlwidgets 1.3 and confirm (same as 1.5).
I've reported two issues. Let's see what they say.
ramnathv/htmlwidgets#350. - this is about the login not working anymore
ramnathv/htmlwidgets#349 - this is about rpivotTable not working anymore from 1.3 to 1.4 and 1.5.

[smartinsightsfromdata]

@AndreasPhilippi There is a temporary fix (beyond using htmlwidgets 1.3) in ramnathv/htmlwidgets#349. I suggest to follow the evolution there.

[AndreasPhilippi]

@smartinsightsfromdata
Great, thank you for your help and lets see what turns out for version 1.5!