Сохранить выбранные строки при фильтрации в DT - PullRequest
Новая
       44

Сохранить выбранные строки при фильтрации в DT

0 голосов
/ 24 октября 2018

Я пытаюсь сохранить выбранные строки в таблице DT при фильтрации.Когда фильтр применяется, он не должен удалять предыдущие выбранные строки.Я вычисляю сумму на основе выбранных строк, а затем продолжаю добавлять ее, когда выбирается новая строка.Например.если вы выберете первую и вторую строку таблицы, созданной с помощью кода ниже, это добавит к 42. Затем, если я применю фильтр к раскрывающемуся значению drat и выберу первую строку, он должен вернуться к 60 which is (42 + 18.1).

#############################################
# Install Packages if not installed already
#############################################

Install_And_Load <- function(Required_Packages) {
  Remaining_Packages <- Required_Packages[!(Required_Packages %in% installed.packages()[,"Package"])];
  if(length(Remaining_Packages)) 
  {install.packages(Remaining_Packages);}
  for(package_name in Required_Packages)
  {library(package_name,character.only=TRUE, quietly = TRUE);}
}

packages  <- c("shiny", "shinydashboard", "shinyalert", "DT",  "dplyr")
Install_And_Load(packages)

# FETCH DATA
mydata = mtcars
mydata$id = 1:nrow(mydata)


####################
# Dashboard
####################

#Dashboard header carrying the title of the dashboard
header <- dashboardHeader(title = "My Dashboard")

######################
# Dashboard Sidebar
######################

sidebar <- dashboardSidebar(
    sidebarMenu(
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    selectInput(
        "hyp",
        "Select:", 
        list(
        'All','drat','wt'
        ) , 
        selected =  "All", selectize = TRUE)
  )
)

##################
# Dashboard Body
#################

frow1 <- fluidRow(
   valueBoxOutput("value1")
)


frow2 <- fluidRow(
    tags$style(HTML('table.dataTable th {background-color: #5F5DA8 !important; color: white !important;}')),
      box(DT::dataTableOutput("mytable"), width = 12)
    )

# combine the two fluid rows to make the body
body <- dashboardBody(frow1, frow2)

####################
# Dashboard Page
###################
ui <- dashboardPage(title = 'Model', header, sidebar, body, skin='purple')

####################
# SERVER
###################

d = data.frame(stringsAsFactors = F)
server <- function(input, output, session) {
dd = reactiveValues(select = NULL, select2 = NULL)
ee = reactiveValues(mydf = NULL)

# DropDown and Data
  test <- reactive({
      if(input$hyp == 'All') {
          mydata
        } else {
                mydata %>% dplyr::filter(UQ(as.name(input$hyp)) <= 3)
                }
      })


observe({
    if(!is.null(input$mytable_rows_selected)){
    dd$select =  as.numeric(input$mytable_rows_selected)
    dd$select2 = data.frame(n = test()[dd$select, "id"])
    }
    })


   #creating the valueBoxOutput content
   output$value1 <- renderValueBox({
    c_a = sum(mydata[dd$select2[["n"]],"mpg"], na.rm = T)
    valueBox(
       formatC(c_a, format="d", big.mark=',')
      ,'Total MPG'
      ,icon = icon("th",lib='glyphicon')
      ,color = "purple")
  })


    # Render Table
    output$mytable = DT::renderDataTable({

    # Hide Columns
    columns_js <- "
                [{
                    extend: 'collection',
                    text: 'Hide Columns',
                    buttons: [ 'columnsToggle' ],
                    collectionLayout: 'four-column'
                }]"

    DT::datatable(test(), rownames= FALSE, extensions = c('FixedHeader', 'Buttons'),
                                  filter = 'top', 
                                  selection=list(mode = 'multiple'), 
                                  options = list( autoWidth = TRUE,
                                        # columnDefs = list(list(width = '75px', targets = c(1:12))),
                                                  scrollX = TRUE, 
                                                  orderClasses = TRUE,
                                                  pageLength = 50, 
                                                 fixedHeader = TRUE,
                                                 # fixedColumns = list(leftColumns = 3),
                                                dom = 'Bfrtip',
                                   buttons = DT::JS(columns_js)
                                  ),escape=F)
      }
    )


    proxy = DT::dataTableProxy('mytable')
    observe({print(dd$select2)})
    }

runApp(list(ui = ui, server = server), launch.browser = TRUE)
...