r - 启动闪亮时的警报消息

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)

非常感谢！

标签： rshiny

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)