问题
Friends could help me with my shiny code below. It is executable code for manipulation. I am managing to generate the scatter plot normally, it varies according to my SliderInput. In my case, I am generating clusters. If sliderinput is selected as 5, the scatterplot will generate 5 clusters and so on. Everything is fine here. I also did a selectInput below the sliderinput to show the map for a specific cluster. However, I was unable to generate the scatterplot for a specific cluster, that is, if it selected 2 in my selectInput, I would like it to show only the map for cluster 2. Could you help me with this?
library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)
library(DT)
library(shinythemes)
function.cl<-function(df,k,Filter1,Filter2,Filter3){
#database df
df<-structure(list(Properties = c(1,2,3,4,5),
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9),
Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6),
Waste = c(526, 350, 526, 469, 285)), class = "data.frame", row.names = c(NA, -5L))
#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
#database df1
df1<-df[c("Latitude","Longitude")]
df1$cluster<-clusters
#Table to join df and df1
data_table <- Reduce(merge, list(df, df1))
#Scatter Plot for all
suppressPackageStartupMessages(library(ggplot2))
g<-ggplot(data=df1, aes(x=Longitude, y=Latitude, color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
plotGD<-g
#Scatter Plot for specific cluster
suppressPackageStartupMessages(library(ggplot2))
g<-ggplot(data=df1[df1$cluster == Filter3,], aes(x=Longitude, y=Latitude, color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
plotGD1<-g
return(list(
"Plot" = plotGD,
"Plot1" = plotGD1,
"Data"=data_table
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
radioButtons("filter1", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
radioButtons("filter2", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
tags$hr(),
tags$b(h3("Satisfied?")),
tags$b(h5("(a) Choose other filters")),
tags$b(h5("(b) Choose clusters")),
sliderInput("Slider", h5(""),
min = 2, max = 5, value = 3),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", plotOutput("ScatterPlot"))))
))),
tabPanel("",
sidebarLayout(
sidebarPanel(
selectInput("Filter3", label = h4("Select just one cluster to show"),""),
),
mainPanel(
tabsetPanel(
tabPanel("Map", plotOutput("ScatterPlot1"))))
)))
server <- function(input, output, session) {
Modelcl<-reactive(function.cl(df,input$Slider,1,1,input$Filter3))
output$ScatterPlot <- renderPlot({
Modelcl()[[1]]
})
output$ScatterPlot1 <- renderPlot({
Modelcl()[[2]]
})
observeEvent(c(df,input$Slider,1,1),{
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter3',
choices=sort(unique(abc$cluster)))
})
}
shinyApp(ui = ui, server = server)
Thank you very much!
回答1:
A few thoughts:
Your
observeEventcan be dependent on justinput$Slider- I was not sure what was intended with other numbers and data frame therePass
inputFilter3to yourfunction.cl- again keep in mind, as that function is involving reactive inputs, you might want to have as a reactive expression inserverYou will want to filter your data for the specific cluster plot, something like:
df1[df1$cluster == Filter3,]To have the same color scheme between the two plots, you can make a color vector (using whatever palette you wish), and then reference it with
scale_color_manual
This seems to work at my end. For your next example, try to simplify to "minimum" working example if possible to demonstrate what the problem is. Good luck!
library(shiny)
library(ggplot2)
library(rdist)
library(geosphere)
library(kableExtra)
library(readxl)
library(tidyverse)
library(DT)
library(shinythemes)
function.cl<-function(df,k,Filter1,Filter2,Filter3){
#database df
df<-structure(list(Properties = c(1,2,3,4,5),
Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9),
Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6),
Waste = c(526, 350, 526, 469, 285)), class = "data.frame", row.names = c(NA, -5L))
#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
#all cluster data df1 and specific cluster df_spec_clust
df1<-df[c("Latitude","Longitude")]
df1$cluster<-as.factor(clusters)
df_spec_clust <- df1[df1$cluster == Filter3,]
#Table to join df and df1
data_table <- Reduce(merge, list(df, df1))
#Setup colors to share between both plots
my_colors <- rainbow(length(df1$cluster))
names(my_colors) <- df1$cluster
#Scatter Plot for all clusters
g <- ggplot(data = df1, aes(x=Longitude, y=Latitude, color=cluster)) +
geom_point(aes(x=Longitude, y=Latitude), size = 4) +
scale_color_manual("Legend", values = my_colors)
plotGD <- g
#Scatter Plot for specific cluster
g <- ggplot(data = df_spec_clust, aes(x=Longitude, y=Latitude, color=cluster)) +
geom_point(aes(x=Longitude, y=Latitude), size = 4) +
scale_color_manual("Legend", values = my_colors)
plotGD1 <- g
return(list(
"Plot" = plotGD,
"Plot1" = plotGD1,
"Data" = data_table
))
}
ui <- bootstrapPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
"Cl",
tabPanel("Solution",
sidebarLayout(
sidebarPanel(
radioButtons("filter1", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
radioButtons("filter2", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
tags$hr(),
tags$b(h3("Satisfied?")),
tags$b(h5("(a) Choose other filters")),
tags$b(h5("(b) Choose clusters")),
sliderInput("Slider", h5(""),
min = 2, max = 5, value = 3),
),
mainPanel(
tabsetPanel(
tabPanel("Solution", plotOutput("ScatterPlot"))))
))),
tabPanel("",
sidebarLayout(
sidebarPanel(
selectInput("Filter3", label = h4("Select just one cluster to show"),""),
),
mainPanel(
tabsetPanel(
tabPanel("Map", plotOutput("ScatterPlot1"))))
)))
server <- function(input, output, session) {
Modelcl<-reactive({
function.cl(df,input$Slider,1,1,input$Filter3)
})
output$ScatterPlot <- renderPlot({
Modelcl()[[1]]
})
output$ScatterPlot1 <- renderPlot({
Modelcl()[[2]]
})
observeEvent(input$Slider, {
abc <- req(Modelcl()$Data)
updateSelectInput(session,'Filter3',
choices=sort(unique(abc$cluster)))
})
}
shinyApp(ui = ui, server = server)
来源：https://stackoverflow.com/questions/61691358/insert-new-features-from-a-selectinput-in-shiny