我正在创建一个处理一些原始数据的Shiny模块，以汇总表的形式提供输出。对于闪亮的程序设计我还是比较陌生，对于任何新手的错误，我都表示歉意。
对于该表，目的是创建动态按钮（基于过滤器变量）。根据选择的过滤器，应显示不同数量的按钮，每个按钮具有唯一的功能。
每个按钮的功能是然后按隐藏列对表格进行排序。 虽然我已经能够创建按钮，但是我却无法触发observeEvent函数。单击按钮不会触发任何操作。创建按钮的代码主要来自此处提供的解决方案：Dynamically name the action buttons in R shiny from the values in Data Frame
我尝试了以下解决方案：Shiny - Can dynamically generated buttons act as trigger for an event和R Shiny: Handle Action Buttons in Data Table，但是这两种解决方案似乎都不起作用。我想知道这是否是一个名称空间问题，但是也不知道如何解决这个问题。
这是当前模块中的一个最小的，可复制的示例。我删除了大部分代码，这些代码与当前问题无关。不过，请让我知道我是否遗漏了任何东西。
模块用户界面
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部分
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"))
)
)
)
)
服务器部分
# Define server logic
ShinyServer <- function(input, output, session) {
# Call Module for Segment Summary
callModule(Segmentation, "Summary")
}
运行应用
shinyApp(ui, ShinyServer)
我根据当前对数据表排序的理解，刚刚生成的排序函数本身可能并不正确。目前，我已经尝试了诸如print（“ hi”）和renderText之类的更简单的watchEvent效果，但是单击按钮似乎没有任何影响。如果排序功能本身有误，我将最乐意接受任何建议。
这是相关代码中使用的表的简要数据结构。
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
任何帮助/建议将不胜感激。谢谢！