Assingment 10B-Approach

Author

Mubin Ejaz

Approach:

I’d first make just a simple call to API to make sure I can connect.
I chose the 4 questions I’d want to be answered.

library(httr2)
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.1     
── 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(DT)

# Getting Nobel laureate data
get_page <- function(offset) {
  request("https://api.nobelprize.org/2.1/laureates") %>%
    req_url_query(
      limit = 1000,
      offset = offset,
      format = "json"
    ) %>%
    req_perform() %>%
    resp_body_json()
}

# Downloading all pages
laureates <- list()
offset <- 0

repeat {
  data <- get_page(offset)
  page <- data$laureates

  if (length(page) == 0) break

  laureates <- append(laureates, page)

  if (length(page) < 1000) break

  offset <- offset + 1000
}

length(laureates)

[1] 1028

Question 1:
ORIGINAL Question:
What is the basic criteria for choosing the nominees?

The change:
One important distinction: the Nobel API publishes laureates and award motivations, but it does not publish current nominee lists or confidential nomination evaluations. Those records are kept secret for 50 years.

So:

Q1 becomes: What reasons are given for awarding Nobel Prizes?

# Helper function to get information from nested JSON
get_value <- function(x, ...) {
  value <- purrr::pluck(x, ..., .default = NA_character_)
  as.character(value[[1]])
}

# Getting the laureate's name
get_name <- function(x) {
  name <- get_value(x, "fullName", "en")

  if (is.na(name)) {
    name <- get_value(x, "orgName", "en")
  }

  name
}

# Getting birthplace country
get_country <- function(x) {
  country <- get_value(x, "birth", "place", "countryNow", "en")

  if (is.na(country)) {
    country <- get_value(x, "birth", "place", "country", "en")
  }

  country
}

# Creating a table of laureates
laureates_df <- tibble(
  id = map_chr(laureates, ~ get_value(.x, "id")),
  name = map_chr(laureates, get_name),
  gender = map_chr(laureates, ~ get_value(.x, "gender")),
  birth_country = map_chr(laureates, get_country),
  birth_date = map_chr(laureates, ~ get_value(.x, "birth", "date")),
  death_date = map_chr(laureates, ~ get_value(.x, "death", "date")),
  prizes = map(laureates, ~ purrr::pluck(.x, "nobelPrizes", .default = list()))
)

# Creating one row per laureate and prize
prize_df <- laureates_df %>%
  unnest_longer(prizes, values_to = "prize") %>%
  mutate(
    award_year = map_int(prize, ~ as.integer(get_value(.x, "awardYear"))),
    category = map_chr(prize, ~ get_value(.x, "category", "en")),
    motivation = map_chr(prize, ~ get_value(.x, "motivation", "en")),
    date_awarded = map_chr(prize, ~ get_value(.x, "dateAwarded"))
  )

#QUESTION 1

# motivation_results <- prize_df %>%
#   filter(!is.na(motivation)) %>%
#   distinct(category, award_year, motivation) %>%
#   group_by(category) %>%
#   slice_max(award_year, n = 1, with_ties = FALSE) %>%
#   ungroup() %>%
#   select(category, award_year, motivation)
# 
# motivation_results


# Keeping only the information needed for Question 1
motivation_table <- prize_df %>%
  filter(!is.na(motivation), motivation != "") %>%
  distinct(award_year, category, motivation) %>%
  arrange(desc(award_year)) %>%
  select(
    AwardYear = award_year,
    Category = category,
    Motivation = motivation
  )

# Displaying the results in an interactive table
datatable(
  motivation_table,
  rownames = FALSE,
  options = list(
    pageLength = 10,
    lengthMenu = c(10, 25, 50, 100),
    scrollX = TRUE
  )
)

Question 2:
Does every category ends up with a winner every year
My approach is to check years in which a category had no winners

# Finding the first and latest year for each category
latest_year <- max(prize_df$award_year, na.rm = TRUE)

category_years <- prize_df %>%
  group_by(category) %>%
  summarise(first_year = min(award_year), .groups = "drop") %>%
  mutate(
    award_year = map(first_year, ~ seq(.x, latest_year))
  ) %>%
  unnest(award_year)

# Finding category/year combinations without a laureate
missing_awards <- category_years %>%
  anti_join(
    prize_df %>% distinct(category, award_year),
    by = c("category", "award_year")
  )

# Counting years without awards by category
missing_awards %>%
  count(category, name = "years_without_award")

# A tibble: 5 × 2
  category               years_without_award
  <chr>                                <int>
1 Chemistry                                8
2 Literature                               7
3 Peace                                   19
4 Physics                                  6
5 Physiology or Medicine                   9

Question 3:
Does Nobel Prize laureates data seem to be politically motivated at all?

The Change due to data limitations:
Q3 becomes: How many Peace Prize recipients are individuals versus organizations? The data cannot establish political motivation by itself.

Instead of trying to prove political motivation, I’ll compare the number of individual and organizational recipients of the Peace Prize.

peace_results <- prize_df %>%
  filter(category == "Peace") %>%
  distinct(id, award_year, gender) %>%
  mutate(
    recipient_type = case_when(
      gender == "org" ~ "Organization",
      gender %in% c("male", "female") ~ "Individual",
      TRUE ~ "Unknown"
    )
  ) %>%
  count(recipient_type, sort = TRUE)

peace_results

# A tibble: 2 × 2
  recipient_type     n
  <chr>          <int>
1 Individual       113
2 Unknown           31

Question 4:
Can peaple that have passed away get nobel prize?
I’ll compare the laureate’s death date with the date the prize was announced.

posthumous_results <- prize_df %>%
  mutate(
    death_date = as.Date(death_date),
    date_awarded = as.Date(date_awarded),
    death_year = as.integer(format(death_date, "%Y")),

    died_before_announcement = case_when(
      !is.na(death_date) & !is.na(date_awarded) ~
        death_date < date_awarded,

      !is.na(death_year) ~ death_year < award_year,

      TRUE ~ FALSE
    )
  ) %>%
  filter(died_before_announcement) %>%
  distinct(
    name, category, award_year,
    death_date, date_awarded
  ) %>%
  arrange(award_year)

posthumous_results

# A tibble: 3 × 5
  name                               category award_year death_date date_awarded
  <chr>                              <chr>         <int> <date>     <date>      
1 Erik Axel Karlfeldt                Literat…       1931 1931-04-08 1931-11-08  
2 Dag Hjalmar Agne Carl Hammarskjöld Peace          1961 1961-09-18 1961-10-23  
3 Ralph M. Steinman                  Physiol…       2011 2011-09-30 2011-10-03