_load-data-explore.qmd

```{r}
#| label: load-data-explore

library(dplyr)
library(tidyr)
library(stringr)
library(purrr)
library(readr)
library(tibble)
library(forcats)
library(glue)
library(jsonlite)
library(redivis)

## Tables are addressed by NAME, never as `name:referenceId`. A reference id
## belongs to one version's table, and the release cut on 2026-09-04 minted a
## new id for all thirteen tables in irw_meta at once -- every pinned id in
## this repo stopped resolving that morning. Names survive a release; they
## break only on a rename, which is the rarer event.
irw_meta <- redivis$user("datapages")$dataset("irw_meta:bdxt")
metadata_table <- irw_meta$table("metadata")$to_tibble()

metadata <- metadata_table |>
  mutate(table = str_to_lower(table)) |>
  mutate(variable = str_split(variables, "\\| "),
         prefix = str_extract_all(variables, "(?<= )[A-z_]*?(?=_)") |>
           map(unique) |> map(sort)) |>
         # prefix = if_else(map_int(prefix, length) == 0, list("[no prefix]"), prefix)) |>
  mutate(longitudinal = if_else(longitudinal, "longitudinal", "cross-sectional"),
         longitudinal = as.list(longitudinal)) |>
  filter(n_categories != 0)

var_vals <- metadata |>
  select(table, variable, prefix) |>#, longitudinal) |>
  pivot_longer(cols = -table, names_to = "type", values_to = "value") |>
  unnest(value) |>
  count(type, value) |>
  filter(n >= 10) |>
  arrange(type, desc(n)) |>
  select(-n) |>
  group_by(type) |>
  summarise(vals = list(value)) |>
  deframe()

itemtext_meta <- irw_meta$table("itemtext_metadata")$to_tibble()
itemtext_tables <- itemtext_meta |> pull(table) |> str_to_lower() |> unique()

biblio <- irw_meta$table("biblio")$to_tibble()
bib_data <- biblio |>
  mutate(table = str_to_lower(table)) |>
  # select(table, license = `Derived_License`)
  select(table, license = `Derived_License`, data_url = URL__for_data_,
         description = Description, reference = Reference_x, doi = DOI__for_paper_)

tag_table <- irw_meta$table("tags")$to_tibble()

na_vals <- c("no access to the osf page", "non-verbal task",
             "I can't find the description of this dataset",
             "missing description", "need help", "no link or info",
             "Missing (NA)")

## Tag columns are multi-select, stored as one comma-joined string. A plain
## split is correct because no tag value contains a comma: the one that did,
## "Internet-based (Mturkers, etc)", was renamed to "Internet-based" when
## 03_tags.R started normalizing the sheet export (issue #1720). Until then
## this block swapped that comma for a "~", split, then swapped it back.
## Don't reintroduce that -- fix the vocabulary instead.
tags <- tag_table |>
  mutate(table = str_to_lower(table)) |>
  left_join(bib_data |> select(table, license)) |>
  mutate(across(everything(), \(s) if_else(s %in% na_vals, "NA", s))) |>
  mutate(across(everything(), \(s) replace_na(s, "NA"))) |>
  mutate(across(-table, \(s) s |> str_split(",") |> map(str_trim))) |>
  left_join(metadata |> select(table, longitudinal)) |>
  relocate(longitudinal, .before = age_range) |>
  mutate(has_item_text = if_else(table %in% itemtext_tables, "Yes", "No"),
         has_item_text = as.list(has_item_text)) |>
  relocate(has_item_text, .before = age_range)

color_vars <- tags |>
  pivot_longer(cols = -table, names_to = "tag", values_to = "value") |>
  distinct(tag, value) |>
  mutate(tag = fct_inorder(tag)) |>
  count(tag) |>
  filter(n <= 10) |>
  pull(tag) |>
  as.character()

sort_alpha <- \(v) v |> fct_relevel("NA", after = Inf) |> levels()
sort_n <- \(v) v |> fct_infreq() |> fct_relevel("NA", after = Inf) |> levels()

age_range_vals <- c("Child (<18y)", "Adult (18+)", "Elderly (minimum age >50)", "Mixed", "Non-human", "NA")
child_age_vals <- c("Early (<6y)", "Child (6-12y)", "Adolescent (12-18y)", "NA")
has_item_text_vals <- c("Yes", "No")

sort_funs <- list(
  "age_range" = \(v) age_range_vals,
  "child_age__for_child_focused_studies_" = \(v) child_age_vals,
  "construct_name" = sort_alpha,
  "construct_type" = sort_alpha,
  "has_item_text" = \(v) has_item_text_vals,
  "item_format" = sort_n,
  "license" = sort_n,
  "longitudinal" = sort_n,
  "measurement_tool" = sort_alpha,
  "primary_language_s_" = sort_n,
  "sample" = sort_n
)

sort_tag_values <- \(tag, values) exec(sort_funs[[tag]], values)

tag_vals <- tags |>
  select(-construct_name) |>
  pivot_longer(cols = -table, names_to = "tag", values_to = "value") |>
  unnest(value) |>
  group_by(tag) |>
  summarise(values = list(value)) |>
  mutate(vals = map2(tag, values, sort_tag_values)) |>
  select(-values) |>
  deframe()

ds <- c("item_response_warehouse", "item_response_warehouse_2", "item_response_warehouse_3", "item_response_warehouse_4", "item_response_warehouse_5", "item_response_warehouse_6")
urls <- ds |>
  map(\(d) redivis$user("datapages")$dataset(d)$list_tables() |>
        map(\(t) tibble(table = t$name, url = t$properties$url)) |>
        list_rbind()) |>
  list_rbind() |>
  mutate(table = str_to_lower(table), url = str_remove(url, "\\?.*$"))

# Collections (issue #1633): labelled groupings, long format -- one row per
# (table, collection). Collapsed to a list-column so the OJS overlap filter can
# do `d.collection.includes(v)` the same way it does for the tag columns.
#
# Joined onto BOTH datasets_all and datasets_tagged on purpose: the `design`
# collections are derived from metadata.csv, so they are meaningful even when
# qualitative filtering is off. That is why the facet below lives in the
# always-active variables panel rather than the qualitative one.
collection_members <- irw_meta$table("collection_members")$to_tibble()
collections_by_table <- collection_members |>
  mutate(table = str_to_lower(table)) |>
  group_by(table) |>
  summarise(collection = list(sort(unique(collection))), .groups = "drop")

add_collections <- function(df) {
  df |>
    left_join(collections_by_table, by = "table") |>
    mutate(collection = map(collection, \(x) if (is.null(x)) character(0) else x))
}

# Options for the multiselect, commonest first, each labelled with its size and
# -- where it matters -- the fact that it is not exhaustive. This is the only
# place a site user meets the coverage caveat.
collections_reg <- irw_meta$table("collections")$to_tibble()
collection_opts <- collections_reg |>
  arrange(desc(n_tables)) |>
  mutate(opt = paste0(collection, "  (", n_tables,
                      if_else(coverage == "tagged-subset-only", ", tagged subset only", ""),
                      ")")) |>
  pull(opt)
collection_key <- collections_reg |> arrange(desc(n_tables)) |> pull(collection)

# full set of tables with quantitative metadata + url + bibliography, regardless of
# whether they have a row in the (manually curated) tags sheet -- used when
# qualitative filtering is disabled in the explorer
datasets_all <- metadata |> inner_join(urls) |> inner_join(bib_data) |>
  mutate(license = license |> str_split(",") |> map(str_trim)) |>
  add_collections() |>
  arrange(table)

# subset of the above that also has qualitative tags -- used when qualitative
# filtering is enabled
datasets_tagged <- metadata |> inner_join(tags) |> inner_join(urls) |> inner_join(bib_data |> select(-license)) |>
  add_collections() |> arrange(table)

# save(datasets_tagged, datasets_all, var_vals, tag_vals, color_vars, file = "ojs_data.RData")
# load("ojs_data.RData")

ojs_define(datasets_tagged = datasets_tagged)
ojs_define(datasets_all = datasets_all)
ojs_define(tags = tag_vals)
ojs_define(vars = var_vals)
ojs_define(color_vars = color_vars)
ojs_define(collection_opts = collection_opts)
ojs_define(collection_key = collection_key)
```