With shinyfilter
you can link
selectizeInput
widgets to a 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.
Execute
install.packages("shinyfilter", dependencies = TRUE)
in the
R console to install the package including all packages it depends
on.
In your user interface:
selectizeInput
widgets that will serve as
filters for the reactable
table; make sure they all have
their onChange
property set to the same input variablereactable
table to present your datause_tooltips()
(and change the
appearance of the tooltips or popovers, if you like)In your server function:
define_filters()
to configure which
selectizeInput
widget will filter which column of your
tableonChange
event of the
selectizeInput
widgets with observeEvent()
:
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 automaticallyupdate_tooltips()
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. This is also the example used in the online help for
shinyfilter
. Let us start with the UI.
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).
In our example, two filter widgets could then look like this:
selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$manufacturer)))
selectizeInput(inputId = "sel_fuel", label = "Fuel",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$fuel))),
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:
use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF")
This is it. Now your UI is ready for shinyfilter
. Let’s
move on to the server function.
In the server function you need to do three things:
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:
input
argument provided to the server function of
your applicationinputId
of the reactable
inputId
s
of the selectizeInput
widgets that represent the
filtersA 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
):
define_filters(input,
"tbl_cars",
c(sel_manufacturer = "manufacturer",
sel_fuel = "fuel"),
cars)
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
.
In our example, the data for the reactable
is stored in
a reactive object r
which had been created with:
<- reactiveValues(mycars = cars) r
The reactable
is rendered based on this data:
$tbl_cars <- renderReactable({
outputreactable(data = r$mycars,
filterable = TRUE,
rownames = FALSE,
selection = "multiple",
showPageSizeOptions = TRUE,
paginationType = "jump",
showSortable = TRUE,
highlight = TRUE,
resizable = TRUE,
rowStyle = list(cursor = "pointer"),
onClick = "select"
) })
To update the reactable
we only need to assign the
return value of update_filters()
to the reactive
variable:
$mycars <- update_filters(input, session, "tbl_cars") r
So far, the observeEvent()
call looks like this:
observeEvent(input$ev_click, {
$mycars <- update_filters(input, session, "tbl_cars")
r })
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
unavailable 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.
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
.
In our example, embedded in the observeEvent()
call,
this could look like this:
observeEvent(input$ev_click, {
$mycars <- update_filters(input, session, "tbl_cars")
rupdate_tooltips("tbl_cars",
session, tooltip = TRUE,
title_avail = "Available is:",
title_nonavail = "Currently not available is:",
max_avail = 10,
max_nonavail = 10)
})
This is how the application looks like (here, we use some more filters than just the two from above):
And here is the code:
library(shiny)
library(reactable)
library(shinyfilter)
<- system.file("cars.csv", package="shinyfilter")
cars_csv
<- read.csv(cars_csv, stringsAsFactors = FALSE, header = TRUE, encoding = "UTF-8")
cars
<- fluidPage(
ui titlePanel("Cars Database"),
sidebarLayout(
sidebarPanel(
width = 2,
selectizeInput(inputId = "sel_manufacturer", label = "Manufacturer",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$manufacturer))),
selectizeInput(inputId = "sel_year", label = "Year",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$year))),
selectizeInput(inputId = "sel_fuel", label = "Fuel",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$fuel))),
selectizeInput(inputId = "sel_condition", label = "Condition",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$condition))),
selectizeInput(inputId = "sel_size", label = "Size",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$size))),
selectizeInput(inputId = "sel_transmission", label = "Transmission",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$transmission))),
selectizeInput(inputId = "sel_color", label = "Color",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$paint_color))),
selectizeInput(inputId = "sel_type", label = "Type",
multiple = TRUE, options = list(onChange = event("ev_click")),
choices = sort(unique(cars$type))),
use_tooltips(background = "#1B3F8C", foreground = "#FFFFFF")
),mainPanel(
reactableOutput(outputId = "tbl_cars")
)
)
)
<- function(input, output, session) {
server
<- reactiveValues(mycars = cars)
r
define_filters(input,
"tbl_cars",
c(sel_manufacturer = "manufacturer",
sel_year = "year",
sel_fuel = "fuel",
sel_condition = "condition",
sel_size = "size",
sel_transmission = "transmission",
sel_color = "paint_color",
sel_type = "type"),
cars)
observeEvent(input$ev_click, {
$mycars <- update_filters(input, session, "tbl_cars")
rupdate_tooltips("tbl_cars",
session, tooltip = TRUE,
title_avail = "Available is:",
title_nonavail = "Currently not available is:",
popover_title = "My filters",
max_avail = 10,
max_nonavail = 10)
})
$tbl_cars <- renderReactable({
outputreactable(data = r$mycars,
filterable = TRUE,
rownames = FALSE,
selection = "multiple",
showPageSizeOptions = TRUE,
paginationType = "jump",
showSortable = TRUE,
highlight = TRUE,
resizable = TRUE,
rowStyle = list(cursor = "pointer"),
onClick = "select"
)
})
}
shinyApp(ui = ui, server = server)
Joachim Zuckarelli
Twitter: [@jsugarelli](https://twitter.com/jsugarelli)