下面给出了可执行代码,当排除农场选项警报选择。该警报还显示哪些行业将被排除。但是,我想生成一个新功能,即没有要排除的行业,即代码的“ 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)
非常感谢你!
如@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)
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句