Вставить новые функции из избранного

Question

Друзья могут помочь мне с моим блестящим кодом ниже. Это исполняемый код для манипуляции. Мне удается нормально сгенерировать диаграмму рассеяния, она зависит от моего SliderInput. В моем случае я генерирую кластеры. Если для параметра sliderinput установлено значение 5, диаграмма рассеяния будет генерировать 5 кластеров и так далее. Здесь все хорошо. Я также сделал selectInput ниже sliderinput, чтобы показать карту для определенного кластера c. Однако мне не удалось сгенерировать диаграмму рассеяния для определенного кластера c, то есть, если он выбрал 2 в моем selectInput, я бы хотел, чтобы он отображал только карту для кластера 2. Не могли бы вы мне помочь с этим?

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)

Большое спасибо!

Answer 1

Несколько мыслей:

• Ваш observeEvent может зависеть только от input$Slider - я не был уверен, что было предназначено с другими числами и фреймом данных там

• Передайте inputFilter3 вашему function.cl - опять же имейте в виду, поскольку эта функция включает реактивные входы, вы можете захотеть иметь в качестве реактивного выражения в server

• Вы захотите отфильтровать свои данные для указанного c кластерного графика, например: df1[df1$cluster == Filter3,]

• Чтобы иметь одинаковую цветовую схему между двумя графиками , вы можете создать цветной вектор (используя любую палитру sh), а затем ссылаться на него с помощью scale_color_manual

Похоже, это работает с моей стороны. Для вашего следующего примера попробуйте упростить до "минимального" рабочего примера, если возможно, чтобы продемонстрировать, в чем проблема. Удачи!

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)