Functionality for the Confirm button that confirmSweetAlert generates in shiny

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!

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

make a reactiveVals list to track which industries you have confirmed on and dont want to show the alerts for, and then make the observe that places the sweetalert do it conditional based on whats on that list and what is being asked to be done

Okay, thanks for the tip.