1

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 Answers1

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)
Ben
  • 28,684
  • 5
  • 23
  • 45
  • Thanks for the answer Ben. I'm new to shiny, how do I define the tables and graphs that I want to show from the shiny code, that is, how in shiny does it get the desired tables and graphs? Do I need to leave the codes corresponding to the table and graph that I presented in the question somewhere in the shiny code? Thankss –  Apr 19 '20 at 12:22
  • There's a lot to this, I would go through the [tutorial](https://shiny.rstudio.com/tutorial/) if you haven't already, and review info on [scoping rules](https://shiny.rstudio.com/articles/scoping.html). For now, to make it simpler and make sure it works, you can start out just putting all your table/plot code in your .R file outside of `server` somewhere. A lot would depend where you want objects to be available, how data is stored, what reactivity you want for certain elements, etc. – Ben Apr 19 '20 at 12:43
  • Thanks for the answers Ben. I will check out the sites you sent me. In fact I would like to just display the tables and figures that I got from my R script in shiny code. –  Apr 19 '20 at 14:01
  • Thanks Ben for all the help. I improved my question regarding the problem I want to solve. I adjusted the shiny code according to your guidelines. I inserted the executable code of the Script I want. –  Apr 19 '20 at 16:18
  • Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/212023/discussion-between-ben-and-jovani-souza). – Ben Apr 19 '20 at 18:40
  • Ben, would you know how to help me with the questions that I entered above? Thanksss –  Apr 21 '20 at 04:30
  • @JovaniSouza The short answer is that this is possible. But if you're looking for additional code, I would recommend making this a new question on SO and removing from this question. You will have higher likelihood of getting an answer quicker. I might not get a chance to look at more closely until later in week. – Ben Apr 21 '20 at 04:37
  • Ben, Please, could you take a look at two questions asked by my brother Jose: https://stackoverflow.com/questions/61595335/find-the-shortest-path-between-points-on-a-map-made-by-the-leaflet-package https://stackoverflow.com/questions/61591674/general-function-to-insert-the-colors-of-the-clusters-in-my-map-made-by-the-leaf We are working together. Thank you very much friend. –  May 04 '20 at 15:20