Friends, I would like you to help me with the following question: The executable code below generates clusters and shows in a table which industries are part of each cluster. However, an alert made by confirmSweetAlert is being displayed when running Shiny to show which industry is being excluded from generating the clusters. ConfirmSweetAlert generates two buttons, the first is "Confirm" and the second is "Not yet". However, I would like to give functionality to "Confirm" that when you press, you no longer display the message at all times from which industry you will be excluded, because every time you change the clusters through the Slider, the same message appears through confirmSweetAlert. The "Not Yet" button functionality, I will develop later, but could you help me with the "Confirm" button, please?
library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(tidyverse)
library(DT)
library(shinyWidgets)
function.cl<-function(df,k){
#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.8,-49.8),
Waste = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))
# Exclude long-distance industries
coordinates<-subset(df,select=c("Latitude","Longitude"))
d<-distm(coordinates[,2:1])
diag(d)<-1000000
min_distance<-as.matrix(apply(d,MARGIN=2,FUN=min))
limite<-mean(min_distance)+sd(min_distance)
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_distance,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])}}
#cluster
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
#Number of clusters
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
#Location
location<-matrix(nrow=k,ncol=2)
for(i in 1:k){
location[i,]<-c(weighted.mean(subset(df,cluster==i)$Latitude,subset(df,cluster==i)$Waste),
weighted.mean(subset(df,cluster==i)$Longitude,subset(df,cluster==i)$Waste))}
coordinates$cluster<-clusters
location<-cbind(location,matrix(c(1:k),ncol=1))
#Coverage
coverage<-matrix(nrow=k,ncol=1)
for(i in 1:k){
aux_dist<-distm(rbind(subset(coordinates,cluster==i),location[i,])[,2:1])
coverage[i,]<-max(aux_dist[nclusters[i,1]+1,])}
coverage<-cbind(coverage,matrix(c(1:k),ncol=1))
colnames(coverage)<-c("Coverage","cluster")
#Sum of Waste from clusters
sum_waste<-matrix(nrow=k,ncol=1)
for(i in 1:k){
sum_waste[i,]<-sum(subset(df,cluster==i)["Waste"])
}
sum_waste<-cbind(sum_waste,matrix(c(1:k),ncol=1))
colnames(sum_waste)<-c("Potential","cluster")
#Output table
data_table <- Reduce(merge, list(df, coverage, sum_waste))
data_table <- data_table[order(data_table$cluster, as.numeric(data_table$Industries)),]
data_table_1 <- aggregate(. ~ cluster + Coverage + Potential, data_table[,c(1,7,6,2)], toString)
return(list(
"IND" = ind_exclude,
"Data" = data_table_1
))
}
ui <- fluidPage(
titlePanel("Clustering "),
sidebarLayout(
sidebarPanel(
sliderInput("Slider", h3("Number of clusters"),
min = 2, max = 6, value = 4),
),
mainPanel(
DTOutput("tabela")
)))
server <- function(input, output, session) {
Modelcl<-reactive(function.cl(df,input$Slider))
output$ind <- renderTable({
IND <- ((Modelcl()[[1]]))
})
observe({
if(is_empty(Modelcl()[[1]])==FALSE){
confirmSweetAlert(
session = session,
inputId = "myconfirmation",
btn_labels = c("Confirm", "Not yet"),
text = tags$div(h5("The industry below is being excluded from clustering:"),
paste(Modelcl()[[1]], collapse = ", ")),
type="info"
)
}})
output$tabela <- renderDataTable({
data_table_1 <- req(Modelcl())[[2]]
x <- datatable(data_table_1[order(data_table_1$cluster), c(1, 4, 2, 3)],
options = list(
paging =TRUE,
pageLength = 5
)
)
return(x)
})
}
shinyApp(ui = ui, server = server)
Thank you very much!