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。

谢谢

Answer 1

如果您有多种布局，我有两个建议：

将data.frame与所有可能的组合（您的多个输入/单选按钮的组合）一起使用，并在另一列中指示要显示的表/图表。
将表和图存储在列表中，而不是单个变量中。如果选择不执行此操作，则可以在变量名（例如，$choice中添加变量名（例如，table1），然后使用get来检索特定的变量。

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

来自R Studio的闪亮问题

1 个答案: