Link executable code with shiny

shiny
1

Friends, could you help me with the following question: I would like to adjust my executable code with shiny. The shiny code is created, but I want to know how to link the executable code with the shiny. IF you have suggestions for improving shiny feel free.

I want to show for example, when pressing option 1_1 and option 2_1 show table 1 and graph 1. When pressing option 1_1 and option 2_2 show table 2 and graph 2. In this case both for B1 (Button 1). For button B2, I intend to change the graph. However, if you help me with these examples that I mentioned, I believe I managed to do the rest.

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

#database
df<-structure(list(Latitude = c(-23.8, -23.8, -23.9, -24.5, -23.4, -25.4), Longitude = c(-49.6, -49.6, -49.6, 49.3, 49.3, 49.2), Waste = c(526, 350, 526, 600, 240,750)), class = "data.frame", row.names = c(NA, -6L))

#cluster
d<-dist(df)
fit.average<-hclust(d,method="average")
clusters<-cutree(fit.average,k=3)
df$cluster<-clusters

#table1
kable(df[order(df$cluster, as.numeric(df$Waste)),c(4,2,3,1)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 3:4, valign = "middle")

#plot 1
g<-ggplot(data=df,  aes(x=Longitude, y=Latitude,  color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
Centro_View<- g +  geom_text(data=df, mapping=aes(x=eval(Longitude), y=eval(Latitude), label=Waste), size=3, hjust=-0.1) 
print(Centro_View + ggtitle("Scatter Plot") + theme(plot.title = element_text(hjust = 0.5)))

#table2
kable(df[order(df$cluster, as.numeric(df$Waste)),c(2,4,1,3)], align = "c", row.names = FALSE) %>%
    kable_styling(full_width = FALSE) %>%
    column_spec(1, bold = TRUE) %>%
    collapse_rows(columns = 3:4, valign = "middle")

#plot 2
g<-ggplot(data=df,  aes(x=Latitude, y=Longitude,  color=factor(clusters))) + geom_point(aes(x=Longitude, y=Latitude), size = 4)
Centro_View<- g +  geom_text(data=df, mapping=aes(x=eval(Longitude), y=eval(Latitude), label=Waste), size=3, hjust=-0.1) 
print(Centro_View + ggtitle("Scatter Plot") + theme(plot.title = element_text(hjust = 0.5)))


library(shiny)
library(ggplot2)
layouts <- expand.grid(rb1 = c("Option1_1", "Option1_2"), rb2 = c("Option2_1", "Option2_2"), rb3 = c("B1", "B2"),
                       stringsAsFactors = FALSE)
layouts$choice <- c(1:4, 4:1)

shinyApp(
    ui = fluidPage(
        sidebarLayout(
            sidebarPanel(
                radioButtons("rb1", "Choice 1", c("Option1_1", "Option1_2")),
                radioButtons("rb2", "Choice 2", c("Option2_1", "Option2_2"))
            ),
            mainPanel(
                fluidRow(
                    actionButton("btn1", "Button B1"),
                    actionButton("btn2", "Button B2")
                ),
                tableOutput("tbl"),
                plotOutput("plt")
            )
        )
    ),
    server = function(input, output, session) {
        btn <- reactiveVal("B1")
        observeEvent(input$btn1, btn("B1"))
        observeEvent(input$btn2, btn("B2"))
        selection <- reactive({
            req(input$rb1, input$rb2)
            out <- with(layouts, choice[ rb1 == input$rb1 & rb2 == input$rb2 & rb3 == btn() ])
            updateTextInput(session, "txt", value = out)
            out
        })
        output$tbl <- renderTable({
            req(selection())
            tables[[ selection() ]]
        })
        output$plt <- renderPlot({
            req(selection())
            print(plots[[ selection() ]])
        })
    }
)

Thank you very much!

2

Please read this article.
https://shiny.rstudio.com/articles/dynamic-ui.html

3

Thanks for the reply friend. I've looked at several sites, but I don't know how to adjust in my case. If you could help me with this, I would appreciate it.

4 
library(shiny)
library(tidyverse)
library(kableExtra)

# database
df <- structure(list(Latitude = c(-23.8, -23.8, -23.9, -24.5, -23.4, -25.4), Longitude = c(-49.6, -49.6, -49.6, 49.3, 49.3, 49.2), Waste = c(526, 350, 526, 600, 240, 750)), class = "data.frame", row.names = c(NA, -6L))

# cluster
d <- dist(df)
fit.average <- hclust(d, method = "average")
clusters <- cutree(fit.average, k = 3)
df$cluster <- clusters

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

# plot 1
plot1 <- ggplot(data = df, aes(x = Longitude, y = Latitude, color = factor(clusters))) +
  geom_point(aes(x = Longitude, y = Latitude), size = 4) +
  geom_text(
    data = df, mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
    size = 3, hjust = -0.1
  ) +
  ggtitle("Scatter Plot") +
  theme(plot.title = element_text(hjust = 0.5))

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

# plot 2
plot2 <- ggplot(data = df, aes(x = Latitude, y = Longitude, color = factor(clusters))) +
  geom_point(aes(x = Longitude, y = Latitude), size = 4) +
  geom_text(
    data = df, mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
    size = 3, hjust = -0.1
  ) +
  ggtitle("Scatter Plot") +
  theme(plot.title = element_text(hjust = 0.5))


tables <- list(table1, table2)
plots <- list(plot1, plot2)

layouts <- expand.grid(
  rb1 = c("Option1_1", "Option1_2"), rb2 = c("Option2_1", "Option2_2"), rb3 = c("B1", "B2"),
  stringsAsFactors = FALSE
)
# when pressing option 1_1 and option 2_1 show table 1 and graph 1.
# When pressing option 1_1 and option 2_2 show table 2 and graph 2.
layouts$choice <- case_when(
  layouts$rb1 == "Option1_1" & layouts$rb2 == "Option2_1" ~ 1,
  layouts$rb1 == "Option1_1" & layouts$rb2 == "Option2_2" ~ 2,
  TRUE ~ 3
)

shinyApp(
  ui = fluidPage(
    sidebarLayout(
      sidebarPanel(
        radioButtons("rb1", "Choice 1", c("Option1_1", "Option1_2")),
        radioButtons("rb2", "Choice 2", c("Option2_1", "Option2_2")),
      ),
      mainPanel(
        fluidRow(
          actionButton("btn1", "Button B1"),
          actionButton("btn2", "Button B2")
        ),
        textOutput("txt"),
        tableOutput("tbl"),
        plotOutput("plt")
      )
    )
  ),
  server = function(input, output, session) {
    btn <- reactiveVal("B1")
    observeEvent(input$btn1, btn("B1"))
    observeEvent(input$btn2, btn("B2"))
    selection <- reactive({
      req(input$rb1, input$rb2)
      out <- with(layouts, choice[rb1 == input$rb1 & rb2 == input$rb2 & rb3 == btn()])
    })



    output$tbl <- function() {
      req(selection())
      validate(
        need(
          selection() < 3,
          "layout not defined"
        )
      )
      tables[[selection()]]
    }
    output$plt <- renderPlot({
      req(selection())
      validate(
        need(
          selection() < 3,
          "layout not defined"
        )
      )
      plots[[selection()]]
    })
    output$txt <- renderText({
      selection()
    })
  }
)
5

Thanks friend for the answer. It worked, I would like to clarify some doubts?

1° - To show plot 1 table1 and plot1, as well as table 2 and plot2 you did:

    layouts$rb1 == "Option1_1" & layouts$rb2 == "Option2_1" ~ 1,
    layouts$rb1 == "Option1_1" & layouts$rb2 == "Option2_2" ~ 2,

Does this "~ 1" refer to table 1 and plot1? I didn't understand how you defined to call table1 and plot1 together.

2° - That part of the code what does it mean?

 selection() < 3,
                    "layout not defined"

3° - I made table3, table 4 and plot 3 and 4, could you check if I did it right in the code, please?

library(shiny)
library(tidyverse)
library(kableExtra)

# database
df <- structure(list(Latitude = c(-23.8, -23.8, -23.9, -24.5, -23.4, -25.4), Longitude = c(-49.6, -49.6, -49.6, 49.3, 49.3, 49.2), Waste = c(526, 350, 526, 600, 240, 750)), class = "data.frame", row.names = c(NA, -6L))

# cluster
d <- dist(df)
fit.average <- hclust(d, method = "average")
clusters <- cutree(fit.average, k = 3)
df$cluster <- clusters

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

# plot 1
plot1 <- ggplot(data = df, aes(x = Longitude, y = Latitude, color = factor(clusters))) +
    geom_point(aes(x = Longitude, y = Latitude), size = 4) +
    geom_text(
        data = df, mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
        size = 3, hjust = -0.1
    ) +
    ggtitle("Scatter Plot") +
    theme(plot.title = element_text(hjust = 0.5))

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

# plot 2
plot2 <- ggplot(data = df, aes(x = Latitude, y = Longitude, color = factor(clusters))) +
    geom_point(aes(x = Longitude, y = Latitude), size = 4) +
    geom_text(
        data = df, mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
        size = 3, hjust = -0.1
    ) +
    ggtitle("Scatter Plot") +
    theme(plot.title = element_text(hjust = 0.5))

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

# plot 3
plot3 <- ggplot(data = df, aes(x = Longitude, y = Latitude, color = factor(clusters))) +
    geom_point(aes(x = Longitude, y = Latitude), size = 4) +
    geom_text(
        data = df, mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
        size = 3, hjust = -0.1
    ) +
    ggtitle("Scatter Plot") +
    theme(plot.title = element_text(hjust = 0.5))

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

# plot 4
plot4 <- ggplot(data = df, aes(x = Longitude, y = Latitude, color = factor(clusters))) +
    geom_point(aes(x = Longitude, y = Latitude), size = 4) +
    geom_text(
        data = df, mapping = aes(x = eval(Longitude), y = eval(Latitude), label = Waste),
        size = 3, hjust = -0.1
    ) +
    ggtitle("Scatter Plot") +
    theme(plot.title = element_text(hjust = 0.5))

tables <- list(table1, table2,table3,table4)
plots <- list(plot1, plot2,plot3,plot4)

layouts <- expand.grid(
    rb1 = c("Option1_1", "Option1_2"), rb2 = c("Option2_1", "Option2_2"), rb3 = c("B1", "B2"),
    stringsAsFactors = FALSE
)
# when pressing option 1_1 and option 2_1 show table 1 and graph 1.
# When pressing option 1_1 and option 2_2 show table 2 and graph 2.
layouts$choice <- case_when(
    layouts$rb1 == "Option1_1" & layouts$rb2 == "Option2_1" ~ 1,
    layouts$rb1 == "Option1_1" & layouts$rb2 == "Option2_2" ~ 2,
    layouts$rb1 == "Option1_2" & layouts$rb2 == "Option2_1" ~ 3,
    layouts$rb1 == "Option1_2" & layouts$rb2 == "Option2_2" ~ 4,
    TRUE ~ 3
)

shinyApp(
    ui = fluidPage(
        sidebarLayout(
            sidebarPanel(
                radioButtons("rb1", "Choice 1", c("Option1_1", "Option1_2")),
                radioButtons("rb2", "Choice 2", c("Option2_1", "Option2_2")),
            ),
            mainPanel(
                fluidRow(
                    actionButton("btn1", "Button B1"),
                    actionButton("btn2", "Button B2")
                ),
                textOutput("txt"),
                tableOutput("tbl"),
                plotOutput("plt")
            )
        )
    ),
    server = function(input, output, session) {
        btn <- reactiveVal("B1")
        observeEvent(input$btn1, btn("B1"))
        observeEvent(input$btn2, btn("B2"))
        selection <- reactive({
            req(input$rb1, input$rb2)
            out <- with(layouts, choice[rb1 == input$rb1 & rb2 == input$rb2 & rb3 == btn()])
        })
        
        
        
        output$tbl <- function() {
            req(selection())
            validate(
                need(
                    selection() < 3,
                    "layout not defined"
                )
            )
            tables[[selection()]]
        }
        output$plt <- renderPlot({
            req(selection())
            validate(
                need(
                    selection() < 3,
                    "layout not defined"
                )
            )
            plots[[selection()]]
        })
        output$txt <- renderText({
            selection()
        })
    }
)
6

It didn't work the way I did for tables 3 and 4 and plot 3 and 4 = /

Nirgrahamuk, could you help me again?

7

I wouldn't necessarily arrange things this way, but i was following your code appraoch as close as possible making minimal changes that I could.
seemed you were intending to use selection() to index into a list of table and of plot. yes, so implicitly, 1 means the first in the list, which is table1 in tables and plot1 in plots

it means you only told me what some options together would produce, and not others, so the other layouts were not defined.

this is probably redundant as always rb1 and rb2 should choose from 1 to 4 and there wont be a 5th case (That needs setting to layout 3)

if selection() including 3 and 4 are now valid you should set a higher threshold, or if everything is guaranteed defined do away with the validate/need checks altogether.

8

Thanks friend for the answers

9

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.