I'm creating a Shiny module which manipulates some raw data, providing the output in the form of a summary table. I'm rather new to shiny programming, apologies in advance for any newbie mistakes.
For the table, the aim is to create dynamic buttons (based on a filter variable). Depending on the filter selected, different number of buttons should appear, each with a unique function.
The function of each button is then to sort the table by a hidden column. While i have been able to create the buttons, i have not been able to trigger the observeEvent function. Clicking on the buttons does not trigger any action. The code for creating the button is largely taken from the solution provided here: Dynamically name the action buttons in R shiny from the values in Data Frame
I have tried following the solution here: Shiny - Can dynamically generated buttons act as trigger for an event as well as R Shiny: Handle Action Buttons in Data Table, but both solutions does not seem to work. I'm wondering if this is a namespace issue, but have no idea on how to resolve that either.
Here's a minimal, reproducible example that from the current module. I have removed a large portion of the code which should be irrelevant for the current problem. Nevertheless, do let me know if i have left out anything.
Module UI
SegmentationUI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(column(12, uiOutput(ns("sortbuttons")))), br(),
fluidRow(DT::dataTableOutput(ns("table1")), style = "width: 50%")
)
}
Segmentation <- function(input, output, session) {
combinedtable <- reactiveVal({
combinedtable <- data.table(c("a", "b", "c", "d", "e", "f"),
c(" 0.5", "0.8", "1.0", "0.2", "0.6", "0.5"),
c(" 0.5", "0.8", "0.5", "0.4", "0.4", "0.5"),
c(" 0.3", "0.1", "0.2", "0.6", "0.4", "0.3"),
c(" 0.7", "0.8", "0.4", "0.3", "0.6", "0.3"),
c(" 0.8", "0.9", "0.8", "0.5", "0.6", "0.7"),
c(" 0.1", "0.4", "0.3", "0.2", "0.6", "0.8"),
c(" 0.8", "0.8", "1.0", "1.2", "0.6", "0.5"),
c(" 1.5", "0.8", "0.5", "0.4", "0.4", "1.5"),
c(" 1.3", "1.1", "0.2", "0.9", "1.0", "0.3"),
c(" 0.7", "0.8", "1.4", "0.3", "0.7", "1.3"),
c(" 1.8", "1.9", "0.8", "0.9", "1.6", "0.9"),
c(" 0.1", "0.4", "0.3", "1.0", "0.6", "0.8"))
setnames(combinedtable, c(" ", "1", "2", "3", "4", "5", "6", "1new", "2new", "3new", "4new", "5new", "6new"))
})
unpivotedtable <- reactiveVal({
unpivotedtable <- data.table(c("1", "2", "3", "4", "5", "6"),
c(" 0.5", "0.5", "0.3", "0.7", "0.8", "0.1"),
c(" 0.8", "0.8", "0.1", "0.8", "0.9", "0.4"),
c(" 1.0", "0.5", "0.2", "0.4", "0.8", "0.3"),
c(" 0.2", "0.4", "0.6", "0.3", "0.5", "0.2"),
c(" 0.6", "0.4", "0.4", "0.6", "0.6", "0.6"),
c(" 0.5", "0.5", "0.3", "0.3", "0.7", "0.8"))
setnames(unpivotedtable, c("solution1", "a", "b", "c", "d", "e", "f"))
})
obsList <- list()
# Sort buttons
output$sortbuttons <- renderUI({
buttons <- lapply(1:nrow(unpivotedtable()), function(i)
{
buttonname <- paste0("button_", unpivotedtable()[i,1])
# creates an observer only if it doesn't already exists
if (is.null(obsList[[buttonname]])) {
# make sure to use <<- to update global variable obsList
obsList[[buttonname]] <<- observeEvent(input[[buttonname]], {
cat("Button ", i, "\n")
combinedtable() <- combinedtable()[order(paste(i,"new")),]
})
}
actionButton(buttonname, paste(unpivotedtable()[i,1]))
})
})
# Output table
output$table1 <- DT::renderDataTable(
datatable(combinedtable(), selection = "single", escape = FALSE,
options = list(
pageLength = 10,
lengthMenu = c(10, 15, 20),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}")
)
)
)
}
Ui Portion
library(shiny)
library(shinydashboard)
library(DT)
library(data.table)
# source("SegmentSummary.R")
# Define UI for dashboard
ui <- shinyUI(dashboardPage(
dashboardHeader(title = "Segmentation Dashboard"),
# Dashboard Sidebar
dashboardSidebar(
# Sidebar Menu
sidebarMenu(id = "tabs",
# Menu for Segment Summary
menuItem("Segment Summary", tabName = "SegmentSummary", icon = NULL)
)
),
dashboardBody(
tabItems(
# Content for Segment Summary
tabItem(tabName = "SegmentSummary", SegmentationUI(id = "Summary"))
)
)
)
)
Server Portion
# Define server logic
ShinyServer <- function(input, output, session) {
# Call Module for Segment Summary
callModule(Segmentation, "Summary")
}
Run App
shinyApp(ui, ShinyServer)
The sort function itself that i have included may not be correct in itself as i have just produced it based on my current understanding of data table sorting. Currently i have tried simpler observeEvent effect such as print("hi") and renderText, but clicking the buttons doesnt seem to have any impact. I'll be most open to any suggestions if the sort function itself is mistakened.
Here's a brief data structure of the tables that are used in the relevant code.
Unpivoted Table
Solution1 A B C
1 0.50 1.93 0.62
2 0.85 1.58 0.53
3 0.45 1.69 0.82
4 1.42 0.85 0.45
5 0.52 1.40 0.98
6 0.36 0.39 1.95
Combined Table
1 2 3 4 5 6 1new 2new 3new 4new 5new 6new
A 0.50 0.85 0.45 1.42 0.52 0.36 0.50 0.06 1.20 0.64 1.96 0.31
B 1.93 1.58 1.69 0.85 1.40 0.39 0.40 1.54 1.54 1.69 1.63 0.18
C 0.62 0.53 0.82 0.45 0.98 1.95 0.30 1.56 0.74 0.16 1.67 1.71
Any help/advice would be greatly appreciated. Thanks!
