确认SweetAlert在SHINY中生成的确认按钮的功能 [英] Functionality for the Confirm button that confirmSweetAlert generates in shiny

问题描述

朋友们，我希望你们能帮我回答以下问题： 下面的可执行代码生成集群，并在表中显示每个集群所属的行业。但是，在运行SHINY时，会显示由confirmSweetAlert发出的警报，以显示哪个行业被排除在生成集群之外。Confy SweetAlert生成两个按钮，第一个是"确认"，第二个是"还没有"。然而，我想要提供"确认"功能，当您按下时，您不再总是显示消息，您将被排除在哪个行业之外，因为每次您通过滑块更改集群时，都会通过confirmSweetAlert显示相同的消息。"尚未"按钮功能，我将在稍后开发，但您能帮助我使用"确认"按钮吗？

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)

非常感谢！

推荐答案

您可以创建reactive标志(confirmed_status)，该标志将在您通过甜蜜警报确认时更改。它将默认为FALSE，并且当按下确认按钮时，您的警报结果可以触发observeEvent更改为TRUE。然后，如果确认后不想再次显示该对话框，可以在observe中选中confirmed_status，然后再显示它。如果这是您要查找的行为，请让我知道。

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

  confirmed_status <- reactiveVal(FALSE)

  Modelcl<-reactive(function.cl(df,input$Slider))

  output$ind <- renderTable({
    IND <- ((Modelcl()[[1]]))
  })

  observe({
    if(is_empty(Modelcl()[[1]])==FALSE && isFALSE(confirmed_status())){
      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"
      )
    }})

  observeEvent(input$myconfirmation, {
    if (isFALSE(input$myconfirmation)) {
      confirmed_status(TRUE)
    } else {
      # Add here more for the "Not yet" condition
    }
  })

  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)
  })

}

这篇关于确认SweetAlert在SHINY中生成的确认按钮的功能的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！