Блог

У меня есть довольно простое блестящее приложение, которое состоит из таблицы, реагирующей на три фильтра, и оно работает просто отлично. Тем не менее, мне нужно, чтобы он имел хотя бы умеренный уровень безопасности, поэтому я добавил модуль входа в систему с пакетом Shinyauthr, адаптировав код моего приложения к тому, который опубликован в https://github.com/PaulC91/shinyauthr.

Проблема в том, что когда я запускаю приложение, появляются фильтры и таблица, и кажется, что все работает нормально, но все равно я получаю следующую ошибку:

«Предупреждение: Ошибка в : Проблема с filter() вводом ..1 . я ввожу ..1 это conditional(input$selector_destiny != "", Destiny_flight == input$selector_destiny) . аргумент x имеет длину 0.»

Я просмотрел много сообщений в Интернете, но, поскольку я новичок в Shiny, я все еще не могу понять, что не так с моим кодом. Любая помощь в решении этой проблемы была бы отличной!

Вот код для приложения с формой входа в систему:

 library(DT)
library(shiny)
library(dplyr) 
library(shinyjs)

#data
my_data <- data.frame(
    "Destiny_flight" = as.character(c("CDB", "OPF", "ABC", "CDB", "OPF")), 
    "Origin" = as.character(c("ABC", "CDB", "CDB", "OPF", "ABC")), 
    "Date_flight" = as.Date(c("2020-01-24", "2021-06-09", "2021-03-19", "2020-12-24", "2021-01-08"),format = "%Y-%m-%d")
)


# dataframe that holds usernames, passwords and other user data
user_base <- tibble::tibble(
    user = c("user1", "user2"),
    password = c("pass1", "pass2"),
    permissions = c("admin", "standard"),
    name = c("User One", "User Two"))

# ui ----
ui <- navbarPage(title = "Title2",
    tabPanel(title = "Title2",
             useShinyjs(), 
             div(class = "container", 
                 div(
                     class = "pull-right", shinyauthr::logoutUI(id = "logout")),
                 shinyauthr::loginUI(id = "login")),
             uiOutput(outputId = "row_input"),
             DTOutput('table_final')))

# Server ----

server <- function(input, output, session) {
    
    # call the logout module with reactive trigger to hide/show
    logout_init <- callModule(
        shinyauthr::logout,
        id = "logout",
        active = reactive(credentials()$user_auth))
    
    # call login module supplying data frame, user and password cols
    # and reactive trigger
    credentials <- callModule(
        shinyauthr::login,
        id = "login",
        data = user_base,
        user_col = user,
        pwd_col = password,
        log_out = reactive(logout_init()))
    
conditional <- function(condition, success) {
        if (condition) success else TRUE}
    
    reactiveDf <- reactive({
        my_data %>%
            dplyr::filter(
                conditional(input$selector_destiny != '', Destiny_flight == input$selector_destiny), 
                Date_flight >= input$dateRange[1] amp; Date_flight <= input$dateRange[2]
            )
    })
    
#  App ---- 
output$table_final <- renderDT({
    req(credentials()$user_auth)
    reactiveDf() 
})
    
output$row_input <- renderUI({
    req(credentials()$user_auth)
    fluidRow(
             column(width = 6,
                         selectInput(
                             "selector_destiny",
                             label = "Destiny",
                             choices = c('',unique(unlist(my_data$Destiny_flight))),
                             multiple = FALSE, 
                             selectize = TRUE)),
             column(width= 6,
                         dateRangeInput('dateRange',
                                        label = 'Date',
                                        start = as.Date('2020-01-24') , 
                                        end = as.Date('2021-06-09'),
                                        width = '1500%')))
        
    }) 
}
# Run app
shinyApp(ui = ui, server = server)