0
votes

Friends, could you help me solve the following problem: The executable code below is generating with a scatterplot with 3 clusters (k=3). However, I did conditionPanel so that if he is not satisfied, he can change the cluster number through the sliderInput. However my sliderInput is not working. Could you help me solve this problem? So, I would like that when he clicks on the option "Change the number of clusters" he can change according to the sliderInput.

library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)

function.clustering <- function(df, k, Filter1) {
  df<-structure(list(Properties = c(1,2,3,4,5,6), Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6), Waste = c(526, 350, 526, 469, 285, 175)), class = "data.frame", row.names = c(NA, -6L))

  k=3

  if (Filter1 == 1) {
    Q1 <- matrix(quantile(df$Waste, probs = 0.65))
    Q3 <- matrix(quantile(df$Waste, probs = 0.95))
    L <- Q1 - 1.5 * (Q3 - Q1)
    S <- Q3 + 1.5 * (Q3 - Q1)
    df_1 <- subset(df, Waste > L[1])
    df <- subset(df_1, Waste < S[1])
  }

  #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

  #Localization
  center_mass <- matrix(nrow = k, ncol = 2)
  for (i in 1:k) {
    center_mass[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
  center_mass <- cbind(center_mass, 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), center_mass[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_meters", "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_Waste_m3", "cluster")

  #Output table
  data_table <- Reduce(merge, list(df, coverage, sum_waste))
  data_table <-
    data_table[order(data_table$cluster, as.numeric(data_table$Properties)), ]
  data_table_1 <-
    aggregate(. ~ cluster + Coverage_meters + Potential_Waste_m3,
              data_table[, c(1, 7, 6, 2)],
              toString)
  #Scatter Plot
  suppressPackageStartupMessages(library(ggplot2))
  df1 <- as.data.frame(center_mass)
  colnames(df1) <- c("Latitude", "Longitude", "cluster")
  g <-
    ggplot(data = df,  aes(
      x = Longitude,
      y = Latitude,
      color = factor(clusters)
    )) + geom_point(aes(x = Longitude, y = Latitude), size = 4)
  Centro_View <-
    g +  geom_text(
      data = df,
      mapping = aes(
        x = eval(Longitude),
        y = eval(Latitude),
        label = Waste
      ),
      size = 3,
      hjust = -0.1
    ) + geom_point(
      data = df1,
      mapping = aes(Longitude, Latitude),
      color = "green",
      size = 4
    ) + geom_text(
      data = df1,
      mapping = aes(x = Longitude, y = Latitude, label = 1:k),
      color = "black",
      size = 4
    )

  plotGD <-
    Centro_View + 
    ggtitle("Scatter Plot") + 
    theme(plot.title = element_text(hjust = 0.5))

  return(list(
   "Plot" = plotGD

  ))
}



ui <- fluidPage(

  titlePanel("Clustering "),

  sidebarLayout(
    sidebarPanel(
      helpText(h3("Generation of clustering")),

      radioButtons("filter1", h3("Waste Potential"),
                   choices = list("Select all properties" = 1, 
                                  "Exclude properties that produce less than L and more than S" = 2),
                   selected = 1),

      tags$hr(),

      helpText(h3("Satisfied?")),
      radioButtons("satisfied","", choices = list("Yes" = 1,"NO " = 2),selected = 1),
      conditionalPanel(
        "input.satisfied == '2'",
        selectInput("nosatisf", h4("Select one of the options below:"), 
                    choices = c("Change the filter options" = 1, "Change the number of clusters" = 2), selected = "")),

      conditionalPanel(
        "input.nosatisf == '2'",  
      sliderInput("Slider", h3("Number of clusters"),
                 min = 1, max = 3, value = 2))
    ),

    mainPanel(
      plotOutput("ScatterPlot")
      )))

server <- function(input, output) {

  Modelclustering<-reactive({function.clustering(df,input$Slider,input$filter1)})



  output$ScatterPlot <- renderPlot({
    Modelclustering()[[1]]
  })


}

# Run the application 
shinyApp(ui = ui, server = server)

2

2 Answers

0
votes

You need to change your function

function.clustering <- function(df, k, Filter1) {
  df<-structure(list(Properties = c(1,2,3,4,5,6), Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6), Waste = c(526, 350, 526, 469, 285, 175)), class = "data.frame", row.names = c(NA, -6L))

  k=3

To

function.clustering <- function(df, k = 3, Filter1) {
  df<-structure(list(Properties = c(1,2,3,4,5,6), Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6), Waste = c(526, 350, 526, 469, 285, 175)), class = "data.frame", row.names = c(NA, -6L))
0
votes

If you really need the slider to start at 2 you can do

library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)

function.clustering <- function(df,k, Filter1) {
  df<-structure(list(Properties = c(1,2,3,4,5,6), Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6), Waste = c(526, 350, 526, 469, 285, 175)), class = "data.frame", row.names = c(NA, -6L))


  if (Filter1 == 1) {
    Q1 <- matrix(quantile(df$Waste, probs = 0.65))
    Q3 <- matrix(quantile(df$Waste, probs = 0.95))
    L <- Q1 - 1.5 * (Q3 - Q1)
    S <- Q3 + 1.5 * (Q3 - Q1)
    df_1 <- subset(df, Waste > L[1])
    df <- subset(df_1, Waste < S[1])
  }

  #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

  #Localization
  center_mass <- matrix(nrow = k, ncol = 2)
  for (i in 1:k) {
    center_mass[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
  center_mass <- cbind(center_mass, 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), center_mass[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_meters", "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_Waste_m3", "cluster")

  #Output table
  data_table <- Reduce(merge, list(df, coverage, sum_waste))
  data_table <-
    data_table[order(data_table$cluster, as.numeric(data_table$Properties)), ]
  data_table_1 <-
    aggregate(. ~ cluster + Coverage_meters + Potential_Waste_m3,
              data_table[, c(1, 7, 6, 2)],
              toString)
  #Scatter Plot
  suppressPackageStartupMessages(library(ggplot2))
  df1 <- as.data.frame(center_mass)
  colnames(df1) <- c("Latitude", "Longitude", "cluster")
  g <-
    ggplot(data = df,  aes(
      x = Longitude,
      y = Latitude,
      color = factor(clusters)
    )) + geom_point(aes(x = Longitude, y = Latitude), size = 4)
  Centro_View <-
    g +  geom_text(
      data = df,
      mapping = aes(
        x = eval(Longitude),
        y = eval(Latitude),
        label = Waste
      ),
      size = 3,
      hjust = -0.1
    ) + geom_point(
      data = df1,
      mapping = aes(Longitude, Latitude),
      color = "green",
      size = 4
    ) + geom_text(
      data = df1,
      mapping = aes(x = Longitude, y = Latitude, label = 1:k),
      color = "black",
      size = 4
    )

  plotGD <-
    Centro_View + 
    ggtitle("Scatter Plot") + 
    theme(plot.title = element_text(hjust = 0.5))

  return(list(
    "Plot" = plotGD

  ))
}



ui <- fluidPage(

  titlePanel("Clustering "),

  sidebarLayout(
    sidebarPanel(
      helpText(h3("Generation of clustering")),

      radioButtons("filter1", h3("Waste Potential"),
                   choices = list("Select all properties" = 1, 
                                  "Exclude properties that produce less than L and more than S" = 2),
                   selected = 1),

      tags$hr(),

      helpText(h3("Satisfied?")),
      radioButtons("satisfied","", choices = list("Yes" = 1,"NO " = 2),selected = 1),
      conditionalPanel(
        "input.satisfied == '2'",
        selectInput("nosatisf", h4("Select one of the options below:"), 
                    choices = c("Change the filter options" = 1, "Change the number of clusters" = 2), selected = "")),

      conditionalPanel(
        "input.nosatisf == '2'",  
        sliderInput("Slider", h3("Number of clusters"),
                    min = 1, max = 3, value = 3))
    ),

    mainPanel(
      plotOutput("ScatterPlot")
    )))

server <- function(input, output) {

  Modelclustering <-reactive({
    if (input$nosatisf == 2) {
      function.clustering(df,input$Slider,input$filter1)
    } else {
      function.clustering(df,2,input$filter1)
    }
    })



  output$ScatterPlot <- renderPlot({
    Modelclustering()[[1]]
  })