The code below works fine. Basically, a clustered map is generated. To know the cluster number, I use the TOPSIS multicriteria method. For the TOPSIS method, it is necessary to choose criteria weights, which usually range from 0 to 1. Since I have two criteria, I created two numericInput to generate the weights. If you test the APP you will see that it works, the only case that doesn't work is if you put weights1 equal to 1. Therefore, I would like to put some condition or something, that when this happens, consider, weight 1 = 0.9 and not equal to 1.

library(shiny)
library(rdist)
library(geosphere)
library(shinythemes)
library(leaflet)
library(topsis)

function.cl<-function(df,k,weights){
  
  #database df
  df<-structure(list(Properties = c(1,2,3,4,5,6,7), 
                     Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,-23.4,-23.5), 
                     Longitude = c(-49.6, -49.3, -49.4, -49.8, -49.6,-49.4,-49.2), 
                     Coverage = c (1526, 2350, 3526, 2469, 1285, 2433, 2456),
                     Production = c(526, 350, 526, 469, 285, 433, 456)), class = "data.frame", row.names = c(NA, -7L))

  #Topsis
  df1 <- df[c(4:5)]
  df1<-data.matrix(df1)
  i <- c("-", " ") 
  #weights <- c(0.3,0.7) 
  scaled2<-topsis(df1, weights, i)
  scaled2$rank <- rank(-scaled2$score,ties.method= "first")
  colnames(scaled2)<-c("Alternatives","score","Ranking")
  
  k<-subset(scaled2, Ranking==2)$Alternatives #cluster number
  
  #clusters
  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 
  df1<-df[c("Latitude","Longitude")]
  
  
  #Color and Icon for map
  ai_colors <-c("red","gray","blue","orange","green","beige")
  
  clust_colors <- ai_colors[df$cluster]
  icons <- awesomeIcons(
    icon = 'ios-close',
    iconColor = 'black',
    library = 'ion',
    markerColor =  clust_colors)
  
  # Map for all clusters:
  m1<-leaflet(df1) %>% addTiles() %>%
    addMarkers(~Longitude, ~Latitude) %>%
    addAwesomeMarkers(lat=~df$Latitude, lng = ~df$Longitude, icon=icons, label=~as.character(df$cluster)) %>% 
    addLegend( position = "topright", title="Cluster", colors = ai_colors[1:max(df$cluster)],labels = unique(df$cluster))
  
  plot1<-m1
  
  return(list(
    "Plot1" = plot1
  ))
}

ui <- bootstrapPage(
  navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
             "Cl", 
             tabPanel("Solution",
                      sidebarLayout(
                        sidebarPanel(
                          
                          numericInput("weights1", label = h5("Choose the weight 1"),min = 0, max = 1, value = NA, step = 0.1),
                          numericInput("weights2", label = h5("Choose the weight 2"),min = 0, max = 1, value = NA, step = 0.1)
                        ),
                        mainPanel(
                          tabsetPanel(      
                            tabPanel("Solution", (leafletOutput("Leaf1",width = "95%", height = "600")))))
                        
                      ))))

server <- function(input, output, session) {
  
  Modelcl<-reactive({
    function.cl(df,k,weights=c(input$weights1, input$weights2))
  })
  
  output$Leaf1 <- renderLeaflet({
    req(weights=c(input$weights1, input$weights2))
    Modelcl()[[1]]
  })
  
  observeEvent(input$weights1, {
    freezeReactiveValue(input, "weights2")
    updateNumericInput(session, 'weights2',
                       value = 1 - input$weights1)
  })
  
  
}

shinyApp(ui = ui, server = server)

CodePudding user response：

The topsis function requires positive weights; if weight1 is 1, then weight2 is non-positive (it's zero). So, before you pass the weights vector to topsis make sure that both of these is non-zero. You can handle this in lots of ways, here is one example, where I add the following lines before the call to topis():

if(0 %in% weights) {
  weights[which(weights==0)] <- 0.01
  weights[which(weights==1)] <- 0.99
}
scaled2<-topsis(df1, weights, i)