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