开始闪亮时发出警报消息

Question

下面示出了可执行代码的警报时排除农场选项被选中。该警报还显示哪些行业将被排除。但是，我想生成一个新功能，即没有要排除的行业，即代码的“ ind_exclude”为空。我希望消息警报一出现就发出警报，说：“没有要排除的行业”

library(shiny)
library(rdist)
library(geosphere)
library(tidyverse)
library(shinyWidgets)
library(shinythemes)

function.cl<-function(df){

  #database df
  df<-structure(list(Industries = c(1,2,3,4,5,6,7), 
                     Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.8,-23.8), 
                     Longitude = c(-49.8, -49.8, -49.5, -49.8, -49.8,-49.5,-49.8), 
                     Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))


  coordinates<-subset(df,select=c("Latitude","Longitude")) 
  d<-distm(coordinates[,2:1]) 
  diag(d)<-1000000 
  min_distancia<-as.matrix(apply(d,MARGIN=2,FUN=min))
  limite<-mean(min_distancia)+sd(min_distancia) 

  search_vec <- function(mat, vec, dim = 1, tol = 1e-7, fun = all)
    which(apply(mat, dim, function(x) fun((x - vec) > tol)))
  ind_exclude<-search_vec(min_distancia,limite,fun=any)
  if(is_empty(ind_exclude)==FALSE){
    for (i in 1:dim(as.array(ind_exclude))){
      df<-subset(df,Industries!=ind_exclude[i])}}


  return(list(
    "IND" =  ind_exclude
  ))

}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(

                          selectInput("filter1", h3("Select farms"),
                                      choices = list("All farms" = 1, 
                                                     "Exclude farms" = 2),
                                      selected = 1),


                        ),
                        mainPanel(
                          tabsetPanel())))))  

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

  Modelcl<-reactive({
    function.cl(df)
  })

  output$ind <- renderTable({
    IND <- ((Modelcl()[[1]]))
  })
  observe({
    if(input$filter1 == 2){
      sendSweetAlert(
        session = session,
        title = "Information!",
        btn_labels = c("Yes", "No"),
        text = tags$div(h5("The industries that need to exclude are:"), 
                        paste(Modelcl()[[1]], collapse = ", ")
        ),

        type = "info"
      )
    }
  })


}

shinyApp(ui = ui, server = server)

非常感谢您！

Answer 1

如@Bruno所述，将观察者添加到要查找的对象中，该观察者可能为空。您只需要测试对象是否为NULL /空/没有值。这是一个使用rlang::is_empty来检查data.frame是否为空的应用。如果是，则在应用程序开始时发送警报（我创建了一个新的反应性对象Modelcl2，该对象始终为空，只是为了演示使用if语句进行观察的方法）：

library(shiny)
library(rdist)
library(geosphere)
library(tidyverse)
library(shinyWidgets)
library(shinythemes)

function.cl<-function(df){

  #database df
  df<-structure(list(Industries = c(1,2,3,4,5,6,7), 
                     Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.8,-23.8), 
                     Longitude = c(-49.8, -49.8, -49.5, -49.8, -49.8,-49.5,-49.8), 
                     Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))


  coordinates<-subset(df,select=c("Latitude","Longitude")) 
  d<-distm(coordinates[,2:1]) 
  diag(d)<-1000000 
  min_distancia<-as.matrix(apply(d,MARGIN=2,FUN=min))
  limite<-mean(min_distancia)+sd(min_distancia) 

  search_vec <- function(mat, vec, dim = 1, tol = 1e-7, fun = all)
    which(apply(mat, dim, function(x) fun((x - vec) > tol)))
  ind_exclude<-search_vec(min_distancia,limite,fun=any)
  if(is_empty(ind_exclude)==FALSE){
    for (i in 1:dim(as.array(ind_exclude))){
      df<-subset(df,Industries!=ind_exclude[i])}}


  return(list(
    "IND" =  ind_exclude
  ))

}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(

                          selectInput("filter1", h3("Select farms"),
                                      choices = list("All farms" = 1, 
                                                     "Exclude farms" = 2),
                                      selected = 1),


                        ),
                        mainPanel(
                          tabsetPanel())))))  

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

  Modelcl<-reactive({
    function.cl(df)
  })

  Modelcl2<-reactive({
    data.frame()
  })

  output$ind <- renderTable({
    IND <- ((Modelcl()[[1]]))
  })
  observe({
    if(input$filter1 == 2){
      sendSweetAlert(
        session = session,
        title = "Information!",
        btn_labels = c("Yes", "No"),
        text = tags$div(h5("The industries that need to exclude are:"), 
                        paste(Modelcl()[[1]], collapse = ", ")
        ),

        type = "info"
      )
    }
  })

  observe({
    if(is_empty(Modelcl2())){
      sendSweetAlert(session = session,
                     title = "Hey",
                     btn_labels = c("Yes", "No"),
                     text = "nothing to exclude",

                     type = "info"
      )
    }
  })

}

shinyApp(ui = ui, server = server)

这是向裸露的工作流程展示的一个非常小的示例。如果它是基于行数if(nrow(dataframe) < 1)或类似数据的数据框，您也可以进行测试，只需找到适合您所使用对象类型的测试即可：

library(shiny)
library(tidyverse)
library(shinyWidgets)


ui <- bootstrapPage()

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


  Modelcl2 <-reactive({
    data.frame()
  })

  observe({
    if(rlang::is_empty(Modelcl2())){
      sendSweetAlert(session = session,
                     title = "Hey",
                     btn_labels = c("Yes", "No"),
                     text = "nothing to exclude",

                     type = "info"
      )
    }
  })

}

shinyApp(ui = ui, server = server)