朋友,您能帮我解决以下问题吗: 下面的可执行代码是使用具有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开始的滑杆,可以
您需要更改功能
至