时间戳

首页 > 解决方案 > RStudio 中与 Shiny 相关的问题

r - RStudio 中与 Shiny 相关的问题

问题描述

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

谢谢 ！！

标签： rshiny

解决方案

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

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

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

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

至于情节，以 R 为底，您需要使用recordPlot()or 或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)

推荐阅读