tidytuesday 2022 Semana 23

Pride Corporate Accountability Project

Autor

Lucas Carmo

Publicado

2022 - 06 - 07

Setup

library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.0     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.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(rvest)

Attaching package: 'rvest'

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

    guess_encoding
library(ggsvg)
library(colorspace)
library(glue)
library(ggtext)
library(ragg)

Functions

agora <- function() {
    x <- format(Sys.time(), "%Y-%m-%d %H%M%S")
    return(x)
}

parse_svg <- function(x) {
    # Function that parses svg files into text.
    svg_string <- paste(
        readLines(x),
        collapse = "\n"
    )
    return(svg_string)
}

Read data

pride_aggregates <-
    readr::read_csv(
        "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-06-07/pride_aggregates.csv"
    ) %>%
    janitor::clean_names()
Rows: 31 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (1): Company
dbl (3): Total Contributed, # of Politicians Contributed to, # of States Whe...

ℹ 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.
fortune_aggregates <-
    readr::read_csv(
        "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-06-07/fortune_aggregates.csv"
    ) %>%
    janitor::clean_names()
Rows: 117 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (1): Company
dbl (3): Total Contributed, # of Politicians Contributed to, # of States Whe...

ℹ 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.
static_list <-
    readr::read_csv(
        "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-06-07/static_list.csv"
    ) %>%
    janitor::clean_names()
Rows: 126 Columns: 6
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (1): Company
dbl (3): Amount Contributed Across States, # of Politicians Contributed to, ...
lgl (2): Pride?, HRC Business Pledge

ℹ 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.
pride_sponsors <-
    readr::read_csv(
        "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-06-07/pride_sponsors.csv"
    ) %>%
    janitor::clean_names()
Rows: 364 Columns: 6
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): Company, Pride Event Sponsored, Sponsorship Amount, where available...
dbl (1): Year

ℹ 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.
corp_by_politician <-
    readr::read_csv(
        "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-06-07/corp_by_politician.csv"
    ) %>%
    janitor::clean_names()
Rows: 103 Columns: 4
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (3): Politician, Title, State
dbl (1): SUM of Amount

ℹ 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.
donors <-
    readr::read_csv(
        "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-06-07/donors.csv"
    ) %>%
    janitor::clean_names()
Rows: 5497 Columns: 5
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (4): Donor Name, "True" Donor - Pride Sponsor Match Only, Pride and Spon...
lgl (1): "True" Donor - Fortune Match Only

ℹ 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.

Analysis

saturated_palette <- c(
    "#fe0000",
    "#fe8d00",
    "#ffee00",
    "#018114",
    "#014cff",
    "#8a018c"
)

desaturated <- darken(saturated_palette, amount = .45)

path <- here::here('projetos','tidytuesday','2022','2022-Week_23')


# List svg files from the directory
path_logos <- dir(path,
    pattern = "*.svg",
    full.names = TRUE,
)

# Create an object that contains the svg text of the logos
image_logos <- map(path_logos, parse_svg)

# Company names in the correct order for later matching
company_names <- c("Amazon", "AT&T", "Comcast", "FedEx", "State Farm", "Toyota")

# Set names for the logos
names(image_logos) <- company_names

# Create a dataframe with the information
logos_df <- bind_rows(image_logos) %>%
    pivot_longer(1:6) %>%
    rename("company" = name)

Binds columns

df <- pride_aggregates %>%
    select(company, total_contributed) %>%
    head(6) %>%
    mutate(companies = fct_reorder(company, total_contributed)) %>%
    bind_cols("saturated" = saturated_palette) %>%
    left_join(logos_df)
Joining with `by = join_by(company)`
p <- ggplot() +
    geom_col(
        aes(
            x = df$companies,
            y = Inf,
            fill = desaturated
        ),
        width = 1
    ) +
    geom_col(
        data = df,
        aes(
            x = companies,
            y = total_contributed,
            fill = saturated
        ),
        width = 1
    ) +
    geom_point_svg(
        data = df,
        aes(
            x = companies,
            y = total_contributed + 80000,
            svg = value
        ),
        size = 20,
        hjust = .7
    ) +
        geom_text(
            data = df,
            aes(
                x = companies,
                y = total_contributed - 5000,
                label = paste0("U$", round(total_contributed / 1e3, 0), " K")
            ),
            color = "white",
            hjust = 1,
            size = 5
        ) +
    scale_fill_identity() +
        coord_flip() +
        labs(title = "Companies that donated money to PRIDE") +
        theme_void()

p