Я создал блестящую панель инструментов, которая состоит из двух частей: 1) вычисляемой сводной таблицы вверху и 2) соответствующей таблицы данных, которая при фильтрации должна обновлять сводку в # 1 только для отфильтрованных строк. Я также создал кнопку для динамического добавления / удаления новых блоков с одинаковой структурой, чтобы можно было сравнивать различные сводки различных отфильтрованных данных. Добавление / удаление нескольких таблиц работает, но сводные таблицы не обновляются соответствующими отфильтрованными таблицами данных.
Я пытался использовать row_all, но, похоже, это не работает. Приведенные ниже коды уменьшены с использованием данных mtcars для удобства просмотра и должны работать при запуске в качестве блестящего приложения.
library("shiny")
library("shinydashboard")
library("DT")
library("formattable");
ui <- dashboardPage(dashboardHeader(title="Pipeline Rebuild"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Portfolio Builder",
tabName = "combo",
icon = icon("bars"))
)
),
dashboardBody(
tags$head(tags$style(HTML(".same-row {
max-width: 675px;
display: table-cell;
vertical-align: top;
padding-right: 50px;
}"
))
),
tabItems(
tabItem(tabName = "combo",
actionButton("insertPF",
"+ Add Portfolio"),
tags$div(style='overflow-x: scroll;',
id = "placeholder")
)
)
),
skin="blue"
)
server <- function(input, output, session) {
rv <- reactiveValues()
observeEvent(input$insertPF, {
divID <- gsub("\\.", "", format(Sys.time(), "%H%M%OS3"))
ttID <- paste0(divID, "DT")
ptID <- paste0(divID, "PT")
btnID <- paste0(divID, "rmv")
if (is.null(rv[[divID]])) {
insertUI(
selector = "#placeholder",
ui = tags$div(class = "same-row",
id = divID,
box(width="100%",
solidHeader = TRUE,
status = "primary",
actionButton(btnID, "Remove This Portfolio",
icon = icon("trash-alt"),
class = "pull-right"),
tableOutput(ttID),
div(style='overflow-x: scroll;',
dataTableOutput(ptID)
))
)
)
output[[ptID]] <- renderDataTable({
DT::datatable(mtcars,filter="top",rownames=FALSE,
options = list(pageLength = 10)) %>%
formatCurrency(c(11:32),
currency = "",
interval = 3,
digits = 0,
mark = ",")
});
output[[ttID]] <- renderTable({
if (length(input$ptID_rows_all) == 0) {
selected_rows = as.numeric(rownames(mtcars))
subdata = mtcars[selected_rows,]}
else {selected_rows<-as.numeric(input$ptID_rows_all)
subdata<-mtcars[selected_rows,]}
mtable <- data.frame(
matrix(c("Number of Project Count",
nrow(subdata)
),
nrow = 1,
ncol = 2
)
);
colnames(mtable)[1] <- paste0("Combined Portfolio Metric")
colnames(mtable)[2] <- "Weighted Average"
formattable(mtable);
});
rv[[divID]] <- TRUE
observeEvent(input[[btnID]], {
removeUI(selector = paste0("#", divID))
rv[[divID]] <- NULL
}, ignoreInit = TRUE, once = TRUE)
}
else {
message("The button has already been created!")
}
})
}
shinyApp(ui, server)
Я хотел бы иметь возможность отфильтровывать данные в каждом поле и видеть, что соответствующая сводная таблица обновляется только с выбранными строками.