Question

我想在两个简单的问题上寻求帮助：

上下文：以下可执行代码生成集群，并在表中显示哪些行业是每个集群的一部分。此外，运行Shiny时会显示由verifySweetAlert发出的警报，以显示哪个行业被排除在生成集群之外。

问题1：当我运行Shiny时，除了警报之外，还生成了输出表。我希望首先显示警报，并且一旦按下“确认”按钮，便会生成输出表。

问题2：代码中有一个重置按钮，当我按下该按钮时，滑块将返回其默认值。但是，我也想重置reactVal，以便再次显示警报。

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),
      actionButton("reset", "Reset"),
    ),

    mainPanel(
      DTOutput("tabela")
    )))

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

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

  observeEvent(input$reset, {
    updateRadioButtons(session,"Slider", selected = 4)

  })
}

shinyApp(ui = ui, server = server)

Answer 1

嗨，shiyn可以让您轻松地做到这一点，只需在req(confirmed_status())中添加一个renderDataTable语句，就可以同时重置reactValue和使用confirmed_status(FALSE)重置其他值。

output$tabela <- renderDataTable({
    req(confirmed_status())
    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)
  })

  observeEvent(input$reset, {
    updateRadioButtons(session,"Slider", selected = 4)
    confirmed_status(FALSE)
  })

闪亮问题的新功能

1 个答案: