#load libraries ----
library(dplyr)
library(stringr)
library(tibble)
library(reactable)
library(crosstalk)
library(DT)
library(gt)
library(scales)
library(htmltools)
library(tippy)
library(reactablefmtr)
#installed from Github using devtools
# devtools::install_github("jcheng5/d3scatter")
# devtools::install_github("kent37/summarywidget")
library(d3scatter)
library(summarywidget)
#define dataset ----
# specify order of interest
gtcars_mod <- gt::gtcars %>%
dplyr::relocate(msrp, .after = year) %>%
dplyr::relocate(ctry_origin, .after = year) %>%
dplyr::relocate(bdy_style, .after = msrp) %>%
dplyr::relocate(drivetrain, .after = bdy_style) %>%
dplyr::relocate(hp_rpm, .after = trsmn) %>%
dplyr::relocate(trq_rpm, .after = trsmn) %>%
mutate(ctry_origin = ifelse(ctry_origin == "United States", "United States of America", ctry_origin)) %>%
mutate(mfr_model = mfr) %>%
relocate(mfr_model, everything()) %>%
arrange(mfr, model)
data <- SharedData$new(gtcars_mod)
#setup crosstalk widgets ----
bscols(widths = c(3, 8, 12, 12),
list(
filter_select("mfr", "Manufacturer", data, ~gtcars_mod$mfr, multiple=TRUE),
filter_select("model", "Model", data, ~gtcars_mod$model, multiple = TRUE),
filter_slider("year", "Year", data, ~year, width = "80%", sep = "", animate=FALSE),
filter_slider("hp", "Horsepower", data, ~hp, width = "90%"),
filter_checkbox("bdy_style", "Body Style", data, ~bdy_style, inline = TRUE),
filter_slider("msrp", "MSRP", data, ~msrp, width = "100%",pre = "$")
),
list(
d3scatter(data, ~hp, ~mpg_h, ~factor(bdy_style), width="100%", height=250),
d3scatter(data, ~hp, ~mpg_c, ~factor(bdy_style), width="100%", height=250)
),
reactable(data, searchable = TRUE, minRows = 3,
showPageSizeOptions = TRUE,
pageSizeOptions = c(5, 10, 15),
defaultPageSize = 5,
resizable = TRUE, highlight = TRUE,
selection = "multiple",
onClick = "select",
theme = example_theme,
bordered = TRUE,
striped = TRUE,
filterable = TRUE,
columns = list(
mfr_model = colDef(
# Show species under character names
cell = JS("function(cellInfo) {
var model = cellInfo.row['model'] || 'Unknown'
return (
'<div>' +
'<div style=\"font-weight: 600\">' + cellInfo.value + '</div>' +
'<div style=\"font-size: 12px\">' + model + '</div>' +
'</div>'
)
}"), header=with_tooltip("model", "Manufacturer/model name"),
footer = "Total",
html = TRUE),
mfr = colDef(show = FALSE),
model = colDef(show = FALSE),
# mfr = colDef(header=with_tooltip("mfr", "Manufacturer")),
# model = colDef(header= with_tooltip("model", "Model name")),
year = colDef(header= with_tooltip("year", "Model year"), minWidth = 60,
cell = reactablefmtr::icon_sets(gtcars_mod, icon_size = 18, icons = "clock", color = "lightgrey")),
trim = colDef(header= with_tooltip("trim", "Dscription of the car model's trim"),
style = list(fontWeight = 600)
),
bdy_style = colDef(header= with_tooltip("bdy_style", "Body style"),
minWidth = 115,
cell = function(value) {
class <- paste0("tag bdy_style-", tolower(value))
div(class = class, value)
}
),
hp = colDef(header= with_tooltip("hp", "Horsepower"),
cell = function(value) {
width <- paste0(value / max(gtcars_mod$hp, na.rm=TRUE) * 100, "%")
bar_chart(value, width = width, fill = "#A0522D", background = "#e1e1e1")
}),
hp_rpm = colDef(header= with_tooltip("hp_rpm", "Horsepower associated RPM level"), format=colFormat(separators = TRUE),
cell = icon_sets(gtcars_mod, icons = "horse")),
trq = colDef(header= with_tooltip("trq", "Torque"),
cell = function(value) {
width <- paste0(value / max(gtcars_mod$trq, na.rm=TRUE) * 100, "%")
bar_chart(value, width = width, fill = "#DDA0DD", background = "#e1e1e1")
}),
trq_rpm = colDef(header= with_tooltip("trq_rpm", "Torque associated RPM level"), format=colFormat(separators = TRUE),
cell = icon_sets(gtcars_mod, icons = "tachometer-alt")),
mpg_c = colDef(header= with_tooltip("mpg_c", "Miles per gallon fuel efficiency city"),
cell = reactablefmtr::icon_sets(gtcars_mod, icon_size = 18, icons = "gas-pump", colors = c("#ee9090", "grey", "#90ee90"))),
mpg_h = colDef(header= with_tooltip("mpg_h", "Miles per gallon fuel efficiency highway"),
cell = reactablefmtr::icon_sets(gtcars_mod, icon_size = 18, icons = "gas-pump", colors = c("#ee9090", "grey", "#90ee90"))
),
drivetrain = colDef(header= with_tooltip("drivetrain", "Car's drivetrain"),
cell = function(value) {
class <- paste0("tag drivetrain-", tolower(value))
div(class = class, value)
}),
trsmn = colDef(header= with_tooltip("trsmn", "Codified transmission type")),
ctry_origin = colDef(
header = with_tooltip("ctry_origin", "Vehicle manufacturer's headquarter country"),
headerStyle = list(fontWeight = 700),
minWidth = 200,
style = list(fontWeight = 600),
class = "cell",
cell = function(value, index) {
img_src <- stringr::str_c('https://cdn.countryflags.com/thumbs/',
stringr::str_replace_all(stringr::str_to_lower(value)," ","-"), '/flag-800.png')
image <- img(class = "logo",
src = img_src,
height = 20,
width = 35,
alt = value)
div(class = "country",
image,
div(class = "country-name", value)
)
}),
msrp = colDef(header = with_tooltip("msrp", "Car prices in USD"),
format = colFormat(separators = TRUE, digits = 0, prefix = "$"),
minWidth = 120,
# cell = function(value) div(scales::dollar(value), rating_msrp(value), width = "100%"),
cell = reactablefmtr::icon_assign(gtcars_mod, icon = "dollar-sign", fill_color = "darkgreen",
empty_color = "lightgrey", buckets = 5, show_values = "right",
icon_size = 13,
number_fmt = scales::dollar),
footer = function(values) scales::dollar(sum(values) )
)
),
defaultColDef = colDef(footerStyle = list(fontWeight = "bold"),)
)
# DT::datatable(data)
)