Plots Thicken

One could think of data science as art grounded in facts. It tells a story through visualization. Both story and visualization rely on a good plot. And there are plenty to choose from, many with their own Wikipedia page
Which attract the most readers? How has that attention changed over time? Let’s build a Shiny app to explore their daily page views. These tell us something about attention to the articles, rather than how often people actually use each chart.
Want to make your own version? The source folder contains the complete index.qmd and supporting files, including the logo. The named chunks supply both this walkthrough and the embedded app. To render the whole article, download the repository too: its Quarto configuration and extensions live at the root.
theme_set(theme_bw(base_size = 11))
pal <- wes_palette(8, name = "IsleofDogs1", type = "continuous")display_palette(pal, "wesanderson::IsleofDogs1")
First, I’ll use {rvest} (Wickham 2022) to collect the article names from Wikipedia’s Statistical charts and diagrams category. The app builds this list when it starts, so the choices can follow changes to the category.
charts <-
tibble(
chart = read_html(str_c(
"https://en.wikipedia.org/wiki/",
"Category:Statistical_charts_and_diagrams"
)) |>
html_elements(".mw-category-group a") |>
html_text()
)The page-view data comes from the Wikimedia API. This little {httr2} (Wickham 2026) function retrieves an article’s daily views from July 2015 onwards and returns the article name, date and count. Later, the app will call it for whichever charts the visitor selects.
pv <- function(article, end_date = today()) {
request("https://wikimedia.org/api/rest_v1/metrics/pageviews/per-article") |>
req_url_path_append(
"en.wikipedia",
"all-access",
"user",
URLencode(article, reserved = TRUE),
"daily",
"2015070100",
str_c(format(end_date, "%Y%m%d"), "00")
) |>
req_perform() |>
resp_body_json(simplify = TRUE) |>
pluck("items") |>
as_tibble() |>
mutate(date = ymd(str_sub(timestamp, 1, 8))) |>
select(article, date, views)
}The controls let visitors choose up to six chart types, a date range and the y-axis scales. ‘Fixed’ gives every panel the same scale for comparing counts. ‘Free’ gives each panel its own range, making individual patterns easier to see. ‘Log 10’ helps when counts differ greatly, while ‘Normal’ keeps the original spacing between counts.
I’m using {bslib} to arrange the controls above the plot, keeping everything compact enough for this page. The plot card can also expand when six charts need a little more elbow room.
logo_file <- c(
"www/logo.png",
file.path("project", "thicken", "www", "logo.png")
) |>
purrr::keep(file.exists) |>
head(1)
logo <- paste0(
"data:image/png;base64,",
openssl::base64_encode(readBin(logo_file, "raw", file.size(logo_file)))
)
ui <- bslib::page(
theme = bs_theme(
bootswatch = "simplex",
primary = "#9986A5",
font_scale = 0.95
),
tags$style(
".app-title {
display: flex;
justify-content: center;
align-items: center;
gap: 0.5rem;
padding: 0.5rem 0;
font-size: 1.1rem;
}
.controls {
padding: 0.75rem 1rem;
}
.card-header {
padding: 0.5rem 0.75rem;
}
.card-body {
padding: 0.75rem;
}
.shiny-input-container {
margin-bottom: 0.75rem;
}
.control-label {
margin-bottom: 0.15rem;
}"
),
tags$header(
tags$img(src = logo, height = "32px", alt = "Plot Plotter logo"),
"Plot Plotter",
class = "app-title"
),
div(
class = "controls",
layout_columns(
col_widths = c(6, 6),
dateRangeInput(
"dates",
label = "Date range",
start = "2015-07-01",
end = NULL
),
selectizeInput(
inputId = "article",
label = "Chart type",
choices = charts$chart,
selected = c(
"Violin plot",
"Dendrogram",
"Histogram",
"Pie chart",
"Q–Q plot",
"Error bar"
),
options = list(maxItems = 6),
multiple = TRUE
),
selectInput(
inputId = "scales",
label = "Fixed or free y-axis",
choices = c("Fixed" = "fixed", "Free" = "free"),
selected = "fixed"
),
selectInput(
inputId = "log10",
label = "Log 10 or normal y-axis",
choices = c("Log 10" = "log10", "Normal" = "norm"),
selected = "log10"
)
)
),
card(
full_screen = TRUE,
plotOutput("line")
)
)The server fetches the selected articles and draws one panel per chart with {ggplot2}. A straight trend line summarizes each article’s views across the selected period. With ‘Normal’, the fit uses the view counts, while with ‘Log 10’ it uses their logarithms. It is a broad summary, so bumps and changes of direction still deserve a look.
To avoid fetching the same history repeatedly, I wrap the page-view function in {memoise}. Each browser session gets its own in-memory cache, managed by {cachem}, with a 32 MiB limit and a one-hour expiry setting. Changing the date range filters the data already retrieved, while changing the scale redraws the plot. Returning to a previously selected article can reuse its cached history while that entry remains available.
server <- function(input, output, session) {
pv_cached <- memoise::memoise(
pv,
cache = cachem::cache_mem(
max_size = 32 * 1024^2,
max_age = 3600
)
)
pv_history <- reactive({
req(input$article)
end_date <- today()
input$article |>
map(pv_cached, end_date = end_date) |>
list_rbind() |>
mutate(article = str_replace_all(article, "_", " "))
})
pv_df <- reactive({
pv_history() |>
dplyr::filter(date >= input$dates[1], date <= input$dates[2])
})
output$line <- renderPlot({
p <- ggplot(
pv_df(),
aes(date, views, colour = article)
) +
geom_line() +
geom_smooth(method = "lm", formula = y ~ x, colour = pal[7]) +
scale_colour_manual(values = pal) +
facet_wrap(~article, ncol = 3, scales = input$scales) +
theme(
legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1, size = 8),
axis.text.y = element_text(size = 8),
strip.text = element_text(size = 9),
plot.margin = margin(5, 10, 5, 10, "pt"),
plot.caption = element_text(size = 8, hjust = 0)
) +
labs(
x = NULL,
y = NULL,
caption = "Source: Daily Wikipedia Article Page Views"
)
switch(
input$log10,
norm = p,
log10 = p +
scale_y_log10(
labels = label_number(scale_cut = cut_short_scale())
)
)
})
}shinyApp(ui, server)The app below runs R and {shiny} in your browser through WebR, using the {shinylive} (Chang et al. 2026) Quarto extension. There is no hosted R session behind it. You still need an internet connection to load the runtime and packages and retrieve Wikipedia data, and the first load can take a little patience.
If the app doesn’t load
An intermittent loading problem can sometimes show a ‘404’ inside the app. A reload or a new private browsing window may help, though neither is a guaranteed fix. The cause is still being investigated.
#| standalone: true
#| components: [viewer]
#| viewerHeight: 700
library(dplyr)
library(ggplot2)
library(lubridate)
library(purrr)
library(stringr)
library(tibble)
library(shiny)
library(bslib)
library(rvest)
library(scales)
library(httr2)
library(wesanderson)
charts <-
tibble(
chart = read_html(str_c(
"https://en.wikipedia.org/wiki/",
"Category:Statistical_charts_and_diagrams"
)) |>
html_elements(".mw-category-group a") |>
html_text()
)
pv <- function(article, end_date = today()) {
request("https://wikimedia.org/api/rest_v1/metrics/pageviews/per-article") |>
req_url_path_append(
"en.wikipedia",
"all-access",
"user",
URLencode(article, reserved = TRUE),
"daily",
"2015070100",
str_c(format(end_date, "%Y%m%d"), "00")
) |>
req_perform() |>
resp_body_json(simplify = TRUE) |>
pluck("items") |>
as_tibble() |>
mutate(date = ymd(str_sub(timestamp, 1, 8))) |>
select(article, date, views)
}
theme_set(theme_bw(base_size = 11))
pal <- wes_palette(8, name = "IsleofDogs1", type = "continuous")
logo_file <- c(
"www/logo.png",
file.path("project", "thicken", "www", "logo.png")
) |>
purrr::keep(file.exists) |>
head(1)
logo <- paste0(
"data:image/png;base64,",
openssl::base64_encode(readBin(logo_file, "raw", file.size(logo_file)))
)
ui <- bslib::page(
theme = bs_theme(
bootswatch = "simplex",
primary = "#9986A5",
font_scale = 0.95
),
tags$style(
".app-title {
display: flex;
justify-content: center;
align-items: center;
gap: 0.5rem;
padding: 0.5rem 0;
font-size: 1.1rem;
}
.controls {
padding: 0.75rem 1rem;
}
.card-header {
padding: 0.5rem 0.75rem;
}
.card-body {
padding: 0.75rem;
}
.shiny-input-container {
margin-bottom: 0.75rem;
}
.control-label {
margin-bottom: 0.15rem;
}"
),
tags$header(
tags$img(src = logo, height = "32px", alt = "Plot Plotter logo"),
"Plot Plotter",
class = "app-title"
),
div(
class = "controls",
layout_columns(
col_widths = c(6, 6),
dateRangeInput(
"dates",
label = "Date range",
start = "2015-07-01",
end = NULL
),
selectizeInput(
inputId = "article",
label = "Chart type",
choices = charts$chart,
selected = c(
"Violin plot",
"Dendrogram",
"Histogram",
"Pie chart",
"Q–Q plot",
"Error bar"
),
options = list(maxItems = 6),
multiple = TRUE
),
selectInput(
inputId = "scales",
label = "Fixed or free y-axis",
choices = c("Fixed" = "fixed", "Free" = "free"),
selected = "fixed"
),
selectInput(
inputId = "log10",
label = "Log 10 or normal y-axis",
choices = c("Log 10" = "log10", "Normal" = "norm"),
selected = "log10"
)
)
),
card(
full_screen = TRUE,
plotOutput("line")
)
)
server <- function(input, output, session) {
pv_cached <- memoise::memoise(
pv,
cache = cachem::cache_mem(
max_size = 32 * 1024^2,
max_age = 3600
)
)
pv_history <- reactive({
req(input$article)
end_date <- today()
input$article |>
map(pv_cached, end_date = end_date) |>
list_rbind() |>
mutate(article = str_replace_all(article, "_", " "))
})
pv_df <- reactive({
pv_history() |>
dplyr::filter(date >= input$dates[1], date <= input$dates[2])
})
output$line <- renderPlot({
p <- ggplot(
pv_df(),
aes(date, views, colour = article)
) +
geom_line() +
geom_smooth(method = "lm", formula = y ~ x, colour = pal[7]) +
scale_colour_manual(values = pal) +
facet_wrap(~article, ncol = 3, scales = input$scales) +
theme(
legend.position = "none",
axis.text.x = element_text(angle = 45, hjust = 1, size = 8),
axis.text.y = element_text(size = 8),
strip.text = element_text(size = 9),
plot.margin = margin(5, 10, 5, 10, "pt"),
plot.caption = element_text(size = 8, hjust = 0)
) +
labs(
x = NULL,
y = NULL,
caption = "Source: Daily Wikipedia Article Page Views"
)
switch(
input$log10,
norm = p,
log10 = p +
scale_y_log10(
labels = label_number(scale_cut = cut_short_scale())
)
)
})
}
shinyApp(ui, server)
## file: www/logo.png
## type: binary
iVBORw0KGgoAAAANSUhEUgAAAmUAAAJlCAYAAACbj4UnAAAACXBIWXMAAAsSAAALEgHS3X78AAAgAElEQVR4nO3deZSl11nf+291Vc+j1HLLmqfWLMuSPMmYaXkAbIwTAiSASezYBBwTB4jjAE5YKzErI3DBDHcFXxLb10wGEi+GCxhiG9t4kKzJkjVLrW5rHnqeh6q6f+xzXOecPjWf/ex3+H7Weteprm7t531b1XV+9bz73RskSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSZIkSbUzVvoEJA21Cvgu4HuA64FLgJXAceAR4A7gE8DngMlC5yhJktRYa4D3Ai8A0ws4HgZ+CH/AkiRJGpmrgPtYWBgbPP4c2Bp/ypIkSc3yTcABlhbIertm50afuCRJUlNcwcJvV8533Adsij19SZKk+psgTdofRSDrHh+JvABJkqQmeDejDWTd41siL0KSJKnOJoBd5AllfxF4HZIkSbX2I+QJZNPAFLAt7lIkSZLqaQXwAPlC2TTww2FXI0lathWlT0Bqqb8HXJm5xvWZx5ckjZChTCrj3QE1zg+oIUkaEUOZFO9K4HUBddYE1JAkjYihTIr3s8TsVXksoIYkaUQMZVKsC4G3BtV6PKiOJGkEDGVSrPcCK4Nq3RZUR5IkqVa2AIfIuwxG9zgKbIy5LEnSKNgpk+K8HVgfVOuvgYNBtSRJkmrlPmK6ZNPAu4KuSZIkqVZuJi6QTQEXxFyWJGlUvH0pxXhHYK0v4pOXkiRJp1kH7CeuU/YvYy5LkiSpXv4xcYFsGrgs5rIkSZLq5dPEBbJ7g65JkjRizimT8roE+PbAen8aWEuSNEKGMimvtxOzz2XXJwJrSZIk1cIKYBdxty4fi7ksSVIOdsqkfF5L2oA8yh8G1pIkSaqN3yX2qcurYi5LkiSpPjYDR4gLZJ+PuSxJUi7evpTy+EfA2sB6HwqsJUmSVBtfJK5LtpfYAChJklQL24mdS/YbMZclScrJ25fS6P1IcL3/GVxPkiSpFh4mrkt2V9A1SZIys1MmjdbNpNuXUeySSZIkDfGbxHXJjgNbYy5LkiSpPlYCzxMXyv4o5rIkSZLq5XuIferyjTGXJUmSVC8fJy6QPQ6Mx1yWJElSfWwidlul/xBzWZIkSfXyTuIC2SRwYcxlSZIk1cvniQtlfxl0TZIkSbVyGXGBbBr4vpjLkiRJqpcPEBfIniEtvSFJkqQeK4CdxIWy/xpyVZIkSTXzemJvXV4ec1mSJEn18nvEBbLPBF2TJElSrWwBjhIXyn445rIkSZLq5d3EBbLdwOqYy5IkSaqX24gLZb8adE2SJEm1cj1xgWwauDbmsiRJkurlV4kLZF8KuiZJkqRaWQU8T1wo+7GYy5IkSaqX7ycukB0BNsdcliRJUr38BXGh7PeCrkmSJKlWzgNOERfKviPmsiRJkurl54gLZI+T9taUJEnSgIeJC2X/KeiaJEmSauVbiQtk08AVMZclSZJULx8hLpB9MeaSJEmS6mUjcJi4UPbjMZclSZJUL/+MuEB2FNgSc1mSJEn18iXiQtkfBF2TJElSrVxDXCCbBr4r5rIkSZLq5ZeIC2RPAeMxlyVJklQfK4FniQtl/zXmsiRJkurle4m9dXllzGVJkiTVy58RF8g+H3RNkiRJtXIOsZuPvz3kqiRJkmrmZ4gLZAeA9TGXJUmSVC8PEhfKPhR0TZIkSbXyLcQFsmnglTGXJUmSVC8fJi6Q3RN0TZIkSbWyEThEXCj7qZjLkiRJqpfIzcePA2fFXJYkSVK9RG4+/sdB1yRJklQr0ZuPvzHmsiRJkuolcvPxJ3DzcUmSpNOsBJ4jLpT9x5jLkiRJqpfvJy6QTQGXxVyWJElSvfwVcaHsc0HXJEmSVCsXAZPEhbJ3xFyWJElSvfwH4gLZYdICtZIkSeqxAnicuFD2/8ZcliRJUr28ibhANg28LuayJEmS6uUTxAWyXcBYzGVJkiTVx7nASeJC2S/EXJYkSVK9/Dyxty63x1yWJElSfawg3U6MCmRfiLksSVIdrSh9AlJBbwQuDKz30cBakiRJtfGnxHXJjgKbYy5LkiSpPi4mdgX/Pwi5KklSbXn7Um31HmK//r11KUmSNGADsI+4LtnTwHjIlUmSastOmdro7cTO7/pd0q1SSZIkdYwBDxHXJZsGbgy5MkmSpBr5+8QGsntjLkuSJKk+LgCeIzaUvT/kyiRJkmrkb4gNZFOkpTckSZrXROkTkIK8BXh9cM0vADuDaw4aB1YDa0lPnW4E1nd+vRpY0/ncxp7f7/14EjhE6jB+HTgArCR97zgBHCM9MLSt89+c6tTcB+zt/Le7SfP49me+VkmqNUOZ2uLnC9T83UX82W5oWs/sAan348HPdf/b9aSgtbpzVGUpjmngNuBjwG+TdjiQJPUYK30CUoBriJ9wP0kKICtIgav3WEcKT71hqk3L0zxFWrz3f5c+EUmqEkOZqmKM1OFZN+To3m5bA6widYCGvU6Qbq0NHjcCL4m7FC3QfwN+pvRJSFJVGMo0n27oWT3w8Rr6Oz+9naDubbTeTlDvx8OC11r8emwjg5kkdfgmuDxjwBmkeTsHSZOeo6yiv5PUG3C6Aao3RPWGpsG5SL1Hb4BahV8jyu/78FamJPmGu0hrgO8G3gjcDFxOCi5dTwNfJj2l1l0SYbrzeyuZCUjdY/B220TnGB84Jpi5tdcNVlWZwC0t11Okf0tHSp+IJJVkKFuYTcD7gJ8gdcYkjdZPAR8sfRKSVJKhbH5vAv4H8OLSJyI12F24R6ikljOUze3ngP+If09ShK3AntInIUmltGltpMX6d8B/wkAmRbmu9AlIUkmGsuH+AfALpU9CapnNpU9AkkoylJ3uRaRtYCTFmip9ApJUkqHsdB/AJyylEi4vfQKSVJKhrN+LgX9a+iSklvq20icgSSUZyvq9lbSoq6R4r8UHayS1mKGs3/eUPgGpxTYBF5U+CUkqxVA2Y5y0dZKkcs4ufQKSVIqhbMaFeOtSKs3vSZJay2+AM7aWPgFJPFf6BCSpFEPZDP8upLIOADtKn4QklWIQmbG39AlILfcAMF36JCSpFEPZjJ3AydInIbXYk6VPQJJKMpTNOAk8VPokpBY7v/QJSFJJE6VPoGK+Dlxb+iSkQMeBw8Ax0g8mx3s+d6hzXAzcEHAu2wJqSFJlGcr6PVv6BKQe06Sw1D2ODvn4CGmC/MHOMezjQ50/f7znvz3S+fypBZzH34zqguaxIaiOJFWSoayfbwpaimPA/iFHNxwdGji6n+t2qLrH8SG/roKo7rHTKSS1mqGs36bSJ6AQJ5kJRwfpD0qDn5vt40OkTtR+qhOectgInBNU61hQHUmqJENZv3WlT0DzOkEKQ4PH3iHHns5r7228gzQ7RI3alYG1DgXWkqTKMZT1c1X/5TtBmq90dJbXI6TbdocHPp7v1waqMiJD2TOBtSSpcgxl/dq0GfIUKSjNdhymvxO1f+DXg7fyuh+71luzXBVY67HAWpJUOYayGSuBM0qfxCxOkAJPt2N0eMjR7SodpH+yeTdEDf455+9oISI7Za4TKKnVDGUztgFjAXXuZWbO0z6Gz4Ua/PyRgPOShokMZV8LrCVJqrCbSOtC5TwMV6qTMdLXbO5/F91je8xlSVI1uS7QjBcF1NgfUEMalYuAtUG1jgI7gmpJUiUZymZEbPFiKFOdRE7yf5D08IkktZahbIahTOp3dWCthwNrSVIlGcpmRNy+3BdQQxqVyE6ZT15Kaj1D2YyzAmoYylQndsokKZChbEbEav6GMtVJZCizUyap9QxlMyI6ZXsDakijcBYx/ya67JRJaj1D2Qw7ZdKMyC7ZXuCFwHqSVEmGshnOKZNmeOtSkoK5zVIyTkynzCUxVBdO8peqZStwDamBMAk8RdqazH2MG8RQlmwlpmtop0x1YadMKm8V8KPAO4EbOX1/5uPAp4APAn8de2pSPtcRs7ffq6MuSFqmXcTtefmDQdck1cl3AI+x8H9Hf0PaGk2qvdcR8+YT2X2Qlmo9acujqFB2U8xlSbXxftItysX+W3oOeE2B85VG6oeIefM5J+qCpGV4GXGBbBrYGHNZUi38DMv793QAuDb8rDUSPn2ZnB1Ux4n+qoPIju4zwMHAelKVvQH4z8scYyPwp8C65Z+OohnKkojNyE8CRwLqSMvlJH8p3lrg1zl9Mv9SXAr89AjGUTBDWRLRKfPJS9WFoUyK99vAlSMc79+Qgp5qxFCWGMqkGYYyKdbbgR8e8ZibSLdDVSOGssRQJiUrge2B9Vw4Vm23CfjFTGO/LtO4ysRQlkTMKTOUqQ62E7uotJ0ytd2Pkm+bv4szjatMDGVJRCjzyUvVwVWBtaaARwPrSVX0YxnHdrmZmjGUpS/aNQF17JSpDiLnk32dtE2M1FavYrST+wfZDKgZQ1lMlwwMZaqHyE6Zty7Vdj+XefxHMo+vETOUGcqkXpGdMif5q81uBv5e5hpfyDy+RsxQZiiTeuW8lTLITpna7P0BNR4IqKERMpTle+plkPf2VXXnEzsx2FCmtroKeHPmGtOkeZuqEUMZbA2qY6dMVRc5nwy8fan2+ueMZjuluezArf1qx1AW1ykzlKnqIueTnQB2BtaTqmIN8I8D6vxtQA2NmKHMUCZ1RXbKHgMmA+tJVfEW4IyAOh8PqKERM5R5+1Lqcs9LKb+3BtS4D/g/AXU0YoYyJ/pLXT55KeV1PvDGgDr/ljTRXzVjKIsJZaeAgwF1pKXaAJwbWM9H9dVG/xZYmbnG48CfZK6hTAxlMbcv9wbUkJbjiuB6hjK1zcXAOwPq/C/sktVW20PZCmImXO4OqCEtR3Qouz+4nlTaz5O/Swbw4YAayqTtoexMYv4O9gTUkJYjMpS9gD+oqF0uImYZjC8BdwfUUSZtD2VRk/x9A1LVRYYyb12qbd5HTJfsNwNqKKO2h7Izg+rYKVPVRT556a1LtcmLiZlL9izwRwF1lJGhLIadMlWdnTIpj/eQVvHP7ddIO2WoxtoeyiIm+YOdMlXb2cCmwHp2ytQW64AfD6jzAvAbAXWUWdtDmZ0yyeUwpFz+CTHLLv1n4EBAHWVmKIthp0xVFjmf7CiwK7CeVMoY8FMBdSaB3wmoowCGshh2ylRlkZ2yh4CpwHpSKW8i5geevwWeC6ijAG0PZc4pk5zkL+Xwr4LqfDyojgK0PZTZKZMMZdKovRR4bUCdE6RtldQQhrIYdspUVePAZYH1fPJSbfAvgur8Gb6/qEEeJG3cmvM4FnY10uJtJ/+/gd7jpTGXJRWzBThMzL+ntwRdk4LYKcvPW5eqssgnL6dJE/2lJns7aX2y3J4B/jKgjgK1OZSNETPR31CmKosMZbtIS2JITTUGvDuo1m8DJ4NqKUibQ9kW0nya3AxlqrLIUPZgYC2phDcAlwfUmQR+K6COgrU5lJ0VVOeFoDrSUhjKpNH5iaA6fwY8EVRLgdocyiK2vgA7Zaq2qwJrGcrUZBcBbw6q9etBdRSszaEsqlNmKFNVbSZtRh7FNcrUZD9OzHvqvcCnA+qogDaHMjtlarvIW5dgp0zNtQp4Z1Atu2QN1uZQZqdMbRcZyg4BTwbWkyJ9P7AtoM4e4GMBdVRIm0NZVKfMif6qKif5S6MRtQzGbwFHgmqpgDaHMjtlajtDmbR81wOvCahzEvjNgDoqqM2hzDllajtDmbR8UV2yP8QpAGqwzxKzN1nUpufSYqwgra4fteflP4y5LCnUJuAgMf+GXhZ0TSrITlleU8DegDrSYl0ErAmsZ6dMTfQjwIaAOp8Hbg+oIxXzDPl/snGSv6rqu4jrkk0Ba2MuSwp1DzH/hr436oJUlp2yvPYE1JCWInI+2ddxI3I1zzcD1wXUeRT4k4A6qoC2hrLNwERAHW9dqqoit1d6KLCWFOVdQXV+ldRtVgu0NZRFPXlpKFNVGcqkpTuLtGBsbnuADwfUUUW0NZRFrVFmKFNVXR1Yy0n+app3AKsD6vwWcDigjiqiraHMTpnabAuxG5HbKVOTrCBtPp7bCdznsnXaGsqiOmX7gupIixF56xIMZWqW7wIuDajz+8DTAXVUIYayvOyUqYoiQ9lxYFdgPSm3qBX8fzmojiqkraHM25dqs8hQ9ig+OabmuAR4Y0CdvyatgaaWaWsos1OmNosMZU7yV5O8h5j3TbtkLWUoy8tQpipyOQxp8TYB7wyocw+pU6YWMpTlZShT1awELgusZyhTU7yTFMxys0um1onar+zioOuRFuoq4va8nCZtRSPV3TjwGPn/vTwFrAq6JlWQnbK87JSpalwOQ1q87yfmh+xfJ61PJrXKCfL/xDMJjEVdkLRAP0tcl8wfStQUt5H/38sh4IyoC1I1tbFTtpk0rya3faR/aFKVOMlfWpxvB14WUOcj+INM67UxlEWtUbYnqI60GIYyaXHeF1BjCvhgQB1VXBtDmfPJ1GZXBtZ6ILCWlMO1xCwW++fAwwF1VHGGsnzslKlqtpE2I49iKFPdvZeYucG/FlBDNWAoy8dQpqq5Irje/cH1pFE6F3hrQJ0HgU8F1FENtDGUOadMbRUZyiaBRwLrSaP2k8SsGfZ/B9RQTbQxlDmnTG0VGcp24HpLqq9NwLsC6hwGPhpQRzVhKMvHTpmqJjKUOZ9MdfbjxGyp9AfA/oA6qglDWT6GMlVNZChzPpnqahXwU0G1/ntQHdVEG0OZc8rURiuA7YH17JSprn6ENMk/tztIOwVI3zBR+gQKcE6Z2ugiYHVgPUPZ4qwhrSF3Dum22WXA2aQlTDaSHpx4gfTwxK3ALcDJImfabOPELBYLdsk0hKEsHztlqpLo5TAMZfPbDLyNtNn1zSxu+7d9wF3AUeB45zi2iNcjPcfhIb+eXNaV1dePErPrxUHg9wPqqGbaGMrODKpjKFOVRIayZ7FTPJcNwE8D/4qlL+a7hbQnYy4nSeGtN8j1Hic6f+bUEl9P9ozR+/Fsr4OfGzynUYTITcAHRjDOQvwOaQNyqU/bQtl6YjYjB0OZqsUnL6vhJuDjxM7vW4qVnWNj6RNZoFPMHSKHhcpuuOt+/K2kXS8i/FZQHdVM20JZVJfsCK7RpGpxz8vyfpC0JlXEgqRtM0HqQG4ofSILdBepuzfVOSYHXmf7eHLg87Mdp+jvTp4a8rmTQz7u/rr3dvdR0i3tg6Tu3hHS1lNrSXPwDpHWJXx+pH9DLWUoy2N3UB1poeyUlfVm4GO073uuZjfeOZpiB/CXwFeBaVJo20/aaP1OUsjTPNr2DeKMoDovBNWRFmINcGFgPdco63ct8Ie07/ut2uVS4Cdm+b2jwP9H2lLqM2FnVENtW6fMTpna6HLS7YYodspmjAEfJnUNpLZaS3rK+NPA54Ebyp5OdbUtlNkpUxtFzic7Anw9sF7VfR/witInIVXIN5PW2ftnpU+kitoWyuyUqY0iQ9mDpPkkSt5T+gSkCloFfAh4d+kTqZq2hTI7ZWojJ/mXsY3UFZA03G8AnwV+gLjlqiqtbaHMTpnayOUwyngN7fseKy3GGGl9uD8kbSH2trKnU17bvmFEhTI7ZaqSyFDmk5czXlL6BKQauRD4CPA3xC3iWzltC2VRty/tlKkqtrH0rXyWwk7ZjAtKn4BUQ68HvkJ6arx12hbK7JSpbSLnk02RFopUsq70CUg1dSHwt8D5hc8jXNtCmZ0ytU3krcuduGp3L/8upKU7F/gELXsAoG2hzE6Z2sb5ZOW4F6C0PC8Hfqb0SURqUyibADYH1DlO2rxVqgKfvCzn6dInIDXAzwJnlz6JKG0KZa5RpjZyjbJyXERXWr71zL6nZuO0KZRtDarjfDJVxQRwWWA9Q1m/m/D7gTQKbyN2/95i2hTKnE+mtrmE2EmyzinrdzWwpvRJSA1wIfDS0icRoU2hzE6Z2iZyPtkL+LXfa4wUytaXPhGpIV5d+gQiGMpGzzcmVYWT/Mu5HNhY+iSkBtle+gQitCmUue+l2ubqwFoPBtaqg5eXPgGpYaIe1iuqTaHMTpna5qrAWg8F1qoDQ5k0WidLn0CENoWyqE7ZnqA60nwiO2WGsn6vKH0CUsPsKn0CEdoUyuyUqU1eRNwPIuDty17jpOUwJI3OnaVPIMJE6RMIFPUG9a+BHyP93Q4e46QFJXsPhnxu2O9PzXPM92dG8fuLOd/BY2qZr7ONPQWc6hyTPR93j5M9xyT9xkg/mAy+dn9YmevaBn9/vl9PD9SZ7ejWnyAtZ7GWtLF192vnOOlJxz2dP7+yc12Hgec6fx8Q2yWbAh4NrFd119KMzcinSF9b3X+DvV+7vR9LuZ0Cvlj6JCK0KZRFdcq+LaiONOg46SnIzxA7/2IncCKwXtVFrac0TXrC9iinh/puWOr+UDU58Drf57rhfiEGa4/3vI4P+XXvDx6Df36ukLeQHRIGr2nwda4fJnvP5TrgB4HXARfMUutp4MvAX5E6xd0fvJfy2v0hrPcY9rnZju5Y8/3dD/v1sGZB7w+Sqzp/BtL3lWOdemfN8veSwxeA/YH1imlTKIu8lSOVsJoUCKIXWXQ+Wb+ov/8ngIeDas2lt2vdFE8Cn+x8fA5piZMzSde4G9hBu/c2/Wbg84H1PhpYq6g2hbKoTpnUNoayfi8JqvNIUJ22e5p2B7Bhrg+s9Tjwe4H1imrLRP/VuLK2lIuhrN8lQXUMZSrlhsBav0qamtEKbQlldsmkfAxlM8aAi4JqVeHWpdopMpR9JrBWcYYySctlKJtxLmlidIR7gupIvcaJu0V/ELg7qFYltCWURT4lIrXJMdKcDyVRXTJo2ZuVKuMqYE1QrS9z+lJGjWYok7Qcj9Csp+6W67ygOs8CTwXVknpFPt3dirXJehnKJC2Hty77RYWyLwfVkQZFhrIvBdaqhLaEMueUSXkYyvoZytR0kYsj3xpUqzLaEsrslEl5GMr6Rc0p+7ugOtKgqCcvHwT2BtWqDEOZpOUwlPW7PKDGMeArAXWkQWd3jgit7AYbyiQth2tl9dseUONWWrSYpirF+WSZtSWUOadMGr0DwHOlT6JCXgxsCKjzuYAa0jCGsszaEsrslEmj563LflcF1TGUqZSo+WQHgHuDalWKoUzSUnnrst81ATWmaelcG1VCVKfsVlq6/mEbQtlqYm4pSG1jKOt3dUCNh0lbz0jRVgNXBtVq5a1LaEcocz6ZlIe3L/tFdMpuD6ghDXMtMBFUq3Ur+Xe1IZR561LKw05ZP0OZmixqPtk0cEtQrcoxlElaKkPZjDNIT1/mZihTKVHzyR6ghYvGdhnKJC3Fblr8jXOIqEn+dwbUkYaJ6pS1dj4ZtCOUnVn6BKQGcj5Zv4hQ9giwP6CONMz1QXUMZQ1nKJNGz1uX/SJC2R0BNaRhLga2BNUylDWcoUwaPUNZv2sDahjKVErUfLL9wH1BtSrJUCZpKbx92S+iU3ZPQA1pmKj5ZLeQ5k62VtSaIyUZyhZvCpjsvE4v83W235sETvUcJwd+PdlzDlNDPp4c+Lj3OAmcGHjtftx7TnMdDLx2j97zGDyv6SFjD/v8sPoAY51jvHNMAGuB9cDKzp/bQ5pkv6fz30x0ru1NwK8Tx07ZjM3AeQF1DGUqJapT1upbl2AoG6X/i3R7oftmOk7qRPam/sE3++7H3Tf7YcdgQDk1x58d9t/2Boe5Qk73tdU/pdTY+cH1DGUzIrpke4EnAupIw0R1ylq/hZihbHT+BDcKVjlRm2EDPAkcCqxXdRHzyb4WUEMaZhNpon9u7uuKc8pGyTWbVFJkKHswsFYdRISyuwNqSMPcQJpWkdsDwL6AOpVmKBudPfP/ESmLCeCywHpO8u/nJH812Y1BdVo/nwyaH8rWkXa2j2AoUymXETsVwU5Zv4hOmaFMpRjKAjU9lEV1yY4BR4NqSYMib12CoaxXxJOX0xjKVI6hLJChbDScT6aSDGXlbA+osQM4GFBHGrSamNvzrV80tstQNhreulRJVwbWOg7sCqxXdRGh7K6AGtIw1xEzNaL1i8Z2GcpGw1CmkiI7ZY+S1rNTYihTk90UVKf1S2F0GcpGw1CmklwOoxxDmZrM+WTBmh7KtgbVcU6ZStkGnBFYz1DWL2IpEkOZSokIZdOk25ei+aHMTpmaLnI+GbhG2aDcnbLduL2SyhgHrg+o8xA2Nr6h6aEsqlNmKFMpPnlZznrgnMw1vpp5fGk2V5LW+szNLlkPQ9lovBBURxpkKCvn0oAatwfUkIZ5WVAdQ1mPpocyb1+q6SJD2e7OoSQilPmGpVKinry8NahOLTQ9lEV1ynyjUimRocz5ZP0iJvkbylRKRKfsGN6i79P0UBbVKTOUqYTVwMWB9R4IrFUHuTtlT+Ikf5WxgpgnL+8CTgbUqY2mhzI7ZWqy7cT+G3Y+Wb/cocwumUq5AtgQUOe2gBq10uRQth5YFVTLUKYSopfDsFPWL/ftS0OZSnE+WSFNDmVRXbKjnUOKFv3kpaFsxgry3zo2lKmUqCcvvxJUpzYMZctnl0ylRHbKTgE7AutV3SXk7cRP4q0dlRMRyg7glIjTNDmUOclfTRcZyh7FCbm9rsk8/n3A4cw1pGHGiJnkfxtpiyX1aHIoczV/NV1kKPMn2n65Q9mdmceXZrMd2BRQx1uXQxjKls9OmUrYBmwJrOd8sn5XZx7/jszjS7NxPllBhrLlM5SpBLdXKstQpqaKCmU+eTlEk0OZc8rUZC6HUVbOUDZNWlRTKiEilD0LPB5Qp3aaHMrslKnJDGXlvBjYmHH8HcDBjONLsxkjZo0yu2SzMJQtn6FMJUSGshfwgZZeF2Qe3y6ZSrkU2BxQx/lkszCULZ+hTCVEhjK7ZP3Oyzy+oUylOMm/sCaHMueUqalWkX/fxV5O8u93fubxneSvUgxlhTU5lLlOmZrqMmA8sJ6dsn7nZB7fNyyVEjGfbAc2M2bV1FC2AqxGP3AAACAASURBVDgjqJZfXIoWPcnfTlm/nF34XcDzGceX5hIRyvyhYw5NDWVbiLm2aeyUKZ5PXpaVM5R9IePY0lwuJGbaj09ezqGpoSxqPtk+YCqoltQVGcpOAo8F1quDnN9fPpdxbGkuEftdAtwSVKeWmhrKfPJSTRa9EfmpwHp1cG7GsT+bcWxpLjcE1DiFD7LMyVC2PIYylRC5xZLzyfqNkzZszmEX3ipWORGdsruBowF1astQtjyGMkU7i7jb82AoG3QpaUmSHP4i07jSQkR0yrx1OY+mhjLXKFNT+eRlWTm7lIYylXImcFFAHUPZPJoaylyjTE1lKCsr10bkJ4FPZxpbmk9Elwx88nJehrLlsVOmaIaysnJ1yh4AjmQaW5pPRCjbj3Mm52UoWx5DmaJFTvLfQ9qMXDMuyzTuPZnGlRYiYpL/V0hre2oOTQ1lzilTU0V2yuySne6STOPenWlcaSGc5F8RTQ1ldsrURBPk69QMYyjrtxI4L9PYd2YaV5rPGvLNlexlKFsAQ9nyGMoU6VJSMItiKOt3KXm+Z07jBGiVcx1p/b3c/BpfAEPZ8hjKFMlJ/mXlnOS/L9PY0nwi5pPtAp4NqFN7TQxlq4ANQbWeD6ojgaGstFx//1/KNK60EBGhzFuXC9TEUBY1yf8obhehWJFPXk4CjwTWq4OXZxrXNyyVZCirkCaGsqhbly4VoGiRoWwncCKwXh18W6ZxXQ5DpawArg+oYyhbIEPZ0hnKFM3lMMq5DNiWaez7M40rzedKYF3mGqeAOzLXaIwmhjLXKFMTnUnajDyKoazfqzKN+wxO8lc5Ebcu78apPgvWxFBmp0xN5CT/sm7ONK7z9lSS88kqxlC2dHbKFClyPhkYyga9ItO4uzKNKy2EK/lXjKFs6eyUKZKdsnLGSAts5vD1TONKC2GnrGIMZUtnKFOkyFB2AHg6sF7VXUy+tQ93ZhpXms+F5H+/3I8/4C1KE0PZGUF1vH2pSJGh7KHAWnXwkoxjO6dMpUTcuvwKaRsxLVATQ1nU05d2yhRlHDciL+najGP7d61SvHVZQU0MZVGdMkOZolxC2j4sikGhX66HLPYBBzONLc3HUFZBE6VPIAPXKVPTOMm/rFyhbAtpzs1J4BApoA17HXbsA/YCe3pe9wNTmc5VzWMoq6AmhjI7ZWoaQ1lZuZcjWUn6vrXc711TpGD2wizHblLQOzDL68ll1ld9nEma6J/TTuC5zDUap2mhbIJ8T0n1OgocCagjQewaZdM40b/XucCm0iexQCuYCXeXL+G/P8bcoa23gzfbx72vdu2qyy5ZRTUtlG0JqmOXTJEiO2WP45Yova4pfQKB1nSOF41ovCP0h7blHEdIX5fHRnRubWcoq6imhTJvXaqJ3Ii8nDaFslFb1znOHuGYU8zcqVjocXiRr20IfhGh7NaAGo3TtFBmp0xNs5nRvqnNx1DW7+rSJ6A+K4D1nSOXKRYf5rofd3/d7fAN3tI9nPG8FyN3KDsJ3J65RiM1LZTZKVPTRE/yfyC4XtXZKWufFaS5yTnmJ0+Rgtls8/CW8npqkeewDrhimdcxn6/Sjo7jyDUtlNkpU9P45GVZdso0SiuAjZ1jVI4zE9K68+6OdT4+0XMcJwXCDaQFqXP6cubxG8tQtjSGMkWxU1bOVkY36V3KZXXnOKv0ifQwlC1R01b09/almiYylB0GngysV3V2yaSlMZQtUdNCmZ0yNU3kGmUP4ebBvQxl0uI9Dzxa+iTqylC2NIYyRVgBbA+s563LfoYyafHski1D00KZty/VJBeRFvOM4iT/foYyafEMZcvQtFAWtRm5oUwRnORflqFMWjxD2TIYypbGUKYILodRzlryb9gsNc0U8JXSJ1FnhrLFO0ha80XKLTKUuRF5vyuAsdInIdXMvaT3SC2RoWzx7JIpSvRG5EcC61VddJdSagJvXS5Tk0LZOLApoI6hTFEig4HzyfoZyqTFM5QtU5NC2RnE3G7YHVBD2gCcF1jP+WT9DGXS4n2p9AnUXZNCWdQkf0OZIjjJvyxDmbQ4+7DjvmyGssUzlCmCy2GUZSiTFucLuCPIsjUplEVtxmooUwRDWTnnAxtLn4RUM58vfQJNYChbPEOZIlweWOsAbkTey0VjpcUzlI1Ak0LZ1qA6hjJFuCKwll2yfoYyaXGOAbeVPokmaFIos1OmJonslN0fWKsODGXS4tyCi6qPxETpExghQ5ma4mxi1tzrMpT1uybDmKeAXyRtQwNpQvQqYHXPsZ60FEr3dcPA51ZmOC9pFLx1OSKGssXbE1RH7RXZJQNvXw7K0Sn7KvD+ZY4xDqwh7cu5hhTkVpK+j68c8vGwY6Lz360F1vW8zvbxsM+tXuZ1qHkMZSPSpFDmnDI1ReR8MrBT1msr8KIM4351BGNMAoc7R0njpHC2npnAtn6W18HP9Xb+Zvu4Se9LbTCJi8aOTJO++CM6ZSdws1XlF9kpOwE8Gliv6q7LNO5dmcYtYZL0fTDX98JVDA9sG0hLlXSPTUM+HvY5O3t53YXviyNjKFscb10qQmSn7GHSm6ySl2QadxSdsrY40Tn2jmi8VQwPckv53DpitvOrk8+VPoEmaUooGyNmRX9vXSqCT16WkyuU3Z1pXM3vBOl79yi+f49xevdu2DHs93vn5q2d5eM6vic7n2yE6vgFMMwW0jyH3OyUKbcxYHtgPSf597s+w5i7SPsCqv6mgUOd49kM409w+kMWsz2MMXhbt/d1M+l9cQvpLlLO90dD2Qg1JZT55KWa4nzSN94odspmjJMnlDVpPpnyOsXo5+t9EviOEY7X60HghUxjt1JTFo81lKkpfPKynKtJHYhRuzfDmNJCrABelXF8n7ocMUPZ4hjKlFvkfLJp0k+6Sm7KNK7BV6VcQ7qVmcsXM47dSk0JZVFrlBnKlFtkp2wXcCSwXtW9LNO4hjKV8k2Zx7dTNmJNCWU5FnscZlSPaEuziQxlhoV+uTplPkyhUl6dcewjwH0Zx2+lpoQyb1+qKSJDmWFhxgrghgzjPkP5FfjVXjk7Zfcws5erRsRQtjiGMuW0ErgksJ6hbMYVpKUERs3dElTKVvL+kOdTxRkYyhbHUKacLiV2mRpD2Yxc2ysZylRKzluXAHdmHr+VmhLKnOivJrgyuJ6hbMa1mcb16VaVknuSv52yDJoSyqI6ZU70V06R88n2As8F1qu6azKN60RolfKajGNPkeaUacQMZQs3CewPqKP2iuyU2SXrZyhTk6wEXpFx/B24nE4WTQhlK4AzAursIy22KeXik5dl5Npv9BjOKVMZN5J3uza7ZJk0IZSdScx1OJ9MuV0VWMu5TjPOA9ZkGPdrpA67FC33fDJDWSZNCGVO8lcTnAlsC6z3cGCtqsu1tdUdmcaV5pNzPhkYyrJpQihzOQw1Qa45TbN5KLheleXqULpkgErJ3Sm7O/P4rWUoWzifvFROVwfWmsa5Tr1yLYdhp0wlXAycm3H8o8AjGcdvNUPZwtkpU06RnbInSN9YleT4uz+F3QSVkfvW5X24vVI2hrKFM5Qpp8hOmfPJZoyRZ8/L+0hPX0rRXpl5fH/YyKgJocyJ/mqCyE6Z88lmbCfPkjreulQpL888vpP8M2pCKHtRUB1DmXLZCFwQWM9O2YxcXQXXgVMJ46Q1ynKyU5ZRE0JZVKfMif7KJfrJS0PZjFyhzHXgVMK15F00FtzzMqsmhLIzg+rYKVMuuZ7+m41PTs14SaZxDWUqIfety8eB3ZlrtFoTQplzylR31wXWmiLtW6ckx36jk7jkiMrI8dBKL9fey8xQtnCGMuUS2Sl7HDgeWK/KNpBnPaedwIkM40rzeWnm8b11mVkTQlnEZuRgKFM+kZ0yb13OyLUBvLcuVUruUHZ75vFbr+6hbDMwEVDnAGkxSGnUziDv6tuDnOQ/I9eel/dnGleay8Wk98Scvpx5/Nareyhzkr/qzkn+5WzPNO6tmcaV5pK7S/YY8FzmGq1X91DmfDLVnaGsnFxLkdySaVxpLtdnHv9LmccX9Q9lUZ0yHwFWLq5RVk6OzsIzwK4M40rzyR3KvHUZoO6hzE6Z6i4ylLkcxoy15FkOw+2VVIqdsgYwlC2MoUy5RIayJ3CT7K7ryfOQkPsCqoR15JsjCXAU+GrG8dVR91DmRH/V2WZin7x0PtmMmzKNayhTCdeR9/38duBkxvHVUfdQFtUpc06ZcoieT2Yom/GyTOMaylRC7pX8vXUZpO6hzE6Z6uzq4HpO8p9xY4YxTwEPZBhXmo+hrCHqHsqcU6Y6s1NWxgR5liLZgdsrqYwcP2T0MpQFqXsos1OmOrNTVsZVwOoM47q9kkpYAbwk4/g7SUu9KEDdQ9mWoDrOKVMOkaFsCjtlXblu9XjrUiVcA6zPOL7rkwWqeyjLvc9Xl50yjdpa4KLAejuB44H1qizXek52ylTCzZnH99ZloLqHsqhOmaFMo3YFsf/+HgqsVXW5trayU6YSDGUNUudQthpYE1DnIOmpKmmUrgquZxdnRq5Qdm+mcaW5vDrj2MeAuzKOrwF1DmVRty6dT6Ycoif52ylLNgAXZhj3cWBfhnGluWwm7/cSF40NVudQdkZQHW9dKgc7ZWVcAYxlGNdFY1XCq8jz9dx1W8axNUSdQ5lrlKnOct1Cm42dsuTSTOMaylRC7vlkd2QeXwPqHMrOCqpjKNOorQKuDKx3lLQZufKFsrszjSvNJed8MoA7M4+vAXUOZduC6jinTKN2JbAysN4OYDqwXpVdkmlcb/Mo2hjp9mUux4D7M46vIeocys4PqmOnTKOWc/XtYVw0dsZlGcbcj7slKN6V5J1bfQ+uPBDOUDa//UF11B7RoezR4HpVtj3DmLdhJ1Lxcs8n89ZlAROlT2CJxoDXBNU6FFSnTdaQtgVZR/oaHO85VpD+/67oOcZ6fn+i5xjveZ0i/VQ37Jjs/P446bZh979bQXrc+3jPcbLnoFN78FgxUL/36P5+94moI8DhntfD2CkrZTV5lsP4SoYxpfnkDmWuT1ZAXUPZG4lbUqDKoWycNGl8LSnorCG98aztvK4HNvYcG0ihZDBETJGCSzdIdEPHqs6Y6zpj9h6rO2Ot7Py57rhweoDpPdZ1zrvNorsqhrLkavJ87RnKVELuUObDKwXUNZS9NbDWu4BXACc6R7eb0qsbTFaRwkrv0fu5bpemtyvU+zrXxyt7jonOa871aZRP9P83b18mL800rrd5FG0N+ZfVcZmXAuoYysaA7wys902dQ6qjSWBX6ZOoiFdmGHM/8FiGcaW53EDe9++dwIGM42sWdZzofxFxC8dKdfcMKZgpz+0elwxQCS/LPL63LgupayiTtDAuGpusBa7PMO4DGcaU5vPyzON/NfP4mkUdQ9mW0icg1YihLLmRPLd7nK+nEgxlDVXHUObkdmnhnix9AhVxQ6ZxDWWKto70JHFOLodRSB1D2bOlT0CqETtlSa5QtiPTuNJsbiDvskIH8Ou6mDqGsodKn4BUI4ayJNdyGL55KVqur+Wuu3CHimLqGMp242KY0kIZylJXIccuCruB5zOMK80lV9e369bM42sOdQxlAH9a+gSkmnANrTT/Zm2Gce/NMKY0n9ydslsyj6851DWU/c/SJyDVwGHgqdInUQG53sRcy0nRVpB/71xDWUF1DWX3YrdMms8dpH1N2y7H+mTgsgGKdznp6ctcngIezzi+5lHXUAbwPpyMKM3lb0ufQEVck2lcb18qWu75ZF/MPL7mUedQtgPXLJPm8uelT6AicoUyV/NXNENZw9U5lJ3qHJJOdx8+RQXpVs/FGcZ9AtibYVxpLrn3vPxS5vE1jzqHMkibLUs63a+UPoGKuJ483+dc8Vwl3JRx7OOkeagqqO6h7GulT0CqoAeBj5Q+iYrI1VnwyUtFuwjYmnH824ETGcfXAtQ9lH2m9AlIFTMFvANv7XflWg7jnkzjSrPJ2SUD55NVQt1D2R+XPgGpYv41fnPtdV2mcd1VRNFuzDz+VzKPrwWoeyjbAfxl6ZOQKuIDOJdsUK4nL3dmGleaTe6V/G/PPL5a4ibSrZppD4+WHgeBt6NB28jz97078iKkjp3k+x7ik8QVUfdOGaSnRX659ElIBUwDnyA9YfiRsqdSSZdnGve+TONKs9lCmuifi12yipgofQIj8u+BbwdeWfY0pFkdAJ7tHM91jueBF0idl93APuBVwBuB1wIrZxlrJ/C/gA/jqvJzuSTTuHdmGleaTa6twrqcT1YRTQllR4E3AZ8j3xwSNcsJ0ro8B4D9nWNv59hH2sz76JDjBHCSdMu8+9o9JnuOo8ChznGw82cX4svAB4E1wMuBS0mPwR8mrct3J+5Nt1C5QpmL8iqa88laoimhDFKn4XXAx4FvLXwuOt0RUgAa6zkmScGoG5COA8cGjuOdPzdNWu5huvPr3jB0jP4AdJAUsvZ1jv2kUNP731TdMeDvOoeWJlco+3KmcaXZ5A5lt2QeXwvUpFAGqZPwWuAXSBuW576+KYZ3SqZ6ju7nTjITQIYdJ4ccvePO9jr4uame8xvcG3S68zo5pP6xzusq0p6Ja5b8tzLcClIL/vkRjyvN5rIMYz6Py2EoXs5Q9jR23yujaaEMUuB4P/Ax4N8BP8Dsc3N6PQt8lDRf53DnODTLx0dY+O2ouvlRRh/I6Iz5TuC/ZBhbGubKDGO6BpyijZNvvT2wS6ZgZ5FWOP8ocBtpI+HngUeBTwG/BLyBhQW3Nvhz8j127bwFRdlEnq/hfxN5ERJwLXmX1Hlv3KVIWowx0vyrXP/4J4GNYVejNruZPF/DzldVtH9B3lD2qrhL0XyasE6ZRud8UochlxXAVRnHl7q+PcOYU6R1EaVIr8849hH8mq4UQ5l6nR9Q45yAGlKON7KHSHNLpSjj5PkBo+vLNHd+dC0ZytQr4tbi1oAaarfVwGsyjHt/hjGluVwFbM44/ucyjq0lMJSp1+ASGjk4p0y5vZI8TxA/mGFMaS4vyzy+a+5VjKFMvSLa2KsDaqjdck3GfzbTuNJsXpJ5/Icyj69FMpSpV8RK9zk6GFKvGzONuzvTuNJsLsw49gng6xnH1xIYytQrIpR5+1K55eouuBuFouUMZY+SlilShRjK1CsilOVcckOaIM/2SuBWNIr3ooxj35dxbC2RoUy9jgfUWBtQQ+11LmkZgRwMZYp2Rsaxb804tpbIUKZehwNqRHTj1F4XZBr3KeBAprGlYcbIuxzGZzKOrSVq4obkWrojATVcqFA5XZxpXFc910JNAGf2HJuADcB6YBWpkzvsmCDdSVhDCmNnka/r+zRpL2hVjKFMvSImfbokhnLKNZ/s9kzjqppWkoLRpp7XwaMbnLaR5n51j83ErPm4HH9M2vdSFWMoU7Sc7Xjp8kzjfjHTuMpngpnwtIX+7lX32Drkc2fQ/KV7frf0CWg4Q5l6rQqoYShTTjdkGPMUhrJo48wEqm6o2jzHMez314efdT08ANxS+iQ0nKFMvQxlqrO1wNUZxr0DNyJfiHFO7z51P94IrCMFpfU9H6/rOdZ2Ptedg6U8/p/SJ6DZGcrUK2K+l6FMuVxPnonRd2UYs6rW0j+Paq7XM+mfT3Um1Z9L1XaHgP9R+iQ0O0OZekV0yvwJWLnk2rz5/kzjjsoK0r+r7gT0jQv4uPfX3dt9m0gT3NVcnwX2lz4Jzc5Qpl4RT+NEBD+1002Zxn1gROOMk4JQ79ENR90lE3pv8Q3e6pvtc2uxQ6WFeab0CWhuhjL1ilgSw1CmXHJ1yqZJt0bHOscqUogaPDaSntwbPLZ0XtdlOj9podp0K76W/OlKvS4lbVKb0wlcq0yjNwYcxa8taS7X4p6XleY2S+oVsc2Sc1aUw3kYyKS53I2BrPIMZeoVsc3SGN421+jlWslfaooPlj4Bzc9Qpl4RoQz8utPoGcqk2T0I/E7pk9D8fHNUr0nSnK/c/LrTqF1Y+gSkijoOvIOY7+1aJt8cNehoQA0fMNGonVP6BKQKmgR+GLcJqw1DmQZFhDLnlGnUDGXS6d4N/O/SJ6GFM5RpkKFMdXRe6ROQKuZTwIdKn4QWx1CmQRHzDlxAVqN2bukTkCrkKPDPS5+EFs9QpkERq/qvCaihdtlY+gSkipgE/gnwcOkT0eIZyjRoKqCGoUyjdqr0CUgVcBT4IeCPS5+IlsZQpkERnbL1ATXULvtLn4BU2O3Aq4A/Kn0iWjpDmQZFdMq81aRRe6H0CUgFnAI+DfwA8ArgnrKno+XyKTgNilhDzFCmUbsfuKn0SUgjsAd4ovN6ADjYee0eu0k/hDxB2svyYJnTVA6GMg2KCGUbAmqoXR4ofQLSHE6RwtMe4KnO8XTPx08AT3aOiGWJVFGGMg2KuKVtKNOo3Vf6BNRIh0nzFff1HN1fHwAOdf7M4Gu3q7W/8xq1r7BqzlCmQXbKVEd/B0zjFl5KpkmdqX3AXvoDVTcoDb4Ofu4gMQ8+Sd9gKNMgQ5nq6DngC8A3lz4RjURvqBrsUPX+eu/A57ohbD8xDy1JI2UoUwlO9FcOH8JQVlXdW3p7gecHjhdIoXrwc649p9YxlGmQnTLV1e8DPw9cXvpE9A2XAF/HrpW0IIYyleDiscrhFPAe4K9Kn0jFHGXmtt6wo/t73SUYPgRcMYK6p4DHMZBJC2Yo06DpgBqrA2qonT4J/Arw06VPJINjzNza6772fryH0+dX7QNOLKLGuxhNIIP0vWQr6dakpAUwlGnQyYAaft0pp/cBFwPfW/g85nKEFKK63ao9nB64BoPX4cznNAa8d4TjrQTeBvziCMeUGs03Rw2KCGUrA2qovSaBf0i6DfdPM9bZDzwDPMvME3/d5RQGP95PfwhbTPcqyquA7SMe8y0YyqQFM5RpkJ0yNcEp4B2kZTJ+Gdi8hDFOAp8DdgA7O8djpFXXnwWOj+A8q+Q7M4z5SmAtrlIvSUvyGdJckJzHJ8OuRoKzgQ+Sbv8t5OuzO9n94gLnWtIXyfPv/ebIi5DqzI6FBkX89O/XnSI9C/wkabmM7wW+A7gBeDHpa/EZ0lOCd5CCySdpX2fnTFJXK4dzMo0rNY5vjhoUEcqcU6YSDgAf7Rzq993AeKax/fcuLVDE5tOqF0OZ1D5vzji2+5FKC2Qo06BjATVWBdSQtDBjwBsyjr8u49hSoxjKNMhOmdQu24EzMo6/lCdfpVYylGlQRKfMUCZVR64J/l2bMo8vNYahTIMiOmXevpSqI3coy/UAgdQ4hjINilhp3E6ZVB3XZB7fif7SAhnKNMhtlqR2uSzz+FXcUkqqJEOZBkWEMm9fStWwErgwc43dmceXGsNQpkERoWx1QA1J87uQ/HO+DGXSAhnKNMhOmdQeFwTUeCGghtQIhjINippT5teeVN75ATWeC6ghNYJvjBp0KqiO3TKpvIhQtiughtQIhjINinpSynllUnm5Q9lu4GDmGlJjGMo0KGLxWDCUSVWQO5Q9lnl8qVEMZRoUsc0SGMqkKsgdynZmHl9qFEOZBkWFsomgOpJmZ6dMqhBDmQZFhTL3w5PKWg1sy1zDUCYtgqFMgwxlUjucT/59KXdmHl9qFEOZBkWFMr/2pLIuCqixM6CG1Bi+MWqQnTKpHXLveQnweEANqTEMZRpkKJPaIXco2w8cylxDahRDmQYZyqR2yH370i6ZtEiGMg0ylEntkLtT9kTm8aXGMZRpUNSK/iuD6kgaLncos1MmLZKhTIOiOmVuSC6VlXvhWEOZtEiGMg06CUwF1LFTJpVzJrAucw1vX0qLZCjTMBG3MO2USeVcEFDDTpm0SIYyDRMRyuyUSeVEhDI7ZdIiGco0zHRADTtlUjm555OBnTJp0QxlGib3fnhgp0wqKXenbC9wOHMNqXEMZSol9yRjSbPL3Sn7eubxpUYylGmYiE7ZpoAakobLvUaZoUxaAkOZStlY+gSkFjOUSRVkKNMwEZ0yQ5lUxhjevpQqyVCmUgxlUhlnk//pZ0OZtASGMg0T8XXhnDKpjIg1ygxl0hIYyjRMxNeFnTKpjNzzycBQJi2JoUzDjAfUsFMmlZE7lJ0CnspcQ2okQ5mGsVMmNVfuUPYkMJW5htRIhjINYyiTmuuSzON761JaIkOZhvH2pdRcl2Ye31AmLZGhTIMi1igDO2VSKXbKpIoylGnQdFCd1eRfK0lSv7OADZlrGMqkJTKUaZioSbp2y6RYuW9dgqFMWjJDmYaZDKqT+yd2Sf1y37oEQ5m0ZIYyDXMqqM66oDqSkohO2ZMBNaRGMpRpmKhOmaFMinVZ5vGPAnsz15Aay1CmYaJC2dqgOpKS7ZnHdyV/aRkMZRomaqK/nTIplqFMqjBDmYaJWhbDUCbFWQucm7mGoUxaBkOZhjGUSc1zGfkXhzaUSctgKNMwhjKpeXLfugRDmbQshjINEzWnbGtQHUkxoeyZgBpSYxnKNOhc0lYsEf5+UB1JcGVAjecCakiNZSjToO8h7uviVcQFQKntrgqo8WxADamxDGUa9OrAWmPB9aQ2uzqghp0yaRkMZRoUMe+kV8QtFantXkT+OZzTwPOZa0iNZijToC3B9bYF15PaKOLW5V7i9s2VGslQpkFRWyx1rQ6uJ7WRty6lGjCUadALwfUOBdeT2iiiU+atS2mZDGUa9HBwvceC60ltdG1AjQMBNaRGM5Rp0C3B9W4Nrie10fUBNfYH1JAazVCmQX9N3Ir+TwL3BNWS2mob8OKAOnbKpGUylGnQk8Cng2p9hLh9NqW2emlQHUOZtEyGMg3zSwE1jgC/FlBHaruIW5dgKJOWzVCmYT5Juo2Z0wfwEXopgp0ySaq5i0iLQU5nOD4LjMdditRqXyXPv+PB421RFyRJbfQG4ASj/cb9EK7iL0VZw+j/Dc92fF/QNUlSa72FNP9rFN+0vwacF3v6Uqu9nphANg18Z9A1SVKrvYy0qOxyvmH/HrAp+sSllvsvxIWymdM/FgAAAb1JREFU1wRdkyS13lrg35MWiFzMN+p7gO+OP11JwO3EhbKbg65JktSxGXgX8H+Y/bbmM8DHSLczxsqcptR6F5AWgo4KZa+MuSypuSZKn4BqZz/w3zvHBHApcA5pQvFBYCfwVKmTk/QNbyb2h6LpwFpSIxnKtBynSE9TPlT6RCSdJrpztSa4ntQ4Lh4rSc10bXC9M4PrSY1jKJOkZtoaXO+M4HpS4xjKJKmZoh+ycZcOaZkMZZLUTNF7UR4Kric1jqFMkpppV3C9J4PrSY1jKJOkZro9sNYUaRs1SZIkDbiZuIVjbwm6JkmSpNoZAx4lJpT9y6BrkiRJqqX3kD+Q7QY2Rl2QJElSHa0CHiFvKHtP2NVIkiTV2LcAk+QJZJ/CB8YkSZIW7CcZfSC7Bzgr8iIkSZKa4OcYXSD7GrAt9vQlSZKa4x+RVvpfTiD7KE7slyRJWrYLgD8gLfi6mDD2CPAPCpyvJElSo10N/ArwGLMHsUPAJ0hhzA3HpczGSp+AJKm480khbSuwGtgP7ADuA04VPC9JkiRJkiRJkiRJkiRJkiRJkiRJkiRJkiRJkiRJkiRJkiRJkiRJkiRJ5f3//1apdPd/iLYAAAAASUVORK5CYII=
Try ‘Fixed’ and ‘Normal’ with the default charts and the full date range. The ‘world histogram day’ spike in July 2015 steals the show. Switching to ‘Log 10’ gives the underloved charts a chance to be heard.
My first version was finger-tappingly slow. Profiling with {profvis} (Chang et al. 2020) helped explain why: I was fetching histories for every chart before anyone had chosen one. The more reactive approach of fetching only the selected articles, then reusing their histories, makes for a less impatient plot.
There are two different waits here. Loading R and its packages gets the browser ready to run the app. Fetching and plotting the selected articles comes afterwards. Memoization helps with repeated data requests within a session, but does not remove that initial runtime download.
To adapt the example, start with the Quarto source and supporting files. The named chunks in index.qmd supply both the code shown here and the embedded app, so there is only one version to edit. The source also shows how to include a logo as a file within the app. The website’s Quarto configuration and extensions live at the repository root.
R Toolbox
Here are the packages and functions used in this example, gathered with {usedthese}. For more ideas, explore the toolbox visualization, which brings together examples from across the site.
used_here()| Package | Function |
|---|---|
| base | c[7], file.path[1], file.size[2], format[1], function[2], library[14], list[1], paste0[1], readBin[2], switch[1], unlist[1], writeLines[1] |
| bslib | bs_theme[1], card[1], layout_columns[1], page[1] |
| cachem | cache_mem[1] |
| dplyr | filter[1], mutate[2], select[1] |
| ggfoundry | display_palette[1] |
| ggplot2 | aes[1], element_text[4], facet_wrap[1], geom_line[1], geom_smooth[1], ggplot[1], labs[1], margin[1], scale_colour_manual[1], scale_y_log10[1], theme[1], theme_bw[1], theme_set[1] |
| htmltools | div[1], img[1] |
| httr2 | req_perform[1], req_url_path_append[1], request[1], resp_body_json[1] |
| lubridate | today[2], ymd[1] |
| memoise | memoise[1] |
| openssl | base64_encode[2] |
| purrr | keep[1], list_rbind[1], map[2], pluck[1] |
| rvest | html_elements[1], html_text[1] |
| scales | cut_short_scale[1], label_number[1] |
| shiny | dateRangeInput[1], plotOutput[1], reactive[2], renderPlot[1], req[1], selectInput[2], selectizeInput[1] |
| stringr | str_c[2], str_replace_all[1], str_sub[1] |
| tibble | as_tibble[1], tibble[1] |
| usedthese | used_here[1] |
| utils | URLencode[1], head[1] |
| wesanderson | wes_palette[1] |
| xml2 | read_html[1] |