1 + 1[1] 2Untitled
Quarto
Quarto enables you to weave together content and executable code into a finished document. To learn more about Quarto see https://quarto.org.
Running Code
When you click the Render button a document will be generated that includes both content and the output of embedded code. You can embed code like this:
You can add options to executable code like this
[1] 4The echo: false option disables the printing of code (only output is displayed).
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 errorslibrary(RColorBrewer)
library(scales)
Attaching package: 'scales'
The following object is masked from 'package:purrr':
discard
The following object is masked from 'package:readr':
col_factorlibrary(highcharter)Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo library(extrafont)Registering fonts with Rlibrary(ggthemes)
library(ggrepel)
library(dslabs)
Attaching package: 'dslabs'
The following object is masked from 'package:highcharter':
starssetwd(file.path(Sys.getenv("USERPROFILE"), "Downloads"))
disease_democ <- read_csv("disease_democ.csv")Rows: 168 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (2): country, income_group
dbl (2): democ_score, infect_rate
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.names(postscriptFonts()) [1] "serif" "sans" "mono"
[4] "AvantGarde" "Bookman" "Courier"
[7] "Helvetica" "Helvetica-Narrow" "NewCenturySchoolbook"
[10] "Palatino" "Times" "URWGothic"
[13] "URWBookman" "NimbusMon" "NimbusSan"
[16] "URWHelvetica" "NimbusSanCond" "CenturySch"
[19] "URWPalladio" "NimbusRom" "URWTimes"
[22] "URW2Helvetica" "URW2HelveticaItalic" "URW2Times"
[25] "NimbusMonoPS" "ArialMT" "ComputerModern"
[28] "ComputerModernItalic" "Japan1" "Japan1HeiMin"
[31] "Japan1GothicBBB" "Japan1Ryumin" "Korea1"
[34] "Korea1deb" "CNS1" "GB1" disease_democ_chart <- ggplot(disease_democ, aes(x = infect_rate, y = democ_score)) +
labs(x = "Infectious Disease Prevalence Score",
y = "Democratization Score",
title = "Comparison of Disease Prevalence and Democratization Score") +
theme_minimal(base_family = "serif")
disease_democ_chart
disease_democ_chart +
geom_point()
disease_democ_chart +
geom_point(size = 3, alpha = 0.5) +
geom_smooth(method = lm, se = FALSE, color = "red")`geom_smooth()` using formula = 'y ~ x'
disease_democ_chart +
geom_point(size = 3, alpha = 0.5, aes(color = income_group)) +
geom_smooth(method = lm, se = FALSE, color = "black", lty = 2, linewidth = 0.3)`geom_smooth()` using formula = 'y ~ x'
ggplot(disease_democ, aes(x = infect_rate, y = democ_score, color = income_group)) +
labs(x = "Infectious Disease Prevalence Score",
y = "Democratization Score",
title = "Comparison of Disease Prevalence and Democratization Score") +
theme_minimal(base_size = 14, base_family = "serif") +
geom_point(size = 3, alpha = 0.5) +
geom_smooth(method = lm, se = FALSE, lty = 2, linewidth = 0.3)`geom_smooth()` using formula = 'y ~ x'
ggplot(disease_democ, aes(x = infect_rate, y = democ_score, color = income_group)) +
labs(x = "Infectious Disease Prevalence Score",
y = "Democratization Score",
title = "Comparison of Disease Prevalence and Democratization Score") +
theme_minimal(base_size = 14, base_family = "serif") +
geom_point(size = 3, alpha = 0.5) +
geom_smooth(method = lm, se = FALSE, lty = 2, linewidth = 0.3) +
scale_color_brewer(name = "Income group", palette = "Set1")`geom_smooth()` using formula = 'y ~ x'
data(package = "dslabs")
list.files(system.file("script", package = "dslabs")) [1] "make-admissions.R"
[2] "make-brca.R"
[3] "make-brexit_polls.R"
[4] "make-calificaciones.R"
[5] "make-death_prob.R"
[6] "make-divorce_margarine.R"
[7] "make-gapminder-rdas.R"
[8] "make-greenhouse_gases.R"
[9] "make-historic_co2.R"
[10] "make-mice_weights.R"
[11] "make-mnist_127.R"
[12] "make-mnist_27.R"
[13] "make-movielens.R"
[14] "make-murders-rda.R"
[15] "make-na_example-rda.R"
[16] "make-nyc_regents_scores.R"
[17] "make-olive.R"
[18] "make-outlier_example.R"
[19] "make-polls_2008.R"
[20] "make-polls_us_election_2016.R"
[21] "make-pr_death_counts.R"
[22] "make-reported_heights-rda.R"
[23] "make-research_funding_rates.R"
[24] "make-results_us_election_2012.R"
[25] "make-stars.R"
[26] "make-temp_carbon.R"
[27] "make-tissue-gene-expression.R"
[28] "make-trump_tweets.R"
[29] "make-weekly_us_contagious_diseases.R"
[30] "save-gapminder-example-csv.R" data("murders")
ds_theme_set()
murders |> ggplot(aes(x = population/10^6, y = total, label = abb)) +
geom_smooth(method = "lm", se = FALSE, lty = 2, col = "darkgrey") +
geom_point(aes(color = region), size = 3) +
geom_text_repel(nudge_x = 0.005) +
scale_x_log10("Populations in millions (log scale)") +
scale_y_log10("Total number of murders (log scale)") +
ggtitle("US Gun Murders in 2010") +
scale_color_discrete(name = "Region")`geom_smooth()` using formula = 'y ~ x'Warning: The following aesthetics were dropped during statistical transformation: label.
ℹ This can happen when ggplot fails to infer the correct grouping structure in
the data.
ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
variable into a factor?
data("gapminder")
west <- c("Western Europe", "Northern Europe", "Southern Europe",
"Northern America", "Australia and New Zealand")
gapminder1 <- gapminder |>
mutate(group = case_when(
region %in% west ~ "The West",
region %in% c("Eastern Asia", "South-Eastern Asia") ~ "East Asia",
region %in% c("Caribbean", "Central America", "South America") ~ "Latin America",
continent == "Africa" & region != "Northern Africa" ~ "Sub-Saharan Africa",
TRUE ~ "Others"))
gapminder2 <- gapminder1 |>
mutate(group = factor(group, levels = rev(c("Others", "Latin America", "East Asia", "Sub-Saharan Africa", "The West"))))
gapminder2 |>
filter(year %in% c(1963, 2013) & !is.na(group) &
!is.na(fertility) & !is.na(life_expectancy)) |>
mutate(population_in_millions = population/10^6) |>
ggplot(aes(x = fertility, y = life_expectancy, col = group, size = population_in_millions)) +
geom_point(alpha = 0.8) +
guides(size = "none") +
theme(plot.title = element_blank(), legend.title = element_blank()) +
coord_cartesian(ylim = c(30, 85)) +
xlab("Fertility rate (births per woman)") +
ylab("Life Expectancy") +
geom_text(aes(x = 6, y = 82, label = year), cex = 12, color = "grey") +
facet_grid(. ~ year) +
theme(strip.background = element_blank(),
strip.text.x = element_blank(),
strip.text.y = element_blank(),
legend.position = "top")
data("us_contagious_diseases")
unique(us_contagious_diseases$disease)[1] Hepatitis A Measles Mumps Pertussis Polio Rubella
[7] Smallpox
Levels: Hepatitis A Measles Mumps Pertussis Polio Rubella Smallpoxus_contagious_diseases |>
filter(!state %in% c("Hawaii", "Alaska") & disease == "Measles") |>
mutate(rate = count / population * 10000 / (weeks_reporting/52)) |>
mutate(state = reorder(state, rate)) |>
ggplot(aes(year, state, fill = rate)) +
geom_tile(color = "grey50") +
scale_x_continuous(expand = c(0, 0)) +
scale_fill_gradientn(colors = brewer.pal(9, "Reds"), trans = "sqrt") +
geom_vline(xintercept = 1963, col = "blue") +
theme_minimal() +
labs(title = "State Rates of Incidents of Measles",
caption = "Source: Tycho Project",
x = "",
y = "")
data(polls_us_election_2016)
poll <- polls_us_election_2016 |>
filter(state == "U.S." & enddate >= "2016-07-01") |>
select(enddate, pollster, rawpoll_clinton, rawpoll_trump) |>
rename(Clinton = rawpoll_clinton, Trump = rawpoll_trump) |>
gather(candidate, percentage, -enddate, -pollster) |>
mutate(candidate = factor(candidate, levels = c("Trump", "Clinton"))) |>
group_by(pollster) |>
filter(n() >= 10) |>
ungroup()
poll# A tibble: 1,412 × 4
enddate pollster candidate percentage
<date> <fct> <fct> <dbl>
1 2016-11-06 ABC News/Washington Post Clinton 47
2 2016-11-07 Google Consumer Surveys Clinton 38.0
3 2016-11-06 Ipsos Clinton 42
4 2016-11-07 YouGov Clinton 45
5 2016-11-06 Gravis Marketing Clinton 47
6 2016-11-06 Fox News/Anderson Robbins Research/Shaw & Co… Clinton 48
7 2016-11-06 CBS News/New York Times Clinton 45
8 2016-11-05 NBC News/Wall Street Journal Clinton 44
9 2016-11-07 IBD/TIPP Clinton 41.2
10 2016-11-06 Monmouth University Clinton 50
# ℹ 1,402 more rowsggplot(data = poll, aes(enddate, percentage, color = candidate)) +
geom_point(show.legend = FALSE, alpha = 0.4) +
geom_smooth(method = "loess", span = 0.15) +
scale_y_continuous(limits = c(30, 50))`geom_smooth()` using formula = 'y ~ x'Warning: Removed 22 rows containing non-finite outside the scale range
(`stat_smooth()`).Warning: Removed 22 rows containing missing values or values outside the scale range
(`geom_point()`).
nations <- read_csv("nations.csv.csv") |>
mutate(gdp_tn = gdp_percap*population/10^12)Rows: 5275 Columns: 10
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): iso2c, iso3c, country, region, income
dbl (5): year, gdp_percap, population, birth_rate, neonat_mortal_rate
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.head(nations)# A tibble: 6 × 11
iso2c iso3c country year gdp_percap population birth_rate neonat_mortal_rate
<chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 AD AND Andorra 1996 NA 64291 10.9 2.8
2 AD AND Andorra 1994 NA 62707 10.9 3.2
3 AD AND Andorra 2003 NA 74783 10.3 2
4 AD AND Andorra 1990 NA 54511 11.9 4.3
5 AD AND Andorra 2009 NA 85474 9.9 1.7
6 AD AND Andorra 2011 NA 82326 NA 1.6
# ℹ 3 more variables: region <chr>, income <chr>, gdp_tn <dbl>big4 <- nations |>
filter(iso3c %in% c("CHN", "DEU", "JPN", "USA")) |>
arrange(year)
highchart() |>
hc_add_series(data = big4,
type = "line",
hcaes(x = year,
y = gdp_tn,
group = country))cols <- brewer.pal(4, "Set1")
highchart() |>
hc_add_series(data = big4,
type = "line",
hcaes(x = year,
y = gdp_tn,
group = country)) |>
hc_colors(cols)highchart() |>
hc_add_series(data = big4,
type = "line",
hcaes(x = year,
y = gdp_tn,
group = country)) |>
hc_colors(cols) |>
hc_xAxis(title = list(text = "Year")) |>
hc_yAxis(title = list(text = "GDP ($ trillion)"))highchart() |>
hc_add_series(data = big4,
type = "line",
hcaes(x = year,
y = gdp_tn,
group = country)) |>
hc_colors(cols) |>
hc_xAxis(title = list(text = "Year")) |>
hc_yAxis(title = list(text = "GDP ($ trillion)")) |>
hc_plotOptions(series = list(marker = list(symbol = "circle"))) |>
hc_legend(align = "right",
verticalAlign = "top")big4_chart <- highchart() |>
hc_add_series(data = big4,
type = "line",
hcaes(x = year,
y = gdp_tn,
group = country)) |>
hc_colors(cols) |>
hc_xAxis(title = list(text = "Year")) |>
hc_yAxis(title = list(text = "GDP ($ trillion)")) |>
hc_plotOptions(series = list(marker = list(symbol = "circle"))) |>
hc_legend(align = "right",
verticalAlign = "top") |>
hc_tooltip(shared = TRUE,
borderColor = "black",
pointFormat = "{point.country}: {point.gdp_tn:.2f}")
big4_chartregions <- nations |>
group_by(year, region) |>
summarize(gdp_tn = sum(gdp_tn, na.rm = TRUE)) |>
ungroup() |>
arrange(year, region)`summarise()` has regrouped the output.
ℹ Summaries were computed grouped by year and region.
ℹ Output is grouped by year.
ℹ Use `summarise(.groups = "drop_last")` to silence this message.
ℹ Use `summarise(.by = c(year, region))` for per-operation grouping
(`?dplyr::dplyr_by`) instead.highchart() |>
hc_add_series(data = regions,
type = "area",
hcaes(x = year,
y = gdp_tn,
group = region))cols <- brewer.pal(7, "Set2")
highchart() |>
hc_add_series(data = regions,
type = "area",
hcaes(x = year,
y = gdp_tn,
group = region)) |>
hc_colors(cols) |>
hc_chart(style = list(fontFamily = "Georgia",
fontWeight = "bold")) |>
hc_plotOptions(series = list(stacking = "normal",
marker = list(enabled = FALSE,
states = list(hover = list(enabled = FALSE))),
lineWidth = 0.5,
lineColor = "white")) |>
hc_xAxis(title = list(text = "Year")) |>
hc_yAxis(title = list(text = "GDP ($ trillion)")) |>
hc_legend(align = "right", verticalAlign = "top",
layout = "vertical")if (file.exists("food_stamps.csv")) {
food_stamps <- read_csv("food_stamps.csv")
cols <- c("dodgerblue", "orange")
highchart() |>
hc_yAxis_multiples(
list(title = list(text = "Participants (millions)")),
list(title = list(text = "Costs ($ billions)"),
opposite = TRUE)
) |>
hc_add_series(data = food_stamps$participants,
name = "Participants (millions)",
type = "column",
yAxis = 0) |>
hc_add_series(data = food_stamps$costs,
name = "Costs ($ billions)",
type = "line",
yAxis = 1) |>
hc_xAxis(categories = food_stamps$year,
tickInterval = 5) |>
hc_colors(cols) |>
hc_chart(style = list(fontFamily = "AvantGarde",
fontWeight = "bold"))
}This code loads the nations.csv dataset and uses dplyr to create a new variable, gdp_tn, which gives each country’s GDP in trillions of dollars (GDP per capita multiplied by population, divided by a trillion). The first chart filters the data to four countries (China, Germany, Japan, and the United States) and uses ggplot2 with geom_point and geom_line and the Set1 color palette to show how each country’s GDP changed over time. The second chart groups the data by region and year, sums the GDP for each group (using na.rm = TRUE to handle missing values), and draws a stacked area chart with geom_area. Each region is filled with a different color from the Set2 palette and outlined with a very thin white line. All of the code is in one chunk because I accidentally deleted the original work, and I combined everything into a single chunk to make it more efficient, so the data is loaded and the new variable is created once and then used for both charts.