Factor Library
This app provides access to the factor library described in tidyfinance: Transparent Factor Construction for Empirical Asset Pricing (Frey, Scheuch, Voigt, and Weiss, 2026). It covers 179 firm characteristics from Open Source Asset Pricing and over 4 million high-minus-low portfolio return series constructed from different formation methods. Select a sorting variable and portfolio parameters below to explore the resulting return series. Data is fetched on demand from HuggingFace and cached in your browser for the session.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 1000px
library(poorman)
library(nanoparquet)
library(base64enc)
grid_url <- "https://huggingface.co/datasets/tidy-finance/factor-library-grid/resolve/main/"
returns_url <- "https://huggingface.co/datasets/tidy-finance/factor-library/resolve/main/"
CACHE_DIR <- file.path(tempdir(), "factor_library_cache")
dir.create(CACHE_DIR, showWarnings = FALSE, recursive = TRUE)
download_cached <- function(url, filename) {
path <- file.path(CACHE_DIR, filename)
if (!file.exists(path)) {
# Download under a temporary name so that a failed download cannot leave
# a partial file in the cache for later reads
partial <- paste0(path, ".part")
if (download.file(url, partial, mode = "wb", quiet = TRUE) != 0) {
stop("Download failed: ", url)
}
file.rename(partial, path)
}
path
}
sv_info <- read_parquet(download_cached(
paste0(grid_url, "sorting_variables.parquet"),
"sorting_variables.parquet"
))
sv_choices <- setNames(
sv_info$sorting_variable,
paste0(sv_info$sorting_variable, " (", sv_info$full_name, ")")
)
# The full grid is too large for the browser, so the app loads the slice of
# the grid for a sorting variable when it is first selected
load_grid_slice <- function(sorting_variable) {
read_parquet(download_cached(
paste0(grid_url, "portfolio_sort_grid/", sorting_variable, ".parquet"),
paste0("grid_", sorting_variable, ".parquet")
))
}
# The returns are cut into files of 1,000 consecutive ids named after the
# range they cover, so the file that holds a series follows from its id
returns_file <- function(id) {
id_first <- (id - 1) %/% 1000 * 1000 + 1
sprintf("id_%07d-%07d.parquet", id_first, id_first + 999)
}
# Months without a valid long-short return are stored as 0. Before a signal
# starts and after it ends, they would only draw flat lines.
trim_zero_months <- function(dat) {
valid <- which(dat$ret != 0)
if (length(valid) == 0) {
return(dat[0, ])
}
dat[min(valid):max(valid), ]
}
no_returns_message <- paste(
"The factor library stores no returns for this specification:",
"its portfolio sort produced no portfolios."
)
tf_colors <- c("#3B9AB2FF", "#78B7C5FF", "#EBCC2AFF", "#E1AF00FF", "#F21A00FF")
tf_primary <- tf_colors[1]
tf_secondary <- tf_colors[5]
tf_accent <- tf_colors[3]
tf_muted <- tf_colors[2]
ui <- fluidPage(
shiny::useBusyIndicators(),
tags$head(
tags$style(HTML(sprintf(
"
body { font-family: 'Helvetica Neue', Helvetica, Arial, sans-serif; padding-top: 20px;}
h2 { color: %s; }
.sidebar { background-color: #f8f9fa; }
.btn-default { background-color: %s; color: white; border-color: %s; }
.btn-default:hover { background-color: %s; color: white; border-color: %s; }
a { color: %s; }
a:hover { color: %s; }
hr.section-divider {
border: 0;
border-top: 2px solid %s;
margin: 15px 0 12px 0;
}
.section-label {
font-size: 0.75em;
font-weight: 600;
text-transform: uppercase;
letter-spacing: 0.05em;
color: %s;
margin-bottom: 8px;
display: block;
}
.sidebar .form-group { margin-bottom: 12px; }
.sidebar .radio { margin-top: 3px; margin-bottom: 3px; }
.sidebar label { font-weight: 600; font-size: 0.9em; }
.action-row .btn { width: 100%%; }
.code-block { position: relative; }
.code-block pre { margin: 0; padding-right: 70px; }
.copy-btn {
position: absolute;
top: 8px;
right: 8px;
font-size: 0.75em;
padding: 2px 8px;
border: 1px solid %s;
border-radius: 4px;
background-color: white;
color: %s;
cursor: pointer;
}
.copy-btn:hover { background-color: %s; color: white; }
",
tf_primary,
tf_primary,
tf_primary,
tf_secondary,
tf_secondary,
tf_primary,
tf_secondary,
tf_muted,
tf_primary,
tf_primary,
tf_primary,
tf_primary
))),
tags$script(HTML(
"
Shiny.addCustomMessageHandler('download_file', function(msg) {
var a = document.createElement('a');
a.href = 'data:' + msg.type + ';base64,' + msg.data;
a.download = msg.filename;
document.body.appendChild(a);
a.click();
document.body.removeChild(a);
});
function copyCode(btn) {
var pre = btn.parentNode.querySelector('pre');
navigator.clipboard.writeText(pre.textContent).then(function() {
var original = btn.textContent;
btn.textContent = 'Copied!';
setTimeout(function() { btn.textContent = original; }, 1500);
});
}
"
))
),
sidebarLayout(
sidebarPanel(
width = 4,
# ---- Section 1: Variable selection (full width) ----
tags$span(class = "section-label", "Factor"),
selectizeInput(
"sorting_variable",
"Sorting variable",
choices = sv_choices,
selected = "bm",
options = list(placeholder = "Type to search...")
),
uiOutput("sv_detail"),
radioButtons(
"sorting_variable_lag",
"Lag",
c(
"1 month (OSAP timing)" = "1m",
"3 months" = "3m",
"6 months" = "6m",
"Fama-French style" = "ff"
),
selected = "3m"
),
radioButtons(
"rebalancing",
"Rebalancing",
c("Monthly" = "monthly", "Annual" = "annual"),
selected = "annual"
),
radioButtons(
"n_portfolios_main",
"Breakpoints",
c("Three" = 3, "Five" = 5, "Ten" = 10),
selected = 10
),
radioButtons(
"sorting_method",
"Sorting method",
c(
"Univariate" = "univariate",
"Bivariate (dependent)" = "bivariate-dependent",
"Bivariate (independent)" = "bivariate-independent"
),
selected = "bivariate-dependent"
),
conditionalPanel(
"input.sorting_method != 'univariate'",
radioButtons(
"n_portfolios_secondary",
"Secondary breakpoints",
c("Two" = 2, "Five" = 5),
selected = 2
)
),
tags$hr(class = "section-divider"),
# ---- Section 3: Weighting & size (two columns) ----
tags$span(class = "section-label", "Weighting & size"),
fluidRow(
column(
6,
radioButtons(
"weighting_scheme",
"Weighting",
c(
"Equal-weighted" = "EW",
"Value-weighted" = "VW",
"Capped VW" = "capped VW"
),
selected = "VW"
)
),
column(
6,
radioButtons(
"breakpoints_min_size",
"Breakpoints min. size",
c("None" = "NA", "Smallest 20%" = "0.2"),
selected = "NA"
)
)
),
fluidRow(
column(
6,
radioButtons(
"breakpoints_exchanges",
"Exchanges",
c("NYSE only" = "NYSE", "All exchanges" = "AMEX|NASDAQ|NYSE"),
selected = "NYSE"
)
),
column(
6,
radioButtons(
"min_size_quantile",
"Exclude small firms?",
c("No" = "NA", "Smallest 20%" = "0.2"),
selected = "0.2"
)
)
),
tags$hr(class = "section-divider"),
# ---- Section 4: Exclusion filters (two columns) ----
tags$span(class = "section-label", "Exclusion filters"),
fluidRow(
column(
6,
checkboxInput("exclude_financials", "Exclude financials", FALSE),
checkboxInput("exclude_utilities", "Exclude utilities", FALSE)
),
column(
6,
checkboxInput(
"exclude_negative_earnings",
"Exclude negative earnings",
FALSE
)
)
),
helpText(
"All series require a listing age of at least 24 months and apply no",
"minimum stock price and no negative book equity screen."
),
tags$hr(class = "section-divider"),
# ---- Section 5: Actions (two columns) ----
fluidRow(
class = "action-row",
column(6, actionButton("download_csv", "Download CSV")),
column(6, actionButton("download_parquet", "Download Parquet"))
)
),
mainPanel(
width = 8,
plotOutput("plot"),
tableOutput("summary_table"),
helpText(
"Months without a valid long-short return are stored as 0. The plot",
"leaves them out before the first and after the last valid month, and",
"the statistics leave them out altogether."
),
h4("Download programmatically"),
p(
"You can download this portfolio return series programmatically",
"using the tidyfinance package, which provides almost the same",
"interface in R and Python:"
),
tabsetPanel(
tabPanel(
"R",
tags$br(),
p(
"Using the",
tags$a(
"tidyfinance",
href = "https://cran.r-project.org/package=tidyfinance",
target = "_blank"
),
"R package:"
),
uiOutput("code_snippet_r")
),
tabPanel(
"Python",
tags$br(),
p(
"Using the",
tags$a(
"tidyfinance",
href = "https://pypi.org/project/tidyfinance/",
target = "_blank"
),
"Python package:"
),
uiOutput("code_snippet_py")
)
)
)
)
)
server <- function(input, output, session) {
output$sv_detail <- renderUI({
req(input$sorting_variable)
sv_key <- input$sorting_variable
info <- sv_info %>% filter(sorting_variable == sv_key)
req(nrow(info) > 0)
direction_label <- if (info$direction == "top_minus_bottom") {
"Long top, short bottom"
} else {
"Long bottom, short top"
}
tags$div(
style = sprintf(
"background-color: %s20; border-left: 3px solid %s; padding: 8px 12px; border-radius: 4px; font-size: 0.9em;",
tf_primary,
tf_primary
),
tags$strong(info$full_name),
tags$br(),
tags$span(
style = "color: #666;",
paste("HML direction:", direction_label)
)
)
})
sv_grid <- reactive({
req(input$sorting_variable)
withProgress(message = "Fetching specifications...", {
load_grid_slice(input$sorting_variable)
})
})
matched_spec <- reactive({
res <- sv_grid() %>%
filter(
sorting_variable_lag == input$sorting_variable_lag,
rebalancing == input$rebalancing,
n_portfolios_main == as.numeric(input$n_portfolios_main),
sorting_method == input$sorting_method,
breakpoints_exchanges == input$breakpoints_exchanges,
weighting_scheme == input$weighting_scheme,
exclude_financials == input$exclude_financials,
exclude_utilities == input$exclude_utilities,
exclude_negative_earnings == input$exclude_negative_earnings,
# The library holds these choices fixed, so they get no inputs;
# filtering on them keeps the match unique should that change
is.na(min_stock_price),
min_listing_age == 24,
!exclude_negative_book_equity
)
if (input$min_size_quantile == "NA") {
res <- res %>% filter(is.na(min_size_quantile))
} else {
res <- res %>%
filter(min_size_quantile == as.numeric(input$min_size_quantile))
}
if (input$breakpoints_min_size == "NA") {
res <- res %>% filter(is.na(breakpoints_min_size_threshold))
} else {
res <- res %>%
filter(
breakpoints_min_size_threshold ==
as.numeric(input$breakpoints_min_size)
)
}
if (input$sorting_method == "univariate") {
res <- res %>% filter(is.na(n_portfolios_secondary))
} else {
res <- res %>%
filter(
n_portfolios_secondary == as.numeric(input$n_portfolios_secondary)
)
}
head(res, 1)
})
matched_id <- reactive(matched_spec()$id)
factor_data <- reactive({
validate(need(
nrow(matched_spec()) > 0,
if (input$sorting_method %in% sv_grid()$sorting_method) {
"The factor library holds no series for this combination of choices."
} else {
paste(
"This sorting variable is only available with univariate sorts,",
"because the bivariate sorts use size as their second variable."
)
}
))
target_id <- matched_id()
file <- returns_file(target_id)
dat <- withProgress(message = "Fetching returns...", {
tryCatch(
read_parquet(download_cached(paste0(returns_url, file), file)),
error = function(e) e
)
})
# The file of an id range is missing when none of its series has returns.
# webR reports a failed download without the HTTP status, so a missing
# file cannot be told apart from a network error.
if (inherits(dat, "error")) {
validate(paste0(
"Could not download the returns for this specification (", file,
"). The factor library stores no such file when none of its 1,000 ",
"series has returns, because their portfolio sorts produced no ",
"portfolios."
))
}
dat <- dat %>%
filter(id == target_id) %>%
arrange(date)
validate(need(nrow(dat) > 0, no_returns_message))
dat
})
# Like download_data(), the downloads carry the construction choices of the
# series next to its returns
series_with_spec <- reactive({
inner_join(factor_data(), matched_spec(), by = "id")
})
# Build the argument values shared by both code snippets. `sep` controls the
# spacing around the assignment (" = " in R, "=" in Python) and the boolean
# labels differ between the two languages. `na_value` selects the missing
# level of a screen: NA in R, and [None] in Python, where None would drop
# the filter instead.
build_args <- function(sep, na_value, bool_labels) {
na_or_value <- function(value) if (value == "NA") na_value else value
bool <- function(value) bool_labels[[as.character(value)]]
args <- c(
sprintf('sorting_variable%s"%s"', sep, input$sorting_variable),
sprintf('sorting_variable_lag%s"%s"', sep, input$sorting_variable_lag),
sprintf('rebalancing%s"%s"', sep, input$rebalancing),
sprintf('n_portfolios_main%s%s', sep, input$n_portfolios_main),
sprintf('sorting_method%s"%s"', sep, input$sorting_method)
)
if (input$sorting_method != "univariate") {
args <- c(
args,
sprintf('n_portfolios_secondary%s%s', sep, input$n_portfolios_secondary)
)
}
c(
args,
sprintf('breakpoints_exchanges%s"%s"', sep, input$breakpoints_exchanges),
sprintf('weighting_scheme%s"%s"', sep, input$weighting_scheme),
sprintf(
'breakpoints_min_size_threshold%s%s',
sep,
na_or_value(input$breakpoints_min_size)
),
sprintf(
'min_size_quantile%s%s',
sep,
na_or_value(input$min_size_quantile)
),
sprintf('exclude_financials%s%s', sep, bool(input$exclude_financials)),
sprintf('exclude_utilities%s%s', sep, bool(input$exclude_utilities)),
sprintf(
'exclude_negative_earnings%s%s',
sep,
bool(input$exclude_negative_earnings)
)
)
}
output$code_snippet_r <- renderUI({
args <- build_args(
sep = " = ",
na_value = "NA",
bool_labels = list("TRUE" = "TRUE", "FALSE" = "FALSE")
)
code <- paste0(
"# Until the next CRAN release, install tidyfinance from GitHub:\n",
'# pak::pak("tidy-finance/r-tidyfinance")\n',
"library(tidyfinance)\n\n",
"download_data(\n",
' "Tidy Finance", "factor_library",\n',
paste0(" ", args, collapse = ",\n"),
"\n)"
)
tags$div(
class = "code-block",
tags$button(class = "copy-btn", onclick = "copyCode(this)", "Copy"),
tags$pre(
style = "white-space: pre; display: block;",
code
)
)
})
output$code_snippet_py <- renderUI({
args <- build_args(
sep = "=",
na_value = "[None]",
bool_labels = list("TRUE" = "True", "FALSE" = "False")
)
code <- paste0(
"# tidyfinance 0.5.1 on PyPI cannot read the current layout of the\n",
"# factor library yet; a release that can is in preparation.\n",
"import tidyfinance as tf\n\n",
"tf.download_data(\n",
' "Tidy Finance", "factor_library",\n',
paste0(" ", args, collapse = ",\n"),
"\n)"
)
tags$div(
class = "code-block",
tags$button(class = "copy-btn", onclick = "copyCode(this)", "Copy"),
tags$pre(
style = "white-space: pre; display: block;",
code
)
)
})
sv_full_name <- reactive({
sv_key <- input$sorting_variable
info <- sv_info %>% filter(sorting_variable == sv_key)
if (nrow(info) > 0) info$full_name else sv_key
})
output$plot <- renderPlot({
dat <- trim_zero_months(factor_data())
validate(need(
nrow(dat) > 0,
"This series has no month with a valid long-short return."
))
dat$date <- as.Date(dat$date)
dat <- dat %>% mutate(cumret = cumprod(1 + ret) - 1)
plot(
dat$date,
dat$cumret,
type = "l",
lwd = 2,
col = tf_primary,
main = sprintf("Cumulative HML returns: %s", sv_full_name()),
xlab = "",
ylab = "Cumulative return",
yaxt = "n"
)
at <- axTicks(2)
axis(2, at = at, labels = sprintf("%.0f%%", at * 100))
})
output$summary_table <- renderTable(
{
dat <- factor_data() %>% filter(ret != 0)
req(nrow(dat) > 0)
# poorman's summarise() cannot see matched_id(), so the one-row table is
# built directly
data.frame(
`Series id` = as.character(matched_id()),
`Start date` = as.character(min(dat$date)),
`End date` = as.character(max(dat$date)),
Observations = nrow(dat),
`Mean return` = sprintf("%.2f%%", mean(dat$ret) * 100),
`Std. dev.` = sprintf("%.2f%%", sd(dat$ret) * 100),
`Sharpe ratio` = sprintf(
"%.2f",
mean(dat$ret) / sd(dat$ret) * sqrt(12)
),
Minimum = sprintf("%.2f%%", min(dat$ret) * 100),
Maximum = sprintf("%.2f%%", max(dat$ret) * 100),
check.names = FALSE
)
},
striped = TRUE,
hover = TRUE,
bordered = TRUE
)
observeEvent(input$download_csv, {
req(nrow(factor_data()) > 0)
tmp <- tempfile(fileext = ".csv")
write.csv(series_with_spec(), tmp, row.names = FALSE)
b64 <- base64enc::base64encode(tmp)
fname <- sprintf("factor_id_%s.csv", matched_id())
session$sendCustomMessage(
"download_file",
list(
data = b64,
filename = fname,
type = "text/csv"
)
)
})
observeEvent(input$download_parquet, {
req(nrow(factor_data()) > 0)
tmp <- tempfile(fileext = ".parquet")
write_parquet(series_with_spec(), tmp)
b64 <- base64enc::base64encode(tmp)
fname <- sprintf("factor_id_%s.parquet", matched_id())
session$sendCustomMessage(
"download_file",
list(
data = b64,
filename = fname,
type = "application/octet-stream"
)
)
})
}
shinyApp(ui, server)