---
title: "Into High-Dimensional Data"
subtitle: "Lecture 6"
author: "Shannon Gallagher"
date: "September 14, 2026"
date-format: long
format:
  revealjs:
    theme: ../mads-36613-assignments/lecture_drafts/theme.scss
    slide-number: c/t
    chalkboard: true
    code-fold: true
    code-line-numbers: true
    smaller: true
    linestretch: 1.25
    fig-width: 8
    fig-height: 4.5
    footer: "MaDS Data Visualization · Fall 2026"
execute:
  echo: true
  warning: false
  message: false
---

```{r setup, include=FALSE}
source("_setup.R")

metric_labels <- c(
  event_records = "Records",
  log_injuries = "Log injuries",
  log_deaths = "Log deaths",
  log_damage = "Log damage",
  mean_duration = "Mean duration"
)
```

## Logistics and today's goals

**Logistics**

- **Homework 3:** due Tuesday, September 15 at 11:59 p.m.
- **Wednesday's checkpoint:** an early-course survey worth 5 points, graded for
  completion only, in the checkpoints category.

**Today's goals**

- define the observational unit of a multivariate table,
- scan relationships with pairs plots and correlograms,
- compare observations with heatmaps and parallel coordinates,
- use dense multivariate views to find patterns, then choose a focused graphic for the
  client-facing report.

## From event reports to state rows

```{r state-aggregation}
#| code-fold: show
metrics <- events |>
  group_by(state_upper) |>
  summarise(
    event_records = n(),
    injuries = sum(injuries_total, na.rm = TRUE),
    deaths = sum(deaths_total, na.rm = TRUE),
    property_damage = sum(prop_usd_zero, na.rm = TRUE),
    mean_duration = mean(duration_hours, na.rm = TRUE),
    .groups = "drop"
  ) |>
  mutate(
    state_upper = state.abb[match(str_to_title(state_upper), state.name)],
    log_injuries = log1p(injuries),
    log_deaths = log1p(deaths),
    log_damage = log1p(property_damage)
  ) |>
  filter(!is.na(state_upper), is.finite(mean_duration), event_records >= 50) |>
  select(state_upper, event_records, log_injuries, log_deaths,
         log_damage, mean_duration)
```

## The state-level analysis table

```{r state-table}
#| echo: false
metrics |> slice_head(n = 6)
```

**Meaningful plots begin with meaningful rows:** each row should represent the thing we
want to compare.

## What are we comparing?

The table mixes:

- volume: number of event records,
- human impact: injuries and deaths,
- monetary impact: reported property damage,
- duration: mean hours per record.

These are not interchangeable measures of “risk.”

## Checkpoint 1 · What can these rows support?

::: {.checkpoint}
An emergency-management client asks, “Which states have the greatest storm risk for
residents?” Our table contains state totals rather than rates.

- What can the current rows tell the client?
- Why might a large or highly exposed state rank high even when an individual resident's
  risk is modest?
- What additional variable would let us calculate a rate per resident?
:::

## Create pairs plots with `GGally`

With $p$ variables, a full pairs plot has $p^2$ panels.

Pairs plots are useful for:

- scanning for strong relationships,
- seeing nonlinear patterns,
- spotting outliers.

Use the matrix to find relationships worth following up. For a client, usually replace
it with one focused graphic and keep the full matrix in the working analysis or appendix.

<div style="position: absolute; bottom: 1.3em; left: 0; font-size: 0.58em;">
[GGally `ggpairs()` vignette: panel types and customization options](https://ggobi.github.io/ggally/articles/ggpairs.html){target="_blank"}
</div>

## A pairs plot combines patterns and summaries

```{r pairs-plot, fig.alt="Pairs plot of five state-level NOAA summary variables."}
GGally::ggpairs(
  metrics,
  columns = 2:6,
  columnLabels = unname(metric_labels),
  lower = list(
    continuous = GGally::wrap(
      "points", color = deep_gold, alpha = 0.55, size = 1.4
    )
  ),
  upper = list(continuous = GGally::wrap("cor", size = 4)),
  diag = list(
    continuous = GGally::wrap(
      "densityDiag", fill = pale_gold, color = deep_gold, alpha = 0.6
    )
  )
) +
  theme_minimal()
```

## What about high-dimensional data?

```{r correlation-table}
cor_mat <- metrics |>
  select(-state_upper) |>
  cor(use = "pairwise.complete.obs")

round(cor_mat, 2)
```

Correlation summarizes linear association. It can miss curvature and can be dominated by
one unusual state.

## Correlogram to visualize a correlation matrix

```{r correlogram, fig.alt="Heatmap of correlations among state-level NOAA summary variables."}
cor_long <- as.data.frame(as.table(cor_mat)) |>
  mutate(
    across(
      c(Var1, Var2),
      ~ factor(
        as.character(.x),
        levels = names(metric_labels),
        labels = unname(metric_labels)
      )
    )
  )

cor_long |>
  ggplot(aes(Var1, Var2, fill = Freq)) +
  geom_tile(color = "white") +
  geom_text(aes(label = sprintf("%.2f", Freq)), size = 3) +
  scale_fill_gradient2(low = blue_gray, mid = "white", high = deep_gold, limits = c(-1, 1)) +
  labs(
    title = "Correlation compresses the pairwise linear relationships",
    x = NULL, y = NULL, fill = "r"
  ) +
  theme(axis.text.x = element_text(angle = 40, hjust = 1))
```

## Reorder variables based on correlation

```{r reordered-correlogram, fig.alt="Correlation heatmap reordered using hierarchical clustering."}
correlation_distance <- as.dist(1 - abs(cor_mat))
clustered_variables <- hclust(correlation_distance)
variable_order <- clustered_variables$labels[clustered_variables$order]
ordered_labels <- unname(metric_labels[variable_order])

cor_long |>
  mutate(
    Var1 = factor(as.character(Var1), levels = ordered_labels),
    Var2 = factor(as.character(Var2), levels = rev(ordered_labels))
  ) |>
  ggplot(aes(Var1, Var2, fill = Freq)) +
  geom_tile(color = "white") +
  scale_fill_gradient2(low = blue_gray, mid = "white", high = deep_gold, limits = c(-1, 1)) +
  labs(title = "Ordering helps related variables appear together", x = NULL, y = NULL, fill = "r") +
  theme(axis.text.x = element_text(angle = 40, hjust = 1))
```

## Checkpoint 2 · Why are the correlations positive?

::: {.checkpoint}
Nearly every correlation among our state-level metrics is positive. Why does aggregating
injuries, deaths, damage, and event records by state tend to produce this pattern? Would
you necessarily expect the same result from rates per resident or severity per event?
:::

::: {.fragment}
**Answer:** States with more recorded storms have more opportunities to accumulate every
type of total. That shared exposure pushes the correlations upward. Rates remove some of
the exposure effect and may show weaker or negative relationships. Count variables can
also be negatively correlated when categories compete or must add to a fixed total.
:::

## Heatmap displays of observations

Variables measured in dollars, counts, and hours cannot share a color scale directly.

Standardizing converts each column across all 50 states to:

$$z = \frac{x - \bar{x}}{s}$$

Now color means low or high relative to that variable's distribution across states. To
show both kinds of departure, we will display the states whose profiles differ most from
zero across the five metrics.

## Manual version of heatmaps

```{r state-heatmap, fig.alt="Heatmap of standardized NOAA metrics for selected states."}
standardized_profiles <- metrics |>
  mutate(across(-state_upper, ~ as.numeric(scale(.x)))) |>
  rowwise() |>
  mutate(
    profile_score = mean(abs(c_across(all_of(names(metric_labels)))))
  ) |>
  ungroup()

selected_states <- standardized_profiles |>
  slice_max(profile_score, n = 12, with_ties = FALSE) |>
  arrange(profile_score) |>
  pull(state_upper)

selected_long <- standardized_profiles |>
  filter(state_upper %in% selected_states) |>
  select(-profile_score) |>
  pivot_longer(-state_upper, names_to = "metric", values_to = "z") |>
  mutate(
    state_upper = factor(state_upper, levels = selected_states),
    metric = factor(
      metric,
      levels = names(metrics)[-1],
      labels = unname(metric_labels)
    )
  )

z_limit <- max(abs(selected_long$z))

selected_long |>
  ggplot(aes(metric, state_upper, fill = z)) +
  geom_tile(color = "white") +
  scale_fill_gradient2(
    low = blue_gray, mid = "white", high = deep_gold,
    midpoint = 0, limits = c(-z_limit, z_limit),
    breaks = c(-4, -2, 0, 2, 4)
  ) +
  labs(
    title = "Twelve states with the most unusual standardized profiles",
    x = NULL, y = NULL, fill = "All-state z-score"
  ) +
  theme(axis.text.x = element_text(angle = 35, hjust = 1))
```

## Parallel coordinates plots

A parallel-coordinates plot draws one line per observation across standardized variables.

Useful for:

- inspecting profiles,
- highlighting a few cases,
- seeing tradeoffs across variables.

With many lines, it becomes spaghetti.

## Manual parallel-coordinates display

```{r parallel-coordinates, fig.alt="Parallel-coordinates plot for selected state-level NOAA metrics."}
parallel_data <- selected_long

parallel_data |>
  ggplot(aes(metric, z, group = state_upper)) +
  geom_line(alpha = 0.45, color = blue_gray) +
  geom_point(size = 1.5, color = deep_gold) +
  labs(
    title = "Parallel coordinates compare profiles, not raw units",
    x = NULL, y = "All-state z-score"
  ) +
  theme(axis.text.x = element_text(angle = 35, hjust = 1))
```

## Highlight before presenting

```{r parallel-highlight, fig.alt="Parallel-coordinates plot highlighting one state among selected states."}
focus_state <- parallel_data |>
  distinct(state_upper) |>
  left_join(
    standardized_profiles |> select(state_upper, profile_score),
    by = "state_upper"
  ) |>
  slice_max(profile_score, n = 1, with_ties = FALSE) |>
  pull(state_upper) |>
  as.character()

parallel_data |>
  ggplot(aes(metric, z, group = state_upper)) +
  geom_line(color = "gray80") +
  geom_line(data = ~ filter(.x, state_upper == focus_state), color = deep_gold, linewidth = 1.4) +
  labs(
    title = paste("Largest average absolute z-score:", focus_state),
    x = NULL, y = "All-state z-score"
  ) +
  theme(axis.text.x = element_text(angle = 35, hjust = 1))
```

## Checkpoint 3 · Choose what to show

::: {.checkpoint}
Your client asks, “Which states look unusual across several impact measures?” Choose a
pairs plot, correlogram, heatmap, or parallel-coordinates plot. State what you would show
in the meeting and what you would keep in the appendix.
:::

## Recap and next steps

- Aggregation changes the observational unit.
- High-dimensional views are usually for exploration.
- Scaling is necessary but changes interpretation.
- A correlation matrix should send you back to the raw pairs.

Next: distance, multidimensional scaling, and principal components.

## Homework 3 is your project launch

Problem 1 begins the final project for the **executive-search steering committee**.

1. Propose **three client questions** that could guide a recruiting decision. *(10 pts)*
2. Plan a **different plot type for each question**, naming the variables, subset, units,
   and one limitation or sample-size check. *(20 pts)*
3. Make **one** of those plots, with complete labels and no claim that record counts
   measure employer demand. *(10 pts)*

Today, we will use the archive and rubric to pressure-test those choices.

## What decision should the report support?

The client is considering whether and where to build a stronger **Data and AI recruiting
practice**.

Your analysis should help the steering committee decide:

- which employer should be the first recruiting target,
- which roles and experience levels deserve attention,
- what directional pay benchmarks are defensible, and
- what evidence the client should collect next.

The goal is not a generic tour of the labor market. It is a recommendation supported by
careful visual evidence.

## Load the frozen course snapshot

```r
library(tidyverse)

salary_url <- paste0(
  "https://stat.cmu.edu/~sgallagh/courses/mads-fall-2026/",
  "datavis-36613/data/salaries.csv.gz"
)

salaries <- read_csv(salary_url, show_col_types = FALSE)
dim(salaries)
#> [1] 151445     11
```

The course copy was frozen on **August 3, 2025** and covers work years **2020–2025**.
Use this version so everyone works from the same evidence.

<div style="position: absolute; bottom: 1.3em; left: 0; font-size: 0.58em;">
[Salary archive guide and variable definitions](../data/compensation-salary-guide.html){target="_blank"}
</div>

## Eleven fields, four kinds of evidence

:::: {.columns}
::: {.column width="50%"}
**Time and job**

- `work_year`: year represented
- `job_title`, `experience_level`, `employment_type`: role, seniority, and work
  arrangement
:::

::: {.column width="50%"}
**Pay, geography, and firm**

- `salary`, `salary_currency`, `salary_in_usd`: reported pay
- `employee_residence`, `company_location`, `company_size`, `remote_ratio`: worker and
  employer setting
:::
::::

**Each row is one compensation observation.** It may not be a unique person, job
posting, employer, or opening.

## What the archive cannot establish

- **Record frequency is not employer demand.** We do not know the archive's sampling
  process or whether repeated records represent distinct openings.
- **Employer identity and row-level provenance are absent.** Exact duplicates therefore
  require an explicit audit and sensitivity choice.
- **`salary_in_usd` is not total compensation.** It is not adjusted for inflation or
  local cost of living.
- **Associations are descriptive.** The archive cannot identify the causal effect of
  experience, remote work, location, or firm size on pay.

Before choosing a plot, ask: *Can these rows actually answer my client question?*

## How the rubric allocates 100 points

| Rubric section                  | Points | What the rubric looks for                                      |
|:--------------------------------|-------:|:---------------------------------------------------------------|
| Visual portfolio | **48** | Six honest, readable graphics with purposeful comparisons |
| Cohesive visual story | **25** | Three client questions that build to a defensible recommendation |
| Data scope and evidence boundaries | **10** | Coverage, duplicates, denominators, and limits on what the data can show |
| Statistical support | **10** | Careful interpretation of uncertainty or model evidence |
| Reproducibility and submission | **7** | A self-contained report that another analyst can check and reproduce |

**Seventy-three points** reward the graphics and the story they build together.

## Use the rubric to revise Homework 3

For each proposed client question, check:

- Does the answer change a **recruiting decision**?
- Is the proposed plot type a good match for the comparison?
- Have you named the variables, subset, units, and sample-size check?
- What limitation must appear beside the visual?
- If this became one of your six scored graphics, what would make it client-ready?

Your report ultimately needs **6–10 graphics**, including at least three foundational
forms, three advanced or later-course forms, and one statistical or uncertainty
component. Only the written HTML report and its reproducibility materials count toward
the 36-613 grade.

<div style="position: absolute; bottom: 1.3em; left: 0; font-size: 0.58em;">
[Project brief](../final-project.html){target="_blank"} ·
[Full rubric](../project-rubric.html){target="_blank"} ·
[Salary archive guide](../data/compensation-salary-guide.html){target="_blank"}
</div>