问题
I would like to insert a table and graph when selecting an option defined in Shiny from RStudio. When selecting the option "Select all properties" I would like to show Table1 and Graph1 on the same page. And if I press the option "Exclude properties that produce less than L and more than S" to present just Table2 and Graph2. I left an executable script below to show the table and figure I want to insert in my shiny code. I just want to display the table and figure when selecting one of the options that I mentioned above.
Executable script and shiny code
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)
Thanks !!
回答1:
Here is a simplified version use can adapt for your own use. This works with example data from your previous question.
You can add uiOutput and plotOutput to your ui to show the table and plot.
In server, you can add an eventReactive expression to determine what should be displayed when the radio button changes. The table1, plot1, table2, plot2 should be your plots and tables for the two conditions. This assumes your tables are HTML produced by kable.
Edit: I added what you need below for table1 and plot1 from your example. Just assign the kable output to table1 and you're set for displaying the table in shiny. It won't be reactive, but this is just a starting point.
As for the plot, with base R you would need to use recordPlot() or or gridGraphics. If you use ggplot2 which I think you were planning, then all you need to do is plot1 <- ggplot(data = ... and you're set for plot1. Again, in this case, it won't be reactive, and recordPlot() is not a good long-term solution (it just stores the current plot to replay or use later), but it should work as a starting point for your demo.
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)
来源：https://stackoverflow.com/questions/61298886/issues-related-to-shiny-from-rstudio