10 B Assignemnt

Loading the Data

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.2.1     ✔ readr     2.2.0
✔ forcats   1.0.1     ✔ stringr   1.6.0
✔ ggplot2   4.0.3     ✔ tibble    3.3.1
✔ lubridate 1.9.5     ✔ tidyr     1.3.2
✔ purrr     1.2.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(jsonlite)

Attaching package: 'jsonlite'

The following object is masked from 'package:purrr':

    flatten

url1 <- "https://api.nobelprize.org/2.1/laureates?limit=1000&offset=0"
url2 <- "https://api.nobelprize.org/2.1/laureates?limit=1000&offset=1000"

page1 <- fromJSON(url1, simplifyVector = FALSE)
page2 <- fromJSON(url2, simplifyVector = FALSE)

laureates <- c(page1$laureates, page2$laureates)

length(laureates)

[1] 1028

Inspect JSON Structure

names(laureates[[1]])

 [1] "id"          "knownName"   "givenName"   "familyName"  "fullName"   
 [6] "fileName"    "gender"      "birth"       "wikipedia"   "wikidata"   
[11] "sameAs"      "links"       "nobelPrizes"

str(laureates[[1]], max.level = 2)

List of 13
 $ id         : chr "745"
 $ knownName  :List of 2
  ..$ en: chr "A. Michael Spence"
  ..$ se: chr "A. Michael Spence"
 $ givenName  :List of 2
  ..$ en: chr "A. Michael"
  ..$ se: chr "A. Michael"
 $ familyName :List of 2
  ..$ en: chr "Spence"
  ..$ se: chr "Spence"
 $ fullName   :List of 2
  ..$ en: chr "A. Michael Spence"
  ..$ se: chr "A. Michael Spence"
 $ fileName   : chr "spence"
 $ gender     : chr "male"
 $ birth      :List of 3
  ..$ date : chr "1943-11-07"
  ..$ year : chr "1943"
  ..$ place:List of 6
 $ wikipedia  :List of 2
  ..$ slug   : chr "Michael_Spence"
  ..$ english: chr "https://en.wikipedia.org/wiki/Michael_Spence"
 $ wikidata   :List of 2
  ..$ id : chr "Q157245"
  ..$ url: chr "https://www.wikidata.org/wiki/Q157245"
 $ sameAs     :List of 2
  ..$ : chr "https://www.wikidata.org/wiki/Q157245"
  ..$ : chr "https://en.wikipedia.org/wiki/Michael_Spence"
 $ links      :List of 2
  ..$ :List of 4
  ..$ :List of 6
 $ nobelPrizes:List of 1
  ..$ :List of 12

Convert JSON into a Tidy Data Frame

nobel_data <- map_dfr(laureates, function(person) {
  map_dfr(person$nobelPrizes, function(prize) {
    tibble(
      id = person$id,
      gender = pluck(person, "gender", .default = NA_character_),
      birth_country = pluck(person, "birth", "place",
                            "country", "en", .default = NA_character_),
      birth_year = as.integer(substr(
        pluck(person, "birth", "date", .default = NA_character_), 1, 4)),
      category = pluck(prize, "category", "en",
                       .default = NA_character_),
      award_year = as.integer(pluck(prize, "awardYear",
                                    .default = NA_character_))
    )
  })
})

head(nobel_data)

# A tibble: 6 × 6
  id    gender birth_country                     birth_year category  award_year
  <chr> <chr>  <chr>                                  <int> <chr>          <int>
1 745   male   USA                                     1943 Economic…       2001
2 102   male   Denmark                                 1922 Physics         1975
3 779   male   British Protectorate of Palestine       1947 Chemistry       2004
4 259   male   Lithuania                               1926 Chemistry       1982
5 1004  male   <NA>                                    1948 Literatu…       2021
6 114   male   India                                   1926 Physics         1979

Question 1 — Which Nobel Prize categories have the most laureates?

Physiology or Medicine

nobel_data %>%
  distinct(id, category) %>%
  count(category, sort = TRUE) %>%
  knitr::kable()

category	n
Physiology or Medicine	235
Physics	230
Chemistry	200
Peace	141
Literature	123
Economic Sciences	101

Question 2 — Which countries have produced the most Nobel Prize laureates?

USA

nobel_data %>%
  filter(!is.na(birth_country)) %>%
  distinct(id, birth_country) %>%
  count(birth_country, sort = TRUE) %>%
  slice_head(n = 10)

# A tibble: 10 × 2
   birth_country       n
   <chr>           <int>
 1 USA               299
 2 United Kingdom     94
 3 Germany            82
 4 France             61
 5 Japan              31
 6 Sweden             30
 7 Canada             23
 8 the Netherlands    20
 9 Switzerland        19
10 Italy              18

Question 3 — What percentage of Nobel laureates in each category are women?

category	total	female	female_pct
Peace	113	21	18.58
Literature	123	19	15.45
Physiology or Medicine	235	14	5.96
Chemistry	200	8	4.00
Economic Sciences	101	3	2.97
Physics	230	5	2.17

nobel_data %>%
  filter(gender %in% c("male", "female")) %>%
  distinct(id, category, .keep_all = TRUE) %>%
  group_by(category) %>%
  summarise(
    total = n(),
    female = sum(gender == "female"),
    female_pct = round(mean(gender == "female") * 100, 2)
  ) %>%
  arrange(desc(female_pct)) %>%
  knitr::kable()

category	total	female	female_pct
Peace	113	21	18.58
Literature	123	19	15.45
Physiology or Medicine	235	14	5.96
Chemistry	200	8	4.00
Economic Sciences	101	3	2.97
Physics	230	5	2.17

Question 4 — What is the average age of Nobel Prize laureates when they receive their award, and how does it differ across categories?

category	total_awards	average_age
Economic Sciences	101	67.21
Literature	123	65.04
Peace	113	60.97
Chemistry	202	59.48
Physiology or Medicine	235	59.02
Physics	231	57.82

nobel_data %>%
  filter(!is.na(birth_year), !is.na(award_year)) %>%
  filter(birth_year <= award_year) %>%
  mutate(age_at_award = award_year - birth_year) %>%
  group_by(category) %>%
  summarise(
    total_awards = n(),
    average_age = round(mean(age_at_award), 2)
  ) %>%
  arrange(desc(average_age)) %>%
  knitr::kable()

category	total_awards	average_age
Economic Sciences	101	67.21
Literature	123	65.04
Peace	113	60.97
Chemistry	202	59.48
Physiology or Medicine	235	59.02
Physics	231	57.82