pivottable does not work with login/logout module
AndreasPhilippi opened this issue · 7 comments
AndreasPhilippi commented
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 commented
@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 commented
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 commented
@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 commented
@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 commented
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 commented
@AndreasPhilippi There is a temporary fix (beyond using htmlwidgets 1.3) in ramnathv/htmlwidgets#349. I suggest to follow the evolution there.
AndreasPhilippi commented
@smartinsightsfromdata
Great, thank you for your help and lets see what turns out for version 1.5!