Make condition for weight equal to a specific value in a shiny app

Question

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)

I'm not sure i understand the question. why not just limit your input `weight1` to have max of 0.99 or 0.9?. or just add a statement within the function that changes weights[1] to 0.99 or 0.9 if it equals 1? — langtang, Mar 19 '22 at 23:20
Thanks for answering. It's just that I'm using other multicriteria methods at the same time. And other methods let you put weight 1 equal to 1, only `TOPSIS` doesn't. That's why I didn't change `max ` in `numericInput`. Now with the most complete information, do you have any solution to solve it? — Antonio, Mar 19 '22 at 23:28
my second suggestion seems to fit. when you are using`weights` in TOPSIS, can you not simply do `weights[1]=ifelse(weights[1]==1,.99,weights[1])` — langtang, Mar 19 '22 at 23:33
Good approach, but it didn't work when I tested it. If you can test in the code above, I'd appreciate it! — Antonio, Mar 19 '22 at 23:56

langtang · Accepted Answer · 2022-03-20T00:23:38.850

1

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)

edited Mar 20 '22 at 00:23

answered Mar 20 '22 at 00:14

langtang

22,248
1
12
27

Perfect, that's it! Thanks for the help @langtang. Please, can you see a question that I've been trying to solve for a long time, but I still can't? Maybe you can help me, if you need additional information, you can contact me. It's this question: https://stackoverflow.com/questions/71506509/how-to-link-selected-cluster-in-shiny-app – Antonio Mar 20 '22 at 00:25
I tried to provide an answer for that one too. Please let me know if I need to adjust it in anyway. – langtang Mar 20 '22 at 01:02
langtang, taking advantage of this question that I used TOPSIS and you solved it, I asked this question here that also uses TOPSIS: https:https://stackoverflow.com/questions/71528241/adjust-selecinput-so-that-it-works-for-two -different-methods-at-the-same-time. Could this resolution approach you've taken be used on this other issue? – Antonio Mar 20 '22 at 03:25

Make condition for weight equal to a specific value in a shiny app

1 Answers1