Вопросы, связанные с Shiny от RStudio

Question

Я хотел бы вставить таблицу и график при выборе опции, определенной в Shiny, из RStudio. При выборе опции «Выбрать все свойства» я хотел бы показать Таблицу 1 и График 1 на одной странице. И если я нажимаю опцию «Исключить свойства, которые производят меньше, чем 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 должны быть вашими графиками и таблицами для двух условий. Это предполагает, что ваши таблицы HTML созданы kable.

Редактировать : я добавил то, что вам нужно ниже для 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)