Question

我创建了一个闪亮的仪表板框，该框具有两个部分：1）顶部的计算摘要表和2）相应的数据表，该表在过滤后应将＃1中的摘要更新为仅过滤后的行。我还创建了一个按钮，用于动态添加/删除具有相同结构的新框，以便可以并排比较不同过滤数据的各种摘要。添加/删除多个表是可行的，但是摘要表并未由相应的过滤数据表更新。

我尝试使用rows_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)

我希望能够过滤每个框中的数据表，并查看仅更新了那些选定行的相应摘要表。

数据表过滤的选择不适用于多个r闪亮表的动态UI

0 个答案: