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()
})
}
)