Отфильтрованные данные с возможностью выборки не работают для динамического пользовательского интерфейса нескольких блестящих таблиц - PullRequest
0 голосов
/ 27 июня 2019

Я создал блестящую панель инструментов, которая состоит из двух частей: 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)

Я хотел бы иметь возможность отфильтровывать данные в каждом поле и видеть, что соответствующая сводная таблица обновляется только с выбранными строками.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...