RStudio 中与 Shiny 相关的问题

Question

在从 RStudio 中选择 Shiny 中定义的选项时，我想插入表格和图形。选择“选择所有属性”选项时，我想在同一页面上显示 Table1 和 Graph1。如果我按下选项“排除产生小于 L 且大于 S 的属性”以仅显示 Table2 和 Graph2。我在下面留下了一个可执行脚本来显示我想在闪亮代码中插入的表格和图形。我只想在选择上面提到的选项之一时显示表格和图形。

可执行脚本和闪亮代码

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

#database
df<-structure(list(Latitude = c(-23.8, -23.8, -23.9, -23.9, -23.9,  -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, -23.9, 
                                + -23.9, -23.9, -23.9, -23.9, -23.9), Longitude = c(-49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.6, -49.7, 
                                                                                    + -49.7, -49.7, -49.7, -49.7, -49.6, -49.6, -49.6, -49.6), Waste = c(526, 350, 526, 469, 285, 175, 175, 350, 350, 175, 350, 175, 175, 364, 
                                                                                                                                                         + 175, 175, 350, 45.5, 54.6)), class = "data.frame", row.names = c(NA, -19L))

Q1<-matrix(quantile(df$Waste, probs = 0.25))
df_Q1<-subset(df,Waste>Q1[1])
df_Q1

#cluster
d<-dist(df_Q1)
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average,k=4)
df_Q1$cluster<-clusters
df_Q1$properties<-names(clusters)

#calculate sum waste
dc<-aggregate(df_Q1[,"Waste"],list(cluster=clusters),sum)
colnames(dc)<-c("cluster","Sum_Waste")
head(dc)

#calculate mean waste
dd<-aggregate(df_Q1[,"Waste"],list(cluster=clusters),mean)
colnames(dd)<-c("cluster","Mean_Waste")
head(dd)

#merge everything
df_table <- Reduce(merge, list(df_Q1, dc, dd))


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

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

#make table 3
table3<- kable(df_table[order(df_table$cluster, as.numeric(df_table$properties)),c(4,3,2,5,1,7,6)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 5:7, valign = "middle")

#make table 4
table4<- kable(df_table[order(df_table$cluster, as.numeric(df_table$properties)),c(7,6,3,4,1,2,5)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 5:7, valign = "middle")

#make table 5
table5<- kable(df_table[order(df_table$cluster, as.numeric(df_table$properties)),c(4,1,2,5,7,6)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 4:6, valign = "middle")

#make graph1
vars = c("Longitude", "Latitude")
plot1<-fviz_cluster(list(data = df_Q1, cluster = clusters), choose.var=vars)

#make graph2
plot2<-ggplot(data=df_Q1,  aes(x=Longitude, y=Latitude,  color=factor(clusters))) +  geom_point()

#make graph3
vars = c("Latitude", "Longitude")
plot3<-fviz_cluster(list(data = df_Q1, cluster = clusters), choose.var=vars)

#make graph4
plot(clusters)
plot4 <- recordPlot()


# 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
           } else {
           my_table <- table2
           my_plot <- plot2
        }
        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)

谢谢！！

Answer 1

这里有一个简化版使用，可以适应你自己的使用。这适用于您之前问题中的示例数据。

您可以将uiOutput 和plotOutput 添加到您的ui 以显示表格和绘图。

在server 中，您可以添加eventReactive 表达式以确定单选按钮更改时应显示的内容。 table1、plot1、table2、plot2 应该是这两个条件的图和表​​。这假设您的表格是由kable 生成的 HTML。

编辑：我在下面为您的示例中的table1 和plot1 添加了您需要的内容。只需将kable 输出分配给table1，您就可以以闪亮的方式显示表格了。它不会是被动的，但这只是一个起点。

至于情节，以 R 为基数，您需要使用 recordPlot() 或 gridGraphics。如果您使用我认为您正在计划的ggplot2，那么您需要做的就是plot1 <- ggplot(data = ...，然后您就可以使用plot1。同样，在这种情况下，它不会是被动的，recordPlot() 不是一个好的长期解决方案（它只是存储当前情节以供以后重播或使用），但它应该作为您演示的起点.

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

#copy other code here needed for df_table, clusters, etc.

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

#make plot1
plot(clusters)
plot1 <- recordPlot()

ui <- fluidPage (

  titlePanel (title = h1 ("Model for the formation of agricultural property clusters", align = "center")),

  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),
    ),

    mainPanel (
      textOutput ("nclusters"),
      textOutput ("abran"),
      textOutput ("bio"),

      uiOutput("table"),
      plotOutput("plot")
    )))


# Define server logic required to draw a histogram
server <- function (input, output, session) {

  my_data <- eventReactive(input$filter1, {
    if (input$filter1 == 1) {
      my_table <- table1
      my_plot <- plot1
    } else {
      my_table <- table2
      my_plot <- plot2
    }
    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)