Ошибка Shiny Dashboard в datatable: «данные» должны быть двумерными (например, фрейм данных или матрица) - PullRequest
0 голосов
/ 12 января 2020

Я относительно новичок в блестящих панелях мониторинга, и у меня появляется следующая ошибка " Ошибка в датированных данных:" данные "должны быть двумерными (например, фрейм данных или матрица) ", что, по-моему, означает не могу найти фрейм данных / функцию, которая содержит мои результаты. Когда я запускаю код, я вижу, что получаю результаты в команде print (collect_data ()), но она не переносится в таблицу данных на главной панели. Любая помощь очень ценится.

Пожалуйста, смотрите мой пример кода -

    library(shiny)
    library(shinydashboard)
    library(dplyr)
    library(shinyjs)
    library(glue)
    library(shinyauthr)
    library(aws.s3)

    campaigns <- data.frame(partner = c("a","b","c","d"), campaignName = c("Perfect Harmony","Bluff City Law", "Bring The Funny", "Ellen Games"), season = c(1,2,3,4))

    user_base <- data_frame(
      user = c("user1", "user2"),
      password = c("pass1", "pass2"), 
      password_hash = sapply(c("pass1", "pass2"), sodium::password_store), 
      permissions = c("admin", "standard"),
      name = c("User One", "User Two")
    )

    fluidPage(
    ui <- dashboardPage( skin = "purple",
      dashboardHeader(title = "Test,
                      tags$li(class = "dropdown", style = "padding: 8px; background-color: #694E91;", 
                           shinyauthr::logoutUI("logout")),
                       tags$li(class = "dropdown", style = "padding: 8px; background-color: #694E91;",
                              tags$img(src='logo.png',  class = "img-fluid", href = "", title = ""))
      ),

      dashboardSidebar(collapsed = TRUE, 
                       div(textOutput("welcome"), style = "padding: 20px"),
                       menuItem("Search Campaign", tabName = "CSF2", icon = icon("search")),
                       selectInput("partner", "Select a Partner", choices = levels(campaigns$partner)),
                       selectInput("campaign", "Select Campaign", choices = NULL),
                       selectInput("season", "Select Season", choices = NULL),
                       hr(), 
                       actionButton("view", "Get Campaign")
      ),

      dashboardBody(
        tags$head(
                  tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"),
                  tags$style(".table{margin: 0 auto;}"),
                  tags$script(src="https://cdnjs.cloudflare.com/ajax/libs/iframe-resizer/3.5.16/iframeResizer.contentWindow.min.js",
                              type="text/javascript"),
                  includeScript("returnClick.js")
        ),
        shinyjs::useShinyjs(),
        shinyauthr::loginUI("login"),
        uiOutput("user_table"),
        uiOutput("results"),
        HTML('<div data-iframe-height></div>')

      )

    )

    )

    server <- function(input, output, session) {



      credentials <- callModule(shinyauthr::login, "login", 
                                data = user_base,
                                user_col = user,
                                pwd_col = password_hash,
                                sodium_hashed = TRUE,
                                log_out = reactive(logout_init()))



      logout_init <- callModule(shinyauthr::logout, "logout", reactive(credentials()$user_auth))

      observe({
        if(credentials()$user_auth) {
          shinyjs::removeClass(selector = "body", class = "sidebar-collapse")
        } else {
          shinyjs::addClass(selector = "body", class = "sidebar-collapse")
        }
       })



      output$user_table <- renderUI({
         if(credentials()$user_auth) return(NULL)
        tagList(
          tags$p("Please enter the correct 'Log In' details above.", class = "text-center"),
        )
        })
      user_info <- reactive({credentials()$info})
       user_data <- reactive({
        req(credentials()$user_auth)
        if (user_info()$permissions == "admin") {
          observe({
            print(input$partner)
            x <- campaigns %>% filter(partner == input$partner) %>% select(campaignName)
            updateSelectInput(session, "campaign", "Select Campaign", choices = unique(x))
          })
          observe({
            seasonData <- campaigns$season[campaigns$campaignName == input$campaign]
            updateSelectInput(session, "season", "Select Season", choices = unique(seasonData))
          })
          observeEvent(input$view, {
            gather_data <- reactive({
                partnerName <- input$partner
                campName <- input$campaign
                folder_files <- paste0("s3://my-data/shiny-apps/",partnerName,"/",campName,"/test.csv")
                test <- s3read_using(read.csv, object=folder_files) %>% mutate_if(is.factor, as.character) %>% slice(4:382)
                colnames(test) = test[1,] 
                test <- test[-1,]
                test <- test %>% select(1,3,9:13,15:16,18,26,27) %>% rename(TuneIns = 6)
            })
              print(gather_data())
          })
        }
      })

      output$results <- renderUI({
        req(credentials()$user_auth)
        fluidPage(    
        fluidRow(
          column(width = 12,
            tags$h2(glue("Your permission level is: {user_info()$permissions}. 
                Your data is: {ifelse(user_info()$permissions == 'admin', {input$campaign}, 'other')}.")),
            box(width = NULL, status = "primary",
                title = ifelse(user_info()$permissions == 'admin',  glue("Welcome {user_info()$name} you are viewing {input$campaign} Data")),
                 DT::renderDT(user_data(), options = list(scrollX = TRUE)),
              )
          )
        ),
        fluidRow(
        column( width = 12,
          box(
            renderPlot({
            ggplot(gatherData(), aes(x = Partners, y = 'Tune-Ins')) +
              theme_minimal() + 
              geom_bar(aes(fill = Partners) , stat = "identity") + 
              labs(x="Partners", y = "Total Tune Ins") +
              ggtitle("Tune-Ins per Partner") + 
              theme(axis.text.x = element_text(angle = 45, hjust = 1, size = 15)) +
              geom_text(aes(label = 'Tune-Ins'),  vjust = 1) +
              theme(legend.position = "bottom")
          })) 
          )
        )
      )  
      })   
    }
    shiny::shinyApp(ui, server)
...