smartinsightsfromdata
commented
5 years ago @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, 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!