Working with the two JSON files available through the API at nobelprize.org, ask and answer 4 interesting questions.

library(tidyverse)
library(RCurl)
library(rjson)
library(data.table)
library(httr)
library(reshape2)
library(htmlwidgets)
library(kableExtra)

Nobel Prize API

prize_url <- "https://raw.githubusercontent.com/moham6839/Extra_Credit_JSON/main/Nobel_Prize.json"

prize_json_df <- jsonlite::fromJSON(prize_url) 
new_prize_df <- prize_json_df$prizes
prize_df <- as.data.frame(new_prize_df)
DT::datatable(prize_df, filter="top")

new_prize_df <- unnest(prize_df)

  kbl(head(new_prize_df, n = 10)) %>%
  kable_styling(latex_options="scale_down", c("striped", "hover", "condensed", full_width=F))

year	category	id	firstname	surname	motivation	share	overallMotivation
2022	chemistry	1015	Carolyn	Bertozzi	“for the development of click chemistry and bioorthogonal chemistry”	3	NA
2022	chemistry	1016	Morten	Meldal	“for the development of click chemistry and bioorthogonal chemistry”	3	NA
2022	chemistry	743	Barry	Sharpless	“for the development of click chemistry and bioorthogonal chemistry”	3	NA
2022	economics	1021	Ben	Bernanke	“for research on banks and financial crises”	3	NA
2022	economics	1022	Douglas	Diamond	“for research on banks and financial crises”	3	NA
2022	economics	1023	Philip	Dybvig	“for research on banks and financial crises”	3	NA
2022	literature	1017	Annie	Ernaux	“for the courage and clinical acuity with which she uncovers the roots, estrangements and collective restraints of personal memory”	1	NA
2022	peace	1018	Ales	Bialiatski	“The Peace Prize laureates represent civil society in their home countries. They have for many years promoted the right to criticise power and protect the fundamental rights of citizens. They have made an outstanding effort to document war crimes, human right abuses and the abuse of power. Together they demonstrate the significance of civil society for peace and democracy.”	3	NA
2022	peace	1019	Memorial	NA	“The Peace Prize laureates represent civil society in their home countries. They have for many years promoted the right to criticise power and protect the fundamental rights of citizens. They have made an outstanding effort to document war crimes, human right abuses and the abuse of power. Together they demonstrate the significance of civil society for peace and democracy.”	3	NA
2022	peace	1020	Center for Civil Liberties	NA	“The Peace Prize laureates represent civil society in their home countries. They have for many years promoted the right to criticise power and protect the fundamental rights of citizens. They have made an outstanding effort to document war crimes, human right abuses and the abuse of power. Together they demonstrate the significance of civil society for peace and democracy.”	3	NA

Nobel Laureates API

laureate_url <- "https://raw.githubusercontent.com/moham6839/Extra_Credit_JSON/main/Nobel_Laureate.json"
laureate_json_df <- jsonlite::fromJSON(laureate_url) 
new_laureate_df <- laureate_json_df$laureates
laureate_df <- as.data.frame(new_laureate_df)
DT::datatable(laureate_df, filter="top")

colnames(laureate_df)

##  [1] "id"              "firstname"       "surname"         "born"           
##  [5] "died"            "bornCountry"     "bornCountryCode" "bornCity"       
##  [9] "diedCountry"     "diedCountryCode" "diedCity"        "gender"         
## [13] "prizes"

new_laureate_df <- unnest(laureate_df)
new_laureate_df2 <- unnest_wider(new_laureate_df, `affiliations`, names_sep = "_")

  kbl(head(new_laureate_df2, n = 10)) %>%
  kable_styling(latex_options="scale_down", c("striped", "hover", "condensed", full_width=F))

id	firstname	surname	born	died	bornCountry	bornCountryCode	bornCity	diedCountry	diedCountryCode	diedCity	gender	year	category	share	motivation	affiliations_name	affiliations_city	affiliations_country	affiliations_1	overallMotivation
1	Wilhelm Conrad	Röntgen	1845-03-27	1923-02-10	Prussia (now Germany)	DE	Lennep (now Remscheid)	Germany	DE	Munich	male	1901	physics	1	“in recognition of the extraordinary services he has rendered by the discovery of the remarkable rays subsequently named after him”	Munich University	Munich	Germany	NA	NA
2	Hendrik A.	Lorentz	1853-07-18	1928-02-04	the Netherlands	NL	Arnhem	the Netherlands	NL	NA	male	1902	physics	2	“in recognition of the extraordinary service they rendered by their researches into the influence of magnetism upon radiation phenomena”	Leiden University	Leiden	the Netherlands	NA	NA
3	Pieter	Zeeman	1865-05-25	1943-10-09	the Netherlands	NL	Zonnemaire	the Netherlands	NL	Amsterdam	male	1902	physics	2	“in recognition of the extraordinary service they rendered by their researches into the influence of magnetism upon radiation phenomena”	Amsterdam University	Amsterdam	the Netherlands	NA	NA
4	Henri	Becquerel	1852-12-15	1908-08-25	France	FR	Paris	France	FR	NA	male	1903	physics	2	“in recognition of the extraordinary services he has rendered by his discovery of spontaneous radioactivity”	École Polytechnique	Paris	France	NA	NA
5	Pierre	Curie	1859-05-15	1906-04-19	France	FR	Paris	France	FR	Paris	male	1903	physics	4	“in recognition of the extraordinary services they have rendered by their joint researches on the radiation phenomena discovered by Professor Henri Becquerel”	École municipale de physique et de chimie industrielles (Municipal School of Industrial Physics and Chemistry)	Paris	France	NA	NA
6	Marie	Curie	1867-11-07	1934-07-04	Russian Empire (now Poland)	PL	Warsaw	France	FR	Sallanches	female	1903	physics	4	“in recognition of the extraordinary services they have rendered by their joint researches on the radiation phenomena discovered by Professor Henri Becquerel”	NULL	NULL	NULL	NA	NA
6	Marie	Curie	1867-11-07	1934-07-04	Russian Empire (now Poland)	PL	Warsaw	France	FR	Sallanches	female	1911	chemistry	1	“in recognition of her services to the advancement of chemistry by the discovery of the elements radium and polonium, by the isolation of radium and the study of the nature and compounds of this remarkable element”	Sorbonne University	Paris	France	NA	NA
8	Lord	Rayleigh	1842-11-12	1919-06-30	United Kingdom	GB	Langford Grove, Maldon, Essex	United Kingdom	GB	NA	male	1904	physics	1	“for his investigations of the densities of the most important gases and for his discovery of argon in connection with these studies”	Royal Institution of Great Britain	London	United Kingdom	NA	NA
9	Philipp	Lenard	1862-06-07	1947-05-20	Hungary (now Slovakia)	SK	Pressburg (now Bratislava)	Germany	DE	Messelhausen	male	1905	physics	1	“for his work on cathode rays”	Kiel University	Kiel	Germany	NA	NA
10	J.J.	Thomson	1856-12-18	1940-08-30	United Kingdom	GB	Cheetham Hill	United Kingdom	GB	Cambridge	male	1906	physics	1	“in recognition of the great merits of his theoretical and experimental investigations on the conduction of electricity by gases”	University of Cambridge	Cambridge	United Kingdom	NA	NA

Which country has the most Nobel Laureates?

most_laureates <- new_laureate_df2 %>%
  filter(!is.na(bornCountry)) %>%
  group_by(bornCountry) %>%
  summarise(count=n()) %>%
  arrange(desc(count))

pct_most_laureates <- most_laureates %>%
  mutate(pct_breakdown = 100 * (most_laureates$count / nrow(new_laureate_df2))) %>%
  top_n(20) %>%
  arrange(desc(pct_breakdown))
pct_most_laureates

## # A tibble: 21 × 3
##    bornCountry     count pct_breakdown
##    <chr>           <int>         <dbl>
##  1 USA               289         29.2 
##  2 United Kingdom     90          9.10
##  3 Germany            67          6.77
##  4 France             56          5.66
##  5 Sweden             30          3.03
##  6 Japan              28          2.83
##  7 Canada             21          2.12
##  8 Switzerland        19          1.92
##  9 the Netherlands    19          1.92
## 10 Italy              18          1.82
## # … with 11 more rows

ggplot(pct_most_laureates, aes(x=reorder(bornCountry, -pct_breakdown), y=pct_breakdown)) +
  geom_bar(stat="identity", position="dodge") +
  coord_flip()

Close to 30% of all Nobel Laureates were born in the U.S., followed by Great Britain and Germany.

What is the percentage of Nobel Laureates that are still alive?

still_alive <- new_laureate_df2 %>%
  filter(died == "0000-00-00") %>%
  group_by(died) %>%
  summarise(count=n()) %>%
  arrange(desc(died))
still_alive

## # A tibble: 1 × 2
##   died       count
##   <chr>      <int>
## 1 0000-00-00   331

pct_still_alive <- (still_alive$count / nrow(new_laureate_df2)) * 100
pct_still_alive

## [1] 33.46815

Approximately 33% of Nobel Laureates are still alive.

Which category has the most female Nobel Laureates winners?

category_breakdown <- new_laureate_df2 %>%
  filter(gender == "female") %>%
  group_by(category) %>%
  summarise(count=n()) %>%
  arrange(desc(count))
category_breakdown

## # A tibble: 6 × 2
##   category   count
##   <chr>      <int>
## 1 peace         18
## 2 literature    17
## 3 medicine      12
## 4 chemistry      8
## 5 physics        4
## 6 economics      2

category_breakdown %>%
ggplot(aes(x = reorder(category, -count), y=count)) +
  geom_bar(stat='identity', position='dodge', width=0.5) +
  labs(title = "Female Nobel Laureates",
       y="Number of Female Nobel Laureates",
       x="Category")

The category that has the most female Nobel Laureates is Peace, followed by Literature and Medicine.

What is the percentage of the Nobel Prize awards that had shared winners?

shared_prize <- new_prize_df %>%
  count(share) 
shared_prize

## # A tibble: 4 × 2
##   share     n
##   <chr> <int>
## 1 1       355
## 2 2       329
## 3 3       231
## 4 4        74

shared_prizes2 <- shared_prize %>%
  mutate(pct_shared = 100 * (shared_prize$n / nrow(new_prize_df))) %>%
  arrange(desc(pct_shared))
shared_prizes2

## # A tibble: 4 × 3
##   share     n pct_shared
##   <chr> <int>      <dbl>
## 1 1       355      35.9 
## 2 2       329      33.3 
## 3 3       231      23.4 
## 4 4        74       7.48

shared_prizes2 %>%
ggplot(aes(x = reorder(share, -pct_shared), y=pct_shared)) +
  geom_bar(stat='identity', position='dodge', width=0.5) +
  labs(title = "Nobel Prizes Winners",
       y="Percentage Breakdown",
       x="Number of Times Shared")

shared_breakdown <- new_prize_df %>%
  summarise(single = sum(share == 1),
            multiple = sum(share > 1))
shared_breakdown

## # A tibble: 1 × 2
##   single multiple
##    <int>    <int>
## 1    355      634

pct_shared_winners <- (shared_breakdown$multiple / sum(shared_breakdown)) * 100
pct_shared_winners

## [1] 64.10516

Approximately 64% of all Nobel Prizes were shared by at least 2 or more people.

Nobel Prize Exploration

Mohamed Hassan-El Serafi

2023-03-27

Nobel Prize API

Nobel Laureates API