Four Questions for the Nobel Prize API

Turning nested JSON into tidy data, and asking who the prize has moved toward

Author

Aniss Sahraoui

Published

November 8, 2026

library(tidyverse)
library(httr2)
library(jsonlite)
library(knitr)

snapshot <- "https://raw.githubusercontent.com/AnissSahraoui/DATA607/main/Week10B/data/"

accent   <- "#2a78d6"
accent_2 <- "#eb6834"
theme_nb <- theme_minimal(base_size = 12) +
  theme(panel.grid.minor = element_blank(), plot.title.position = "plot")

1 The API

The Nobel Prize Developer Zone publishes a public API that needs no key. I used the laureates endpoint, https://api.nobelprize.org/2.1/laureates, which returns one record per laureate with every prize that laureate has won nested inside it.

resp <- request("https://api.nobelprize.org/2.1/laureates") |>
  req_url_query(limit = 1) |>
  req_error(is_error = \(r) FALSE) |>
  req_perform()

parsed <- resp_body_json(resp)

tibble(
  status            = resp_status(resp),
  laureates_in_api  = parsed$meta$count,
  returned_this_call = length(parsed$laureates)
)

status	laureates_in_api	returned_this_call
200	1028	1

1.1 What one record looks like

A laureate is not a row. It is a deeply nested object: names repeat in up to three languages, birth sits inside its own object with a place inside that, and prizes arrive as an array because some laureates have won more than once.

one <- parsed$laureates[[1]]

tibble(
  field = c("knownName", "birth", "birth$place$country", "nobelPrizes", "affiliations"),
  shape = c(
    paste("object:", paste(names(one$knownName), collapse = ", ")),
    paste("object:", paste(names(one$birth), collapse = ", ")),
    paste("object:", paste(names(one$birth$place$country), collapse = ", ")),
    paste("array of", length(one$nobelPrizes), "prize object(s)"),
    paste("array inside each prize, with name / city / country objects")
  )
)

field	shape
knownName	object: en, se
birth	object: date, year, place
birth\(place\)country	object: en, no, se
nobelPrizes	array of 1 prize object(s)
affiliations	array inside each prize, with name / city / country objects

Three further wrinkles shape every decision below: organizations such as the Red Cross appear alongside people but carry orgName and founded instead of knownName and birth, with no gender; results are paginated, 100 at a time; and some birth dates record only a year, written as 1948-00-00.

2 Retrieving and Tidying the Data

The collection script pages through the whole list, flattens each record, and writes two tidy tables. The key part is the flattening:

# English label from a multi-language field, e.g. {en: "USA", se: "USA"}
en <- function(x) if (is.null(x)) NA_character_ else (x[["en"]] %||% NA_character_)

# First non-missing value. en() returns NA (not NULL) for an absent field and
# %||% only catches NULL, so organizations need a fallback that treats NA as
# "try the next one" — otherwise every organization loses its name.
first_present <- function(...) {
  vals <- c(...)
  vals <- vals[!is.na(vals)]
  if (length(vals)) vals[[1]] else NA_character_
}

laureates <- map_dfr(laureates_raw, \(l) tibble(
  laureate_id     = l$id,
  name            = first_present(en(l$knownName), en(l$orgName)),
  is_organization = !is.null(l$orgName),
  gender          = l$gender %||% NA_character_,
  birth_date      = first_present(l$birth$date %||% NA_character_,
                                  l$founded$date %||% NA_character_),
  birth_country_now = first_present(en(l$birth$place$countryNow),
                                    en(l$founded$place$countryNow)),
  n_prizes        = length(l$nobelPrizes)
))

# One row per laureate per prize: a two-time winner becomes two rows.
prizes <- map_dfr(laureates_raw, \(l) {
  map_dfr(l$nobelPrizes, \(p) {
    aff <- if (length(p$affiliations)) p$affiliations[[1]] else NULL
    tibble(
      laureate_id             = l$id,
      award_year              = as.integer(p$awardYear),
      category                = en(p$category),
      prize_status            = p$prizeStatus %||% NA_character_,
      affiliation_country_now = if (is.null(aff)) NA_character_ else en(aff$countryNow)
    )
  })
})

The full script is fetch_nobel.R. Its output is saved to CSV so this report renders from a fixed snapshot rather than a live call.

laureates <- read_csv(paste0(snapshot, "nobel_laureates.csv"),
                      col_types = cols(.default = "c")) |>
  mutate(is_organization = as.logical(is_organization),
         n_prizes        = as.integer(n_prizes),
         # Year only: 48 birth dates are recorded as e.g. 1948-00-00, so the
         # year is reliable but the exact date is not.
         birth_year      = as.integer(str_sub(birth_date, 1, 4)))

prizes <- read_csv(paste0(snapshot, "nobel_prizes.csv"),
                   col_types = cols(.default = "c")) |>
  mutate(award_year = as.integer(award_year))

# One row per laureate-prize, with the laureate's own details attached.
awards <- prizes |>
  left_join(
    laureates |> select(laureate_id, is_organization, gender, birth_year,
                        birth_country, birth_country_now),
    by = "laureate_id"
  )

tibble(
  laureate_records   = nrow(laureates),
  laureate_prize_rows = nrow(awards),
  repeat_winners     = sum(laureates$n_prizes > 1),
  organizations      = sum(laureates$is_organization),
  years_covered      = paste(min(awards$award_year), "-", max(awards$award_year))
)

laureate_records	laureate_prize_rows	repeat_winners	organizations	years_covered
1028	1036	7	28	1901 - 2026

Seven laureates have won more than once, producing the eight extra prize rows:

laureates |>
  filter(n_prizes > 1) |>
  select(name, is_organization, n_prizes) |>
  arrange(desc(n_prizes))

name	is_organization	n_prizes
International Committee of the Red Cross	TRUE	3
Frederick Sanger	FALSE	2
John Bardeen	FALSE	2
K. Barry Sharpless	FALSE	2
Linus Pauling	FALSE	2
Marie Curie	FALSE	2
Office of the United Nations High Commissioner for Refugees	TRUE	2

2.1 Cleaning decisions

bind_rows(
  laureates |> summarise(across(everything(), ~ sum(is.na(.)))) |>
    pivot_longer(everything(), names_to = "column", values_to = "missing") |>
    mutate(table = "laureates"),
  prizes |> summarise(across(everything(), ~ sum(is.na(.)))) |>
    pivot_longer(everything(), names_to = "column", values_to = "missing") |>
    mutate(table = "prizes")
) |>
  filter(missing > 0) |>
  select(table, column, missing)

table	column	missing
laureates	gender	28
laureates	birth_date	1
laureates	birth_country	7
laureates	birth_country_now	7
laureates	birth_continent	31
laureates	death_date	331
laureates	birth_year	1
prizes	affiliation_name	270
prizes	affiliation_country	273
prizes	affiliation_country_now	273

Each gap is kept rather than patched, with a reason:

gender is missing for all 28 organizations. They are excluded from the gender question rather than counted as unknown.
affiliation_country is missing for 273 prizes. Peace and Literature laureates usually have no institutional affiliation. These are excluded from Question 4, which needs both countries, and the report states how many rows that leaves.
death_date is missing for 331 laureates, who are living. That is information, not absence.
Country names are taken from countryNow rather than country. The raw field records the country as it was named at the time, so Marie Curie’s birthplace is “Russian Empire” while countryNow says “Poland”. Using present-day names makes countries comparable across 125 years.

prizes |> count(prize_status)

prize_status	n
declined	2
received	1033
restricted	1

Two prizes were declined and one is restricted. They stay in the counts, because the prize was still awarded.

3 Question 1: How has the number of laureates changed over time?

The question. The prize has grown from a handful of awards a year to a crowded field. Counting by decade and category shows when that happened.

by_decade <- awards |>
  mutate(decade = 10 * (award_year %/% 10)) |>
  count(decade, category)

by_decade |>
  group_by(decade) |>
  summarise(laureates = sum(n), .groups = "drop") |>
  kable(col.names = c("Decade", "Laureates"))

Decade	Laureates
1900	57
1910	40
1920	54
1930	56
1940	43
1950	72
1960	79
1970	104
1980	97
1990	104
2000	123
2010	121
2020	86

by_decade |>
  mutate(category = fct_reorder(category, n, sum, .desc = TRUE)) |>
  ggplot(aes(x = decade, y = n, fill = category)) +
  geom_col(width = 8) +
  scale_fill_brewer(palette = "Set2", name = NULL) +
  labs(title = "Laureates per decade, by category",
       x = NULL, y = "Laureates") +
  theme_nb +
  theme(legend.position = "right")

Figure 1: Laureates per decade by category. The 2020s are incomplete, covering 2020 to 2026.

The answer. Numbers roughly doubled: the 1900s produced 57 laureates and the 2000s produced 123. The cause is sharing rather than more prizes — a single prize is now routinely split between two or three people, where early prizes usually went to one. Economic Sciences only begins in 1969, which is visible as the category appearing part-way along.

4 Question 2: How has the share of women changed?

The question. Women are a small minority of laureates. Is that changing, and does it differ by category?

people <- awards |> filter(!is_organization)

people |>
  count(gender) |>
  mutate(pct = round(100 * n / sum(n), 1)) |>
  kable(col.names = c("Gender", "Prizes", "%"))

Gender	Prizes	%
female	70	7
male	935	93

people |>
  group_by(category) |>
  summarise(
    prizes      = n(),
    women       = sum(gender == "female"),
    pct_women   = round(100 * sum(gender == "female") / n(), 1),
    .groups = "drop"
  ) |>
  arrange(desc(pct_women)) |>
  kable(col.names = c("Category", "Prizes", "Women", "% women"))

Category	Prizes	Women	% women
Peace	113	21	18.6
Literature	123	19	15.4
Physiology or Medicine	235	14	6.0
Chemistry	202	8	4.0
Economic Sciences	101	3	3.0
Physics	231	5	2.2

people |>
  mutate(decade = 10 * (award_year %/% 10)) |>
  group_by(decade) |>
  summarise(pct_women = 100 * sum(gender == "female") / n(), .groups = "drop") |>
  ggplot(aes(x = decade, y = pct_women)) +
  geom_col(fill = accent, width = 8) +
  geom_text(aes(label = sprintf("%.0f%%", pct_women)), vjust = -0.4, size = 3.2) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
  labs(title = "The share of women has risen, from a very low base",
       x = NULL, y = "% of prizes to women") +
  theme_nb

Figure 2: Share of prizes to women by decade. Organizations are excluded, since they have no gender.

The answer. The share has risen from 5.4% in the 1900s to 19.5% in the 2020s, with the 1950s recording none at all. The gap between categories is wider than the change over time: Peace sits at 18.6% and Literature at 15.4%, while Physics is at 2.2% — five women in 231 prizes.

5 Question 3: How old are laureates when they win?

The question. The prize is often awarded long after the work it recognises. Age at the time of the award makes that lag visible, and shows whether it is growing.

ages <- people |>
  filter(!is.na(birth_year)) |>
  mutate(age = award_year - birth_year)

tibble(
  prizes_with_age = nrow(ages),
  mean_age        = round(mean(ages$age), 1),
  median_age      = median(ages$age),
  youngest        = min(ages$age),
  oldest          = max(ages$age)
)

prizes_with_age	mean_age	median_age	youngest	oldest
1005	60.6	61	17	97

Age here is award year minus birth year, not an exact age in years. That is a deliberate simplification: 48 birth dates record only a year, so a precise calculation would silently drop them. The approximation is at most a year out.

ages |>
  group_by(category) |>
  summarise(prizes = n(), mean_age = round(mean(age), 1), .groups = "drop") |>
  arrange(mean_age) |>
  kable(col.names = c("Category", "Prizes", "Mean age"))

Category	Prizes	Mean age
Physics	231	57.8
Physiology or Medicine	235	59.0
Chemistry	202	59.5
Peace	113	61.0
Literature	123	65.0
Economic Sciences	101	67.2

ggplot(ages, aes(x = award_year, y = age)) +
  geom_point(alpha = 0.3, size = 1.4, color = accent) +
  geom_smooth(method = "loess", se = FALSE, color = accent_2, linewidth = 1) +
  labs(title = "Laureates are winning later in life",
       x = "Award year", y = "Age at award") +
  theme_nb

Figure 3: Age at the time of the award. Each point is one prize; the line is a smoothed trend.

bind_rows(
  ages |> slice_min(age, n = 3) |> mutate(group = "Youngest"),
  ages |> slice_max(age, n = 3) |> mutate(group = "Oldest")
) |>
  select(group, name, category, award_year, age) |>
  kable(col.names = c("", "Name", "Category", "Year", "Age"))

	Name	Category	Year	Age
Youngest	Malala Yousafzai	Peace	2014	17
Youngest	Lawrence Bragg	Physics	1915	25
Youngest	Nadia Murad	Peace	2018	25
Oldest	John B. Goodenough	Chemistry	2019	97
Oldest	Arthur Ashkin	Physics	2018	96
Oldest	Henri B. Kagan	Chemistry	2026	96

The answer. The mean is 60.6 and the median 61, but the trend is the real finding: laureates awarded before 1970 averaged 55.2, and those since average 64.0 — nearly nine years older. Economic Sciences has the oldest laureates at 67.2 and Physics the youngest at 57.8. The range runs from Malala Yousafzai at 17 to John B. Goodenough at 97.

6 Question 4: Which countries lost laureates, and which gained them?

The question. This one needs two fields compared rather than counted. Each prize record holds the laureate’s country of birth and the country of the institution they were working at when they won. Where those differ, a country educated someone whose prize was credited elsewhere.

movers <- awards |>
  filter(
    !is_organization,                      # organizations have no birthplace
    !is.na(birth_country_now),             # both countries must be known
    !is.na(affiliation_country_now)
  ) |>
  mutate(moved = birth_country_now != affiliation_country_now)

tibble(
  all_prize_rows      = nrow(awards),
  organizations       = sum(awards$is_organization),
  no_affiliation      = sum(is.na(awards$affiliation_country_now)),
  usable_for_question = nrow(movers),
  moved               = sum(movers$moved),
  pct_moved           = round(100 * mean(movers$moved), 1)
)

all_prize_rows	organizations	no_affiliation	usable_for_question	moved	pct_moved
1036	31	273	761	244	32.1

Only 761 of 1036 prize rows can answer this, because Peace and Literature laureates usually have no listed institution. The result describes the laureates who worked at universities and laboratories, which is most of the science prizes.

lost   <- movers |> filter(moved) |> count(country = birth_country_now,       name = "lost")
gained <- movers |> filter(moved) |> count(country = affiliation_country_now, name = "gained")

net_flow <- full_join(lost, gained, by = "country") |>
  replace_na(list(lost = 0, gained = 0)) |>
  mutate(net = gained - lost)

bind_rows(
  net_flow |> slice_max(net, n = 5) |> mutate(group = "Biggest net gainers"),
  net_flow |> slice_min(net, n = 5) |> mutate(group = "Biggest net losers")
) |>
  select(group, country, lost, gained, net) |>
  kable(col.names = c("", "Country", "Laureates lost", "Laureates gained", "Net"))

	Country	Laureates lost	Laureates gained	Net
Biggest net gainers	USA	4	134	130
Biggest net gainers	United Kingdom	24	35	11
Biggest net gainers	Switzerland	3	12	9
Biggest net gainers	Denmark	0	2	2
Biggest net gainers	Germany	24	25	1
Biggest net gainers	Sweden	3	4	1
Biggest net losers	Poland	19	0	-19
Biggest net losers	Canada	15	6	-9
Biggest net losers	Scotland	9	0	-9
Biggest net losers	Austria	10	2	-8
Biggest net losers	Hungary	8	0	-8
Biggest net losers	Russia	11	3	-8
Biggest net losers	the Netherlands	9	1	-8

net_flow |>
  filter(abs(net) >= 4) |>
  mutate(country = fct_reorder(country, net),
         direction = if_else(net > 0, "Net gain", "Net loss")) |>
  ggplot(aes(x = net, y = country, fill = direction)) +
  geom_col(width = 0.65) +
  geom_text(aes(label = net), hjust = ifelse(net_flow |> filter(abs(net) >= 4) |> pull(net) > 0, -0.3, 1.3),
            size = 3.2) +
  scale_fill_manual(values = c("Net gain" = accent, "Net loss" = accent_2), name = NULL) +
  scale_x_continuous(expand = expansion(mult = 0.12)) +
  labs(title = "One country gains; everyone else loses",
       x = "Laureates gained minus laureates lost", y = NULL) +
  theme_nb +
  theme(legend.position = "top", panel.grid.major.y = element_blank())

Figure 4: Net movement of laureates: born in one country, awarded while working in another.

movers |>
  filter(moved) |>
  count(birth_country_now, affiliation_country_now, sort = TRUE) |>
  head(8) |>
  kable(col.names = c("Born in", "Awarded while working in", "Laureates"))

Born in	Awarded while working in	Laureates
United Kingdom	USA	19
Canada	USA	15
Germany	USA	11
Poland	Germany	9
France	USA	8
Japan	USA	7
Scotland	United Kingdom	7
China	USA	6

movers |>
  summarise(
    born_in_usa      = sum(birth_country_now == "USA"),
    affiliated_usa   = sum(affiliation_country_now == "USA"),
    prizes           = n()
  ) |>
  mutate(pct_born = round(100 * born_in_usa / prizes, 1),
         pct_affiliated = round(100 * affiliated_usa / prizes, 1)) |>
  kable(col.names = c("Born in USA", "Working in USA", "Prizes", "% born", "% working"))

Born in USA	Working in USA	Prizes	% born	% working
272	402	761	35.7	52.8

The answer. Just under a third of these prizes, 32.1%, went to someone working outside their country of birth, and the flow is overwhelmingly in one direction. The United States has a net gain of 130 laureates, losing only 4 while gaining 134. No other country comes close: the United Kingdom is next at +11, and Switzerland at +9.

The largest losers are Poland (−19), then Canada, Scotland, Austria, Hungary, Russia and the Netherlands. The single biggest flow is United Kingdom to USA, 19 laureates, followed by Canada to USA at 15 and Germany to USA at 11.

The clearest way to see it: 35.7% of these laureates were born in the United States, but 52.8% were working there when they won.

movers |>
  mutate(decade = 10 * (award_year %/% 10)) |>
  group_by(decade) |>
  summarise(prizes = n(), n_moved = sum(moved),
            pct_moved = round(100 * sum(moved) / n(), 1), .groups = "drop") |>
  kable(col.names = c("Decade", "Prizes", "Moved", "% moved"))

Decade	Prizes	Moved	% moved
1900	33	14	42.4
1910	24	7	29.2
1920	33	9	27.3
1930	39	9	23.1
1940	30	11	36.7
1950	55	18	32.7
1960	60	17	28.3
1970	78	25	32.1
1980	76	27	35.5
1990	75	25	33.3
2000	97	26	26.8
2010	94	32	34.0
2020	67	24	35.8

Interestingly, the share who moved has not risen much: it was 42% in the 1900s and 36% in the 2020s, hovering around a third throughout. What changed is the destination. The early movements were largely within Europe — Poland to Germany is the fourth-largest flow in the whole dataset — while the modern ones nearly all end in the United States.

7 Conclusions

The prize has roughly doubled in size, from 57 laureates in the 1900s to 123 in the 2000s, mostly because prizes are now shared between two or three people.
Women have gone from 5.4% of laureates to 19.5%, but the category gap is larger than the change over time: Peace is at 18.6% and Physics at 2.2%.
Laureates are winning almost nine years later in life than before 1970, 64.0 against 55.2, which suggests a lengthening gap between the work and its recognition.
The United States has gained 130 laureates it did not produce, while Poland has lost 19. A third of scientific laureates were working outside their country of birth when they won, and that share has been roughly constant for a century — only the destination has changed.

What the data cannot say. Question 4 rests on 761 of 1,036 prize rows, because Peace and Literature laureates rarely list an institution, so it is really a finding about the sciences. The affiliation is also only the one recorded at the time of the award: a laureate who was born in Germany, trained in the UK and won in the USA appears here simply as Germany to USA.

8 Source

Nobel Prize API v2.1, laureates endpoint, https://api.nobelprize.org/2.1/laureates. Data from nobelprize.org, used under the Nobel Prize API terms of use.