Вопросы блестящие от R Studio

Question

Пожалуйста, я хотел бы помочь с некоторыми вопросами, касающимися блеска. Ниже представлен исполняемый код:

Исполняемый скрипт и блестящий код

library(shiny)
library(kableExtra)
library(ggplot2)

#database
df<-structure(list(Latitude = c(-23.8, -23.8, -23.9), Longitude = c(-49.6, -49.6, -49.6), Waste = c(526, 350, 526)), class = "data.frame", row.names = c(NA, -3L))
coordinaties<-df[,1:2]

#cluster
d<-dist(df)
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average,k=2)
df$cluster<-clusters

###Tables
table1<- kable(df[order(df$cluster, as.numeric(df$Longitude)),c(1,2,3,4)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 1:4, valign = "middle")

table2<- kable(df[order(df$cluster, as.numeric(df$Longitude)),c(2,1,4,3)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 1:4, valign = "middle")

table3<- kable(df[order(df$cluster, as.numeric(df$Longitude)),c(3,2,4,1)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 1:4, valign = "middle")

table4<- kable(df[order(df$cluster, as.numeric(df$Longitude)),c(4,3,1,2)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 1:4, valign = "middle")

table5<- kable(df[order(df$cluster, as.numeric(df$Longitude)),c(3,4,1,2)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 1:4, valign = "middle")

###Graphs
plot1<-ggplot(data=df,  aes(x=Longitude, y=Latitude,  color=factor(clusters))) +  geom_point()

plot2<-ggplot(data=df,  aes(x=Latitude, y=Longitude,  color=factor(clusters))) +  geom_point()

plot3<-ggplot(data=coordinaties,  aes(x=Longitude, y=Latitude,  color=factor(clusters))) +  geom_point()

plot4<-ggplot(data=coordinaties,  aes(x=Latitude, y=Longitude,  color=factor(clusters))) +  geom_point()


# Define UI for application that draws a histogram
ui <- fluidPage(

    titlePanel (title = h2 ("Clusters for agricultural properties")),

    sidebarLayout (
        sidebarPanel (
            h2 ("Cluster generation"),

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



            radioButtons ("filter2", h3 ("Coverage between clusters"),
                          choices = list ("Insert all clusters" = 1,
                                          "Exclude with mean less than L and greater than S" = 2),
                          selected = 1),
        ),

        mainPanel (
            uiOutput("table"),
            plotOutput("plot")
        )))
# Define server logic required to draw a histogram
server <- function(input, output) {

    my_data <- eventReactive(input$filter1, {
        if (input$filter1 == 1) {
            my_table <- table1
            my_plot <- plot1
           } 
        return(list(table = my_table, plot = my_plot))
    })

    output$table <- renderUI(HTML(my_data()[["table"]]))

    output$plot <- renderPlot(my_data()[["plot"]])

}

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

Вопросы:

1 - параметры «Выбрать все свойства» и «вставить все кластеры» выбираются вместе при выполнении блеска, поэтому я хотел бы показать в этом случае таблицы 1 и 2, а также графики 1 и 2.

2 - Когда это это «Выбрать все свойства» и «Исключить со средним меньше, чем L и больше, чем s» Я хотел бы показать таблицу 3 и график 3.

Thanksss

Answer 1

Если у вас несколько макетов, у меня есть два предложения:

1. Использовать data.frame со всеми возможными комбинациями (из нескольких входов / переключателей) с другим столбцом, указывающим, какие таблиц / графиков для отображения.

2. Храните ваши таблицы и графики в списках вместо отдельных переменных. Если вы решите не делать этого, то вместо индекса в столбце $choice вы можете включить имя переменной (например, table1) и использовать get, чтобы получить указанную переменную c.

library(shiny)
library(ggplot2)

set.seed(42)
tables <- lapply(1:4, function(i) data.frame(x=10*i + 1:3, y=runif(3)))
plots <- lapply(tables, function(tb) ggplot(tb, aes(x, y)) + geom_line())
layouts <- expand.grid(rb1 = c("Aa", "Bb"), rb2 = c("Cc", "Dd"), rb3 = c("Ee", "Ff"),
                       stringsAsFactors = FALSE)
layouts$choice <- c(1:4, 4:1)

shinyApp(
  ui = fluidPage(
    sidebarLayout(
      sidebarPanel(
        radioButtons("rb1", "Choice 1", c("Aa", "Bb")),
        radioButtons("rb2", "Choice 2", c("Cc", "Dd"))
      ),
      mainPanel(
        fluidRow(
          actionButton("btn1", "Button Ee"),
          actionButton("btn2", "Button Ff")
        ),
        textInput("txt", "Selection"),
        tableOutput("tbl"),
        plotOutput("plt")
      )
    )
  ),
  server = function(input, output, session) {
    btn <- reactiveVal("Ee")
    observeEvent(input$btn1, btn("Ee"))
    observeEvent(input$btn2, btn("Ff"))
    selection <- reactive({
      req(input$rb1, input$rb2)
      out <- with(layouts, choice[ rb1 == input$rb1 & rb2 == input$rb2 & rb3 == btn() ])
      updateTextInput(session, "txt", value = out)
      out
    })
    output$tbl <- renderTable({
      req(selection())
      tables[[ selection() ]]
    })
    output$plt <- renderPlot({
      req(selection())
      print(plots[[ selection() ]])
    })
  }
)

И различные макеты:

layouts
#   rb1 rb2 rb3 choice
# 1  Aa  Cc  Ee      1
# 2  Bb  Cc  Ee      2
# 3  Aa  Dd  Ee      3
# 4  Bb  Dd  Ee      4
# 5  Aa  Cc  Ff      4
# 6  Bb  Cc  Ff      3
# 7  Aa  Dd  Ff      2
# 8  Bb  Dd  Ff      1