I am trying to preserve selected rows in DT table while filtering. When filter is applied, it should not remove previous selected rows. I calculate sum based on selected rows and then keep adding it when new row gets selected. For example. if you select first and second row of the table produced by code below, it will add to 42. Then if I apply filter on drop down value drat and select first row, it should return to 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)