r - rpivottable 不适用于登录模块

Question

我试图rpivottable在我的应用程序中使用该包，但不幸的是，它似乎有一个错误。首先简单介绍一下问题和我的应用程序：该应用程序使用登录界面进行身份验证。如果用户输入有效，则 ui 从登录更改为仪表板视图。仪表板的一部分是数据透视表。到目前为止，everythinkg 工作正常，但如果我单击注销按钮并再次登录，数据透视表将不再显示。我一直在努力解决这个问题。首先，我认为我的代码工作不正常，但如果我用任何其他反应输出替换数据透视表，一切正常。只有当我在服务器中包含数据透视表时，所有反应输出都不再显示。以下代码只是我的应用程序的片段。

有人知道如何解决这个问题吗？如果没有 - 还有其他方法可以生成这样的 表吗？非常感谢您的帮助！

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)

Answer 1

library(shiny)
library(shinythemes)
library(shinyjs)
library(shinyBS)
library(rpivotTable)
library(readxl)
library(shinyWidgets)
library(rvest)
library(htmlwidgets) # to use saveWidget function


gm= tags$h3(strong("Good Morning",style="color:#116bac"))
ga= tags$h3(strong("Good Afternoon",style="color:#116bac"))
ge= tags$h3(strong("Good Evening",style="color:#116bac"))

#===========
## FUNCTIONS
#===========
## SIMPLE GREETING
good_time <- function(){

  ## LOAD PACKAGE
  require(lubridate, quietly = T)

  ## ISOLATE currHour
  currhour = hour(now())

  ## RUN LOGIC
  if(currhour < 12){
    return(gm)
  } 
  else if(currhour >= 12 & currhour < 17){
    return(ga)
  }
  else if( currhour >= 17){
    return(ge)  
  }
}



## STARTING LOGGED VALUE; LET'S CHANGE THAT!
Logged = FALSE;


#====
# UI
#====
## make login screen
ui1 <- function(){

  tagList(tags$style(HTML('body {font-family:"Verdana",Georgia,Serif; background-color:#116bac}')),
          div(id="container",align="center",
              div(id = "login",
                  # make login panel
                  wellPanel(id="well",style = "overflow-y: ;width:100%;height:100%",
                            br(),
                            HTML(paste0('
                                        <h2>
                                        Hello, ', good_time(),
                                        '</h2>',
                                        '<h3>
                                        <br>You are in Admin page.</br>
                                        </h3>')
                            ),
                            br(),
                            br(),
                            tags$div(textInput("userName", "Username",width = "100%"),align="left"),
                            br(),
                            tags$div(passwordInput("passwd", "Password",width = "100%"),align="left"),
                            br(),
                            # button
                            tags$div(actionButton("Login", "Log in"),align="center"),
                            # login error message
                            tags$div(uiOutput("message"),align="center")
                            )

                  )
          ),
          # css for container
          tags$style(type = "text/css", 
                     "#container{
                     display: flex;
                     justify-content: center;
                     margin-top: 150px;
}"),
        # css for login well panel
        tags$style(type="text/css", "
                   #login,{
                   font-size:14px; 
                   width: 360px;}"),
        # well panel
        tags$style(type="text/css",
                   "#well{
                   padding: 50px;
                   background: white;
                   border: 1px;
                   box-shadow: ;}"),
        # welcome text css
        tags$style(type = 'text/css',
                   "h2, h3{
                   color: #525252;}"),
        # input fields
        tags$style(type="text/css",
                   "#userName, #passwd{
                   box-shadow: none;
                   outline:none;
                   border: none;
                   padding-left: 0;
                   border-bottom: 2px solid #116bac;
                   border-radius: 0;
                   }
                   #userName:focus, #passwd:focus{
                   box-shadow: 0px 10px 10px -5px lightgray;
                   }"),
        # button css
        tags$style(type='text/css',
                   "#Login{
                   outline: none;
                   margin-left: 0px;
                   width: 100px;
                   font-size: 12pt;
                   background: transparent;
                   border: 2px solid #116bac;
                   color: #116bac;
                   border-radius: 10px;
                   transition: 0.8s ease-in-out;
                   }
                   #Login:hover{
                   background: #116bac;
                   color: white;}"),
        # error box - fadeOut animation
        tags$style(type="text/css",
                   "@-webkit-keyframes fadeOut {
                   from {
                   opacity: 1;
                   }
                   to {
                   opacity: 0;
                   }
                   }
                   @keyframes fadeOut {
                   from {
                   opacity: 1;
                   }
                   to {
                   opacity: 0;
                   }
                   }"),
        tags$style(type="text/css",
                   "#error-box{
                   margin-top: 20px;
                   margin-left: 0px;
                   padding: 5px 10px 5px 10px;
                   text-align: center;
                   width: 325px;
                   color: white;
                   background: #ef3b2c;
                   border: 1px solid #ef3b2c;
                   border-radius: 5px;
                   -webkit-animation: fadeOut;
                   animation: fadeOut;
                   opacity: 0;
                   animation-duration: 15s;}")
        )
  }

#=========
# PRINT UI
#=========
ui = (uiOutput("page"))

#========
# SERVER
#========

server = shinyServer(function(input, output,session){
  options(shiny.maxRequestSize=50*1024^2)
  users <- data.frame(User=c("summary"),Password=c("statistics"))
  ## BEGIN BUILD LOG IN SCREEN
  USER <- reactiveValues(Logged = Logged)

  ## ERROR CHECKING
  observeEvent(input$Login,{

    ## output error message
    output$message <- renderUI({
      if(!is.null(input$Login)){
        my_username <- length(users$User[grep(pattern = input$userName, x = users$User)])
        my_password <- length(users$User[grep(pattern = input$passwd, x = users$Password)])
        if(input$Login > 0){
          if(my_username < 1 ||  my_password < 1){
            HTML("<div id='error-box'>
                 Sorry, that's not the right username or password. Please, 
                 try again. If you continue to have problems,
                 <a href='http://seaportai.com/contact-us/'>
                 <u>Contact Us..</u></a>
                 </div>")
          }
          }
          }
          })

    ## CHECK INPUT
    if (USER$Logged == FALSE) {
      if (!is.null(input$Login)) {
        if (input$Login > 0) {
          Username <- isolate(input$userName)
          Password <- isolate(input$passwd)
          Id.username <- which(users$User == Username)
          Id.password <- which(users$Password == Password)
          if (length(Id.username) > 0 & length(Id.password) > 0) {
            if (Id.username %in% Id.password) {
              USER$Logged <- TRUE
            }
          }
        }
      }
    }
          })

  ## Make UI
  observe({
    # What to do when logged = F
    if (USER$Logged == FALSE) {
      output$page <- renderUI({
        div(class="outer",do.call(bootstrapPage,c("",ui1())))
      })
    }

    # Render UI when logged = T
    if (USER$Logged == TRUE) 
    {
      ## get the current user's authorization level 
      user_log <- toupper(input$userName)

      # if admin ("input.SELECT == 1 || input.FED == 2" )
      if(user_log == "SUMMARY" ){
        output$page <- renderUI({
          ###################################################### ADMIN UI PAGE ###################################################################################################################
          fluidPage(


            theme = shinytheme("simplex"),
            tagList(
              useShinyjs(),
            tags$style(HTML("


                            .navbar  {
                            background-color:white; }

                            .navbar .navbar-nav {float: left; 
                            margin-top: 32px;
                            color: #; 
                            font-size: 20px; 
                            background-color: #; }

                            .navbar.navbar-default.navbar-static-top{ 
                            color: #; 
                            font-size: 23px; 
                            background-color: # ;}

                            .navbar .navbar-header {
                            float: left;

                            background-color: # ;}

                            .navbar-default .navbar-brand { color: #054b94; 
                            font-size: 28px; 
                            margin-bottom:32px;
                            background-color: # ;} 

                            ")),


            tags$head(HTML("<title>Statistics</title> <link rel='icon' type='image/gif/png' href='log.png'>")),

            navbarPage(id="tabs",

            title = tags$div(img(src="","Statistics", style="color:white;font-weight:200%;margin-top: -5px;margin-left: 30px;", height = 60)),position = "fixed-top",
            selected = tags$div(bsButton("dummy0",strong("Upload"),style = "danger",size="small"),style="color:white;margin-top: -22px;font-weight:100%;",align="center"),inverse = F,

            tabPanel(title = tags$div(bsButton("dummy0",strong("Upload"),style = "danger",size="small"),style="color:white;margin-top: -22px;font-weight:100%;",align="center"),

                     fluidPage(

                       tags$style(" #modal1 .modal-header {background-color:#; border-top-left-radius: 0px; border-top-right-radius: 0px}
                                  #modal1 .modal-dialog { width: 1800px;}
                                  #modal1 .modal-content  {background-color:#;}"), 

                       tags$style(type="text/css",
                                  ".shiny-output-error { visibility: hidden; }",
                                  ".shiny-output-error:before { visibility: hidden; }"
                       ),
                       tags$head(tags$style("#pppp{color:black; font-size:35px; font-style:italic; text-align=center;
                                            overflow-y:scroll; max-height: 300px; background: ghostwhite;}")),
                       tags$head(tags$style("#roi{color:black; font-size:35px; font-style:italic; text-align=center;
                                            overflow-y:scroll; max-height: 300px; background: ghostwhite;}")),


                       br(),
                       br(),
                       br(),

                       column(6,

                              br(),br(),br(),br(),br(),br(),br(),
                              tags$div(id = 'logo1',img(src="https://dunamath.com/image/gif1.gif",height='100%',width='100%'),align="center")
                       ),

                       br(),
                       br(),

                       column(6,


                              bootstrapPage(

                                            br(),
                                            tags$div(id = 'logo2',img(src="https://i.pinimg.com/originals/f8/8a/ca/f88acab7ffd127b4465659500aa0538f.gif",height='40%',width='40%'),align="center"),br(),

                                            tags$div(h4(strong(em("Risk Analytics")),style="color:#2e5cb8;font-size:200%"),align="center"),



                                            br(),
                                              uiOutput('fileupload'),
                                              #uiOutput("bss"),br(),
                                              uiOutput('checkbox'),
                                              uiOutput("button"),
                                              uiOutput("helptext"),
                                            br(),
                                            br(),
                                            bsPopover(id = "dummy000",title = "Note:",content = "XXX",placement = "right"),
                                            bsPopover(id="check",title = "",content = "Note: I accept the SeaportAI Terms & Conditions.. Show the Analyse button",placement = "right"),
                                            tags$div(bsButton("reset", label = "Reset ?", icon =   icon("repeat",lib = "glyphicon"),block = F, style="danger",size = "small"),align="center"),


                                            #tags$h1(actionButton("myuser","Logout",icon=icon("user")),style="text-align:center"),
                                            br(),

                                            tags$div(class = "header", checked = NA,style="text-align:center;color:#929292;font-size:100%",
                                                     tags$tbody("Need Help ?"),
                                                     tags$a(href = "http://seaportai.com/contact-us/", "Contact Us...", target="_blank")
                                            ),tags$div(actionLink("reset2",""),align="center"),
                                            br()
                              )
                       )



                       )),



            tabPanel(value = "mytab2",

              title = tags$div(bsButton("dummy",strong("Summay Statistics"),style = "primary",size="small"),style="color:white;margin-top: -22px;font-weight:100%;",align="center"),
              br(),br(),br(),br(),br(),br(),
              # tags$div(selectInput('select1', "Select One...",choices = c("Table", "Image"),selected = "Image"), align = 'center'),
              uiOutput('download1'),
              # uiOutput('download2'),
              tags$div(rpivotTableOutput("test",width = '100%'),align = 'center')

              ),

            tabPanel(
              title = tags$a(href="javascript:history.go(0)",tags$div(bsButton("ss22",strong("Logout"),style = "success",size="small"),
                                                                      style="color:white;margin-top: -12px;font-weight:100%;",align="center"),style="color:white;margin-top: -32px;")
            )









            )
            )
                  )

          #########################################################################################################################################################################



      })
    }



      # if standard user
      else{
        output$page <- renderUI({


        })
      }
    }
    })



  ####################################################### server #############################################################################################




  observeEvent(input$reset,{
    reset(id = "file")
  })

    output[["fileupload"]] <- renderUI({
      input$reset
      tags$div(fileInput("file",label = tags$h4(strong(em("Upload data..")),style="color:#004264;font-size:160%"),accept=c('.xlsx','.xlx')),align="center")

    })




    output[["checkbox"]] <- renderUI({
      input$reset
      tags$div(checkboxInput("check",tags$a(href = "http://seaportai.com/privacy-policy/", "Terms & Conditions",style="color:green;"),value = TRUE),align="center")

    })

    output[["button"]] <- renderUI({
      if (is.null(input$file)) return()
        tags$div(bsButton("analyse",strong("Lets Go..!"),icon = icon("refresh"),style = "primary",size="medium"),
                 style="color:white;font-weight:100%;",align="center")

    })









  ############################################# Data ###############################################################################  

  data <-reactive({
    file1 <- input$file
    if(is.null(file1)) {return(NULL)}
    data <- read_excel(file1$datapath)
    #data=data.frame(readxl::read_excel("ega.xlsx"))
    data=data.frame(data)
    data

  })

  observeEvent(input$analyse, {
    confirmSweetAlert(
      session = session,
      inputId = "confirmation",
      type = "warning",
      title = "Are you sure the data was uploaded ?",
      tags$div(strong(h3("If upload Done then go to the Summary Statistics tab for output..",style="color:red;")),align="center"),
      btn_labels = c("Nope", "Yep"),
      danger_mode = TRUE
    )
  })

  session_store <- reactiveValues()

  pivottab = reactive({

    Pivot = rpivotTable(
      data(),
      onRefresh = 
        htmlwidgets::JS("function(config) { 
                           Shiny.onInputChange('myData', document.getElementById('test').innerHTML); 
                        }")
    )

    Pivot

  })

  observeEvent(input$confirmation, {
    if(input$confirmation==TRUE){

      output$test <- renderRpivotTable({
        pivottab()
      })

    }
  })


  summarydf <- eventReactive(input$myData,{
    input$myData %>% 
      read_html %>% 
      html_table(fill = TRUE) %>% 
      # Turns out there are two tables in an rpivotTable, we want the second
      .[[2]]

  })


  table1 = reactive({
    summarydf()
  })


  output[['download1']] = renderUI({

    if(dim(table1())[1] != 0){

        downloadButton('downloadData1', 'Download Data...')

    }else{

        downloadButton('downloadData2', 'Download Widget')
        # bsButton("downloadData2", "Download Plot")


    }

  })

  output$downloadData1 <- downloadHandler(
    filename = function() {
      paste("dataset-", Sys.Date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(table1(), file)
    })

  output$downloadData2 <- downloadHandler(
    filename = function() {
      paste("Summary - Statistics", Sys.Date(), ".png", sep = "")
    },
    content = function(file) {
      png(file)
      #plot(x = data()$vehicle_claim, y = data()$total_claim_amount)
      pivottab()
      dev.off()
      # saveWidget(pivottab(), file, selfcontained = TRUE)

    })

  # observeEvent(input$downloadData2, {
  #   savedPivot <- "savedPivot.html"
  #   saveWidget(pivottab(),file.path(normalizePath(dirname(savedPivot)),basename(savedPivot)))
  # })










  }) # END SHINYAPP

#======
# RUN
#======
shinyApp(ui = ui, server = server)

#save(app,file = "app.rda")