├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R └── shinyfilter.r ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── inst └── cars.csv ├── man ├── define_filters.Rd ├── event.Rd ├── figures │ ├── logo.png │ └── shinyfilter_animated.gif ├── update_filters.Rd ├── update_tooltips.Rd └── use_tooltips.Rd ├── pkgdown ├── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ ├── apple-touch-icon-180x180.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico ├── index.html └── index.md ├── shinyfilter.Rproj └── vignettes └── shinyfilter.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README.Rmd$ 4 | ^_pkgdown\.yml$ 5 | ^docs$ 6 | ^vignettes$ 7 | ^pkgdown$ 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | docs 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: shinyfilter 2 | Type: Package 3 | Title: Use Interdependent Filters on Table Columns in Shiny Apps 4 | Description: Allows to connect 'selectizeInputs' widgets as filters to a 'reactable' table. 5 | As known from spreadsheet applications, column filters are interdependent, so each 6 | filter only shows the values that are really available at the moment based on 7 | the current selection in other filters. Filter values currently not available 8 | (and also those being available) can be shown via popovers or tooltips. 9 | Version: 0.1.1 10 | Authors@R: person("Joachim", "Zuckarelli", role = c("aut", "cre"), email = "joachim@zuckarelli.de", comment = c(ORCID="0000-0002-9280-3016")) 11 | Maintainer: Joachim Zuckarelli 12 | Depends: R (>= 3.5.0) 13 | License: GPL-3 14 | Imports: shiny, reactable, shinyBS, shinyjs, stringr 15 | Repository: CRAN 16 | BugReports: https://github.com/jsugarelli/shinyfilter/issues 17 | URL: https://github.com/jsugarelli/shinyfilter/ 18 | Encoding: UTF-8 19 | ByteCompile: true 20 | RoxygenNote: 7.1.1 21 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(define_filters) 4 | export(event) 5 | export(update_filters) 6 | export(update_tooltips) 7 | export(use_tooltips) 8 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # shinyfilter 0.1.1 2 | 3 | ## Bug fixes: 4 | 5 | * Fixed errors in example code. 6 | * Fixed 'locked environment' error' (GitHub issue #1). 7 | * Extended documentation regarding what to do if tooltips/popups are not visible. 8 | 9 | 10 | # shinyfilter 0.1.0 11 | 12 | Initial version. 13 | -------------------------------------------------------------------------------- /R/shinyfilter.r: -------------------------------------------------------------------------------- 1 | # Set up environment to store temporary data 2 | shinyfilterenv <- new.env(parent = emptyenv()) 3 | 4 | 5 | 6 | ifnull <- function(arg) { 7 | if(is.null(arg)) return("") 8 | else return(arg) 9 | } 10 | 11 | 12 | #' @title Get JavaScript code for filters' selectizeInput onchange event 13 | #' 14 | #' @description Helper function to create the JavaScript event handler code for 15 | #' the \code{selectizeInput} filters of a shiny app using \code{shinyfilters}. 16 | #' 17 | #' @param name Name of the event/input variable set by the \code{selectizeInput} 18 | #' filters whenever the selection changes. Can be handled in a call of 19 | #' \code{observeEvent()}. 20 | #' 21 | #' @details Processing the \code{onChange} event of the \code{selectizeInput} 22 | #' widgets that serve as the filters is necessary so that filters all the 23 | #' other \code{shinyfilter} filters bound to the same \code{reactable} can be 24 | #' updated accordingly and show the currently available filter options. All 25 | #' \code{selectizeInput} should have exactly the same event handler. 26 | #' 27 | #' You can of course create the JavaScript code for the \code{onChange} event 28 | #' handler function yourself, especially if you want to trigger additional 29 | #' operations in JavaScript whenever an \code{onChange} event occurs. 30 | #' \code{event()} function is just intended as a shortcut to save time and 31 | #' effort. 32 | #' 33 | #' For a full example of a shiny app using \code{shinyfilter} please call up 34 | #' the help for \code{\link{update_filters}()}. See the \code{README.md} file 35 | #' or the GitHub repo on 36 | #' \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 37 | #' for a comprehensive \code{shinyfilter} tutorial. 38 | #' 39 | #' @return JavaScript code for the \code{onChange} event. 40 | #' 41 | #' @examples 42 | #' event("myEvent") 43 | #' 44 | #' @export 45 | event <- function(name) { 46 | return(I(paste0("function(value) { Shiny.setInputValue('", name, "', Math.random()); }"))) 47 | } 48 | 49 | 50 | 51 | filter_exists <- function() { 52 | return(exists("shinyfilter.r", envir = shinyfilterenv)) 53 | } 54 | 55 | 56 | 57 | #' @title Define the set of interdependent filters 58 | #' 59 | #' @description Installs the filters and binds them to the \code{reactable} 60 | #' widget and the dataframe presented in the \code{reactable}. 61 | #' 62 | #' \code{define_filters()} needs to be called in the server function of any 63 | #' shiny app using \code{shinyfilter}. 64 | #' 65 | #' @param input The input object provided as an argument to the server function. 66 | #' @param react_id Object ID/input slot of the \code{reactable} which the 67 | #' filters will be linked to. 68 | #' @param filters A named character vector with the column names of the 69 | #' dataframe that will be filtered. The \emph{names} of the vector elements 70 | #' are the object IDs/input slots of the respective \code{selectizeInput()} 71 | #' widgets used as filters. 72 | #' @param data The (unfiltered) dataframe presented in the \code{reactable}. 73 | #' 74 | #' 75 | #' @details For a full example of a shiny app using \code{shinyfilter} please 76 | #' call up the help for \code{\link{update_filters}()}. See the 77 | #' \code{README.md} file or the GitHub repo on 78 | #' \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 79 | #' for a comprehensive \code{shinyfilter} tutorial. 80 | #' 81 | #' 82 | #' @return No return value. 83 | #' @export 84 | 85 | define_filters <- function(input, react_id, filters, data) { 86 | cur_sel <- list() 87 | sf <- list() 88 | for(i in 1:NROW(filters)) { 89 | cur_sel[[i]] <- eval(paste0("input$", names(filters)[i])) 90 | } 91 | names(cur_sel) <- names(filters) 92 | 93 | if(filter_exists()) { 94 | sf <- shiny::isolate(shiny::reactiveValuesToList(get("shinyfilters.r", envir = shinyfilterenv))) 95 | if(react_id %in% names(sf$filters.internal)) nxt <- which(names(sf$filters.internal) == react_id)[1] 96 | else nxt <- length(sf$filters.internal) + 1 97 | filters.internal <- sf$filters.internal 98 | filters.internal[[nxt]] <- list(filters = filters, data = data, cur_sel = cur_sel) 99 | names(filters.internal)[nxt] <- react_id 100 | } 101 | else { 102 | lst <- list(filters = filters, data = data, cur_sel = cur_sel) 103 | filters.internal = list(lst) 104 | names(filters.internal)[1] <- react_id 105 | } 106 | sf.list <- shiny::reactiveValues(filters.internal = filters.internal) 107 | assign("shinyfilters.r", sf.list, envir = shinyfilterenv) 108 | } 109 | 110 | 111 | 112 | 113 | #' @title Update the filter options in each filter when the selection 114 | #' in any of the filters changes 115 | #' 116 | #' @description Updates all filters linked to a \code{reactable}. As 117 | #' \code{shinyfilter} filters are interdependent, \code{update_filters()} 118 | #' makes sure that each filter (\code{selectizeInput} widget) only shows the 119 | #' filter options currently available, given the selection in all other 120 | #' filters. 121 | #' 122 | #' @param input The input object provided as an argument to the server function. 123 | #' @param session The session variable provided as an argument to the server 124 | #' function. 125 | #' @param react_id The output variable/ID of the \code{reactable} for which 126 | #' filters will be updated. 127 | #' 128 | #' @return The filtered dataframe to be presented in the \code{reactable} 129 | #' widget. Ideally, this is captured in a reactive value so that the 130 | #' \code{reactable} updates automatically. 131 | #' 132 | #' @details See below for a full example of a shiny app using 133 | #' \code{shinyfilter}. See the \code{README.md} file or the GitHub repo on 134 | #' \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 135 | #' for a comprehensive \code{shinyfilter} tutorial. 136 | #' 137 | #' 138 | #' @examples 139 | #' if(interactive()) { 140 | #' library(shiny) 141 | #' library(reactable) 142 | #' library(shinyfilter) 143 | #' 144 | #' cars_csv <- system.file("cars.csv", package="shinyfilter") 145 | #' 146 | #' cars <- read.csv(cars_csv, stringsAsFactors = FALSE, header = TRUE, encoding = "UTF-8") 147 | #' 148 | #' app = shinyApp( 149 | #' ui <- fluidPage( 150 | #' titlePanel("Cars Database"), 151 | #' sidebarLayout( 152 | #' sidebarPanel( 153 | #' width = 2, 154 | #' 155 | #' selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 156 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 157 | #' choices = sort(unique(cars$manufacturer))), 158 | #' 159 | #' selectizeInput(inputId = "sel_year", label = "Year", 160 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 161 | #' choices = sort(unique(cars$year))), 162 | #' 163 | #' selectizeInput(inputId = "sel_fuel", label = "Fuel", 164 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 165 | #' choices = sort(unique(cars$fuel))), 166 | #' 167 | #' selectizeInput(inputId = "sel_condition", label = "Condition", 168 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 169 | #' choices = sort(unique(cars$condition))), 170 | #' 171 | #' selectizeInput(inputId = "sel_size", label = "Size", 172 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 173 | #' choices = sort(unique(cars$size))), 174 | #' 175 | #' selectizeInput(inputId = "sel_transmission", label = "Transmission", 176 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 177 | #' choices = sort(unique(cars$transmission))), 178 | #' 179 | #' selectizeInput(inputId = "sel_color", label = "Color", 180 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 181 | #' choices = sort(unique(cars$paint_color))), 182 | #' 183 | #' selectizeInput(inputId = "sel_type", label = "Type", 184 | #' multiple = TRUE, options = list(onChange = event("ev_click")), 185 | #' choices = sort(unique(cars$type))), 186 | #' use_tooltips(background = "#' 1B3F8C", foreground = "#' FFFFFF") 187 | #' ), 188 | #' mainPanel( 189 | #' reactableOutput(outputId = "tbl_cars") 190 | #' ) 191 | #' ) 192 | #' ), 193 | #' 194 | #' 195 | #' server = function(input, output, session) { 196 | #' 197 | #' r <- reactiveValues(mycars = cars) 198 | #' 199 | #' define_filters(input, 200 | #' "tbl_cars", 201 | #' c(sel_manufacturer = "manufacturer", 202 | #' sel_year = "year", 203 | #' sel_fuel = "fuel", 204 | #' sel_condition = "condition", 205 | #' sel_size = "size", 206 | #' sel_transmission = "transmission", 207 | #' sel_color = "paint_color", 208 | #' sel_type = "type"), 209 | #' cars) 210 | #' 211 | #' 212 | #' observeEvent(input$ev_click, { 213 | #' r$mycars <- update_filters(input, session, "tbl_cars") 214 | #' update_tooltips("tbl_cars", 215 | #' session, 216 | #' tooltip = TRUE, 217 | #' title_avail = "Available is:", 218 | #' title_nonavail = "Currently not available is:", 219 | #' popover_title = "My filters", 220 | #' max_avail = 10, 221 | #' max_nonavail = 10) 222 | #' }) 223 | #' 224 | #' 225 | #' output$tbl_cars <- renderReactable({ 226 | #' reactable(data = r$mycars, 227 | #' filterable = TRUE, 228 | #' rownames = FALSE, 229 | #' selection = "multiple", 230 | #' showPageSizeOptions = TRUE, 231 | #' paginationType = "jump", 232 | #' showSortable = TRUE, 233 | #' highlight = TRUE, 234 | #' resizable = TRUE, 235 | #' rowStyle = list(cursor = "pointer"), 236 | #' onClick = "select" 237 | #' ) 238 | #' }) 239 | #' 240 | #' } 241 | #' ) 242 | #' 243 | #' runApp(app) 244 | #' } 245 | #' 246 | #' @export 247 | update_filters <- function(input, session, react_id) { 248 | sf.list <- shiny::isolate(shiny::reactiveValuesToList(get("shinyfilters.r", envir = shinyfilterenv))) 249 | sf <- sf.list$filters.internal[[react_id]] 250 | data.new <- sf$data 251 | change <- c(rep(FALSE, NROW(sf$filters))) 252 | 253 | for(i in 1:NROW(sf$filters)) { 254 | col <- which(names(data.new) == sf$filters[i])[1] # Filter column in the data 255 | sel <- eval(parse(text = paste0("input$", names(sf$filters))[i])) 256 | 257 | if(all(ifnull(sort(sel)) != ifnull(sort(sf$cur_sel[[i]])))) { 258 | change[i] <- TRUE 259 | sf$cur_sel[[i]] <- ifnull(sel) 260 | } 261 | if(!is.null(sel)) data.new <- data.new[data.new[,col] %in% sel,] 262 | } 263 | if(sum(change) > 0){ 264 | for(i in 1:length(sf$filters)) { 265 | shiny::updateSelectizeInput(session, names(sf$filters)[i], choices = sort(unique(data.new[,sf$filters[i]])), selected = sf$cur_sel[i]) 266 | } 267 | } 268 | 269 | avail <- list() 270 | non.avail <- list() 271 | for(i in 1:length(sf$filters)) { 272 | avail[[i]] <- sort(unique(data.new[,sf$filters[i]])) 273 | non.avail[[i]] <- sort(unique(sf$data[,sf$filters[i]][!(sf$data[,sf$filters[i]] %in% avail[[i]])])) 274 | } 275 | sf$avail <- avail 276 | sf$non.avail <- non.avail 277 | 278 | sf.list$filters.internal[[react_id]] <- sf 279 | sfx <- shiny::reactiveValues(filters.internal = sf.list$filters.internal) 280 | assign("shinyfilters.r", sfx, envir = shinyfilterenv) 281 | return(data.new) 282 | } 283 | 284 | 285 | 286 | 287 | #' @title Update the tooltips/popovers based on the currently available filter 288 | #' options 289 | #' 290 | #' @description Updates all tooltips or popovers for \code{shinyfilter} filter 291 | #' \code{selectizeInput} widgets. Tooltips/popovers can be used to show the 292 | #' currently unavailable filter options, i.e. the filter options that are not 293 | #' available at the moment because of the dataframe presented in the 294 | #' \code{reactable} is filtered by the choices made in the other filters. It 295 | #' is also possible to list the available filter options as well. 296 | #' 297 | #' If you want to use tooltips/popovers, you need to call 298 | #' \code{\link{use_tooltips}()} from within the UI definition of your shiny 299 | #' app. 300 | #' 301 | #' @param react_id The output variable/ID of the \code{reactable} to which the 302 | #' filters are linked. 303 | #' @param session The session variable provided as an argument to the server 304 | #' function. 305 | #' @param tooltip If \code{TRUE}, tooltips will be shown. If \code{FALSE}, 306 | #' popovers will be shown. 307 | #' @param show_avail If \code{TRUE} not only the unavailable filter options will 308 | #' be listed in the tooltips/popovers, but the unavailable ones as well. 309 | #' @param title_avail Header text for the list of available filter options. 310 | #' @param title_nonavail Header text for the list of unavailable filter options. 311 | #' @param popover_title Title text for the popover window. Only relevant when 312 | #' \code{tooltips = FALSE}. 313 | #' @param max_avail Maximum number of available filter options shown. Use the 314 | #' \code{more_avail} argument to determine what is shown if the number of 315 | #' available filter options exceeds \code{max_avail}. 316 | #' @param max_nonavail Maximum number of non-available filter options shown. Use 317 | #' the \code{more_nonavail} argument to determine what is shown if the number 318 | #' of non-available filter options exceeds \code{max_nonavail}. 319 | #' @param more_avail Text to be shown if \code{show_avail = TRUE} and the number 320 | #' of available filter options exceeds \code{max_avail}. In this case, only 321 | #' the first \code{max_avail} filter options are shown followed by 322 | #' \code{more_avail}. In \code{more_avail} you can use \code{#} as a 323 | #' placeholder for the number of filter options exceeding \code{max_avail}. 324 | #' @param more_nonavail Text to be shown if the number of available filter 325 | #' options exceeds \code{max_nonavail}. In this case, only the first 326 | #' \code{max_nonavail} filter options are shown followed by 327 | #' \code{more_nonavail}. In \code{more_nonavail} you can use \code{#} as a 328 | #' placeholder for the number of filter options exceeding \code{max_nonavail}. 329 | #' @param placement Defines where the tooltip/popover is placed relative to the 330 | #' filter (i.e. \code{selectizeInput} widget) it belongs to. Can be either 331 | #' \code{"top"}, \code{"bottom"}, \code{"left"} or \code{"right"}. 332 | #' 333 | #' @return No return value. 334 | #' 335 | #' @details For a full example of a shiny app using \code{shinyfilter} please 336 | #' call up the help for \code{\link{update_filters}()}. See the 337 | #' \code{README.md} file or the GitHub repo on 338 | #' \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 339 | #' for a comprehensive \code{shinyfilter} tutorial. 340 | #' 341 | #' \bold{Tip}: If your tooltips/popovers are not visible attach the 342 | #' \code{shinyBS} package directly in your Shiny app by adding 343 | #' \code{library(shinyBS)} to your code. The \code{shinyBS} package is used to 344 | #' create the tooltips and popovers. 345 | #' 346 | #' @export 347 | update_tooltips <- function(react_id, session, tooltip = TRUE, show_avail = TRUE, title_avail = "Available values:", 348 | title_nonavail = "Currently not available filters:", popover_title = "Filter options", 349 | max_avail = NULL, max_nonavail = max_avail, more_avail = "... (# more)", 350 | more_nonavail = "... (# more)", placement = "top") { 351 | sf.list <- shiny::isolate(shiny::reactiveValuesToList(get("shinyfilters.r", envir = shinyfilterenv))) 352 | sf <- sf.list$filters.internal[[react_id]] 353 | avail <- sf$avail 354 | non.avail <- sf$non.avail 355 | 356 | 357 | for(i in 1:length(sf$filters)) { 358 | text <- "" 359 | 360 | if(!is.null(max_avail)) { 361 | n.avail <- NROW(avail[[i]]) 362 | if(n.avail > max_avail) { 363 | avail[[i]] <- avail[[i]][1:max_avail+1] 364 | if(!is.null(more_avail)) { 365 | avail[[i]][max_avail+1] = stringr::str_replace(more_avail, "#", as.character(n.avail - max_avail)) 366 | } 367 | else avail[[i]][max_avail+1] = "..." 368 | } 369 | } 370 | if(!is.null(max_nonavail)) { 371 | n.nonavail <- NROW(non.avail[[i]]) 372 | if(n.nonavail > max_nonavail) { 373 | non.avail[[i]] <- non.avail[[i]][1:max_nonavail+1] 374 | if(!is.null(more_nonavail)) { 375 | non.avail[[i]][max_nonavail+1] = stringr::str_replace(more_nonavail, "#", as.character(n.nonavail - max_nonavail)) 376 | } 377 | else non.avail[[i]][max_avail+1] = "..." 378 | } 379 | } 380 | 381 | if((!is.na(avail[[i]][1])) & show_avail) text <- paste0("

", title_avail, "

", 382 | paste0(avail[[i]], collapse = "
")) 383 | if(show_avail & !is.na(avail[[i]][1])) text <- paste0(text, "

") 384 | if(!is.na(non.avail[[i]][1])) text <- paste0(text,"

", title_nonavail, "

", 385 | paste0(non.avail[[i]], collapse = "
")) 386 | 387 | if(tooltip) shinyBS::addTooltip(session, names(sf$filters)[i], text, placement, trigger = "hover", options = list(html = TRUE)) 388 | else shinyBS::addPopover(session, names(sf$filters)[i], popover_title, text, placement, trigger = "hover", options = list(html = TRUE)) 389 | } 390 | } 391 | 392 | 393 | 394 | 395 | #' @title Add tooltip functionality to the app 396 | #' 397 | #' @description Prepares the application for the use of tooltips or popovers to 398 | #' show the (un)available filter options. \code{use_tooltips()} needs to be 399 | #' called from within the UI definition of your shiny app. See 400 | #' \code{\link{update_tooltips}()} for how to create the actual tooltips or 401 | #' popovers. 402 | #' 403 | #' @param background Background color of the tooltips/popovers the in CSS hex 404 | #' format. 405 | #' @param foreground Font color of the tooltips/popovers the in CSS hex format. 406 | #' @param textalign Alignment of the text in the tooltips/popovers; either 407 | #' \code{"left"}, \code{"right"}, \code{"center"} or \code{"justify"}. 408 | #' @param fontsize Font size of the tooltips/popovers. 409 | #' @param opacity Opacity of the tooltips/popovers. 410 | #' 411 | #' @return No return value. 412 | #' 413 | #' @details For a full example of a shiny app using \code{shinyfilter} please 414 | #' call up the help for \code{\link{update_filters}()}. See the 415 | #' \code{README.md} file or the GitHub repo on 416 | #' \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 417 | #' for a comprehensive \code{shinyfilter} tutorial. 418 | #' 419 | #' \bold{Tip}: If your tooltips/popovers are not visible attach the 420 | #' \code{shinyBS} package directly in your Shiny app by adding 421 | #' \code{library(shinyBS)} to your code. The \code{shinyBS} package is used to 422 | #' create the tooltips and popovers. 423 | #' 424 | #' 425 | #' @export 426 | use_tooltips <- function(background = "#000000", foreground = "#FFFFFF", textalign = "left", 427 | fontsize = "100%", opacity = 0.8) { 428 | res <-list( 429 | shinyjs::useShinyjs(), 430 | shinyjs::inlineCSS( 431 | list( 432 | ".tooltip > .tooltip-inner" = c(paste0("background-color: ", background), 433 | paste0("color: ", foreground), 434 | paste0("text-align: ", textalign), 435 | paste0("font-size: ", fontsize)), 436 | ".tooltip.in" = paste0("opacity: ", opacity, "!important"), 437 | ".tooltip.bottom > .tooltip-arrow" = paste0("border-bottom-color: ", background), 438 | ".tooltip.top > .tooltip-arrow" = paste0("border-top-color: ", background), 439 | ".tooltip.right > .tooltip-arrow" = paste0("border-right-color: ", background), 440 | ".tooltip.left > .tooltip-arrow" = paste0("border-left-color: ", background) 441 | ) 442 | ), 443 | shinyBS::bsTooltip(paste0("X", as.integer(stats::runif(1)*10000000)), "", placement = "bottom", trigger = "hover", options = list(html = TRUE)) 444 | ) 445 | return(res) 446 | } 447 | 448 | 449 | 450 | .onUnload <- function(libname) { 451 | rm("shinyfilter.r", envir = shinyfilterenv) 452 | rm(shinyfilterenv) 453 | } 454 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Package shinyfilter" 3 | output: github_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | knitr::opts_chunk$set(echo = TRUE) 8 | ``` 9 | 10 | ![shinyfiler logo](man/figures/logo.png) 11 | 12 | ## What *shinyfilter* does 13 | 14 | With `shinyfilter` you can link `selectizeInput` widgets to a [`reactable`](https://glin.github.io/reactable/) table and use them as filters for the columns of that table. All filters are interdependent: When you change the selection in one filter not only is the table updated, of course, but also will the available filter values in the other filters adjust to the new data selection; each filter will only show those values that are available given the current selection defined by all the filters together. This mimics the behavior of column filters in spreadsheet applications like Microsoft *Excel* or LibreOffice *Calc*. 15 | 16 | 17 | ## How you install *shinyfilter* 18 | 19 | Execute `install.packages("shinyfilter", dependencies = TRUE)` in the R console to install the package including all packages it depends on. 20 | 21 | 22 | ## How you work with *shinyfilter* 23 | 24 | ### Cookbook recipe for the impatient 25 | 26 | In your user interface: 27 | 28 | * add the `selectizeInput` widgets that will serve as filters for the `reactable` table; make sure they all have their `onChange` property set to the same input variable 29 | * add the `reactable` table to present your data 30 | * if you want to use tooltips or popovers to show the currently (un)available filter options (given the current filter selection in all filters together), call `use_tooltips()` (and change the appearance of the tooltips or popovers, if you like) 31 | 32 | In your server function: 33 | 34 | * call `define_filters()` to configure which `selectizeInput` widget will filter which column of your table 35 | * handle the `onChange` event of the `selectizeInput` widgets with `observeEvent()`: 36 | * call `update_filters()` to update the filter values; `update_filters()` will return the 'new', filtered dataframe. Ideally, this is captured in a reactive value so that the `reactable` updates automatically 37 | * if you want to work with tooltips or popovers, call `update_tooltips()` 38 | 39 | 40 | ### Comprehensive tutorial 41 | 42 | There is a couple of simple steps to run through when you use `shinyfilters`. In the following, the process is shown using an example with `cars`, a subset of the used cars dataset by [Austin Reese](https://github.com/AustinReese/UsedVehicleSearch). This is also the example used in the online help for `shinyfilter`. Let us start with the UI. 43 | 44 | ##### User interface 45 | 46 | 1. Create your UI as usual and place the `reactable` widget and the `selectizeInput` widgets for the filters on it. Make sure the `selectizeInput` widgets all have an event handler function for the `onChange` event (which is triggered everytime the selection in that widget changes). All your `selectizeInput` widgets should use the *same* event handler for the `onChange` event. To set up such an event binding easily you can use `shinyfilter`'s `event()` function which produces the required JavaScript code for you. The argument of `event()` is the name of the input value that you can process in the server function of your application using `observeEvent()` (more on that further down below). 47 | 48 | In our example, two filter widgets could then look like this: 49 | ```{r eval = FALSE} 50 | selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 51 | multiple = TRUE, options = list(onChange = event("ev_click")), 52 | choices = sort(unique(cars$manufacturer))) 53 | 54 | selectizeInput(inputId = "sel_fuel", label = "Fuel", 55 | multiple = TRUE, options = list(onChange = event("ev_click")), 56 | choices = sort(unique(cars$fuel))), 57 | ``` 58 | 2. If you want to use tooltips or popovers to show the user of your application the filter options that are currently not available (i.e. hidden) because they do not occur in the current selection that is shown in the `reactable` then you need to call `use_tooltips()` from the UI. Here you can specify the `background` (default: black) and `foreground` (default: white) colors, the `textalign`ment (default: left), the `fontsize` (default: 100%) and the `opacity` (default: 0.8). A call of `use_tooltips()` could look like this: 59 | ```{r eval = FALSE} 60 | use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF") 61 | 62 | ``` 63 | 64 | This is it. Now your UI is ready for `shinyfilter`. Let's move on to the server function. 65 | 66 | 67 | ##### Server 68 | 69 | In the server function you need to do three things: 70 | 71 | 1. Call `define_filters()` to bind the filters to the columns of the dataframe you are presenting in the `reactable`. The arguments of `define_filters()` are the following: 72 | 73 | * the `input` argument provided to the server function of your application 74 | * the `inputId` of the `reactable` 75 | * a named vector of the columns of the dataframe that will be filtered; the names of the vector elements are the `inputId`s of the `selectizeInput` widgets that represent the filters 76 | * the dataframe shown in the reactable 77 | 78 | A call of `define_filters()` in our example could look this (assuming, the dataframe which is presented in the reactable is called `cars` and the `reactable` itself is named `tbl_cars`): 79 | 80 | ```{r eval = FALSE} 81 | define_filters(input, 82 | "tbl_cars", 83 | c(sel_manufacturer = "manufacturer", 84 | sel_fuel = "fuel"), 85 | cars) 86 | ``` 87 | 88 | 2. An `observeEvent()` call to handle the filter event (`ev_click` in our example). In the expression to execute when the event is triggered (the `handleExpr` argument of `observeEvent()`) you need to call `update_filters()` with the input and session variables (the arguments of the server function), and the `inputId` of the `reactable` as arguments. `update_filters()` will return a filtered dataframe that can be used to update your `reactable`. 89 | 90 | In our example, the data for the `reactable` is stored in a reactive object `r` which had been created with: 91 | ```{r eval = FALSE} 92 | r <- reactiveValues(mycars = cars) 93 | ``` 94 | The `reactable` is rendered based on this data: 95 | ```{r eval = FALSE} 96 | output$tbl_cars <- renderReactable({ 97 | reactable(data = r$mycars, 98 | filterable = TRUE, 99 | rownames = FALSE, 100 | selection = "multiple", 101 | showPageSizeOptions = TRUE, 102 | paginationType = "jump", 103 | showSortable = TRUE, 104 | highlight = TRUE, 105 | resizable = TRUE, 106 | rowStyle = list(cursor = "pointer"), 107 | onClick = "select" 108 | ) 109 | }) 110 | ``` 111 | To update the `reactable` we only need to assign the return value of `update_filters()` to the reactive variable: 112 | ```{r eval = FALSE} 113 | r$mycars <- update_filters(input, session, "tbl_cars") 114 | ``` 115 | So far, the `observeEvent()` call looks like this: 116 | 117 | ```{r eval = FALSE} 118 | observeEvent(input$ev_click, { 119 | r$mycars <- update_filters(input, session, "tbl_cars") 120 | }) 121 | ``` 122 | 123 | 3. If you want to use tooltips or popovers to show the hidden (currently not available) filter options then you need an additional call of `update_tooltips()` in `observeEvent()`. Here, you can specify if you want to show not only the *un*available but the available filter options as well (argument `show_avail`), how many filter options you want to show at most (arguments `max.avail` and `max.nonavail` - default for both is `NULL` which means *all* filter values are shown), how the available (`title_avail`) and unavailable (`title_unavail`) filter options shall be captioned, and what to show if the list of filter values exceeds `max.avail`/`max.nonavail`; default for the latter arguments (`more.nonavail` and `more.avail`) is `"... (# more)"` where `#` is a placeholder for the number of values not shown any more. You can provide any text you like and use `#` to show the number of filter options not listed in the tooltip/popover. 124 | 125 | If you want to show popovers instead of tooltips you need to set the `tooltips` argument of `update_tooltips()` to `FALSE`. In this case you can specify an additional `popover_title`. 126 | 127 | In our example, embedded in the `observeEvent()` call, this could look like this: 128 | 129 | ```{r eval = FALSE} 130 | observeEvent(input$ev_click, { 131 | r$mycars <- update_filters(input, session, "tbl_cars") 132 | update_tooltips("tbl_cars", 133 | session, 134 | tooltip = TRUE, 135 | title_avail = "Available is:", 136 | title_nonavail = "Currently not available is:", 137 | max_avail = 10, 138 | max_nonavail = 10) 139 | }) 140 | ``` 141 | 142 | If your tooltips/popovers are not visible attach the `shinyBS` package directly in your Shiny app by adding `library(shinyBS)` to your code. The `shinyBS` package is used to create the tooltips and popovers. 143 | 144 | 145 | ### Full code of the example application 146 | 147 | This is how the application looks like (here, we use some more filters than just the two from above): 148 | 149 | ![shinyfiler logo](man/figures/shinyfilter_animated.gif) 150 | And here is the code: 151 | 152 | ```{r eval = FALSE} 153 | 154 | library(shiny) 155 | library(reactable) 156 | library(shinyfilter) 157 | 158 | cars_csv <- system.file("cars.csv", package="shinyfilter") 159 | 160 | cars <- read.csv(cars_csv, stringsAsFactors = FALSE, header = TRUE, encoding = "UTF-8") 161 | 162 | ui <- fluidPage( 163 | titlePanel("Cars Database"), 164 | sidebarLayout( 165 | sidebarPanel( 166 | width = 2, 167 | 168 | selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 169 | multiple = TRUE, options = list(onChange = event("ev_click")), 170 | choices = sort(unique(cars$manufacturer))), 171 | 172 | selectizeInput(inputId = "sel_year", label = "Year", 173 | multiple = TRUE, options = list(onChange = event("ev_click")), 174 | choices = sort(unique(cars$year))), 175 | 176 | selectizeInput(inputId = "sel_fuel", label = "Fuel", 177 | multiple = TRUE, options = list(onChange = event("ev_click")), 178 | choices = sort(unique(cars$fuel))), 179 | 180 | selectizeInput(inputId = "sel_condition", label = "Condition", 181 | multiple = TRUE, options = list(onChange = event("ev_click")), 182 | choices = sort(unique(cars$condition))), 183 | 184 | selectizeInput(inputId = "sel_size", label = "Size", 185 | multiple = TRUE, options = list(onChange = event("ev_click")), 186 | choices = sort(unique(cars$size))), 187 | 188 | selectizeInput(inputId = "sel_transmission", label = "Transmission", 189 | multiple = TRUE, options = list(onChange = event("ev_click")), 190 | choices = sort(unique(cars$transmission))), 191 | 192 | selectizeInput(inputId = "sel_color", label = "Color", 193 | multiple = TRUE, options = list(onChange = event("ev_click")), 194 | choices = sort(unique(cars$paint_color))), 195 | 196 | selectizeInput(inputId = "sel_type", label = "Type", 197 | multiple = TRUE, options = list(onChange = event("ev_click")), 198 | choices = sort(unique(cars$type))), 199 | use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF") 200 | ), 201 | mainPanel( 202 | reactableOutput(outputId = "tbl_cars") 203 | ) 204 | ) 205 | ) 206 | 207 | 208 | 209 | server <- function(input, output, session) { 210 | 211 | r <- reactiveValues(mycars = cars) 212 | 213 | define_filters(input, 214 | "tbl_cars", 215 | c(sel_manufacturer = "manufacturer", 216 | sel_year = "year", 217 | sel_fuel = "fuel", 218 | sel_condition = "condition", 219 | sel_size = "size", 220 | sel_transmission = "transmission", 221 | sel_color = "paint_color", 222 | sel_type = "type"), 223 | cars) 224 | 225 | 226 | observeEvent(input$ev_click, { 227 | r$mycars <- update_filters(input, session, "tbl_cars") 228 | update_tooltips("tbl_cars", 229 | session, 230 | tooltip = TRUE, 231 | title_avail = "Available is:", 232 | title_nonavail = "Currently not available is:", 233 | popover_title = "My filters", 234 | max_avail = 10, 235 | max_nonavail = 10) 236 | }) 237 | 238 | 239 | output$tbl_cars <- renderReactable({ 240 | reactable(data = r$mycars, 241 | filterable = TRUE, 242 | rownames = FALSE, 243 | selection = "multiple", 244 | showPageSizeOptions = TRUE, 245 | paginationType = "jump", 246 | showSortable = TRUE, 247 | highlight = TRUE, 248 | resizable = TRUE, 249 | rowStyle = list(cursor = "pointer"), 250 | onClick = "select" 251 | ) 252 | }) 253 | 254 | } 255 | 256 | shinyApp(ui = ui, server = server) 257 | 258 | ``` 259 | ## Contact the author 260 | 261 | Joachim Zuckarelli 262 | 263 | Twitter: [@jsugarelli](https://twitter.com/jsugarelli) 264 | 265 | GitHub: [https://github.com/jsugarelli/shinyfiler](https://github.com/jsugarelli/shinyfilter) 266 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Package shinyfilter 2 | ================ 3 | 4 | ![shinyfiler logo](man/figures/logo.png) 5 | 6 | ## What *shinyfilter* does 7 | 8 | With `shinyfilter` you can link `selectizeInput` widgets to a 9 | [`reactable`](https://glin.github.io/reactable/) table and use them as 10 | filters for the columns of that table. All filters are interdependent: 11 | When you change the selection in one filter not only is the table 12 | updated, of course, but also will the available filter values in the 13 | other filters adjust to the new data selection; each filter will only 14 | show those values that are available given the current selection defined 15 | by all the filters together. This mimics the behavior of column filters 16 | in spreadsheet applications like Microsoft *Excel* or LibreOffice 17 | *Calc*. 18 | 19 | ## How you install *shinyfilter* 20 | 21 | Execute `install.packages("shinyfilter", dependencies = TRUE)` in the R 22 | console to install the package including all packages it depends on. 23 | 24 | ## How you work with *shinyfilter* 25 | 26 | ### Cookbook recipe for the impatient 27 | 28 | In your user interface: 29 | 30 | - add the `selectizeInput` widgets that will serve as filters for the 31 | `reactable` table; make sure they all have their `onChange` property 32 | set to the same input variable 33 | - add the `reactable` table to present your data 34 | - if you want to use tooltips or popovers to show the currently 35 | (un)available filter options (given the current filter selection in 36 | all filters together), call `use_tooltips()` (and change the 37 | appearance of the tooltips or popovers, if you like) 38 | 39 | In your server function: 40 | 41 | - call `define_filters()` to configure which `selectizeInput` widget 42 | will filter which column of your table 43 | - handle the `onChange` event of the `selectizeInput` widgets with 44 | `observeEvent()`: 45 | - call `update_filters()` to update the filter values; 46 | `update_filters()` will return the ‘new’, filtered dataframe. 47 | Ideally, this is captured in a reactive value so that the 48 | `reactable` updates automatically 49 | - if you want to work with tooltips or popovers, call 50 | `update_tooltips()` 51 | 52 | ### Comprehensive tutorial 53 | 54 | There is a couple of simple steps to run through when you use 55 | `shinyfilters`. In the following, the process is shown using an example 56 | with `cars`, a subset of the used cars dataset by [Austin 57 | Reese](https://github.com/AustinReese/UsedVehicleSearch). This is also 58 | the example used in the online help for `shinyfilter`. Let us start with 59 | the UI. 60 | 61 | ##### User interface 62 | 63 | 1. Create your UI as usual and place the `reactable` widget and the 64 | `selectizeInput` widgets for the filters on it. Make sure the 65 | `selectizeInput` widgets all have an event handler function for the 66 | `onChange` event (which is triggered everytime the selection in that 67 | widget changes). All your `selectizeInput` widgets should use the 68 | *same* event handler for the `onChange` event. To set up such an 69 | event binding easily you can use `shinyfilter`’s `event()` function 70 | which produces the required JavaScript code for you. The argument of 71 | `event()` is the name of the input value that you can process in the 72 | server function of your application using `observeEvent()` (more on 73 | that further down below). 74 | 75 | In our example, two filter widgets could then look like this: 76 | 77 | ``` r 78 | selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 79 | multiple = TRUE, options = list(onChange = event("ev_click")), 80 | choices = sort(unique(cars$manufacturer))) 81 | 82 | selectizeInput(inputId = "sel_fuel", label = "Fuel", 83 | multiple = TRUE, options = list(onChange = event("ev_click")), 84 | choices = sort(unique(cars$fuel))), 85 | ``` 86 | 87 | 2. If you want to use tooltips or popovers to show the user of your 88 | application the filter options that are currently not available 89 | (i.e. hidden) because they do not occur in the current selection 90 | that is shown in the `reactable` then you need to call 91 | `use_tooltips()` from the UI. Here you can specify the `background` 92 | (default: black) and `foreground` (default: white) colors, the 93 | `textalign`ment (default: left), the `fontsize` (default: 100%) and 94 | the `opacity` (default: 0.8). A call of `use_tooltips()` could look 95 | like this: 96 | 97 | ``` r 98 | use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF") 99 | ``` 100 | 101 | This is it. Now your UI is ready for `shinyfilter`. Let’s move on to the 102 | server function. 103 | 104 | ##### Server 105 | 106 | In the server function you need to do three things: 107 | 108 | 1. Call `define_filters()` to bind the filters to the columns of the 109 | dataframe you are presenting in the `reactable`. The arguments of 110 | `define_filters()` are the following: 111 | 112 | - the `input` argument provided to the server function of your 113 | application 114 | - the `inputId` of the `reactable` 115 | - a named vector of the columns of the dataframe that will be 116 | filtered; the names of the vector elements are the `inputId`s of 117 | the `selectizeInput` widgets that represent the filters 118 | - the dataframe shown in the reactable 119 | 120 | A call of `define_filters()` in our example could look this 121 | (assuming, the dataframe which is presented in the reactable is 122 | called `cars` and the `reactable` itself is named `tbl_cars`): 123 | 124 | ``` r 125 | define_filters(input, 126 | "tbl_cars", 127 | c(sel_manufacturer = "manufacturer", 128 | sel_fuel = "fuel"), 129 | cars) 130 | ``` 131 | 132 | 2. An `observeEvent()` call to handle the filter event (`ev_click` in 133 | our example). In the expression to execute when the event is 134 | triggered (the `handleExpr` argument of `observeEvent()`) you need 135 | to call `update_filters()` with the input and session variables (the 136 | arguments of the server function), and the `inputId` of the 137 | `reactable` as arguments. `update_filters()` will return a filtered 138 | dataframe that can be used to update your `reactable`. 139 | 140 | In our example, the data for the `reactable` is stored in a reactive 141 | object `r` which had been created with: 142 | 143 | ``` r 144 | r <- reactiveValues(mycars = cars) 145 | ``` 146 | 147 | The `reactable` is rendered based on this data: 148 | 149 | ``` r 150 | output$tbl_cars <- renderReactable({ 151 | reactable(data = r$mycars, 152 | filterable = TRUE, 153 | rownames = FALSE, 154 | selection = "multiple", 155 | showPageSizeOptions = TRUE, 156 | paginationType = "jump", 157 | showSortable = TRUE, 158 | highlight = TRUE, 159 | resizable = TRUE, 160 | rowStyle = list(cursor = "pointer"), 161 | onClick = "select" 162 | ) 163 | }) 164 | ``` 165 | 166 | To update the `reactable` we only need to assign the return value of 167 | `update_filters()` to the reactive variable: 168 | 169 | ``` r 170 | r$mycars <- update_filters(input, session, "tbl_cars") 171 | ``` 172 | 173 | So far, the `observeEvent()` call looks like this: 174 | 175 | ``` r 176 | observeEvent(input$ev_click, { 177 | r$mycars <- update_filters(input, session, "tbl_cars") 178 | }) 179 | ``` 180 | 181 | 3. If you want to use tooltips or popovers to show the hidden 182 | (currently not available) filter options then you need an additional 183 | call of `update_tooltips()` in `observeEvent()`. Here, you can 184 | specify if you want to show not only the *un*available but the 185 | available filter options as well (argument `show_avail`), how many 186 | filter options you want to show at most (arguments `max.avail` and 187 | `max.nonavail` - default for both is `NULL` which means *all* filter 188 | values are shown), how the available (`title_avail`) and unavailable 189 | (`title_unavail`) filter options shall be captioned, and what to 190 | show if the list of filter values exceeds 191 | `max.avail`/`max.nonavail`; default for the latter arguments 192 | (`more.nonavail` and `more.avail`) is `"... (# more)"` where `#` is 193 | a placeholder for the number of values not shown any more. You can 194 | provide any text you like and use `#` to show the number of filter 195 | options not listed in the tooltip/popover. 196 | 197 | If you want to show popovers instead of tooltips you need to set the 198 | `tooltips` argument of `update_tooltips()` to `FALSE`. In this case 199 | you can specify an additional `popover_title`. 200 | 201 | In our example, embedded in the `observeEvent()` call, this could 202 | look like this: 203 | 204 | ``` r 205 | observeEvent(input$ev_click, { 206 | r$mycars <- update_filters(input, session, "tbl_cars") 207 | update_tooltips("tbl_cars", 208 | session, 209 | tooltip = TRUE, 210 | title_avail = "Available is:", 211 | title_nonavail = "Currently not available is:", 212 | max_avail = 10, 213 | max_nonavail = 10) 214 | }) 215 | ``` 216 | 217 | ### Full code of the example application 218 | 219 | This is how the application looks like (here, we use some more filters 220 | than just the two from above): 221 | 222 | ![shinyfiler logo](man/figures/shinyfilter_animated.gif) And here is the 223 | code: 224 | 225 | ``` r 226 | library(shiny) 227 | library(reactable) 228 | library(shinyfilter) 229 | 230 | cars_csv <- system.file("cars.csv", package="shinyfilter") 231 | 232 | cars <- read.csv(cars_csv, stringsAsFactors = FALSE, header = TRUE, encoding = "UTF-8") 233 | 234 | ui <- fluidPage( 235 | titlePanel("Cars Database"), 236 | sidebarLayout( 237 | sidebarPanel( 238 | width = 2, 239 | 240 | selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 241 | multiple = TRUE, options = list(onChange = event("ev_click")), 242 | choices = sort(unique(cars$manufacturer))), 243 | 244 | selectizeInput(inputId = "sel_year", label = "Year", 245 | multiple = TRUE, options = list(onChange = event("ev_click")), 246 | choices = sort(unique(cars$year))), 247 | 248 | selectizeInput(inputId = "sel_fuel", label = "Fuel", 249 | multiple = TRUE, options = list(onChange = event("ev_click")), 250 | choices = sort(unique(cars$fuel))), 251 | 252 | selectizeInput(inputId = "sel_condition", label = "Condition", 253 | multiple = TRUE, options = list(onChange = event("ev_click")), 254 | choices = sort(unique(cars$condition))), 255 | 256 | selectizeInput(inputId = "sel_size", label = "Size", 257 | multiple = TRUE, options = list(onChange = event("ev_click")), 258 | choices = sort(unique(cars$size))), 259 | 260 | selectizeInput(inputId = "sel_transmission", label = "Transmission", 261 | multiple = TRUE, options = list(onChange = event("ev_click")), 262 | choices = sort(unique(cars$transmission))), 263 | 264 | selectizeInput(inputId = "sel_color", label = "Color", 265 | multiple = TRUE, options = list(onChange = event("ev_click")), 266 | choices = sort(unique(cars$paint_color))), 267 | 268 | selectizeInput(inputId = "sel_type", label = "Type", 269 | multiple = TRUE, options = list(onChange = event("ev_click")), 270 | choices = sort(unique(cars$type))), 271 | use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF") 272 | ), 273 | mainPanel( 274 | reactableOutput(outputId = "tbl_cars") 275 | ) 276 | ) 277 | ) 278 | 279 | 280 | 281 | server <- function(input, output, session) { 282 | 283 | r <- reactiveValues(mycars = cars) 284 | 285 | define_filters(input, 286 | "tbl_cars", 287 | c(sel_manufacturer = "manufacturer", 288 | sel_year = "year", 289 | sel_fuel = "fuel", 290 | sel_condition = "condition", 291 | sel_size = "size", 292 | sel_transmission = "transmission", 293 | sel_color = "paint_color", 294 | sel_type = "type"), 295 | cars) 296 | 297 | 298 | observeEvent(input$ev_click, { 299 | r$mycars <- update_filters(input, session, "tbl_cars") 300 | update_tooltips("tbl_cars", 301 | session, 302 | tooltip = TRUE, 303 | title_avail = "Available is:", 304 | title_nonavail = "Currently not available is:", 305 | popover_title = "My filters", 306 | max_avail = 10, 307 | max_nonavail = 10) 308 | }) 309 | 310 | 311 | output$tbl_cars <- renderReactable({ 312 | reactable(data = r$mycars, 313 | filterable = TRUE, 314 | rownames = FALSE, 315 | selection = "multiple", 316 | showPageSizeOptions = TRUE, 317 | paginationType = "jump", 318 | showSortable = TRUE, 319 | highlight = TRUE, 320 | resizable = TRUE, 321 | rowStyle = list(cursor = "pointer"), 322 | onClick = "select" 323 | ) 324 | }) 325 | 326 | } 327 | 328 | shinyApp(ui = ui, server = server) 329 | ``` 330 | 331 | ## Contact the author 332 | 333 | Joachim Zuckarelli 334 | 335 | Twitter: \[@jsugarelli\]() 336 | 337 | GitHub: 338 | [https://github.com/jsugarelli/shinyfiler](https://github.com/jsugarelli/shinyfilter) 339 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | navbar: 2 | structure: 3 | left: [home, intro, reference, articles, tutorials, news, github] 4 | components: 5 | twitter: 6 | icon: "fab fa-twitter fa-lg" 7 | href: https://twitter.com/jsugarelli 8 | authors: 9 | Joachim Zuckarelli: 10 | href: "https://twitter.com/jsugarelli" 11 | home: 12 | title: shinyfilter - Interdependent Filters on Table Columns in Shiny Apps 13 | description: As known from spreadsheet applications, filters are interdependent, so each filter only shows the values that are really available at the moment based on the current selection in other filters. Filter values currently not available (and also those being available) can be shown via popovers or tooltips. 14 | -------------------------------------------------------------------------------- /man/define_filters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shinyfilter.r 3 | \name{define_filters} 4 | \alias{define_filters} 5 | \title{Define the set of interdependent filters} 6 | \usage{ 7 | define_filters(input, react_id, filters, data) 8 | } 9 | \arguments{ 10 | \item{input}{The input object provided as an argument to the server function.} 11 | 12 | \item{react_id}{Object ID/input slot of the \code{reactable} which the 13 | filters will be linked to.} 14 | 15 | \item{filters}{A named character vector with the column names of the 16 | dataframe that will be filtered. The \emph{names} of the vector elements 17 | are the object IDs/input slots of the respective \code{selectizeInput()} 18 | widgets used as filters.} 19 | 20 | \item{data}{The (unfiltered) dataframe presented in the \code{reactable}.} 21 | } 22 | \value{ 23 | No return value. 24 | } 25 | \description{ 26 | Installs the filters and binds them to the \code{reactable} 27 | widget and the dataframe presented in the \code{reactable}. 28 | 29 | \code{define_filters()} needs to be called in the server function of any 30 | shiny app using \code{shinyfilter}. 31 | } 32 | \details{ 33 | For a full example of a shiny app using \code{shinyfilter} please 34 | call up the help for \code{\link{update_filters}()}. See the 35 | \code{README.md} file or the GitHub repo on 36 | \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 37 | for a comprehensive \code{shinyfilter} tutorial. 38 | } 39 | -------------------------------------------------------------------------------- /man/event.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shinyfilter.r 3 | \name{event} 4 | \alias{event} 5 | \title{Get JavaScript code for filters' selectizeInput onchange event} 6 | \usage{ 7 | event(name) 8 | } 9 | \arguments{ 10 | \item{name}{Name of the event/input variable set by the \code{selectizeInput} 11 | filters whenever the selection changes. Can be handled in a call of 12 | \code{observeEvent()}.} 13 | } 14 | \value{ 15 | JavaScript code for the \code{onChange} event. 16 | } 17 | \description{ 18 | Helper function to create the JavaScript event handler code for 19 | the \code{selectizeInput} filters of a shiny app using \code{shinyfilters}. 20 | } 21 | \details{ 22 | Processing the \code{onChange} event of the \code{selectizeInput} 23 | widgets that serve as the filters is necessary so that filters all the 24 | other \code{shinyfilter} filters bound to the same \code{reactable} can be 25 | updated accordingly and show the currently available filter options. All 26 | \code{selectizeInput} should have exactly the same event handler. 27 | 28 | You can of course create the JavaScript code for the \code{onChange} event 29 | handler function yourself, especially if you want to trigger additional 30 | operations in JavaScript whenever an \code{onChange} event occurs. 31 | \code{event()} function is just intended as a shortcut to save time and 32 | effort. 33 | 34 | For a full example of a shiny app using \code{shinyfilter} please call up 35 | the help for \code{\link{update_filters}()}. See the \code{README.md} file 36 | or the GitHub repo on 37 | \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 38 | for a comprehensive \code{shinyfilter} tutorial. 39 | } 40 | \examples{ 41 | event("myEvent") 42 | 43 | } 44 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/man/figures/logo.png -------------------------------------------------------------------------------- /man/figures/shinyfilter_animated.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/man/figures/shinyfilter_animated.gif -------------------------------------------------------------------------------- /man/update_filters.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shinyfilter.r 3 | \name{update_filters} 4 | \alias{update_filters} 5 | \title{Update the filter options in each filter when the selection 6 | in any of the filters changes} 7 | \usage{ 8 | update_filters(input, session, react_id) 9 | } 10 | \arguments{ 11 | \item{input}{The input object provided as an argument to the server function.} 12 | 13 | \item{session}{The session variable provided as an argument to the server 14 | function.} 15 | 16 | \item{react_id}{The output variable/ID of the \code{reactable} for which 17 | filters will be updated.} 18 | } 19 | \value{ 20 | The filtered dataframe to be presented in the \code{reactable} 21 | widget. Ideally, this is captured in a reactive value so that the 22 | \code{reactable} updates automatically. 23 | } 24 | \description{ 25 | Updates all filters linked to a \code{reactable}. As 26 | \code{shinyfilter} filters are interdependent, \code{update_filters()} 27 | makes sure that each filter (\code{selectizeInput} widget) only shows the 28 | filter options currently available, given the selection in all other 29 | filters. 30 | } 31 | \details{ 32 | See below for a full example of a shiny app using 33 | \code{shinyfilter}. See the \code{README.md} file or the GitHub repo on 34 | \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 35 | for a comprehensive \code{shinyfilter} tutorial. 36 | } 37 | \examples{ 38 | if(interactive()) { 39 | library(shiny) 40 | library(reactable) 41 | library(shinyfilter) 42 | 43 | cars_csv <- system.file("cars.csv", package="shinyfilter") 44 | 45 | cars <- read.csv(cars_csv, stringsAsFactors = FALSE, header = TRUE, encoding = "UTF-8") 46 | 47 | app = shinyApp( 48 | ui <- fluidPage( 49 | titlePanel("Cars Database"), 50 | sidebarLayout( 51 | sidebarPanel( 52 | width = 2, 53 | 54 | selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 55 | multiple = TRUE, options = list(onChange = event("ev_click")), 56 | choices = sort(unique(cars$manufacturer))), 57 | 58 | selectizeInput(inputId = "sel_year", label = "Year", 59 | multiple = TRUE, options = list(onChange = event("ev_click")), 60 | choices = sort(unique(cars$year))), 61 | 62 | selectizeInput(inputId = "sel_fuel", label = "Fuel", 63 | multiple = TRUE, options = list(onChange = event("ev_click")), 64 | choices = sort(unique(cars$fuel))), 65 | 66 | selectizeInput(inputId = "sel_condition", label = "Condition", 67 | multiple = TRUE, options = list(onChange = event("ev_click")), 68 | choices = sort(unique(cars$condition))), 69 | 70 | selectizeInput(inputId = "sel_size", label = "Size", 71 | multiple = TRUE, options = list(onChange = event("ev_click")), 72 | choices = sort(unique(cars$size))), 73 | 74 | selectizeInput(inputId = "sel_transmission", label = "Transmission", 75 | multiple = TRUE, options = list(onChange = event("ev_click")), 76 | choices = sort(unique(cars$transmission))), 77 | 78 | selectizeInput(inputId = "sel_color", label = "Color", 79 | multiple = TRUE, options = list(onChange = event("ev_click")), 80 | choices = sort(unique(cars$paint_color))), 81 | 82 | selectizeInput(inputId = "sel_type", label = "Type", 83 | multiple = TRUE, options = list(onChange = event("ev_click")), 84 | choices = sort(unique(cars$type))), 85 | use_tooltips(background = "#' 1B3F8C", foreground = "#' FFFFFF") 86 | ), 87 | mainPanel( 88 | reactableOutput(outputId = "tbl_cars") 89 | ) 90 | ) 91 | ), 92 | 93 | 94 | server = function(input, output, session) { 95 | 96 | r <- reactiveValues(mycars = cars) 97 | 98 | define_filters(input, 99 | "tbl_cars", 100 | c(sel_manufacturer = "manufacturer", 101 | sel_year = "year", 102 | sel_fuel = "fuel", 103 | sel_condition = "condition", 104 | sel_size = "size", 105 | sel_transmission = "transmission", 106 | sel_color = "paint_color", 107 | sel_type = "type"), 108 | cars) 109 | 110 | 111 | observeEvent(input$ev_click, { 112 | r$mycars <- update_filters(input, session, "tbl_cars") 113 | update_tooltips("tbl_cars", 114 | session, 115 | tooltip = TRUE, 116 | title_avail = "Available is:", 117 | title_nonavail = "Currently not available is:", 118 | popover_title = "My filters", 119 | max_avail = 10, 120 | max_nonavail = 10) 121 | }) 122 | 123 | 124 | output$tbl_cars <- renderReactable({ 125 | reactable(data = r$mycars, 126 | filterable = TRUE, 127 | rownames = FALSE, 128 | selection = "multiple", 129 | showPageSizeOptions = TRUE, 130 | paginationType = "jump", 131 | showSortable = TRUE, 132 | highlight = TRUE, 133 | resizable = TRUE, 134 | rowStyle = list(cursor = "pointer"), 135 | onClick = "select" 136 | ) 137 | }) 138 | 139 | } 140 | ) 141 | 142 | runApp(app) 143 | } 144 | 145 | } 146 | -------------------------------------------------------------------------------- /man/update_tooltips.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shinyfilter.r 3 | \name{update_tooltips} 4 | \alias{update_tooltips} 5 | \title{Update the tooltips/popovers based on the currently available filter 6 | options} 7 | \usage{ 8 | update_tooltips( 9 | react_id, 10 | session, 11 | tooltip = TRUE, 12 | show_avail = TRUE, 13 | title_avail = "Available values:", 14 | title_nonavail = "Currently not available filters:", 15 | popover_title = "Filter options", 16 | max_avail = NULL, 17 | max_nonavail = max_avail, 18 | more_avail = "... (# more)", 19 | more_nonavail = "... (# more)", 20 | placement = "top" 21 | ) 22 | } 23 | \arguments{ 24 | \item{react_id}{The output variable/ID of the \code{reactable} to which the 25 | filters are linked.} 26 | 27 | \item{session}{The session variable provided as an argument to the server 28 | function.} 29 | 30 | \item{tooltip}{If \code{TRUE}, tooltips will be shown. If \code{FALSE}, 31 | popovers will be shown.} 32 | 33 | \item{show_avail}{If \code{TRUE} not only the unavailable filter options will 34 | be listed in the tooltips/popovers, but the unavailable ones as well.} 35 | 36 | \item{title_avail}{Header text for the list of available filter options.} 37 | 38 | \item{title_nonavail}{Header text for the list of unavailable filter options.} 39 | 40 | \item{popover_title}{Title text for the popover window. Only relevant when 41 | \code{tooltips = FALSE}.} 42 | 43 | \item{max_avail}{Maximum number of available filter options shown. Use the 44 | \code{more_avail} argument to determine what is shown if the number of 45 | available filter options exceeds \code{max_avail}.} 46 | 47 | \item{max_nonavail}{Maximum number of non-available filter options shown. Use 48 | the \code{more_nonavail} argument to determine what is shown if the number 49 | of non-available filter options exceeds \code{max_nonavail}.} 50 | 51 | \item{more_avail}{Text to be shown if \code{show_avail = TRUE} and the number 52 | of available filter options exceeds \code{max_avail}. In this case, only 53 | the first \code{max_avail} filter options are shown followed by 54 | \code{more_avail}. In \code{more_avail} you can use \code{#} as a 55 | placeholder for the number of filter options exceeding \code{max_avail}.} 56 | 57 | \item{more_nonavail}{Text to be shown if the number of available filter 58 | options exceeds \code{max_nonavail}. In this case, only the first 59 | \code{max_nonavail} filter options are shown followed by 60 | \code{more_nonavail}. In \code{more_nonavail} you can use \code{#} as a 61 | placeholder for the number of filter options exceeding \code{max_nonavail}.} 62 | 63 | \item{placement}{Defines where the tooltip/popover is placed relative to the 64 | filter (i.e. \code{selectizeInput} widget) it belongs to. Can be either 65 | \code{"top"}, \code{"bottom"}, \code{"left"} or \code{"right"}.} 66 | } 67 | \value{ 68 | No return value. 69 | } 70 | \description{ 71 | Updates all tooltips or popovers for \code{shinyfilter} filter 72 | \code{selectizeInput} widgets. Tooltips/popovers can be used to show the 73 | currently unavailable filter options, i.e. the filter options that are not 74 | available at the moment because of the dataframe presented in the 75 | \code{reactable} is filtered by the choices made in the other filters. It 76 | is also possible to list the available filter options as well. 77 | 78 | If you want to use tooltips/popovers, you need to call 79 | \code{\link{use_tooltips}()} from within the UI definition of your shiny 80 | app. 81 | } 82 | \details{ 83 | For a full example of a shiny app using \code{shinyfilter} please 84 | call up the help for \code{\link{update_filters}()}. See the 85 | \code{README.md} file or the GitHub repo on 86 | \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 87 | for a comprehensive \code{shinyfilter} tutorial. 88 | 89 | \bold{Tip}: If your tooltips/popovers do not show up, attach the 90 | \code{shinyBS} package directly in your Shiny app by adding 91 | \code{library(shinyBS)} to your code. The \code{shinyBS} package is used to 92 | create the tooltips and popovers. 93 | } 94 | -------------------------------------------------------------------------------- /man/use_tooltips.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shinyfilter.r 3 | \name{use_tooltips} 4 | \alias{use_tooltips} 5 | \title{Add tooltip functionality to the app} 6 | \usage{ 7 | use_tooltips( 8 | background = "#000000", 9 | foreground = "#FFFFFF", 10 | textalign = "left", 11 | fontsize = "100\%", 12 | opacity = 0.8 13 | ) 14 | } 15 | \arguments{ 16 | \item{background}{Background color of the tooltips/popovers the in CSS hex 17 | format.} 18 | 19 | \item{foreground}{Font color of the tooltips/popovers the in CSS hex format.} 20 | 21 | \item{textalign}{Alignment of the text in the tooltips/popovers; either 22 | \code{"left"}, \code{"right"}, \code{"center"} or \code{"justify"}.} 23 | 24 | \item{fontsize}{Font size of the tooltips/popovers.} 25 | 26 | \item{opacity}{Opacity of the tooltips/popovers.} 27 | } 28 | \value{ 29 | No return value. 30 | } 31 | \description{ 32 | Prepares the application for the use of tooltips or popovers to 33 | show the (un)available filter options. \code{use_tooltips()} needs to be 34 | called from within the UI definition of your shiny app. See 35 | \code{\link{update_tooltips}()} for how to create the actual tooltips or 36 | popovers. 37 | } 38 | \details{ 39 | For a full example of a shiny app using \code{shinyfilter} please 40 | call up the help for \code{\link{update_filters}()}. See the 41 | \code{README.md} file or the GitHub repo on 42 | \href{https://github.com/jsugarelli/shinyfilter}{https://github.com/jsugarelli/shinyfilter} 43 | for a comprehensive \code{shinyfilter} tutorial. 44 | } 45 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jsugarelli/shinyfilter/44df73680e1feb77c51bde32c5f9e7ab4df945eb/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /pkgdown/index.md: -------------------------------------------------------------------------------- 1 | 2 | [![CRAN status](https://www.r-pkg.org/badges/version/shinyfilter)](https://CRAN.R-project.org/package=shinyfilter) 3 | [![Downloads](https://cranlogs.r-pkg.org/badges/grand-total/shinyfilter)](https://cranlogs.r-pkg.org/badges/grand-total/shinyfilter) 4 | 5 | 6 | # 7 | 8 | ## Interdependent filters on table columns in shiny apps 9 | 10 | 11 | ### About *shinyfilter* 12 | 13 | **`shinyfilter`** allows to connect `selectizeInputs` widgets as filters to a `reactable` table. 14 | 15 | As known from **spreadsheet** applications, **column filters** are **interdependent**, so each filter only shows the values that are really available at the moment based on the current **selection in other filters**. Filter values currently not available (and also those being available) can be shown via **popovers** or **tooltips**. 16 | 17 | 18 | ### How you install *shinyfilter* 19 | 20 | Execute `install.packages("shinyfilter", dependencies = TRUE)` in the R console to install the package including all packages it depends on. 21 | 22 | 23 | ### Contact 24 | 25 | Follow me on Twitter: [@jsugarelli](https://twitter.com/jsugarelli) 26 | 27 | Visit the package repo on GitHub: [https://github.com/jsugarelli/shinyfilter](https://github.com/jsugarelli/shinyfilter) 28 | -------------------------------------------------------------------------------- /shinyfilter.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /vignettes/shinyfilter.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Gettting started with shinyfilter" 3 | output: github_document 4 | --- 5 | 6 | ```{r setup, include=FALSE} 7 | knitr::opts_chunk$set(echo = TRUE) 8 | ``` 9 | 10 | ![](../man/figures/logo.png) 11 | 12 | ## What *shinyfilter* does 13 | 14 | With `shinyfilter` you can link `selectizeInput` widgets to a [`reactable`](https://glin.github.io/reactable/) table and use them as filters for the columns of that table. All filters are interdependent: When you change the selection in one filter not only is the table updated, of course, but also will the available filter values in the other filters adjust to the new data selection; each filter will only show those values that are available given the current selection defined by all the filters together. This mimics the behavior of column filters in spreadsheet applications like Microsoft *Excel* or LibreOffice *Calc*. 15 | 16 | 17 | ## How you install *shinyfilter* 18 | 19 | Execute `install.packages("shinyfilter", dependencies = TRUE)` in the R console to install the package including all packages it depends on. 20 | 21 | 22 | ## How you work with *shinyfilter* 23 | 24 | ### Cookbook recipe for the impatient 25 | 26 | In your user interface: 27 | 28 | * add the `selectizeInput` widgets that will serve as filters for the `reactable` table; make sure they all have their `onChange` property set to the same input variable 29 | * add the `reactable` table to present your data 30 | * if you want to use tooltips or popovers to show the currently (un)available filter options (given the current filter selection in all filters together), call `use_tooltips()` (and change the appearance of the tooltips or popovers, if you like) 31 | 32 | In your server function: 33 | 34 | * call `define_filters()` to configure which `selectizeInput` widget will filter which column of your table 35 | * handle the `onChange` event of the `selectizeInput` widgets with `observeEvent()`: 36 | * call `update_filters()` to update the filter values; `update_filters()` will return the 'new', filtered dataframe. Ideally, this is captured in a reactive value so that the `reactable` updates automatically 37 | * if you want to work with tooltips or popovers, call `update_tooltips()` 38 | 39 | 40 | ### Comprehensive tutorial 41 | 42 | There is a couple of simple steps to run through when you use `shinyfilters`. In the following, the process is shown using an example with `cars`, a subset of the used cars dataset by [Austin Reese](https://github.com/AustinReese/UsedVehicleSearch). This is also the example used in the online help for `shinyfilter`. Let us start with the UI. 43 | 44 | ##### User interface 45 | 46 | 1. Create your UI as usual and place the `reactable` widget and the `selectizeInput` widgets for the filters on it. Make sure the `selectizeInput` widgets all have an event handler function for the `onChange` event (which is triggered everytime the selection in that widget changes). All your `selectizeInput` widgets should use the *same* event handler for the `onChange` event. To set up such an event binding easily you can use `shinyfilter`'s `event()` function which produces the required JavaScript code for you. The argument of `event()` is the name of the input value that you can process in the server function of your application using `observeEvent()` (more on that further down below). 47 | 48 | In our example, two filter widgets could then look like this: 49 | ```{r eval = FALSE} 50 | selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 51 | multiple = TRUE, options = list(onChange = event("ev_click")), 52 | choices = sort(unique(cars$manufacturer))) 53 | 54 | selectizeInput(inputId = "sel_fuel", label = "Fuel", 55 | multiple = TRUE, options = list(onChange = event("ev_click")), 56 | choices = sort(unique(cars$fuel))), 57 | ``` 58 | 2. If you want to use tooltips or popovers to show the user of your application the filter options that are currently not available (i.e. hidden) because they do not occur in the current selection that is shown in the `reactable` then you need to call `use_tooltips()` from the UI. Here you can specify the `background` (default: black) and `foreground` (default: white) colors, the `textalign`ment (default: left), the `fontsize` (default: 100%) and the `opacity` (default: 0.8). A call of `use_tooltips()` could look like this: 59 | ```{r eval = FALSE} 60 | use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF") 61 | 62 | ``` 63 | 64 | This is it. Now your UI is ready for `shinyfilter`. Let's move on to the server function. 65 | 66 | 67 | ##### Server 68 | 69 | In the server function you need to do three things: 70 | 71 | 1. Call `define_filters()` to bind the filters to the columns of the dataframe you are presenting in the `reactable`. The arguments of `define_filters()` are the following: 72 | 73 | * the `input` argument provided to the server function of your application 74 | * the `inputId` of the `reactable` 75 | * a named vector of the columns of the dataframe that will be filtered; the names of the vector elements are the `inputId`s of the `selectizeInput` widgets that represent the filters 76 | * the dataframe shown in the reactable 77 | 78 | A call of `define_filters()` in our example could look this (assuming, the dataframe which is presented in the reactable is called `cars` and the `reactable` itself is named `tbl_cars`): 79 | 80 | ```{r eval = FALSE} 81 | define_filters(input, 82 | "tbl_cars", 83 | c(sel_manufacturer = "manufacturer", 84 | sel_fuel = "fuel"), 85 | cars) 86 | ``` 87 | 88 | 2. An `observeEvent()` call to handle the filter event (`ev_click` in our example). In the expression to execute when the event is triggered (the `handleExpr` argument of `observeEvent()`) you need to call `update_filters()` with the input and session variables (the arguments of the server function), and the `inputId` of the `reactable` as arguments. `update_filters()` will return a filtered dataframe that can be used to update your `reactable`. 89 | 90 | In our example, the data for the `reactable` is stored in a reactive object `r` which had been created with: 91 | ```{r eval = FALSE} 92 | r <- reactiveValues(mycars = cars) 93 | ``` 94 | The `reactable` is rendered based on this data: 95 | ```{r eval = FALSE} 96 | output$tbl_cars <- renderReactable({ 97 | reactable(data = r$mycars, 98 | filterable = TRUE, 99 | rownames = FALSE, 100 | selection = "multiple", 101 | showPageSizeOptions = TRUE, 102 | paginationType = "jump", 103 | showSortable = TRUE, 104 | highlight = TRUE, 105 | resizable = TRUE, 106 | rowStyle = list(cursor = "pointer"), 107 | onClick = "select" 108 | ) 109 | }) 110 | ``` 111 | To update the `reactable` we only need to assign the return value of `update_filters()` to the reactive variable: 112 | ```{r eval = FALSE} 113 | r$mycars <- update_filters(input, session, "tbl_cars") 114 | ``` 115 | So far, the `observeEvent()` call looks like this: 116 | 117 | ```{r eval = FALSE} 118 | observeEvent(input$ev_click, { 119 | r$mycars <- update_filters(input, session, "tbl_cars") 120 | }) 121 | ``` 122 | 123 | 3. If you want to use tooltips or popovers to show the hidden (currently not available) filter options then you need an additional call of `update_tooltips()` in `observeEvent()`. Here, you can specify if you want to show not only the *un*available but the available filter options as well (argument `show_avail`), how many filter options you want to show at most (arguments `max.avail` and `max.nonavail` - default for both is `NULL` which means *all* filter values are shown), how the available (`title_avail`) and unavailable (`title_unavail`) filter options shall be captioned, and what to show if the list of filter values exceeds `max.avail`/`max.nonavail`; default for the latter arguments (`more.nonavail` and `more.avail`) is `"... (# more)"` where `#` is a placeholder for the number of values not shown any more. You can provide any text you like and use `#` to show the number of filter options not listed in the tooltip/popover. 124 | 125 | If you want to show popovers instead of tooltips you need to set the `tooltips` argument of `update_tooltips()` to `FALSE`. In this case you can specify an additional `popover_title`. 126 | 127 | In our example, embedded in the `observeEvent()` call, this could look like this: 128 | ```{r eval = FALSE} 129 | observeEvent(input$ev_click, { 130 | r$mycars <- update_filters(input, session, "tbl_cars") 131 | update_tooltips("tbl_cars", 132 | tooltip = TRUE, 133 | session, 134 | title_avail = "Available is:", 135 | title_nonavail = "Currently not available is:", 136 | max_avail = 10, 137 | max_nonavail = 10) 138 | }) 139 | ``` 140 | 141 | If your tooltips/popovers are not visible attach the `shinyBS` package directly in your Shiny app by adding `library(shinyBS)` to your code. The `shinyBS` package is used to create the tooltips and popovers. 142 | 143 | 144 | ### Full code of the example application 145 | 146 | This is how the application looks like (here, we use some more filters than just the two from above): 147 | 148 | ![shinyfiler logo](../man/figures/shinyfilter_animated.gif) 149 | And here is the code: 150 | 151 | ```{r eval = FALSE} 152 | 153 | library(shiny) 154 | library(reactable) 155 | library(shinyfilter) 156 | 157 | cars_csv <- system.file("cars.csv", package="shinyfilter") 158 | 159 | cars <- read.csv(cars_csv, stringsAsFactors = FALSE, header = TRUE, encoding = "UTF-8") 160 | 161 | ui <- fluidPage( 162 | titlePanel("Cars Database"), 163 | sidebarLayout( 164 | sidebarPanel( 165 | width = 2, 166 | 167 | selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer", 168 | multiple = TRUE, options = list(onChange = event("ev_click")), 169 | choices = sort(unique(cars$manufacturer))), 170 | 171 | selectizeInput(inputId = "sel_year", label = "Year", 172 | multiple = TRUE, options = list(onChange = event("ev_click")), 173 | choices = sort(unique(cars$year))), 174 | 175 | selectizeInput(inputId = "sel_fuel", label = "Fuel", 176 | multiple = TRUE, options = list(onChange = event("ev_click")), 177 | choices = sort(unique(cars$fuel))), 178 | 179 | selectizeInput(inputId = "sel_condition", label = "Condition", 180 | multiple = TRUE, options = list(onChange = event("ev_click")), 181 | choices = sort(unique(cars$condition))), 182 | 183 | selectizeInput(inputId = "sel_size", label = "Size", 184 | multiple = TRUE, options = list(onChange = event("ev_click")), 185 | choices = sort(unique(cars$size))), 186 | 187 | selectizeInput(inputId = "sel_transmission", label = "Transmission", 188 | multiple = TRUE, options = list(onChange = event("ev_click")), 189 | choices = sort(unique(cars$transmission))), 190 | 191 | selectizeInput(inputId = "sel_color", label = "Color", 192 | multiple = TRUE, options = list(onChange = event("ev_click")), 193 | choices = sort(unique(cars$paint_color))), 194 | 195 | selectizeInput(inputId = "sel_type", label = "Type", 196 | multiple = TRUE, options = list(onChange = event("ev_click")), 197 | choices = sort(unique(cars$type))), 198 | use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF") 199 | ), 200 | mainPanel( 201 | reactableOutput(outputId = "tbl_cars") 202 | ) 203 | ) 204 | ) 205 | 206 | 207 | 208 | server <- function(input, output, session) { 209 | 210 | r <- reactiveValues(mycars = cars) 211 | 212 | define_filters(input, 213 | "tbl_cars", 214 | c(sel_manufacturer = "manufacturer", 215 | sel_year = "year", 216 | sel_fuel = "fuel", 217 | sel_condition = "condition", 218 | sel_size = "size", 219 | sel_transmission = "transmission", 220 | sel_color = "paint_color", 221 | sel_type = "type"), 222 | cars) 223 | 224 | 225 | observeEvent(input$ev_click, { 226 | r$mycars <- update_filters(input, session, "tbl_cars") 227 | update_tooltips("tbl_cars", 228 | session, 229 | tooltips = TRUE, 230 | title_avail = "Available is:", 231 | title_nonavail = "Currently not available is:", 232 | popover_title = "My filters", 233 | max_avail = 10, 234 | max_nonavail = 10) 235 | }) 236 | 237 | 238 | output$tbl_cars <- renderReactable({ 239 | reactable(data = r$mycars, 240 | filterable = TRUE, 241 | rownames = FALSE, 242 | selection = "multiple", 243 | showPageSizeOptions = TRUE, 244 | paginationType = "jump", 245 | showSortable = TRUE, 246 | highlight = TRUE, 247 | resizable = TRUE, 248 | rowStyle = list(cursor = "pointer"), 249 | onClick = "select" 250 | ) 251 | }) 252 | 253 | } 254 | 255 | shinyApp(ui = ui, server = server) 256 | 257 | ``` 258 | --------------------------------------------------------------------------------