почему отсутствующая функция не работает внутри реактивной Ршины? - PullRequest
Новая
       14

почему отсутствующая функция не работает внутри реактивной Ршины?

0 голосов
/ 22 марта 2019

У меня есть блестящее приложение R, которое фильтрует некоторые переменные и возвращает таблицу с использованием модулей. Я хотел бы использовать missing(), чтобы приложение продолжало работать, даже если для модуля не было предоставлено никакого значения. Однако, когда я использую missing() внутри reactive(), это выдает ошибку: Warning: Error in missing: 'missing' can only be used for arguments. Кто-нибудь знает, почему это может иметь место? Есть ли способ обойти это?

Пример приложения: 

df <- data.frame(a = sample(letters,100,T), b = sample(10,100,T))
dfFilter <- function(data, a, b){
  if (!missing(a)) {
    if(!is.null(a)){
      data <- data[data$a %in% a,]
    }
  }
  if (!missing(b)) {
    if(!is.null(b)){
      data <- data[data$b %in% b,]
    }
  }
  return(data)
}
filterTable <- function(input, output, session, data, aFetcher, bFetcher){
  return(reactive(dfFilter(data = data,
                a = switch(!missing(aFetcher),
                                 aFetcher(),NULL),
                b = switch(!missing(bFetcher),
                                 bFetcher(), NULL))))


}

displayTableUI <- function(id){
  ns <- NS(id)
  DT::dataTableOutput(ns('displayer'))
}
displayTable <- function(input, output, session, data){
  output$displayer <- DT::renderDataTable(data())
}


chooserUI <- function(id){
  ns <- NS(id)
  uiOutput(ns('filter'))
}
chooseA <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose A:',
                choices = unique(data$a),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}
chooseB <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose B:',
                choices = unique(data$b),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}

ui <- fluidPage(
  tabPanel('data',
           sidebarPanel(
             chooserUI('aChooser'),
             chooserUI('bChooser')
           ),
           mainPanel(
             displayTableUI('table1')
           )
  )
)

server <- function(input,output){
  chosenA <- callModule(chooseA,
                        id = 'aChooser',
                        data = df)
  chosenB <- callModule(chooseB,
                        id = 'bChooser',
                        data = df)
  table1 <- callModule(filterTable, 
                       data = df,
                       id = 'tableFilterer',
                       aFetcher = chosenA,
                       bFetcher = chosenB)
  callModule(displayTable, id = 'table1', data = table1)


}
shinyApp(ui, server)

1 Ответ

1 голос
/ 22 марта 2019

Исправлено с помощью exists() вместо !missing(): 

df <- data.frame(a = sample(letters,100,T), b = sample(10,100,T))
dfFilter <- function(data, a, b){
  if (!missing(a)) {
    if(!is.null(a)){
      data <- data[data$a %in% a,]
    }
  }
  if (!missing(b)) {
    if(!is.null(b)){
      data <- data[data$b %in% b,]
    }
  }
  return(data)
}
filterTable <- function(input, output, session, data, aFetcher, bFetcher){
  return(reactive(dfFilter(data = data,
                a = switch(exists(aFetcher),
                                 aFetcher(),NULL),
                b = switch(exists(bFetcher),
                                 bFetcher(), NULL))))


}

displayTableUI <- function(id){
  ns <- NS(id)
  DT::dataTableOutput(ns('displayer'))
}
displayTable <- function(input, output, session, data){
  output$displayer <- DT::renderDataTable(data())
}


chooserUI <- function(id){
  ns <- NS(id)
  uiOutput(ns('filter'))
}
chooseA <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose A:',
                choices = unique(data$a),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}
chooseB <- function(input, output, session, data){
  output$filter <- renderUI({
    ns <- session$ns
    pickerInput(inputId = ns('filter'),
                label = 'Choose B:',
                choices = unique(data$b),
                options = list(`actions-box` = TRUE),
                multiple = TRUE)
  })

  return(reactive(input$filter))

}

ui <- fluidPage(
  tabPanel('data',
           sidebarPanel(
             chooserUI('aChooser'),
             chooserUI('bChooser')
           ),
           mainPanel(
             displayTableUI('table1')
           )
  )
)

server <- function(input,output){
  chosenA <- callModule(chooseA,
                        id = 'aChooser',
                        data = df)
  chosenB <- callModule(chooseB,
                        id = 'bChooser',
                        data = df)
  table1 <- callModule(filterTable, 
                       data = df,
                       id = 'tableFilterer',
                       aFetcher = chosenA,
                       bFetcher = chosenB)
  callModule(displayTable, id = 'table1', data = table1)


}
shinyApp(ui, server)
...