Exploring Data and Rethinking Table I

Overview

In general, the way we epidemiologists are taught to present data appears to be a form of “2x2” table, or a contingency table if you’re well-studied. I like to do things a bit differently, and in these notes I demonstrate my approach to doing this.

The basic idea is that a reader or viewer should be able to quickly, intuitively grasp your data and any patterns within it, which requires visual components. Additionally, I like to think that if a person can’t use a distribution as a prior in a model (i.e., if an author doesn’t provide the parameters for simulating the distribution) then that is also a failure to accurately describe your data. So, my approach is an attempt to balance these two concepts, which I think is accomplished well enough by combining a grid of small graphical indicators and a streamlined table in one visual. It’s a bit of show, and also tell.

Main Principles

In general I am following a few guidelines in my approach for this visual:

1. Relations over technical measurements

2. Form follows function

3. Maximum Information with minimum ink

4. Negative Space is a working element

5. Use of visual punctuation, symmetry, and contrast

6. Rejection of default visuals

7. Logos Over Pathos

8. Usable by Readers

9. Intuitive for non-statisticians, rewarding for statisticians

Some may notice that I take inspiration by E. Tufte - and I’ll do so here as well. I also admit a rather unorthodox inspiration - the book “By Hand & Eye” which essentially teaches a more intuitive approach to geometry through woodworking.

Additionally, I am not trying to make a number of small charts - I am trying to make a comprehensive grid that shows patterns across what would otherwise be small charts. I tend to call these little guys glyphs so as to differentiate. I am pretty sure the idea of a glpyh chart exists and is something else, but I go with glyphs for lack of a better term.

Some of my language here is also adapted from different areas of thought - the logos over pathos statement may or may not be self explanatory, but it is taken from Aristotle’s triangle of rhetoric, where I intend logos to mean “fact” or “clarity” of data, and pathos as a stand in for things I equate with emotional or hyperbolic visual appeals, like colors with no function, misleading charts that are meant to be colorful and work the audience more than they are to communicate information sincerely. And make no mistake, humans are extremely susceptible to visual pathos.

Visual Grammar: Glyphs

Here basic glyphs that I use in the example; they all use their section of the grid (cell) as a whole thing, rely on “ink” as the division, and negative space to imply missing data or absence of values.

Variable type	Glyph	Encoding
Continuous	Histogram	Distribution fills the cell, central tendency cut out, two greys for spread
Binary clinical sign (yes / no / unknown)	Proportional bar (a stacked bar chart)	Black = yes, grey = no, blank = unknown (code 9), e.g. \|████▒▒▒▒ \|
Nominal (e.g. sex at birth)	Needles	similar to a bar chart, shows proportions by group, sort of like: Male |————– Female |====

Example Overview

This example shows how categories by range for a main exposure can be used with a number of secondary associated or predictive factors, and an outcome, as you might find them in EHR.

I will use data that are simulated to mimic EHR records, which I am “scoring” using the Movement Disorder Society (MDS) prodromal Parkinson’s Disease (PD is my abbreviation for Parkinson’s Disease, pPD for prodromal PD), which provides an absolute probability of being in the prodromal or preclinical stages of PD. I want to break all this down, highlight the main relationships in my data that are under examination in my study, and show readers everything they might need to know about my data as succinctly and clearly as possible (and I would love for it to not look dumb).

Let’s say I don’t know if this MDS probability of pPD works well in EHRs, since it’s more for clinical assessment by a physician, and I want to see how it plays out in an EHR database.

As I proceed, I will use the structure and forms in my visual as follows:

• There is a grid of glyphs on the left side, and a table for specifics on the right side. They will share a symmetric and mirrored form:

  • Rows: the exposure of interest is the top row, up front, so to speak. The outcome is at the bottom, so that we have a visual beginning (exposure) middle (all the other junk) and end (the outcome of interest, PD). Visuals should have a beginning, middle, and end, just like any good story.

  • Columns: each column will ascend in probability of pPD from left to right, so that again we have a beginning, middle, end - trends will show in our data as our estimated risk increases.

• Grid of glyphs: for each cell in this grid, there is a visual form representing the respective cell in the table as described above: histograms for continuous distributions, needles for nominal categorical distributions, and proportional bars for “binary” variables.

  • binary variables are not truly binary here - I use 0 for a negative indication to a test, 1 for a positive indication, and a 9 for “unknown.”

• Table: given the context, each cell in the table will contain a count (n) and the proportion out of the “column” group as a percent if it is a categorical, or mean/median as is appropriate for the actual distribution and its parameters if it is a . E.g., if the row is for a clinical sign/test which like Type II Diabetes, or a nominal categorical variable like sex at birth, it will be a frequency form, and if it age or a measure of plasma urate, it is a continuous form.

• The table is as minimal as possible - think Tufte style

  NoteSide-Note: Modules and Proportional Geometry

  When I consider visuals, I want them to be proportionally harmonious as much as I can manage. There are constraits from publishers and packages, but if I can, I use “modules” to size things. In this case, I mean that geometrically, all things are sized by multiplying the smallest meaningful unit - the same way the Parthenon was designed and built. It’s akin to using dividers over a ruler and, for the most part, forces the forms to reflect the intended use rather than, say, some R package defaults I don’t really understand.

  This is also how you ensure that even if you want to resize things, they also look like they were meant to work together.

Other notes:

• The histogram glyphs have a center cut, which should differ visibly for a mean and a median.

• Draw the black, the greys, and the variance shades from one lightness progression, so tone is proportioned and not picked by eye.

• Colors are only incorporated where they are needed to provide information - like differentiating categories.

• The rule mentioned above - maximum info in least ink - is actually really important. each glyph needs to be minimal so that the overall visual is not overly busy or full of chart junk.

ImportantMake Your Own Glyphs

Technically, you can do whatever makes sense by eye, using whatever geometry you like. I think we should allow ourselves to have just a bit of fun here, really. Have fun with your data once in a while. Choose something you like, e.g. a rangeframe, box-plot, whatever a sparkchart is, or anything you like and then:

1. Take one binary variable and render it in each form across all five bins, in square cells.

2. Hide the table.

3. Check whether you can see the trend direction, rank the bins, and spot where missing data is.

4. Time how fast each question can be answered with no numbers visible.

And also - ask if yourself if you really like how it looks overall.

ImportantForthright Visuals

While I imagine most statisticians have been admonished about misleading charts, I don’t want anyone to somehow think I am advocating for reducing info gained or somehow misrepresenting data - glyphs are not here to overlook details that you don’t like, they are to make important details more obvious. They’re meant to be minimal, not reductive, so that the whole story is visible.

• always ensure glyphs have standardized axes so that they are directly comparable across the grid (e.g., never have moving axes or different scales for histogram glyphs)

• If approximating values (e.g., rounding values so that you have proportional geometric glyphs rather than making each form an exact 1.302485 of a unit sized thing…) always round to the smallest differentiable-by-eye unit you can (i.e., do not round to 10’s if you can round to 1’s and still easily have good-looking glyphs)

• The specific parameters of the observed distribution must be in the table - no glyphs without explicit details for reference

Potential Glyphs

Here are some experimental ideas for glyphs that might work for you in different contexts:

Glyph Ideas for Experimentation

Variable Type	Candidate Glyph	How it Reads	Cautions
Continuous	Quantile dots (20 dots, 5% each, on the shared axis)	Countable probability: “3 of 20 are above this line”	Needs enough width for 20 dots
Continuous	Range-frame (range line, heavy IQR segment, median gap or dot)	Least ink, all position-based	Hides shape such as bimodality
Continuous	Mirrored density (violin)	Symmetry, with skew as lopsidedness	More ink than a histogram; ugly, and have been used to sexually harass women (I am not joking)
Continuous	Mini ECDF (step curve from 0 to 1)	Shifts and spread show as curve displacement	Less familiar to non-statisticians
Binary	Dot on a track, with a short interval	Position on a common scale, plus uncertainty	Unknown needs it sown mark
Binary	Fill level (thermometer-style)	Tops form a skyline across the five bins	Area-like reading within a cell
Ordinal	Stacked bar with ordered tones	Direction visible, tone from one lightness series	Anchor at the middle category to show direction
Nominal	Recursive subdivision of the square	Area follows proportion, like a small treemap	Limit to 4 or 5 categories plus “other”
Count with many zeros	Two-part glyph	Zero share in one slot, histogram of nonzero values beside it	Keep the zero slot consistent across rows
Outcome over time	Tiny cumulative-incidence or survival curves	Step line on a shared time axis	Needs a shared timescale across rows

Geometric influences

• √2 cells. A rectangle with a 1:√2 ratio keeps its shape when halved, so nested or halvedsubdivisions are all proportionally bound to the cell. This generalizes the corner-anchored nested squares.

• Cell width proportional to n. It shows group size without numbers, at the cost of thefixed square module. A thin strip of n above each column is the cheaper compromise.

• A row as one shape. A ridgeline puts all five bins on one shared axis, so the shift readsas a whole. It gives up the cell grid in exchange for a stronger trend gestalt.

Scaling to Many Variables

A figure that works for six rows has to keep working for sixty, and the glyphs, not a separate statistic, should carry the strength of association. I feel like most graphics are meant for a single relationship - a single 2x2 table. In general, I am trying to accomplish visual scalability with doing the following:

• Association is read from the glyphs. A strong relationship appears as a clear trend across the five bins (a bar that grows, a histogram that shifts), and a weak one as a flat row. Anything added beyond that is a navigation aid, not the main encoding. Essentially, relationships should be readily visible from the glyphs before you even consider the words “associated” or, god forbid, “P-Value.”

• One grammar over many rows. The reader learns the glyph vocabulary once, and row 40 reads like row 1. The same cell size, bin edges, and tone series repeat everywhere, so the eye can sweep a column and exceptions show up as breaks in the rhythm.

• Row order carries meaning. As much as you can, use this to guide the reader by grouping rows by domains (demographics, labs, comorbidities) and sort within each group by how visibly the glyphs change across the bins. The strongest patterns then rise to the top without something like a red highlight or asterisks all over marking your p-hacked results.

• A summary mark or glyph per row is an option, too. If you have many rows and they start to visually mesh, it is possible to add one narrow column with a single trend measure on a shared axis between the glyph grid and the table, so that the reader can identify things you want to highlight. When experimenting with this myself, I didn’t particularly like it, but you might find it works for your case.

• Overview, then detail. Show the whole picture at one scale, and let the reader reach the exact values for one row without redrawing the figure. On paper this is the main figure plus a supplementary version with full numbers; on the web it is hover or expand.

• Shared scales unless stated. Comparison across rows only works when axes mean the same thing. If, for some reason, a row needs its own scale, mark that visibly and consistently.

Considerations for Media Used

The sizing and proportions often have to work in constraints usually set by others, so the constraints are treated as the whole being divided. A journal fixes the printable width, minimum type size, and often may require grayscale; the module then fills that frame (ideally).

Priority when they conflict

1. Legibility and survival of the information in the actual medium.
2. The module’s proportions
3. Refinements and decoration

Media

Medium	What the module starts from	Notes
Journal figure	Column or page width, minimum type size, grayscale	Most restrictive; tones and patterns must survive print
Poster	Panel size and reading distance	Larger cells allow dots or nested squares; fewer rows per panel
Slides	Slide frame and projector contrast	Few rows per slide; build one variable at a time
Web page or dashboard	Viewport width, which varies	Responsive cells, but one module ratio; hover can reveal exact values, though the glyph must still work without it

On digital media, the table’s exact numbers can sit behind interaction (hover or click), but the principle of the cover tests still applies: the glyph must be understood without interaction, and the numbers must be reachable without a mouse in any exported or printed version.

The Actual R Code, Finally

After all that about my approach, here is the code for how I’m doing this. It’s not too crazy - I am just making a grid with cowplot, setting theming in ggplot2 to be minimal for plots and simplifying the plots so that they are the “glyphs,” and then making everything a function so I can re-use this - but some color values or components might need to be altered to suit from this code presented here (you probably can’t just copy and paste this without any adjustment and it work like you want, just FYI - use it as a base for making your own unique function).

The highlights are that I use ggplot2 for glpyhs, cowplot to arrange the glyph grid, gt for the table, a bit of custom themeing to apply to all the glyphs, and some summarizing functions that I had from previous work. This is mostly all wrapped into a big… well, wrapper function, with the neededd helper functions in there, as you’ll see.

NoteUse of AI - Disclaimer

Please note that this code was made with the help of an LLM from Anthropic (a “Claude” model). I follow a specific, personal protocol when using AI, and the core ideas are my own while I use AI to help fill out code I specify beforehand, troubleshoot, or debug. This protocol is also listed here.

While LLMs are ubiquitous today, I still recognize their conventional use as a convoluted form of unfortunately accepted plagiarism, so I would attribute this help to all those who have published helpful, original, and clear documents and blog posts for coding on the internet - a big thanks to the R community as a whole.

Preparation

# data simulation for example - you can use this for your own tests if you'd like

# setup
library(data.table)
library(ggplot2)
library(gt)
library(cowplot)
library(png)
library(grid)

set.seed(42)

n <- 10000

# Simulate prodromal probability (the split variable) - skewed toward low risk
sim_data <- data.table(
  prodromal_prob = pmin(100, pmax(0, rbeta(n, 1, 5) * 100))  # mostly low, tail to high
)

# Age: shifts upward with prodromal_prob
sim_data[, age := 40 + (prodromal_prob / 100) * 35 + rnorm(n, 0, 8)]
sim_data[, age := pmin(95, pmax(18, age))]  # bound to realistic range

# Sex: more male at higher prodromal prob (like PD)
sim_data[, sex_prob := 0.35 + (prodromal_prob / 100) * 0.5]  # 35% male at low, 85% at high
sim_data[, sex_at_birth := factor(
  fifelse(runif(n) < sex_prob, "Male", "Female"),
  levels = c("Female", "Male")
)]

# Binary prodromal markers (1/9 style, higher prob of "Yes" at higher prodromal_prob)
make_binary_marker <- function(base_rate, effect_strength, prob) {
  p_yes <- pmin(0.95, base_rate + (prob / 100) * effect_strength)
  factor(fifelse(runif(length(prob)) < p_yes, "Yes", "No"), levels = c("No", "Yes"))
}

sim_data[, constipation := make_binary_marker(0.05, 0.6, prodromal_prob)]
sim_data[, rbd := make_binary_marker(0.001, 0.25, prodromal_prob)]
sim_data[, depression := make_binary_marker(0.10, 0.3, prodromal_prob)]
sim_data[, hyposmia := make_binary_marker(0.02, 0.4, prodromal_prob)]

# Outcome: developed PD (rare, strongly associated with prodromal_prob)
sim_data[, pd_prob := plogis(-6 + prodromal_prob * 0.08)]  # logistic
sim_data[, developed_pd := factor(
  fifelse(runif(n) < pd_prob, "Yes", "No"),
  levels = c("No", "Yes")
)]

# Check distributions
#sim_data[, .N, keyby = .(bin = cut(prodromal_prob, breaks = c(0, 20, 40, 60, 80, 100)))]
#sim_data[, .(mean_age = mean(age), pct_male = mean(sex_at_birth == "Male")), 
#         keyby = .(bin = cut(prodromal_prob, breaks = c(0, 20, 40, 60, 80, 100)))]
#sim_data[, .(pct_pd = mean(developed_pd == "Yes")), 
#         keyby = .(bin = cut(prodromal_prob, breaks = c(0, 20, 40, 60, 80, 100)))]

The LARGE FUNCTION (It’s 800+ Lines)

This function is the backbone for the creation of the glyph + table panel. It does a lot, and has some requirements for which that the preparatory helper functions should be facilitative

# WARNING - This is a LARGE FUNCTION (in text, not memory) 
# =============================================================================
# TABLE 1 SYSTEM - COMPLETE
# =============================================================================

#library(data.table)
#library(ggplot2)
#library(gt)
#library(cowplot)

# -----------------------------------------------------------------------------
# GLYPH THEME SYSTEM
# -----------------------------------------------------------------------------

glyph_theme <- function(base_unit = 1, target = c("screen", "print", "slide")) {
  target <- match.arg(target)
  
  mult <- switch(target,
                 print = 1,
                 screen = 1.2,
                 slide = 1.8
  )
  
  list(
    # Line weights
    line_thin = 0.3 * base_unit * mult,
    line_med = 0.5 * base_unit * mult,
    line_thick = 1 * base_unit * mult,
    
    # Text
    text_small = 2.5 * base_unit * mult,
    text_med = 3 * base_unit * mult,
    text_large = 4 * base_unit * mult,
    
    # Margins
    margin_tight = 1 * base_unit * mult,
    margin_normal = 2 * base_unit * mult,
    
    # Bar proportions (relative to cell)
    bar_pad = 0.3,
    
    # Base colors 
    white = "#fffff8",
    gray_200 = "#e9ecef",
    gray_500 = "#adb5bd",
    gray_900 = "#212529",
    
    # Semantic colors
    col_dark = "#212529",
    col_mid = "#6c757d",
    col_light = "#ced4da",
    col_border = "#495057",
    col_missing = "#fffff8",
    col_background = "#fffff8",
    
    # Density glyph colors
    col_density_low = "#6c757d",
    col_density_high = "#212529",
    
    # Categorical palette
    col_cat = c("#2F6690", "#C03221", "#F0A202","#1e5c4b", "#440381", "#C03221", "#730071" ),
    
    # alphs controller (keeps from oversaturating, even if I like the colors a lot)
    fill_alpha = 0.6,
    
    # Line patterns for lines
    line_patterns = c("solid", "dashed", "dotted", "dotdash", "longdash", "twodash")
    
    )
  
}

.glyph_opts <- glyph_theme(base_unit = 1, target = "screen")

set_glyph_theme <- function(base_unit = 1, target = "screen") {
  .glyph_opts <<- glyph_theme(base_unit, target)
  invisible(.glyph_opts)
}

get_glyph_theme <- function() .glyph_opts

# -----------------------------------------------------------------------------
# TYPE DETECTION
# -----------------------------------------------------------------------------

detect_var_type <- function(x, var_name = NULL, na_levels = NULL, nominal_vars = NULL) {
  
  if (!is.null(nominal_vars) && var_name %chin% nominal_vars) {
    return("categorical")
  }
  
  if (is.factor(x)) {
    levs <- levels(x)
    if (!is.null(na_levels)) {
      levs <- levs[!levs %chin% na_levels]
    }
    n_levs <- length(levs)
    
    if (n_levs == 0) return("all_missing")
    if (n_levs == 1) return("constant")
    if (n_levs == 2) return("binary")
    return("categorical")
  }
  
  if (is.numeric(x)) {
    x_clean <- x[!is.na(x)]
    n_unique <- uniqueN(x_clean)
    
    if (n_unique == 0) return("all_missing")
    if (n_unique == 1) return("constant")
    if (n_unique == 2) return("binary")
    if (n_unique <= 7) return("categorical")
    return("continuous")
  }
  
  if (is.character(x)) {
    stop(paste0("Variable '", var_name, "' is character. Convert to factor first."))
  }
  
  "continuous"
}

# -----------------------------------------------------------------------------
# DATA PREP HELPERS
# -----------------------------------------------------------------------------

prep_binary <- function(x, positive = NULL, negative = NULL,
                        pos_label = "Yes", neg_label = "No") {
  
  if (is.null(positive) || is.null(negative)) {
    unique_vals <- unique(x[!is.na(x)])
    
    if (all(unique_vals %in% c(0, 1))) {
      positive <- 1; negative <- 0
    } else if (all(unique_vals %in% c("Yes", "No"))) {
      positive <- "Yes"; negative <- "No"
    } else if (all(unique_vals %in% c("yes", "no"))) {
      positive <- "yes"; negative <- "no"
    } else if (all(unique_vals %in% c(TRUE, FALSE))) {
      positive <- TRUE; negative <- FALSE
    } else if (all(unique_vals %in% c("Y", "N"))) {
      positive <- "Y"; negative <- "N"
    } else {
      warning(paste("Cannot auto-detect binary coding. Unique values:", 
                    paste(head(unique_vals, 5), collapse = ", ")))
      return(factor(rep(NA_character_, length(x)), levels = c(neg_label, pos_label)))
    }
  }
  
  factor(
    fifelse(x == positive, pos_label,
            fifelse(x == negative, neg_label, NA_character_)),
    levels = c(neg_label, pos_label)
  )
}

prep_factor <- function(x, levels = NULL, na_values = NULL, ordered = FALSE) {
  if (!is.null(na_values)) {
    if (is.character(x)) {
      x[x %chin% as.character(na_values)] <- NA_character_
    } else if (is.numeric(x)) {
      x[x %in% na_values] <- NA_real_
    }
  }
  
  if (is.null(levels)) {
    levels <- sort(unique(x[!is.na(x)]))
  }
  
  factor(x, levels = levels, ordered = ordered)
}

prep_aou_factors <- function(dt, 
                             binary_vars = NULL,
                             categorical_vars = NULL,
                             binary_codes = list(positive = 1, negative = 0),
                             na_values = c("PMI: Skip", "I prefer not to answer", 
                                           "None Indicated", "No matching concept",
                                           "PMI: Prefer Not To Answer", "", 9, 99)) {
  dt <- copy(dt)
  
  if (!is.null(binary_vars)) {
    for (v in binary_vars) {
      if (v %chin% names(dt)) {
        dt[, (v) := prep_binary(get(v), 
                                positive = binary_codes$positive,
                                negative = binary_codes$negative)]
      }
    }
  }
  
  if (!is.null(categorical_vars)) {
    for (v in categorical_vars) {
      if (v %chin% names(dt)) {
        dt[, (v) := prep_factor(get(v), na_values = na_values)]
      }
    }
  }
  
  dt
}

# -----------------------------------------------------------------------------
# FORMATTING HELPERS
# -----------------------------------------------------------------------------

fmt_pct <- function(n, N, digits = 1) {
  pct <- 100 * n / N
  sprintf(paste0("%.", digits, "f"), pct)
}

fmt_n_pct <- function(n, N, digits = 1) {
  paste0(format(n, big.mark = ","), " (", fmt_pct(n, N, digits), ")")
}

calc_skewness <- function(x) {
  x <- x[!is.na(x)]
  n <- length(x)
  if (n < 3) return(NA_real_)
  m <- mean(x)
  s <- sd(x)
  if (s == 0) return(NA_real_)
  as.double(sum(((x - m) / s)^3) * n / ((n - 1) * (n - 2)))
}

is_skewed <- function(x, threshold = 1) {
  abs(calc_skewness(x)) > threshold
}

# -----------------------------------------------------------------------------
# SUMMARY FUNCTIONS
# -----------------------------------------------------------------------------

summarize_continuous <- function(dt, var, by_var, summary_type = "auto") {
  if (summary_type == "auto") {
    summary_type <- fifelse(is_skewed(dt[[var]]), "median", "mean")
  }
  
  if (summary_type == "median") {
    dt[, .(
      summary = paste0(
        sprintf("%.1f", as.double(median(get(var), na.rm = TRUE))),
        " [",
        sprintf("%.1f", as.double(quantile(get(var), 0.25, na.rm = TRUE))),
        ", ",
        sprintf("%.1f", as.double(quantile(get(var), 0.75, na.rm = TRUE))),
        "]"
      ),
      n_obs = sum(!is.na(get(var))),
      n_miss = sum(is.na(get(var)))
    ), by = by_var]
  } else {
    dt[, .(
      summary = paste0(
        sprintf("%.1f", as.double(mean(get(var), na.rm = TRUE))),
        " (",
        sprintf("%.1f", as.double(sd(get(var), na.rm = TRUE))),
        ")"
      ),
      n_obs = sum(!is.na(get(var))),
      n_miss = sum(is.na(get(var)))
    ), by = by_var]
  }
}

summarize_binary <- function(dt, var, by_var, na_levels = NULL) {
  levs <- levels(dt[[var]])
  if (!is.null(na_levels)) {
    levs <- levs[!levs %chin% na_levels]
  }
  pos_level <- levs[length(levs)]
  
  dt[, .(
    summary = fmt_n_pct(sum(get(var) == pos_level, na.rm = TRUE), .N),
    n_obs = .N,
    n_pos = sum(get(var) == pos_level, na.rm = TRUE),
    n_miss = sum(is.na(get(var)))
  ), by = by_var]
}

summarize_categorical <- function(dt, var, by_var, na_levels = NULL, 
                                  collapse_levels = NULL, level_order = NULL) {
  levs <- levels(dt[[var]])
  if (!is.null(na_levels)) {
    levs <- levs[!levs %chin% na_levels]
  }
  
  if (!is.null(collapse_levels)) {
    dt <- copy(dt)
    dt[get(var) %chin% collapse_levels, (var) := "Other"]
    levs <- c(setdiff(levs, collapse_levels), "Other")
  }
  
  if (!is.null(level_order)) {
    levs <- level_order
  }
  
  counts <- dt[, .(N_total = .N), by = by_var]
  
  level_counts <- dt[!is.na(get(var)), .N, by = c(by_var, var)]
  level_counts <- level_counts[counts, on = by_var]
  level_counts[, summary := fmt_n_pct(N, N_total)]
  
  miss <- dt[, .(n_miss = sum(is.na(get(var)))), by = by_var]
  
  list(counts = level_counts, levels = levs, miss = miss)
}

# -----------------------------------------------------------------------------
# MAIN TABLE FUNCTION
# -----------------------------------------------------------------------------

make_table1 <- function(dt, var_groups, split_var, n_bins = 5, bin_labels = NULL,
                        bin_breaks = NULL,
                        var_labels = NULL, var_types = NULL, var_summary_types = NULL,
                        collapse_levels = NULL, level_order = NULL,
                        outcome_var = NULL, na_levels = NULL, nominal_vars = NULL) {
  
  dt <- copy(dt)
  
  if (is.numeric(dt[[split_var]])) {
    if (!is.null(bin_breaks)) {
      dt[, .split_cat := cut(get(split_var), 
                             breaks = bin_breaks,
                             include.lowest = TRUE,
                             labels = bin_labels)]
    } else {
      dt[, .split_cat := cut(get(split_var), 
                             breaks = quantile(get(split_var), 
                                               probs = seq(0, 1, length.out = n_bins + 1),
                                               na.rm = TRUE),
                             include.lowest = TRUE,
                             labels = bin_labels)]
    }
  } else {
    dt[, .split_cat := get(split_var)]
  }
  
  categories <- levels(dt$.split_cat)
  if (is.null(categories)) {
    categories <- sort(unique(dt$.split_cat[!is.na(dt$.split_cat)]))
  }
  
  results <- list()
  
  n_row <- dt[!is.na(.split_cat), .N, by = .split_cat]
  n_row <- dcast(data.table(.split_cat = categories)[n_row, on = ".split_cat"],
                 . ~ .split_cat, value.var = "N")
  n_row[, variable := "N"]
  n_row[, level := ""]
  n_row[, is_section := FALSE]
  n_row[, . := NULL]
  results[["__N__"]] <- n_row
  
  for (group_name in names(var_groups)) {
    vars <- var_groups[[group_name]]
    
    section_row <- data.table(variable = paste0("__SECTION__", group_name), 
                              level = "")
    for (cat in categories) section_row[, (cat) := ""]
    section_row[, is_section := TRUE]
    results[[paste0("__SEC__", group_name)]] <- section_row
    
    for (var in vars) {
      vtype <- if (!is.null(var_types[[var]])) {
        var_types[[var]]
      } else {
        detect_var_type(dt[[var]], var, na_levels, nominal_vars)
      }
      
      if (vtype %chin% c("all_missing", "constant")) {
        warning(paste0("Skipping '", var, "': ", vtype))
        next
      }
      
      vlabel <- if (!is.null(var_labels[[var]])) var_labels[[var]] else var
      
      if (vtype == "continuous") {
        stype <- if (!is.null(var_summary_types[[var]])) {
          var_summary_types[[var]]
        } else {
          "auto"
        }
        summ <- summarize_continuous(dt, var, ".split_cat", stype)
        summ_wide <- dcast(summ, . ~ .split_cat, value.var = "summary")
        summ_wide[, variable := vlabel]
        summ_wide[, level := ""]
        summ_wide[, is_section := FALSE]
        summ_wide[, . := NULL]
        results[[var]] <- summ_wide
        
      } else if (vtype == "binary") {
        summ <- summarize_binary(dt, var, ".split_cat", na_levels)
        summ_wide <- dcast(summ, . ~ .split_cat, value.var = "summary")
        summ_wide[, variable := vlabel]
        summ_wide[, level := ""]
        summ_wide[, is_section := FALSE]
        summ_wide[, . := NULL]
        results[[var]] <- summ_wide
        
      } else if (vtype == "categorical") {
        coll <- collapse_levels[[var]]
        lord <- level_order[[var]]
        summ <- summarize_categorical(dt, var, ".split_cat", na_levels, coll, lord)
        
        var_row <- data.table(variable = vlabel, level = "")
        for (cat in categories) var_row[, (cat) := ""]
        var_row[, is_section := FALSE]
        results[[paste0(var, "__header")]] <- var_row
        
        for (lev in summ$levels) {
          lev_data <- summ$counts[get(var) == lev]
          lev_wide <- dcast(lev_data, . ~ .split_cat, value.var = "summary")
          lev_wide[, variable := ""]
          lev_wide[, level := paste0("
", lev)]
          lev_wide[, is_section := FALSE]
          lev_wide[, . := NULL]
          results[[paste0(var, "__", lev)]] <- lev_wide
        }
      }
    }
  }
  
  tbl <- rbindlist(results, fill = TRUE, use.names = TRUE)
  
  meta_cols <- c("variable", "level", "is_section")
  data_cols <- intersect(categories, names(tbl))
  setcolorder(tbl, c(meta_cols, data_cols))
  
  if (!is.null(outcome_var) && !is.null(var_labels[[outcome_var]])) {
    tbl[, is_outcome := variable == var_labels[[outcome_var]]]
  } else if (!is.null(outcome_var)) {
    tbl[, is_outcome := variable == outcome_var]
  } else {
    tbl[, is_outcome := FALSE]
  }
  
  attr(tbl, "categories") <- categories
  attr(tbl, "outcome_var") <- outcome_var
  
  tbl
}

# -----------------------------------------------------------------------------
# GT FORMATTING
# -----------------------------------------------------------------------------

format_table1_tufte <- function(tbl, opts = get_glyph_theme()) {
  categories <- attr(tbl, "categories")
  
  display_tbl <- copy(tbl)
  display_tbl[, Variable := fifelse(level != "", level, variable)]
  display_tbl[, Variable := gsub("^__SECTION__", "", Variable)]
  
  gt_tbl <- display_tbl[, c("Variable", categories), with = FALSE] |>
    gt() |>
    tab_options(
      table.background.color = "#fffff8",
      table.border.top.style = "hidden",
      table.border.bottom.style = "hidden",
      heading.border.bottom.style = "hidden",
      column_labels.border.top.style = "solid",
      column_labels.border.top.width = px(2),
      column_labels.border.bottom.style = "solid",
      column_labels.border.bottom.width = px(1),
      table_body.border.bottom.style = "solid",
      table_body.border.bottom.width = px(2),
      table_body.hlines.style = "none",
      data_row.padding = px(4)
    ) |>
    cols_align(align = "left", columns = "Variable") |>
    cols_align(align = "center", columns = all_of(categories))
  
  section_rows <- which(tbl$is_section)
  if (length(section_rows) > 0) {
    gt_tbl <- gt_tbl |>
      tab_style(
        style = cell_text(style = "italic", weight = "bold"),
        locations = cells_body(rows = section_rows)
      )
  }
  
  outcome_rows <- which(tbl$is_outcome)
  if (length(outcome_rows) > 0) {
    gt_tbl <- gt_tbl |>
      tab_style(
        style = cell_text(weight = "bold"),
        locations = cells_body(rows = outcome_rows)
      ) |>
      tab_style(
        style = cell_borders(sides = "top", weight = px(1)),
        locations = cells_body(rows = outcome_rows)
      )
  }
  
  gt_tbl <- gt_tbl |>
    tab_style(
      style = cell_text(weight = "bold"),
      locations = cells_column_labels(columns = last_col())
    )
  
  gt_tbl
}

# -----------------------------------------------------------------------------
# DISTRIBUTION EXTRACTION
# -----------------------------------------------------------------------------

extract_distributions <- function(dt, var_groups, split_var, n_bins = 5, 
                                  bin_labels = NULL, bin_breaks = NULL,
                                  var_types = NULL, na_levels = NULL,
                                  nominal_vars = NULL) {
  dt <- copy(dt)
  
  if (is.numeric(dt[[split_var]])) {
    if (!is.null(bin_breaks)) {
      dt[, .split_cat := cut(get(split_var),
                             breaks = bin_breaks,
                             include.lowest = TRUE,
                             labels = bin_labels)]
    } else {
      dt[, .split_cat := cut(get(split_var),
                             breaks = quantile(get(split_var),
                                               probs = seq(0, 1, length.out = n_bins + 1),
                                               na.rm = TRUE),
                             include.lowest = TRUE,
                             labels = bin_labels)]
    }
  } else {
    dt[, .split_cat := get(split_var)]
  }
  
  categories <- levels(dt$.split_cat)
  if (is.null(categories)) {
    categories <- sort(unique(dt$.split_cat[!is.na(dt$.split_cat)]))
  }
  
  all_vars <- unlist(var_groups, use.names = FALSE)
  distributions <- list()
  
  for (var in all_vars) {
    vtype <- if (!is.null(var_types[[var]])) {
      var_types[[var]]
    } else {
      detect_var_type(dt[[var]], var, na_levels, nominal_vars)
    }
    
    if (vtype %chin% c("all_missing", "constant")) next
    
    var_dist <- list(type = vtype, categories = list())
    
    for (cat in categories) {
      subset_dt <- dt[.split_cat == cat]
      subset_vals <- subset_dt[[var]]
      n_total <- nrow(subset_dt)
      n_miss <- sum(is.na(subset_vals))
      subset_clean <- subset_vals[!is.na(subset_vals)]
      
      if (vtype == "continuous") {
        var_dist$categories[[cat]] <- list(
          values = as.double(subset_clean),
          n = length(subset_clean),
          n_total = n_total,
          n_miss = n_miss,
          pct_complete = if (n_total > 0) length(subset_clean) / n_total else 0
        )
      } else if (vtype == "binary") {
        levs <- levels(subset_vals)
        if (!is.null(na_levels)) levs <- levs[!levs %chin% na_levels]
        pos_level <- levs[length(levs)]
        n_pos <- sum(subset_clean == pos_level)
        var_dist$categories[[cat]] <- list(
          n_pos = n_pos,
          n_total = n_total,
          n_obs = length(subset_clean),
          prop = if (n_total > 0) n_pos / n_total else 0,
          n_miss = n_miss,
          pct_complete = if (n_total > 0) length(subset_clean) / n_total else 0
        )
      } else if (vtype == "categorical") {
        levs <- levels(subset_vals)
        if (!is.null(na_levels)) levs <- levs[!levs %chin% na_levels]
        counts <- table(factor(subset_clean, levels = levs))
        var_dist$categories[[cat]] <- list(
          counts = as.integer(counts),
          levels = levs,
          n_total = n_total,
          n_obs = length(subset_clean),
          n_miss = n_miss,
          pct_complete = if (n_total > 0) length(subset_clean) / n_total else 0
        )
      }
    }
    
    if (vtype == "continuous") {
      all_vals <- dt[!is.na(get(var)), get(var)]
      var_dist$global_range <- as.double(range(all_vals))
    }
    
    distributions[[var]] <- var_dist
  }
  
  attr(distributions, "categories") <- categories
  distributions
}

# -----------------------------------------------------------------------------
# GLYPH GENERATORS
# -----------------------------------------------------------------------------

glyph_density <- function(values, global_range, pct_complete = 1,
                          opts = get_glyph_theme()){
  if (length(values) < 2) {
    return(ggplot() +
             theme_void() +
             theme(plot.background = element_rect(fill = opts$col_background, color = NA)))
  }
  
  dens <- density(values, from = global_range[1], to = global_range[2], cut = 0)
  df <- data.table(x = dens$x, y = dens$y)
  df[, y_norm := y / max(y)]
  
  qs <- quantile(values)
  q1 <- qs[2]
  med_val <- qs[3]
  q3 <- qs[4]
  
  x_min <- min(values, na.rm = TRUE)
  x_max <- max(values, na.rm = TRUE)
  
  df[, in_iqr := x >= q1 & x <= q3]
  
  p <- ggplot(df, aes(x = x)) +
    geom_ribbon(
      aes(ymin = 0, ymax = y_norm),
      fill = opts$col_density_low,
      alpha = opts$fill_alpha
    ) +
    geom_ribbon(
      data = df[in_iqr == TRUE],
      aes(ymin = 0, ymax = y_norm),
      fill = opts$col_density_high,
      alpha = opts$fill_alpha
    ) +
    geom_segment(
      aes(x = med_val, xend = med_val, y = 0, yend = 1),
      color = opts$white, 
      linewidth = opts$line_med
    ) +
    scale_x_continuous(limits = global_range, expand = expansion(mult = 0.08)) +
    scale_y_continuous(limits = c(0, 1), expand = c(0, 0)) +
    theme_void() +
    theme(plot.margin = margin(opts$margin_tight, opts$margin_tight,
                               opts$margin_tight, opts$margin_tight)) +
    annotate("text", x = x_min, y = 0.5, label = round(x_min, 0),
             size = 2, hjust = 1.1, color = "#111111") +
    annotate("text", x = x_max, y = 0.5, label = round(x_max, 0),
             size = 2, hjust = -0.1, color = "#111111")
  
  p
}

glyph_bar <- function(prop, pct_complete = 1, min_visible_width = 0.02,
                      opts = get_glyph_theme()) {
  
  display_prop <- max(prop, min_visible_width)
  is_inflated <- prop < min_visible_width
  fill_color <- if (is_inflated) opts$col_mid else opts$col_dark
  
  ylo <- opts$bar_pad
  yhi <- 1 - opts$bar_pad
  
  ggplot() +
    annotate("rect", xmin = 0, xmax = display_prop, 
             ymin = ylo, ymax = yhi, fill = fill_color) +
    annotate("rect", xmin = display_prop, xmax = pct_complete,
             ymin = ylo, ymax = yhi, fill = opts$col_light) +
    annotate("rect", xmin = pct_complete, xmax = 1,
             ymin = ylo, ymax = yhi, fill = opts$col_missing) +
    annotate("rect", xmin = 0, xmax = 1, ymin = ylo, ymax = yhi,
             fill = NA, color = opts$col_border, linewidth = opts$line_thin) +
    scale_x_continuous(limits = c(0, 1), expand = c(0, 0)) +
    scale_y_continuous(limits = c(0, 1), expand = c(0, 0)) +
    theme_void() +
    theme(plot.margin = margin(opts$margin_tight, opts$margin_tight,
                               opts$margin_tight, opts$margin_tight))
}


glyph_needle <- function(props, labels, opts = get_glyph_theme()) {
  
  n_cats <- length(props)
  
  if (sum(props) > 1.1) {
    props <- props / sum(props)
  }
  
  df <- data.table(
    label = labels,
    prop = props,
    y = seq(from = 0.45, to = 0.55, length.out = n_cats),
    color = opts$col_cat[(seq_len(n_cats) - 1) %% length(opts$col_cat) + 1],
    ltype = opts$line_patterns[(seq_len(n_cats) - 1) %% length(opts$line_patterns) + 1]
  )
  
  ggplot(df) +
    # Baseline axis
    geom_segment(
      aes(x = 0, xend = 0, y = 0, yend = 1),
      color = opts$col_border,
      linewidth = opts$line_thin
    ) +
    # Needles
    geom_segment(
      aes(x = 0, xend = prop, y = y, yend = y),
      color = df$color,
      linetype = df$ltype,
      linewidth = opts$line_med,
      alpha = opts$fill_alpha
    ) +
    scale_x_continuous(limits = c(0, 1), expand = expansion(mult = 0.02)) +
    scale_y_continuous(limits = c(0, 1), expand = c(0, 0)) +
    theme_void() +
    theme(
      plot.margin = margin(
        opts$margin_tight,
        opts$margin_tight,
        opts$margin_tight,
        opts$margin_tight
      )
    )
}

# -----------------------------------------------------------------------------
# GLYPH GRID ASSEMBLY
# -----------------------------------------------------------------------------

make_glyph_grid <- function(distributions, var_labels = NULL,
                            opts = get_glyph_theme()) {
  
  categories <- attr(distributions, "categories")
  vars <- names(distributions)
  
  n_vars <- length(vars)
  n_cats <- length(categories)
  
  glyph_list <- vector("list", n_vars * n_cats)
  dim(glyph_list) <- c(n_vars, n_cats)
  
  for (i in seq_along(vars)) {
    var <- vars[i]
    var_dist <- distributions[[var]]
    
    for (j in seq_along(categories)) {
      cat <- categories[j]
      cat_dist <- var_dist$categories[[cat]]
      
      if (var_dist$type == "continuous") {
        glyph_list[[i, j]] <- glyph_density(
          cat_dist$values,
          var_dist$global_range,
          cat_dist$pct_complete,
          opts
        )
      } else if (var_dist$type == "binary") {
        glyph_list[[i, j]] <- glyph_bar(
          cat_dist$prop,
          cat_dist$pct_complete,
          opts = opts
        )
      } else if (var_dist$type == "categorical") {
        glyph_list[[i, j]] <- glyph_needle(
          cat_dist$counts,
          cat_dist$levels,
          opts
        )
      }
    }
  }
  
  row_labels <- if (!is.null(var_labels)) {
    sapply(vars, function(v) if (!is.null(var_labels[[v]])) var_labels[[v]] else v)
  } else {
    vars
  }
  
  list(
    glyphs = glyph_list,
    row_labels = row_labels,
    col_labels = categories,
    n_rows = n_vars,
    n_cols = n_cats,
    distributions = distributions
  )
}

# -----------------------------------------------------------------------------
# GLYPH GRID RENDER
# -----------------------------------------------------------------------------

render_glyph_grid <- function(glyph_grid, distributions = NULL, var_labels = NULL,
                              opts = get_glyph_theme()) {
  
  n_rows <- glyph_grid$n_rows
  n_cols <- glyph_grid$n_cols
  
  glyph_flat <- as.vector(t(glyph_grid$glyphs))
  
  main_grid <- plot_grid(
    plotlist = glyph_flat,
    nrow = n_rows,
    ncol = n_cols,
    align = "hv"
  )
  
  # Build row labels — enhanced for categorical variables
  row_label_plots <- lapply(seq_along(glyph_grid$row_labels), function(i) {
    lab <- glyph_grid$row_labels[i]
    var_name <- names(glyph_grid$distributions)[i]
    var_dist <- glyph_grid$distributions[[var_name]]
    
    if (!is.null(var_dist) && var_dist$type == "categorical") {
      # Build label with inline key
      levels <- var_dist$categories[[1]]$levels
      n_levs <- length(levels)
      
      colors <- opts$col_cat[(seq_len(n_levs) - 1) %% length(opts$col_cat) + 1]
      ltypes <- opts$line_patterns[(seq_len(n_levs) - 1) %% length(opts$line_patterns) + 1]
      
      # Position: label on left, key items stacked below
      p <- ggplot() +
        annotate("text", x = 0.95, y = 0.75, label = lab,
                 hjust = 1, size = opts$text_med, fontface = "bold") +
        xlim(0, 1) + ylim(0, 1) +
        theme_void()
      
      # Add key lines with labels
      for (j in seq_len(n_levs)) {
        y_pos <- 0.5 - (j - 1) * 0.2
        p <- p +
          annotate("segment", x = 0.4, xend = 0.6, y = y_pos, yend = y_pos,
                   color = colors[j], linetype = ltypes[j],
                   linewidth = opts$line_med, alpha = opts$fill_alpha) +
          annotate("text", x = 0.65, y = y_pos, label = levels[j],
                   hjust = 0, size = opts$text_small, color = colors[j])
      }
      
      p
      
    } else {
      # Standard label
      ggplot() + 
        annotate("text", x = 0.95, y = 0.5, label = lab, 
                 hjust = 1, size = opts$text_med) +
        xlim(0, 1) + ylim(0, 1) +
        theme_void()
    }
  })
  
  row_labels_grid <- plot_grid(
    plotlist = row_label_plots,
    nrow = n_rows,
    ncol = 1
  )
  
  col_label_plots <- lapply(glyph_grid$col_labels, function(lab) {
    ggplot() +
      annotate("text", x = 0.5, y = 0.3, label = lab,
               hjust = 0.5, size = opts$text_med) +
      xlim(0, 1) + ylim(0, 1) +
      theme_void()
  })
  
  col_labels_grid <- plot_grid(
    plotlist = col_label_plots,
    nrow = 1,
    ncol = n_cols
  )
  
  label_width_ratio <- 0.22  # slightly wider to accommodate keys
  header_height_ratio <- 0.08
  
  top_row <- plot_grid(
    NULL, col_labels_grid,
    nrow = 1,
    rel_widths = c(label_width_ratio, 1)
  )
  
  bottom_section <- plot_grid(
    row_labels_grid, main_grid,
    nrow = 1,
    rel_widths = c(label_width_ratio, 1)
  )
  
  plot_grid(
    top_row, bottom_section,
    nrow = 2,
    rel_heights = c(header_height_ratio, 1)
  )
}



# -----------------------------------------------------------------------------
# LEGEND GENERATOR
# -----------------------------------------------------------------------------

make_legend <- function(distributions, var_labels = NULL, opts = get_glyph_theme(),
                        legend_scale = 0.5) {
  
  # Detect which glyph types are present
  types_present <- unique(sapply(distributions, function(x) x$type))
  
  legend_plots <- list()
  
  # Scaled text sizes
  text_title <- opts$text_med * legend_scale
  text_label <- opts$text_small * legend_scale
  line_weight <- opts$line_med * legend_scale
  
  # Continuous legend
  if ("continuous" %in% types_present) {
    # Build density shape as polygon
    outer_x <- c(0, 0.15, 0.3, 0.5, 0.7, 0.85, 1, 1, 0)
    outer_y_top <- c(0.2, 0.4, 0.55, 0.65, 0.55, 0.4, 0.2)
    outer_y <- c(outer_y_top, 0.3, 0.3) * 0.6 + 0.25
    outer_x_full <- c(outer_x[1:7], rev(outer_x[1:7]))
    outer_y_full <- c(outer_y_top * 0.6 + 0.25, rep(0.25, 7))
    
    inner_x <- c(0.3, 0.4, 0.5, 0.6, 0.7, 0.7, 0.3)
    inner_y_top <- c(0.45, 0.58, 0.65, 0.58, 0.45)
    inner_y_full <- c(inner_y_top * 0.6 + 0.25, 0.25, 0.25)
    
    cont_legend <- ggplot() +
      # Outer density shape
      annotate("polygon",
               x = c(0, 0.15, 0.3, 0.5, 0.7, 0.85, 1, 1, 0),
               y = c(0.35, 0.45, 0.52, 0.58, 0.52, 0.45, 0.35, 0.25, 0.25),
               fill = opts$col_density_low, alpha = opts$fill_alpha) +
      # Inner IQR shape
      annotate("polygon",
               x = c(0.3, 0.4, 0.5, 0.6, 0.7, 0.7, 0.3),
               y = c(0.46, 0.54, 0.58, 0.54, 0.46, 0.25, 0.25),
               fill = opts$col_density_high, alpha = opts$fill_alpha) +
      # Median line
      annotate("segment", x = 0.5, xend = 0.5, y = 0.25, yend = 0.58,
               color = opts$white, linewidth = line_weight) +
      # Title
      annotate("text", x = 0.5, y = 0.78, label = "Continuous",
               size = text_title, hjust = 0.5, color = opts$col_dark) +
      # Description
      annotate("text", x = 0.5, y = 0.12, label = "dark = IQR, line = median",
               size = text_label, hjust = 0.5, color = opts$col_mid) +
      xlim(-0.2, 1.2) + ylim(0, 1) +
      theme_void() +
      theme(plot.margin = margin(2, 2, 2, 2))
    
    legend_plots[["continuous"]] <- cont_legend
  }
  
  # Binary legend
  if ("binary" %in% types_present) {
    bin_legend <- ggplot() +
      annotate("rect", xmin = 0.1, xmax = 0.55, ymin = 0.35, ymax = 0.55,
               fill = opts$col_dark, alpha = opts$fill_alpha) +
      annotate("rect", xmin = 0.55, xmax = 0.9, ymin = 0.35, ymax = 0.55,
               fill = opts$col_light, alpha = opts$fill_alpha) +
      annotate("rect", xmin = 0.1, xmax = 0.9, ymin = 0.35, ymax = 0.55,
               fill = NA, color = opts$col_border, linewidth = opts$line_thin * legend_scale) +
      annotate("text", x = 0.5, y = 0.78, label = "Binary",
               size = text_title, hjust = 0.5, color = opts$col_dark) +
      annotate("text", x = 0.5, y = 0.12, label = "dark = yes, light = no",
               size = text_label, hjust = 0.5, color = opts$col_mid) +
      xlim(-0.2, 1.2) + ylim(0, 1) +
      theme_void() +
      theme(plot.margin = margin(2, 2, 2, 2))
    
    legend_plots[["binary"]] <- bin_legend
  }
  
  # Categorical legend (one per categorical variable)
  cat_vars <- names(distributions)[sapply(distributions, function(x) x$type == "categorical")]
  
  for (var in cat_vars) {
    var_dist <- distributions[[var]]
    levels <- var_dist$categories[[1]]$levels
    n_levs <- length(levels)
    
    label <- if (!is.null(var_labels[[var]])) var_labels[[var]] else var
    
    df <- data.table(
      level = levels,
      y = seq(from = 0.55, to = 0.3, length.out = n_levs),
      color = opts$col_cat[(seq_len(n_levs) - 1) %% length(opts$col_cat) + 1],
      ltype = opts$line_patterns[(seq_len(n_levs) - 1) %% length(opts$line_patterns) + 1]
    )
    
    cat_legend <- ggplot(df) +
      # Baseline
      geom_segment(
        aes(x = 0.1, xend = 0.1, y = 0.25, yend = 0.6),
        color = opts$col_border,
        linewidth = opts$line_thin * legend_scale
      ) +
      # Needle samples
      geom_segment(
        aes(x = 0.1, xend = 0.35, y = y, yend = y),
        color = df$color,
        linetype = df$ltype,
        linewidth = line_weight,
        alpha = opts$fill_alpha
      ) +
      # Colored labels
      geom_text(
        aes(x = 0.4, y = y, label = level),
        color = df$color,
        size = text_label,
        hjust = 0
      ) +
      # Title
      annotate("text", x = 0.5, y = 0.78, label = label,
               size = text_title, hjust = 0.5, color = opts$col_dark) +
      xlim(-0.1, 1) + ylim(0, 1) +
      theme_void() +
      theme(plot.margin = margin(2, 2, 2, 2))
    
    legend_plots[[var]] <- cat_legend
  }
  
  # Combine legend plots horizontally
  plot_grid(
    plotlist = legend_plots,
    nrow = 1,
    align = "h"
  )
}


# -----------------------------------------------------------------------------
# COMBINED OUTPUT
# -----------------------------------------------------------------------------

make_table1_panel <- function(dt, var_groups, split_var, n_bins = 5, bin_labels = NULL,
                              bin_breaks = NULL,
                              var_labels = NULL, var_types = NULL, var_summary_types = NULL,
                              collapse_levels = NULL, level_order = NULL,
                              outcome_var = NULL, na_levels = NULL, nominal_vars = NULL,
                              theme_target = "screen", theme_base_unit = 1) {
  
  # Set theme for this panel
  set_glyph_theme(base_unit = theme_base_unit, target = theme_target)
  opts <- get_glyph_theme()
  
  tbl <- make_table1(
    dt = dt,
    var_groups = var_groups,
    split_var = split_var,
    n_bins = n_bins,
    bin_labels = bin_labels,
    bin_breaks = bin_breaks,
    var_labels = var_labels,
    var_types = var_types,
    var_summary_types = var_summary_types,
    collapse_levels = collapse_levels,
    level_order = level_order,
    outcome_var = outcome_var,
    na_levels = na_levels,
    nominal_vars = nominal_vars
  )
  
  tbl_gt <- format_table1_tufte(tbl, opts)
  
  distributions <- extract_distributions(
    dt = dt,
    var_groups = var_groups,
    split_var = split_var,
    n_bins = n_bins,
    bin_labels = bin_labels,
    bin_breaks = bin_breaks,
    var_types = var_types,
    na_levels = na_levels,
    nominal_vars = nominal_vars
  )
  
  glyph_grid <- make_glyph_grid(distributions, var_labels, opts)
  
  figure <- render_glyph_grid(glyph_grid, opts)
  
  list(
    table = tbl,
    table_gt = tbl_gt,
    distributions = distributions,
    glyphs = glyph_grid,
    figure = figure,
    theme = opts
  )
}


# -----------------------------------------------------------------------------
# FULL PANEL RENDER
# -----------------------------------------------------------------------------
render_full_panel <- function(panel, var_labels = NULL, opts = get_glyph_theme(),
                              temp_dir = tempdir(),
                              table_vwidth = 780, table_vheight = 400,
                              glyph_table_ratio = c(0.9, 1)) {
  
  # Save gt table as PNG
  table_path <- file.path(temp_dir, "temp_table.png")
  gtsave(panel$table_gt, table_path, vwidth = table_vwidth, vheight = table_vheight)
  
  # Read back as grob with locked aspect ratio
  table_img <- png::readPNG(table_path)
  img_height <- dim(table_img)[1]
  img_width <- dim(table_img)[2]
  aspect_ratio <- img_width / img_height
  
  table_grob <- grid::rasterGrob(
    table_img,
    interpolate = TRUE,
    width = unit(aspect_ratio, "snpc"),
    height = unit(1, "snpc")
  )
  
  # Combine glyphs + table side by side
  full_panel <- plot_grid(
    panel$figure,
    table_grob,
    nrow = 1,
    rel_widths = glyph_table_ratio,
    align = "none"
  )
  
  # Clean up temp file
  unlink(table_path)
  
  full_panel
}

Calling THE LARGE FUNCTION

panel <- make_table1_panel(
  dt = sim_data,
  var_groups = list(
    "Demographics" = c("age", "sex_at_birth"),
    "Prodromal Markers" = c("constipation", "rbd", "depression", "hyposmia"),
    "Outcome" = "developed_pd"
  ),
  split_var = "prodromal_prob",
  bin_breaks = c(0, 20, 40, 60, 80, 100),
  bin_labels = c("0-20%", "20-40%", "40-60%", "60-80%", "80-100%"),
  var_labels = list(
    age = "Age",
    sex_at_birth = "Sex",
    constipation = "Constipation",
    rbd = "RBD",
    depression = "Depression",
    hyposmia = "Hyposmia",
    developed_pd = "Developed PD"
  ),
  nominal_vars = c("sex_at_birth"),
  outcome_var = "developed_pd"
)

# View outputs
panel$table_gt
panel$figure

full_panel <- render_full_panel(
  panel, 
  var_labels = list(
    age = "Age",
    sex_at_birth = "Sex",
    constipation = "Constipation",
    rbd = "RBD",
    depression = "Depression",
    hyposmia = "Hyposmia",
    developed_pd = "Developed PD"
  )
)

full_panel

# Save to file
ggsave("table1_panel.png", full_panel, width = 18, height = 6, dpi = 300)

If rendered here in this quarto doc as-is, it looks bad. My main goal was the output from ggsave, which is what I need for anything outside of quarto anyway (a word doc or actual publication).

I can’t publish this quarto doc to a scientific journal anyway, and they all want .pdf or .docx files with .png images inserted.

A few notes on the visual:

• any legend information should be incorporated so that a legend isn’t necessary - see how I just labeled the nominal sex category. When experimenting with legends, I found they redirected the eye away from glpyhs or the table, and also were redundant.

• Use of color is limited to where it carries meaning in describing the data - it helps us here to differentiate visually between two categories, male and female, which clearly have different risks for PD

• the histograms have the ranges annotated so that you can see the maximum and minimum values between which the distribution resides, to help see if things shift (yes, use labels if you need to, here it keeps the histograms from being too vague without explicit x-axes a typical chart would have)

• There would still be a complete caption with this visual, of course

• These notes show how I played around with this and adjusted until it fit - feel comfortable making adjustments until things make sense to your eye

Conclusion

Hopefully, this gave you some ideas to create a visual replacement for the uninteresting, potentially more obtuse “Table I” as we generally know it. And, hopefully you feel like getting creative with your data and showing others what you find in your analyses.

After I wrote this, someone also pointed out that there is a concept of “tables as figures” - I actually wasn’t able to find out much beyond their mention of it existing. I think they mostly were thinking of an application of the R package gtExtras, but also a buzzword in one. Maybe what I’ve done here is almost the same thing, but I also don’t know if “tables as figures” is really “tables with chartjunk,” so I will keep this as-is, and if I accidentally reinvented the same thing, then I suppose great minds will always think alike. It is highly likely others have come up with similar ideas as I have here, but this was all original ideas on my end. In any case, I hope we continue to do better as researchers and academics in finding intuitive ways to communicate our analyses, our findings, etc.