Code
# helper and import chunk
library(tidyverse)
set.seed(1234)
theme_set(theme_minimal(base_size = 12)) # one visual style across all three figures
pct_label <- function(x) ifelse(is.na(x), "", paste0(round(x * 100), "%"))Data607_Project2_Codebase
Introduction
The objective of Project 2 is to work through importing, tidying and prepping messy data for downstream analysis using tidyr and dplyr. The following datasets have been chosen, stored as raw CSV files, and could be found in my Week 5 Assignment directory on GitHub:
Motherboard / Vice’s Car Thefts across the USA (Discussion source)
Medical records (Discussion source)
Highest Grossing Concert Tours by Women (Discussion source)
Approach
As per the project requirements, each of the datasets will follow the same steps separately:
Import the raw CSV files from the GitHub directory to preserve the original or scrapped structure. If possible, I will mark any blank records as NA, where needed.
Read the csv file and inspect the structure of the files, then try to get the headers / columns to store as variables.
Reshape the datasets from a wide format into a long format using
pivot_longer(), which will collapse the columns into rows.Cleaning and tidying the datasets will happen next, to standardize variable names (casing, naming patterns, turning Y -> Yes), convert column/row data types to the appropriate formats (ex. dates, numeric). I’ll double check once more for any missing or NA records to make sure that’s documented and accounted for prior to calculations.
After, I can validate that the cleaned data is matching the unstructured data by verifying missing, duplicates or mislabeled variables are converted to the correct labeling.
Lastly, I’ll explore the cleaned and validated data by creating some graphs and charts with
ggplot2for some simple analysis. Some questions I will have are how do Kia/Hyundai’s share of total vehicle thefts change over time, how the clinical measurements compare across diagnosis groups, and adjusted vs actual gross for the tour.
First Dataset — Kia/Hyundai thefts
Challenges
For the car thefts, I anticipate the blank records being a challenge. The missing theft records from certain locations should not be counted as zeroes, but
NA, which I can fix upon import of the file to avoid any complications -na = c("", "N/A").Additionally, there are some inconsistencies of formatting of the locations, such as misspellings and the city/county pattern is not always enforced. Those will have to be fixed with a
case_when()to catch before analysis.
Loading in CSV
Code
car_thefts_raw_url <- "https://raw.githubusercontent.com/shanicesmith98/data-607-assignments/refs/heads/main/week-5-assignment/Motherboard_VICE_News_Kia_Hyundai_Theft_Dataset.csv"
car_theft_header_rows <- read_csv(car_thefts_raw_url, col_names = FALSE, n_max = 2,
col_types = cols(.default = "c"))
car_theft_data_body <- read_csv(car_thefts_raw_url, col_names = FALSE, skip = 2,
na = c("", "N/A"),
col_types = cols(.default = "c")) # skips double header rowsStructure before tidying
Code
dim(car_theft_data_body) [1] 45 211Code
car_theft_header_rows[, 1:7] # first two cities' worth of header| X1 | X2 | X3 | X4 | X5 | X6 | X7 |
|---|---|---|---|---|---|---|
| NA | Denver | NA | NA | El Paso | NA | NA |
| NA | Kia/Hyundais | All | Percent | Kia/Hyundais | All | Percent |
Code
car_theft_data_body[, 1:7] # first two cities' worth of data| X1 | X2 | X3 | X4 | X5 | X6 | X7 |
|---|---|---|---|---|---|---|
| Dec/19 | 48 | 615 | 8% | 13 | 103 | 13% |
| Jan/20 | 21 | 519 | 4% | 9 | 95 | 9% |
| Feb/20 | 28 | 402 | 7% | 5 | 64 | 8% |
| Mar/20 | 35 | 508 | 7% | 6 | 75 | 8% |
| Apr/20 | 39 | 616 | 6% | 1 | 57 | 2% |
| May/20 | 37 | 692 | 5% | 1 | 62 | 2% |
| Jun/20 | 57 | 747 | 8% | 8 | 77 | 10% |
| Jul/20 | 57 | 786 | 7% | 5 | 62 | 8% |
| Aug/20 | 85 | 840 | 10% | 4 | 83 | 5% |
| Sep/20 | 107 | 916 | 12% | 2 | 73 | 3% |
| Oct/20 | 112 | 942 | 12% | 3 | 84 | 4% |
| Nov/20 | 155 | 948 | 16% | 2 | 72 | 3% |
| Dec/20 | 163 | 1,014 | 16% | 6 | 111 | 5% |
| Jan/21 | 209 | 1,039 | 20% | 5 | 111 | 5% |
| Feb/21 | 158 | 927 | 17% | 5 | 90 | 6% |
| Mar/21 | 166 | 948 | 18% | 9 | 81 | 11% |
| Apr/21 | 215 | 979 | 22% | 7 | 87 | 8% |
| May/21 | 242 | 1,068 | 23% | 5 | 66 | 8% |
| Jun/21 | 202 | 1,058 | 19% | 3 | 65 | 5% |
| Jul/21 | 174 | 1,063 | 16% | 5 | 102 | 5% |
| Aug/21 | 214 | 1,129 | 19% | 8 | 87 | 9% |
| Sep/21 | 195 | 1,045 | 19% | 8 | 89 | 9% |
| Oct/21 | 159 | 961 | 17% | 4 | 82 | 5% |
| Nov/21 | 231 | 1,056 | 22% | 5 | 86 | 6% |
| Dec/21 | 297 | 1,129 | 26% | 5 | 93 | 5% |
| Jan/22 | 327 | 1,161 | 28% | 8 | 94 | 9% |
| Feb/22 | 361 | 1,221 | 30% | 6 | 104 | 6% |
| Mar/22 | 427 | 1,301 | 33% | 5 | 133 | 4% |
| Apr/22 | 345 | 1,118 | 31% | 4 | 137 | 3% |
| May/22 | 356 | 1,215 | 29% | 9 | 142 | 6% |
| Jun/22 | 344 | 1,110 | 31% | 10 | 128 | 8% |
| Jul/22 | 464 | 1,198 | 39% | 17 | 125 | 14% |
| Aug/22 | 386 | 1,176 | 33% | 25 | 119 | 21% |
| Sep/22 | 427 | 1,229 | 35% | 8 | 137 | 6% |
| Oct/22 | 401 | 1,243 | 32% | 10 | 120 | 8% |
| Nov/22 | 339 | 1,075 | 32% | 13 | 128 | 10% |
| Dec/22 | 391 | 1,070 | 37% | 11 | 129 | 9% |
| Jan/23 | 424 | 1,170 | 36% | 6 | 150 | 4% |
| Feb/23 | 298 | 940 | 32% | 17 | 121 | 14% |
| Mar/23 | 209 | 917 | 23% | 15 | 168 | 9% |
| Apr/23 | 194 | 838 | 23% | 14 | 157 | 9% |
| May/23 | 285 | 964 | 30% | 17 | 183 | 9% |
| Jun/23 | 308 | 1,116 | 28% | 44 | 192 | 23% |
| Jul/23 | 233 | 1,005 | 23% | 33 | 144 | 23% |
| Aug/23 | NA | NA | NA | 24 | 187 | 13% |
We learn here that the data’s structure is 45 data rows by 211 columns. Column 1 has the month and year from Dec/19 through Aug/23. Row 1 is a merged city header (a name followed by two empty cells) and row 2 repeats Kia/Hyundais, All, Percent for each of 70 geographies. City and measure are values stored as column names, so 9,450 observations sit in 210 columns.
Transformation
Code
# Each city name appears once per three-column block, so two of every
# three header cells are empty and must be filled downward.
city_row <- as.character(car_theft_header_rows[1, ])
measure_row <- as.character(car_theft_header_rows[2, ])
header_map <- tibble(
position = seq_along(city_row),
city = str_trim(city_row),
measure = str_trim(measure_row)
) |>
fill(city, .direction = "down")
n_distinct(header_map$city, na.rm = TRUE) # Output is 70 cities / column[1] 70Code
count(header_map, measure) # 3 measures, 70 columns each| measure | n |
|---|---|
| All | 70 |
| Kia/Hyundais | 70 |
| Percent | 70 |
| NA | 1 |
Trailing space is seen on several measure labels, which is why str_trim() is needed. Otherwise, later in the transformation process, two separate columns for All would be created instead of one.
Code
# Combine city and measure into one name per column. "__" is used as the
# separator because no city name contains it, unlike "_", "," or " ".
new_names <- header_map |>
mutate(col_name = if_else(position == 1,
"month",
str_c(city, measure, sep = "__"))) |>
pull(col_name)
theft_named <- car_theft_data_body |> set_names(new_names)
names(theft_named)[1:7][1] "month" "Denver__Kia/Hyundais" "Denver__All"
[4] "Denver__Percent" "El Paso__Kia/Hyundais" "El Paso__All"
[7] "El Paso__Percent" Code
theft_long <- theft_named |>
pivot_longer(
cols = -month,
names_to = c("city", "measure"),
names_sep = "__",
values_to = "value"
)
dim(theft_long) # expect 9450 x 4[1] 9450 4Code
theft_tidy <- theft_long |>
pivot_wider(names_from = measure, values_from = value) |>
rename(
kia_hyundai_thefts = `Kia/Hyundais`,
all_thefts = All,
pct_reported = Percent
)
dim(theft_tidy) # expect 3150 x 5[1] 3150 5Variable types and naming
Code
theft_tidier <- theft_tidy |>
mutate(
# Turning source data format from "Dec/19" -> 2019-12-01
month = parse_date(month, format = "%b/%y"),
# Strip comma separators from numeric column: "1,014" -> 1014
across(c(kia_hyundai_thefts, all_thefts), parse_number),
# "8%" -> 8 -> 0.08, stored as a proportion for consistency
pct_reported = parse_number(pct_reported) / 100,
# Manually correcting typos and inconsistent formatting
city = case_when(
city == "Cincinatti" ~ "Cincinnati",
city == "Corpus Cristi, TX" ~ "Corpus Christi, TX",
city == "Irving, Texas" ~ "Irving, TX",
TRUE ~ city
)
) |>
# Recompute the share rather than trusting the source column, which is
# rounded to whole percents and blank for several reporting cities.
mutate(
pct_kia_hyundai = if_else(all_thefts > 0,
kia_hyundai_thefts / all_thefts,
NA_real_)
)
glimpse(theft_tidier)Rows: 3,150
Columns: 6
$ month <date> 2019-12-01, 2019-12-01, 2019-12-01, 2019-12-01, 20…
$ city <chr> "Denver", "El Paso", "Portland", "Atlanta", "Chicag…
$ kia_hyundai_thefts <dbl> 48, 13, 13, NA, 46, NA, 14, 25, 2, 21, 12, 9, 11, 6…
$ all_thefts <dbl> 615, 103, 592, NA, 767, NA, NA, 430, NA, NA, 352, 3…
$ pct_reported <dbl> 0.08, 0.13, 0.02, NA, 0.06, NA, NA, 0.06, NA, NA, 0…
$ pct_kia_hyundai <dbl> 0.07804878, 0.12621359, 0.02195946, NA, 0.05997392,…Column names are now using snake_case throughout with kia_hyundai_thefts and all_thefts count reported thefts per city-month.
Missing-value decisions
Code
theft_tidier |>
summarise(
`City-months` = n(),
`Both counts` = sum(!is.na(kia_hyundai_thefts) & !is.na(all_thefts)),
`Kia count only` = sum(!is.na(kia_hyundai_thefts) & is.na(all_thefts)),
`Total count only` = sum( is.na(kia_hyundai_thefts) & !is.na(all_thefts)),
`Neither count` = sum( is.na(kia_hyundai_thefts) & is.na(all_thefts))
)| City-months | Both counts | Kia count only | Total count only | Neither count |
|---|---|---|---|---|
| 3150 | 2793 | 143 | 145 | 69 |
Blank cells are kept as NA and not marked as zero. Some cities, such as Virginia Beach, Norfolk and Miami never report a total theft count; Frisco and Lincoln never report a Kia/Hyundai count; Atlanta, San Antonio and Henderson begin reporting only in January 2021. Treating those blanks as zeros would invent a denominator and hand me a fake 0% share. I’m not dropping the rows here either — the analysis below filters incomplete records only where they would break a calculation, so the counts above stay auditable.
Analysis
I’m comparing each city’s mean monthly Kia/Hyundai share before and after July 2022, the month the theft method got popular on social media. A city needs at least 12 months before and 6 after to qualify, so no mean rests on one or two observations. The statistic is the gap between those means in percentage points.
Code
share_change <- theft_tidier |>
filter(!is.na(pct_kia_hyundai)) |>
mutate(period = if_else(month < as.Date("2022-07-01"), "pre", "post")) |>
group_by(city, period) |>
summarise(months = n(), mean_share = mean(pct_kia_hyundai), .groups = "drop") |>
pivot_wider(names_from = period, values_from = c(months, mean_share)) |>
filter(months_pre >= 12, months_post >= 6) |>
mutate(change_pp = (mean_share_post - mean_share_pre) * 100) |>
arrange(desc(change_pp))
nrow(share_change) # cities meeting the coverage threshold[1] 63Code
share_change |>
slice_max(change_pp, n = 10) |>
transmute(
City = city,
`Share before (%)` = round(mean_share_pre * 100, 1),
`Share Jul 2022 on (%)` = round(mean_share_post * 100, 1),
`Change (pct. points)` = round(change_pp, 1),
`Months (pre / post)` = str_c(months_pre, " / ", months_post)
)
top_cities <- share_change |> slice_max(change_pp, n = 6) |> pull(city)| City | Share before (%) | Share Jul 2022 on (%) | Change (pct. points) | Months (pre / post) |
|---|---|---|---|---|
| Rochester, NY | 9.8 | 52.9 | 43.1 | 31 / 14 |
| Minneapolis, MN | 7.3 | 49.9 | 42.6 | 31 / 14 |
| Cincinnati | 10.3 | 52.6 | 42.2 | 30 / 12 |
| Buffalo, NY | 5.9 | 44.5 | 38.6 | 31 / 14 |
| Atlanta | 7.8 | 44.1 | 36.3 | 18 / 14 |
| Louisville | 5.4 | 37.3 | 31.9 | 30 / 13 |
| Washington, D.C. | 5.6 | 36.2 | 30.6 | 30 / 14 |
| Chicago | 6.3 | 36.6 | 30.3 | 31 / 14 |
| San Antonio | 9.3 | 39.1 | 29.8 | 18 / 6 |
| Henderson, NV | 4.3 | 33.1 | 28.7 | 18 / 14 |
Code
theft_tidier |>
filter(city %in% top_cities, !is.na(pct_kia_hyundai)) |>
ggplot(aes(x = month, y = pct_kia_hyundai)) +
geom_vline(xintercept = as.Date("2022-07-01"),
linetype = "dashed", color = "grey60") +
geom_line(color = "steelblue", linewidth = 0.8) +
facet_wrap(~ city) +
scale_y_continuous(labels = pct_label) +
scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
labs(
x = NULL,
y = "Share of all vehicle thefts",
caption = "Source: Motherboard / VICE News police-record dataset, Dec 2019 - Aug 2023"
)
Code
theft_tidier |>
filter(city %in% top_cities) |>
mutate(Month = format(month, "%b %Y"),
share_pct = round(pct_kia_hyundai * 100, 1)) |>
select(Month, month, city, share_pct) |>
arrange(month) |>
select(-month) |>
pivot_wider(names_from = city, values_from = share_pct)Conclusions
The tidy dataset holds 3150 city-months, 2792 of them with both counts reported, which leaves 63 cities with enough coverage to compare periods. The biggest jump is Rochester, NY, going from 9.8% to 52.9% — a gain of 43.1 percentage points — and the median change across qualifying cities is 13.5 points. Figure 1 shows that rise is sudden rather than gradual, landing mostly in late 2022 and holding through August 2023. That fits a vulnerability being exploited once it was widely known, not a slow change in what cars are on the road. The main limit is coverage: 358 city-months are missing a count, so this describes reporting agencies rather than all 70 locations.
Second Dataset — Medical records
Challenges
Like the first dataset, I also anticipate the blank records being a challenge here with the medical records. The missing records from certain locations should not be counted as zeroes, but
NA, which I can fix upon import of the file to avoid any complications -na = c("", "nan", "N/A").Certain variables, such as Smoker, has inconsistent labeling and will need to be reformatted to one standardized pattern.
Data source
Code
medical_records_raw_url <- "https://raw.githubusercontent.com/shanicesmith98/data-607-assignments/refs/heads/main/week-5-assignment/realworld_medical_dirty_dataset.csv"
# NA values have to be addressed here to avoid issues with 'nan' being turned into a catergory
medical_records_raw_data <- read_csv(
medical_records_raw_url,
na = c("", "nan", "N/A"),
col_types = cols(
Patient_ID = col_character(),
Age = col_double(),
Gender = col_character(),
Blood_Pressure = col_double(),
Cholesterol = col_double(),
BMI = col_double(),
Smoker = col_character(),
Diagnosis = col_character(),
Admission_Date = col_date(format = "%Y-%m-%d"),
Notes = col_character()
)
)Inspecting structure
Code
dim(medical_records_raw_data)[1] 100 10Code
names(medical_records_raw_data) [1] "Patient_ID" "Age" "Gender" "Blood_Pressure"
[5] "Cholesterol" "BMI" "Smoker" "Diagnosis"
[9] "Admission_Date" "Notes" Code
head(medical_records_raw_data, 5)| Patient_ID | Age | Gender | Blood_Pressure | Cholesterol | BMI | Smoker | Diagnosis | Admission_Date | Notes |
|---|---|---|---|---|---|---|---|---|---|
| P1000 | 55 | FEMALE | 120 | NA | 35.4 | Yes | Heart Disease | 2023-12-27 | NA |
| P1001 | 65 | Male | 150 | 180 | 27.8 | NA | None | 2023-01-01 | NA |
| P1002 | 45 | Male | 120 | 220 | 22.5 | No | NA | 2023-12-14 | NA |
| P1003 | 65 | Male | NA | 180 | 35.4 | No | NA | 2023-07-09 | NA |
| P1004 | 65 | Male | 120 | 300 | 40.1 | NA | None | 2023-07-10 | Follow-up required |
Code
sum(duplicated(medical_records_raw_data$Patient_ID)) # Output: 0[1] 0The raw file is 100 rows by 10 columns, one row per patient, with IDs P1000 through P1099 and no duplicates. Four of the columns (Age, Blood_Pressure, Cholesterol, BMI) are four separate measurements of the same patient, column names are inconsistently cased, and the categorical columns carry several spellings of the same value.
Code
count(medical_records_raw_data, Gender)| Gender | n |
|---|---|
| FEMALE | 15 |
| Female | 17 |
| MALE | 21 |
| Male | 22 |
| male | 10 |
| NA | 15 |
Code
count(medical_records_raw_data, Smoker)| Smoker | n |
|---|---|
| N | 20 |
| No | 20 |
| Y | 17 |
| Yes | 23 |
| NA | 20 |
Code
count(medical_records_raw_data, Diagnosis)| Diagnosis | n |
|---|---|
| Diabetes | 27 |
| Heart Disease | 25 |
| None | 27 |
| NA | 21 |
Code
count(medical_records_raw_data, Notes)| Notes | n |
|---|---|
| Checkup due | 18 |
| Follow-up required | 25 |
| Pending | 14 |
| NA | 43 |
Gender holds five spellings of two values (Male, MALE, male, Female, FEMALE). Smoker mixes Yes/Y and No/N. Admission_Date is the one column needing no treatment: valid ISO-8601 throughout.
Transformation steps
Consistent variable names
Code
# Using snake_case throughout
med <- medical_records_raw_data |>
rename(
patient_id = Patient_ID,
age_years = Age,
gender = Gender,
blood_pressure = Blood_Pressure,
cholesterol = Cholesterol,
bmi = BMI,
smoker_raw = Smoker,
diagnosis = Diagnosis,
admission_date = Admission_Date,
notes = Notes
)Standardizing inconsistent values
Code
med <- med |>
mutate(
# Five spellings collapse to two with one title-case call.
gender = str_to_title(gender),
# Yes/Y and No/N become a logical, which makes later proportions trivial.
is_smoker = case_when(
smoker_raw %in% c("Yes", "Y") ~ TRUE,
smoker_raw %in% c("No", "N") ~ FALSE,
TRUE ~ NA
),
# Diagnosis has BOTH a "None" level and missing values; these mean different things and are kept separate.
# "None" = could mean examined, nothing found. NA = not recorded.
diagnosis_group = if_else(is.na(diagnosis), "Not recorded", diagnosis)
) |>
select(-smoker_raw) # drop the raw column now that is_smoker exists
count(med, gender)| gender | n |
|---|---|
| Female | 32 |
| Male | 53 |
| NA | 15 |
Code
count(med, is_smoker)| is_smoker | n |
|---|---|
| FALSE | 40 |
| TRUE | 40 |
| NA | 20 |
Code
count(med, diagnosis_group)| diagnosis_group | n |
|---|---|
| Diabetes | 27 |
| Heart Disease | 25 |
| None | 27 |
| Not recorded | 21 |
Reshaping the measurements to long form
Code
med_tidy <- med |>
pivot_longer(
cols = c(age_years, blood_pressure, cholesterol, bmi),
names_to = "measure",
values_to = "value"
) |>
mutate(
unit = case_when(
measure == "age_years" ~ "years",
measure == "blood_pressure" ~ "mmHg",
measure == "cholesterol" ~ "mg/dL",
measure == "bmi" ~ "kg/m2"
),
measure_label = case_when(
measure == "age_years" ~ "Age",
measure == "blood_pressure" ~ "Blood pressure",
measure == "cholesterol" ~ "Cholesterol",
measure == "bmi" ~ "BMI"
),
facet_label = str_c(measure_label, " (", unit, ")")
)
dim(med_tidy) # Output: 400 x 12[1] 400 12The id columns — patient_id, gender, is_smoker, diagnosis, admission_date, notes — are left untouched by the pivot because they describe the patient, not the measurement. Only the four measured quantities move. The result is 100 patients × 4 measurements = 400 rows, which is the grain that lets one group_by() answer a question about all four measurements at once.
Missing-value decisions
Code
med_tidy |>
group_by(Measurement = facet_label) |>
summarise(
Patients = n(),
Reported = sum(!is.na(value)),
Missing = sum(is.na(value)),
`% missing` = round(100 * mean(is.na(value)), 1),
.groups = "drop"
)| Measurement | Patients | Reported | Missing | % missing |
|---|---|---|---|---|
| Age (years) | 100 | 83 | 17 | 17 |
| BMI (kg/m2) | 100 | 80 | 20 | 20 |
| Blood pressure (mmHg) | 100 | 86 | 14 | 14 |
| Cholesterol (mg/dL) | 100 | 80 | 20 | 20 |
No row and no patient is dropped. Every summary below uses na.rm = TRUE and reports the number of patients behind each statistic in its own column.
Analysis
We’re doing two comparisons on the long data. First, mean and median of each measurement by diagnosis group — I’m showing both because the measurements are pre-binned, and the median is the more honest summary of a discrete variable. Second, mean measurement for smokers against non-smokers. Counts go with every figure and nothing is imputed.
Code
med_summary <- med_tidy |>
group_by(Measurement = facet_label, Diagnosis = diagnosis_group) |>
summarise(
Patients = sum(!is.na(value)),
Mean = round(mean(value, na.rm = TRUE), 1),
Median = round(median(value, na.rm = TRUE), 1),
.groups = "drop"
) |>
arrange(Measurement, Diagnosis)
med_summary| Measurement | Diagnosis | Patients | Mean | Median |
|---|---|---|---|---|
| Age (years) | Diabetes | 22 | 47.7 | 55.0 |
| Age (years) | Heart Disease | 18 | 44.4 | 45.0 |
| Age (years) | None | 23 | 44.6 | 45.0 |
| Age (years) | Not recorded | 20 | 52.0 | 55.0 |
| BMI (kg/m2) | Diabetes | 22 | 31.0 | 28.9 |
| BMI (kg/m2) | Heart Disease | 21 | 32.8 | 35.4 |
| BMI (kg/m2) | None | 20 | 33.0 | 35.4 |
| BMI (kg/m2) | Not recorded | 17 | 32.1 | 35.4 |
| Blood pressure (mmHg) | Diabetes | 21 | 138.6 | 140.0 |
| Blood pressure (mmHg) | Heart Disease | 23 | 137.8 | 140.0 |
| Blood pressure (mmHg) | None | 24 | 137.9 | 140.0 |
| Blood pressure (mmHg) | Not recorded | 18 | 133.3 | 130.0 |
| Cholesterol (mg/dL) | Diabetes | 21 | 229.0 | 220.0 |
| Cholesterol (mg/dL) | Heart Disease | 20 | 233.0 | 220.0 |
| Cholesterol (mg/dL) | None | 19 | 220.5 | 200.0 |
| Cholesterol (mg/dL) | Not recorded | 20 | 224.0 | 220.0 |
Code
smoker_summary <- med_tidy |>
filter(!is.na(is_smoker), !is.na(value)) |>
group_by(Measurement = facet_label, is_smoker) |>
summarise(n = n(), mean_value = mean(value), .groups = "drop") |>
pivot_wider(names_from = is_smoker, values_from = c(n, mean_value)) |>
transmute(
Measurement,
`Smokers (n)` = n_TRUE,
`Smokers mean` = round(mean_value_TRUE, 1),
`Non-smokers (n)` = n_FALSE,
`Non-smokers mean` = round(mean_value_FALSE, 1),
Difference = round(mean_value_TRUE - mean_value_FALSE, 1)
)
smoker_summary| Measurement | Smokers (n) | Smokers mean | Non-smokers (n) | Non-smokers mean | Difference |
|---|---|---|---|---|---|
| Age (years) | 29 | 45.7 | 35 | 47.0 | -1.3 |
| BMI (kg/m2) | 34 | 31.5 | 32 | 32.7 | -1.2 |
| Blood pressure (mmHg) | 34 | 135.9 | 34 | 140.3 | -4.4 |
| Cholesterol (mg/dL) | 32 | 224.4 | 35 | 224.9 | -0.5 |
Code
med_summary |>
ggplot(aes(x = Diagnosis, y = Mean)) +
geom_col(fill = "steelblue", width = 0.7) +
geom_text(aes(label = str_c("n=", Patients)), vjust = -0.4, size = 3) +
facet_wrap(~ Measurement, scales = "free_y") +
scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
labs(
x = NULL,
y = "Mean value",
caption = "Synthetic teaching dataset; 100 patients, admissions during 2023"
) +
theme(axis.text.x = element_text(angle = 20, hjust = 1))
Conclusions
The tidy dataset holds 400 patient-measurement rows, 329 with a reported value and 71 missing. Differences between diagnosis groups are small: mean age spans only 44.4 to 52 years, and mean blood pressure under 6 mmHg. Figure 2 shows why — every measurement takes just five distinct values, so the data is pre-binned and any real difference gets squashed toward the bin width. That rules out correlation or regression on these columns, which is why I stopped at group means and medians. I also kept None (27 patients, examined with nothing found) separate from unrecorded (21 patients), since merging them would overstate how many patients I know are healthy.
Third Dataset — Highest Grossing Concert Tours by Women
Challenges
Rank 7 shows up twice (Celine Dion, Pink) and rank 8 is missing, so I can’t trust
Rankas an identifier and will rank the tours myself.The format for the numeric variables will need to be stripped to be solely numbers by removing the dollar signs and commas for more reliable calculations.
Import Data
Code
high_grossing_women_tours_raw_url <- "https://raw.githubusercontent.com/shanicesmith98/data-607-assignments/refs/heads/main/week-5-assignment/tours_dataset.csv"
# Everything reads as text: currency columns carry "$" and thousands
# separators, and several numeric cells end in a footnote marker.
tours_raw_data <- read_csv(high_grossing_women_tours_raw_url, col_types = cols(.default = "c"))Structure before tidying
Code
dim(tours_raw_data)[1] 20 11Code
names(tours_raw_data) [1] "Rank" "Peak"
[3] "All Time Peak" "Actual gross"
[5] "Adjusted gross (in 2022 dollars)" "Artist"
[7] "Tour title" "Year(s)"
[9] "Shows" "Average gross"
[11] "Ref." Code
head(tours_raw_data, 5)| Rank | Peak | All Time Peak | Actual gross | Adjusted gross (in 2022 dollars) | Artist | Tour title | Year(s) | Shows | Average gross | Ref. |
|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 1 | 2 | $780,000,000 | $780,000,000 | Taylor Swift | The Eras Tour † | 2023–2024 | 56 | $13,928,571 | [1] |
| 2 | 1 | 7[2] | $579,800,000 | $579,800,000 | Beyoncé | Renaissance World Tour | 2023 | 56 | $10,353,571 | [3] |
| 3 | 1[4] | 2[5] | $411,000,000 | $560,622,615 | Madonna | Sticky & Sweet Tour ‡[4][a] | 2008–2009 | 85 | $4,835,294 | [6] |
| 4 | 2[7] | 10[7] | $397,300,000 | $454,751,555 | Pink | Beautiful Trauma World Tour | 2018–2019 | 156 | $2,546,795 | [7] |
| 5 | 2[4] | NA | $345,675,146 | $402,844,849 | Taylor Swift | Reputation Stadium Tour | 2018 | 53 | $6,522,173 | [8] |
Twenty rows by 11 columns, one row per tour. Four problems are visible in the head: currency stored as text ("$780,000,000"), footnote markers inside otherwise numeric cells ("2[5]", "$229,100,000[b]"), status symbols inside the tour title ("The Eras Tour †"), and a year range in a single column ("2023–2024") that holds two variables.
Code
# The two currency column names contain a non-breaking space (U+00A0),
# not a regular space. They look identical on screen, so a rename()
# matching "Actual gross" fails silently.
str_detect(names(tours_raw_data), "\u00a0") [1] FALSE FALSE FALSE TRUE TRUE FALSE FALSE FALSE FALSE FALSE FALSEA fifth problem is not visible at all: Rank is not unique. Rank 7 appears twice and rank 8 is absent, so the column cannot serve as a key.
Transformation steps
Repairing the column names
Code
# Replace non-breaking spaces with ordinary ones before renaming anything.
names(tours_raw_data) <- names(tours_raw_data) |>
str_replace_all("\u00a0", " ") |>
str_trim()
tours <- tours_raw_data |>
rename(
source_rank = Rank,
peak = Peak,
all_time_peak = `All Time Peak`,
actual_gross = `Actual gross`,
adjusted_gross = `Adjusted gross (in 2022 dollars)`,
artist = Artist,
tour_title = `Tour title`,
years = `Year(s)`,
shows = Shows,
average_gross = `Average gross`,
source_ref = `Ref.`
)Capturing the footnote markers before deleting them
Code
# The dagger marks tours still running when the table was compiled, which
# means their grosses are partial. That is real information, so it is
# captured as a column BEFORE the symbol is stripped out.
tours <- tours |>
mutate(
is_ongoing = str_detect(tour_title, "\u2020"), # †
has_marker = str_detect(tour_title, "[\u2021*]") # ‡ and *
)
sum(tours$is_ongoing) # expect 2[1] 2Code
sum(tours$has_marker) # expect 3[1] 3The source page’s legend is not part of the CSV, so the meaning of ‡ and * cannot be recovered from this file. They are recorded in has_marker and flagged as an open question rather than guessed at; the two † tours are treated as incomplete throughout.
Converting text to numbers
Code
# Remove bracketed footnote references like [4], [a], [21].
strip_notes <- function(x) str_remove_all(x, "\\[[0-9a-z]+\\]")
tours <- tours |>
mutate(
# Titles: drop footnotes AND status symbols, then trim the leftover space
tour_title = tour_title |>
strip_notes() |>
str_remove_all("[\u2020\u2021*]") |>
str_trim(),
# Peaks: footnotes removed first, then integer conversion
across(c(peak, all_time_peak), ~ as.integer(strip_notes(.x))),
# Currency: footnotes first, then parse_number() strips "$" and commas
across(c(actual_gross, adjusted_gross, average_gross),
~ parse_number(strip_notes(.x))),
across(c(source_rank, shows), as.integer)
)Splitting the year range
Code
tours <- tours |>
separate_wider_delim(
years,
delim = "\u2013", # EN-DASH, not a hyphen
names = c("year_start", "year_end"),
too_few = "align_start" # single-year tours get NA
) |>
mutate(
across(c(year_start, year_end), as.integer),
year_end = coalesce(year_end, year_start), # a one-year tour ends the year it starts
tour_years = year_end - year_start + 1
)Reshaping the two gross figures to long form
Code
tours_tidy <- tours |>
# average_gross is derived (actual_gross / shows) and is recomputed below;
# source_ref is a citation artifact belonging in Sources, not in the data.
select(-average_gross, -source_ref) |>
pivot_longer(
cols = c(actual_gross, adjusted_gross),
names_to = "gross_basis",
values_to = "gross_usd"
) |>
mutate(
gross_basis = if_else(gross_basis == "actual_gross",
"Nominal (as earned)",
"Adjusted to 2022 USD")
)
dim(tours_tidy) # expect 40 x 13[1] 40 13Nominal and inflation-adjusted dollars are the same quantity measured on two bases. Side by side in separate columns they invite direct comparison of figures that are not comparable; stacked, the basis becomes an explicit grouping variable and every chart and table must declare which one it uses.
Why the derived column is recomputed
Code
tours |>
mutate(
recomputed = actual_gross / shows,
difference = round(average_gross - recomputed, 0)
) |>
filter(abs(difference) > 1) |>
select(tour_title, shows, actual_gross, average_gross, recomputed, difference)| tour_title | shows | actual_gross | average_gross | recomputed | difference |
|---|---|---|---|---|---|
| The Monster Ball Tour | 203 | 227400000 | 1118227 | 1120197 | -1970 |
I’m comparing the two gross bases by ranking every tour twice, once on nominal and once on adjusted gross, then taking the difference. That difference shows how much inflation adjustment moves the standings. Revenue per show is recomputed as actual_gross / shows and reported only for the 18 completed tours, since the two ongoing ones have partial grosses against partial show counts.
Analysis
The analysis compares the two gross bases. Each tour is ranked twice — once by nominal gross and once by inflation-adjusted gross — and the difference between those ranks measures how much inflation adjustment changes the standings. Revenue per show is recomputed as actual_gross / shows and reported separately for the 18 completed tours, since the two ongoing tours have partial grosses against a partial show count.
Code
rank_shift <- tours |>
mutate(
rank_nominal = rank(-actual_gross, ties.method = "min"),
rank_adjusted = rank(-adjusted_gross, ties.method = "min"),
rank_change = rank_nominal - rank_adjusted # positive = climbs
) |>
arrange(rank_adjusted)Code
rank_shift |>
filter(abs(rank_change) >= 2) |>
transmute(
Artist = artist,
Tour = tour_title,
Years = str_c(year_start, "-", year_end),
`Nominal rank` = rank_nominal,
`Adjusted rank` = rank_adjusted,
`Places moved` = rank_change
)| Artist | Tour | Years | Nominal rank | Adjusted rank | Places moved |
|---|---|---|---|---|---|
| Cher | Living Proof: The Farewell Tour | 2002-2005 | 14 | 10 | 4 |
| Madonna | Confessions Tour | 2006-2006 | 15 | 13 | 2 |
| Pink | Summer Carnival | 2023-2024 | 8 | 14 | -6 |
| Katy Perry | Prismatic World Tour | 2014-2015 | 13 | 15 | -2 |
Code
tours |>
filter(!is_ongoing) |>
mutate(gross_per_show = actual_gross / shows) |>
slice_max(gross_per_show, n = 8) |>
transmute(
Artist = artist,
Tour = tour_title,
Shows = shows,
`Actual gross ($M)` = round(actual_gross / 1e6, 1),
`Per show ($M)` = round(gross_per_show / 1e6, 2)
)| Artist | Tour | Shows | Actual gross (\(M)| Per show (\)M) | |
|---|---|---|---|---|
| Beyoncé | Renaissance World Tour | 56 | 579.8 | 10.35 |
| Taylor Swift | Reputation Stadium Tour | 53 | 345.7 | 6.52 |
| Beyoncé | The Formation World Tour | 49 | 256.1 | 5.23 |
| Madonna | Sticky & Sweet Tour | 85 | 411.0 | 4.84 |
| Madonna | The MDNA Tour | 88 | 305.2 | 3.47 |
| Madonna | Confessions Tour | 60 | 194.0 | 3.23 |
| Taylor Swift | The 1989 World Tour | 85 | 250.4 | 2.95 |
| Pink | Beautiful Trauma World Tour | 156 | 397.3 | 2.55 |
Code
# Order the y-axis by adjusted gross so the chart reads as a ranking
title_order <- tours |> arrange(adjusted_gross) |> pull(tour_title)
tours_tidy |>
mutate(tour_title = factor(tour_title, levels = title_order)) |>
ggplot(aes(x = gross_usd / 1e6, y = tour_title)) +
geom_line(aes(group = tour_title), color = "grey75", linewidth = 1) +
geom_point(aes(color = gross_basis), size = 2.6) +
scale_x_continuous(labels = function(x) paste0("$", x, "M")) +
labs(
x = "Tour gross",
y = NULL,
color = "Basis",
caption = "Source: Wikipedia ranking of highest-grossing female solo tours, compiled from Billboard Boxscore"
) +
theme(legend.position = "top")
Code
tours |>
arrange(desc(adjusted_gross)) |>
transmute(
Artist = artist,
Tour = tour_title,
`Nominal gross ($M)` = round(actual_gross / 1e6, 1),
`Adjusted gross ($M)` = round(adjusted_gross / 1e6, 1),
`Difference ($M)` = round((adjusted_gross - actual_gross) / 1e6, 1)
)| Artist | Tour | Nominal gross (\(M)| Adjusted gross (\)M) | Difference ($M) | |
|---|---|---|---|---|
| Taylor Swift | The Eras Tour | 780.0 | 780.0 | 0.0 |
| Beyoncé | Renaissance World Tour | 579.8 | 579.8 | 0.0 |
| Madonna | Sticky & Sweet Tour | 411.0 | 560.6 | 149.6 |
| Pink | Beautiful Trauma World Tour | 397.3 | 454.8 | 57.5 |
| Taylor Swift | Reputation Stadium Tour | 345.7 | 402.8 | 57.2 |
| Madonna | The MDNA Tour | 305.2 | 389.0 | 83.8 |
| Celine Dion | Taking Chances World Tour | 280.0 | 381.9 | 101.9 |
| Beyoncé | The Formation World Tour | 256.1 | 312.3 | 56.2 |
| Taylor Swift | The 1989 World Tour | 250.4 | 309.1 | 58.7 |
| Cher | Living Proof: The Farewell Tour | 200.0 | 299.7 | 99.7 |
| Lady Gaga | The Monster Ball Tour | 227.4 | 295.3 | 67.9 |
| Beyoncé | The Mrs. Carter Show World Tour | 229.1 | 283.2 | 54.1 |
| Madonna | Confessions Tour | 194.0 | 281.6 | 87.6 |
| Pink | Summer Carnival | 257.6 | 257.6 | 0.0 |
| Katy Perry | Prismatic World Tour | 204.0 | 251.9 | 47.9 |
| Pink | The Truth About Love Tour | 184.0 | 227.5 | 43.5 |
| Lady Gaga | Born This Way Ball | 170.0 | 213.6 | 43.6 |
| Madonna | Rebel Heart Tour | 169.8 | 207.0 | 37.2 |
| Adele | Adele Live 2016 | 167.7 | 204.5 | 36.8 |
| Taylor Swift | The Red Tour | 150.0 | 185.4 | 35.4 |
Conclusions
The tidy dataset holds 40 rows, 20 tours on two gross bases. Nominal grosses total $5.76 billion against $6.88 billion adjusted to 2022 dollars, and that gap sits almost entirely in the older tours. Figure 3 shows the two bases pulling apart with age: recent tours are nearly a single point, while mid-2000s tours show a wide spread. Cher’s Living Proof: The Farewell Tour climbs from 14 to 10 once adjusted. Pink’s Summer Carnival drops from 8 to 14, not because it earned less, but because it has no inflation behind it. Revenue per show splits two business models: the Eras Tour made about $13.9M per show over 56 shows, Cher’s run $0.6M over 325, and both land near the top. The limits are that source_rank isn’t unique, all_time_peak is missing for 14 of 20 tours, and 2 tours were still running, so I left them out of the per-show table.
Credit
Throughout the assignment, Claude (Opus 5) was used to help plan, explain concepts, flag data issues, and debug errors. I ran and verified all code in RStudio, checked the reported figures against the raw files, and wrote the final interpretations myself.
Anthropic. (2026). Claude (Opus 5) [Large language model].