调整Shiny中的sliderInput功能

朋友,您能帮我解决以下问题吗: 下面的可执行代码是使用具有3个簇(k = 3)的散点图生成的。但是,我做了conditionPanel,以便如果他不满意,他可以通过sliderInput更改集群号。但是我的sliderInput无法正常工作。您能帮我解决这个问题吗? 因此,我希望当他单击选项“更改群集数”时,可以根据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开始的滑杆,可以

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]]
  })
点赞
评论
fnam
fnam

您需要更改功能

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

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))
点赞
评论