Мне нужна помощь по следующему вопросу: исполняемый код ниже генерирует кластеры и показывает в таблице, какие отрасли являются частью каждого кластера. Кроме того, при запуске Shiny отображается предупреждение, созданное с помощью confirmSweetAlert, чтобы показать, какая отрасль исключена из создания кластеров. Если вы нажмете кнопку «Подтвердить», таблица вывода будет сгенерирована с исключением отрасли 5 для этого примера. Однако я хотел бы добавить функциональность в кнопку «Еще нет», чтобы при нажатии указанное свойство не исключалось, то есть отрасль 5 для этого примера. Вы можете помочь мне? Исполняемый код ниже.
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.8, -49.8, -49.5,-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
k=4
coordinates<-df[c("Latitude","Longitude")]
d<-as.dist(distm(coordinates[,2:1]))
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average, k)
nclusters<-matrix(table(clusters))
df$cluster <- clusters
coordinates$cluster<-clusters
#Location
location<-matrix(nrow=k,ncol=2)
location=matrix(c(-23.8, -23.9, -23.9, -23.8, -49.8, -49.8, -49.8, -49.8),nrow=k,ncol=2)
location<-cbind(location,matrix(c(1:k),ncol=1))
#Coverage
coverage=matrix(c(0,0,0,0),nrow=k,ncol=1)
coverage<-cbind(coverage,matrix(c(1:k),ncol=1))
colnames(coverage)<-c("Coverage","cluster")
#Sum of Waste from clusters
sum_waste=matrix(c(13809,469,285,456),nrow=k,ncol=1)
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(
actionButton("reset", "Reset"),
),
mainPanel(
DTOutput("tabela")
)))
server <- function(input, output, session) {
confirmed_status <- reactiveVal(FALSE)
Modelcl<-reactive(function.cl(df))
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({
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, {
confirmed_status(FALSE)
})
}
shinyApp(ui = ui, server = server)