R Assignments

Introduction

This report demonstrates how R connects to a live MySQL database, pulls real datasets of my choir data:

members — choir member registration records (identity, voice type, status, age)
contributions — payment records per member (amount, month, payment method, status)

Note on db credentials: Database credentials are stored in a local .env file

Assignment 1 — Loading Datasets from RDBMS

Packages

required_packages <- c("DBI", "RMySQL", "dplyr", "ggplot2",
                        "lubridate", "psych", "scales", "dotenv")

for (pkg in required_packages) {
  if (!requireNamespace(pkg, quietly = TRUE)) install.packages(pkg)
  library(pkg, character.only = TRUE)
}

Loading credentials from `.env`

# Load the .env file from the project root directory
dotenv::load_dot_env(file = ".env")

Opening the database connection

con <- DBI::dbConnect(
  RMySQL::MySQL(),
  host     = Sys.getenv("DB_HOST"),
  port     = as.integer(Sys.getenv("DB_PORT")),
  dbname   = Sys.getenv("DB_NAME"),
  user     = Sys.getenv("DB_USER"),
  password = Sys.getenv("DB_PASSWORD")
)

cat("Connected to DB successfully!\n")

Connected to DB successfully!

cat("Available tables:", paste(DBI::dbListTables(con), collapse = ", "), "\n")

Available tables: album_purchases, albums, audit_logs, committees, contacts, contribution_targets, contributions, devotions, event_registrations, events, failed_jobs, galleries, global_site_settings, jobs, meeting_attendees, meetings, members, migrations, notifications, page_settings, page_views, password_resets, personal_access_tokens, r_member_stats, resources, songs, stories, subscribers, users

Loading the `members` table

The members table records members data.

members <- DBI::dbGetQuery(con, "SELECT * FROM members")

cat("members — rows:", nrow(members), "| cols:", ncol(members), "\n")

members — rows: 100 | cols: 52

members$date_of_birth <- as.Date(members$date_of_birth)
members$created_at    <- as.POSIXct(members$created_at)

members$age <- as.integer(
  floor(as.numeric(difftime(Sys.Date(), members$date_of_birth,
                            units = "days")) / 365.25)
)

members$join_year <- lubridate::year(as.Date(members$created_at))

Preview of key columns:

members[, c("member_id", "first_name", "last_name",
            "gender", "voice_type", "status", "age")] |> head(8)

member_id	first_name	last_name	gender	voice_type	status	age
GF2025992	Niyomuhoza	Samuel	male	bass	active	25
GF2025170	Patience	Manizabayo	male	NA	active	26
GF2025B48F4EB7	Jonas	Izabayo	male	NA	active	22
GF2025B1013BE3	KURINTATI	Emmanuel	male	tenor	active	24
GF202586748B76	Claudine	NIYIGENA	female	alto	active	26
GF202564F1F33D	Lawson	Cyizere	male	bass	active	27
GF2025F4C46674	David	SIGENIYO	male	tenor	active	21
GF202568B82B10	Josue	KANANI	male	bass	active	27

Loading the `contributions` table

The contributions table records every payment made by a member.

contributions <- DBI::dbGetQuery(con, "SELECT * FROM contributions")

cat("contributions — rows:", nrow(contributions),
    "| cols:", ncol(contributions), "\n")

contributions — rows: 6 | cols: 14

contributions$payment_date <- as.Date(contributions$payment_date)
contributions$created_at   <- as.POSIXct(contributions$created_at)
contributions$amount       <- as.numeric(contributions$amount)

contributions[, c("id", "member_id", "month", "amount",
                   "has_paid", "payment_date",
                   "payment_method", "payment_type")] |> head(8)

id	member_id	month	amount	has_paid	payment_date	payment_method	payment_type
5	14	2026-05	20000	1	2026-05-12	NA	one_time
6	41	2026-05	6000	1	2026-05-24	NA	one_time
7	18	2026-05	6000	1	2026-05-14	cash	one_time
8	67	2026-05	22000	1	2026-05-10	mobile_money	one_time
9	76	2026-05	22000	0	2026-05-11	mobile_money	one_time
10	20	2026-05	22000	1	2026-05-07	mobile_money	one_time

Assignment 2 — Merging Two Datasets

Why merge tables?

The database stores member identity in members and financial records in contributions separately to avoid duplicating names, voice types, and other details on every payment row. To analyse contributions alongside member attributes we need to bring the two tables together using a join.

The shared key is member_id:

In members it is the column id — the primary key, unique per row
In contributions it is the column member_id — the foreign key, many rows per member

This is a classic one-to-many relationship: one member can have many contribution records.

Preparing the member profile for the join

members_slim <- members %>%
  select(id, member_id, name, gender, voice_type,
         age, status, member_type, is_active_chorister)

cat("members_slim — rows:", nrow(members_slim),
    "| cols:", ncol(members_slim), "\n")

members_slim — rows: 100 | cols: 9

Inner join — members with at least one contribution

An inner join keeps only rows where the key exists in both tables. Members with no contributions are dropped from the result.

merged_inner <- inner_join(
  members_slim,
  contributions,
  by = c("id" = "member_id")
)

cat("Rows in merged_inner:", nrow(merged_inner), "\n")

Rows in merged_inner: 6

cat("Unique members with contributions:",
    n_distinct(merged_inner$id), "\n")

Unique members with contributions: 6

merged_inner[, c("name", "gender", "voice_type", "age",
                  "month", "amount", "has_paid",
                  "payment_method")] |> head(8)

name	gender	voice_type	age	month	amount	has_paid	payment_method
Niyomuhoza Samuel	male	bass	25	2026-05	20000	1	NA
Jonas Izabayo	male	NA	22	2026-05	6000	1	cash
Claudine NIYIGENA	female	alto	26	2026-05	22000	1	mobile_money
Dany TUYIRINGIRE	male	tenor	23	2026-05	6000	1	NA
Benie Solange DUSABIMANA	female	soprano	31	2026-05	22000	1	mobile_money
Seraphin BYIRINGIRO	male	bass	26	2026-05	22000	0	mobile_money

Left join — all members, contributions where available

A left join keeps every row from the left table (members_slim) and attaches contribution data where it exists. Members who have never contributed get NA in the contribution columns instead of being removed.

merged_left <- left_join(
  members_slim,
  contributions,
  by = c("id" = "member_id")
)

cat("Rows in merged_left:", nrow(merged_left), "\n")

Rows in merged_left: 100

no_contrib <- merged_left %>%
  filter(is.na(amount)) %>%
  distinct(id, name, gender, voice_type, status)

cat("Members with zero contributions:", nrow(no_contrib), "\n")

Members with zero contributions: 94

no_contrib

id	name	gender	voice_type	status
15	Patience Manizabayo	male	NA	active
19	KURINTATI Emmanuel	male	tenor	active
21	Lawson Cyizere	male	bass	active
22	David SIGENIYO	male	tenor	active
23	Josue KANANI	male	bass	active
24	Uwemeyimana Yvonne	female	NA	active
25	Confiance UMUHOZA Migisha	female	NA	active
26	Niyigena Ange Aime	male	bass	active
27	Ndizeye Obed Pacifique	male	tenor	active
28	Alleluya Joyeuse	female	soprano	active
29	Isaac UWUMUREMYI	male	tenor	active
30	Cyuzuzo Uwase Alphonsine	female	soprano	active
31	Ndanyuzwe Cyiza Alexandre	male	tenor	active
32	NSHIMYUMUREMYI Olivier	male	tenor	active
33	Rebecca Dukundimana	female	soprano	active
34	NTEZIMANA Ismael	male	bass	active
35	IRADUKUNDA Adeline	female	alto	active
36	Niringiyimana Reverien	male	tenor	active
37	Innocent IRADUKUNDA	male	bass	active
38	Adeline UWAMAHORO	female	soprano	active
39	Telesphore Uwabera	male	bass	active
40	NIYONKURU EMILE	male	tenor	active
42	Flora NSHUTI	female	soprano	active
43	Dinah YANKURIJE	female	soprano	active
44	HIRWA UWIRINGIYE Thierry	male	bass	active
45	Aline Uwimana	female	soprano	active
46	SOKONGARI Marie Aimée	female	soprano	active
47	IRANKUNDA Grace Consience	female	alto	active
48	Aminadab TUYISENGE	male	tenor	active
49	Ndikumana Elysee	male	bass	active
50	Elyse TUYIZERE	male	tenor	active
51	UWERA Peace	female	soprano	active
52	Iradukunda Ingabire Delphine	female	soprano	active
53	clovis DUSINGIZUMUREMYI	male	tenor	active
54	Vanessa KABANYANA	female	soprano	active
55	Rachel HAVUGIMANA	female	soprano	active
56	Mukeshimana Jeannette	female	alto	active
57	UTABARUTSE JEAN DE DIEU	male	bass	active
58	Ashura Ishimwe	female	soprano	active
59	Vivine Imanzi	female	alto	active
60	Giselle NIYONTEGEREJE	female	soprano	active
61	MUNYAMPUNDU Assaph	male	tenor	active
62	Ange UJENEZA	female	soprano	active
63	Sylvine Umurisa	female	soprano	active
64	Honette AYINGENEYE	female	soprano	active
65	Kwizera Norbert	male	tenor	active
66	Niyomukiza Honore	male	bass	active
68	KWIZERA REMY BERTRAND	male	tenor	active
69	Angeline AKIMANA	female	alto	active
70	Isaac Mugiraneza	male	bass	active
71	JIMMY Tuyishime	male	tenor	active
72	Josue Nsengiyumva	male	bass	active
73	MASENGESHO Sabrine	female	soprano	active
74	Abel MUGIRANEZA	male	bass	active
75	Evode BIZIYAREMYE	male	bass	active
77	CYPRIEN MANIRAGABA	male	tenor	active
78	Jean Bonheur TUYUBAHE	male	NA	active
79	Laurent MUNYAMBO	male	tenor	active
80	SAMUEL NIYIBIZI	male	tenor	active
81	UMUKUNDWA Willy prince didier	male	tenor	active
82	DUSHIMIMANA ERIC	male	tenor	active
83	Niyonsenga Schadrack	male	tenor	active
84	NIYITEGEKA Olive	female	soprano	active
85	UWIMBABAZI Francine	female	NA	active
86	Thomas Habumugisha	male	tenor	active
87	NZAYISENGA Pascaline	female	soprano	active
88	UWIZEYE Elina	female	soprano	active
89	Dieu Merci Heureuse	female	soprano	active
90	MFITUMURENGEZI Yves	male	tenor	active
91	Imanirareba Milliam	female	soprano	active
92	Samuel NSHIMIYIMANA	male	bass	active
93	Mumararungu Anitha	female	soprano	active
94	IRASUBIZA MUGISHA Shallom	male	tenor	active
95	NIYOGISUBIZO Josue	male	tenor	active
96	Uwayisaba Safi	female	soprano	active
97	UWERA Aline	female	soprano	active
98	TUYIZERE Christian	male	bass	active
99	Uwiragiye Janvier	male	tenor	active
100	EPHREM NIZEYIMANA	male	tenor	active
101	Prince ISINGIZWE	male	tenor	active
102	Igwaneza Cyuzuzo Paradis	male	bass	active
103	Dusenge Emmanuel	male	tenor	active
104	Olivier Uwiringiyimana	male	unsure	active
105	Niyisubiza Sabato Brave	male	tenor	active
106	UWERA Diane	female	soprano	active
107	Divin Irafasha	male	bass	active
108	Angelique Musabe	female	NA	active
109	Mugisha Aimable	male	NA	active
110	Sylvain UZARAJE Sabato	male	NA	active
111	Aime Patrick MUSHUMBAMWIZA	male	tenor	pending
112	Anitha INGABIRE	female	NA	active
113	Irakoze Albertine	female	NA	active
114	AHISHAKIYE Shema Arsene	male	NA	active
115	IRUMVA Elichadaie	female	alto	active

Join comparison summary

data.frame(
  Join_Type     = c("Inner join", "Left join"),
  Rows_Returned = c(nrow(merged_inner), nrow(merged_left)),
  What_it_means = c(
    "Only members who have at least one contribution record",
    "All members; contribution columns are NA if no record exists"
  )
)

Join_Type	Rows_Returned	What_it_means
Inner join	6	Only members who have at least one contribution record
Left join	100	All members; contribution columns are NA if no record exists

Assignment 3 — dplyr

`select()` — pick columns by name

select() returns only the columns we mention

# Pick identity columns from members
members_core <- members %>%
  select(id, member_id, first_name, last_name,
         gender, voice_type, age, status, member_type)

cat("members_core columns:", paste(names(members_core), collapse = ", "), "\n")

members_core columns: id, member_id, first_name, last_name, gender, voice_type, age, status, member_type

# Pick columns whose name starts with "payment" from contributions
payment_cols <- contributions %>%
  select(id, member_id, amount, starts_with("payment"))

cat("payment_cols columns:", paste(names(payment_cols), collapse = ", "), "\n")

payment_cols columns: id, member_id, amount, payment_date, payment_method, payment_type

`filter()` — keep rows that match a condition

filter() keeps only rows where the logical expression is TRUE. Common operators: ==, !=, >, <, >=, <=, %in%, is.na(), !is.na().

# Active members only
active_members <- members %>%
  filter(status == "active")
cat("Active members:", nrow(active_members), "\n")

Active members: 99

# Female active choristers
female_choristers <- members %>%
  filter(gender == "female", is_active_chorister == 1)
cat("Female active choristers:", nrow(female_choristers), "\n")

Female active choristers: 33

# Members aged 18 to 25
young_members <- members %>%
  filter(age >= 18, age <= 25)
cat("Members aged 18-25:", nrow(young_members), "\n")

Members aged 18-25: 71

# Soprano or tenor using %in%
melody_voices <- members %>%
  filter(voice_type %in% c("soprano", "tenor"))
cat("Soprano or tenor members:", nrow(melody_voices), "\n")

Soprano or tenor members: 60

# Confirmed contributions above 1000 RWF
large_confirmed <- contributions %>%
  filter(has_paid == 1, amount > 1000)
cat("Confirmed payments above 1000 RWF:", nrow(large_confirmed), "\n")

Confirmed payments above 1000 RWF: 5

`mutate()` — add or transform columns

mutate() adds new columns or overwrites existing ones while keeping all original columns. case_when() is the multi-condition version of ifelse().

members <- members %>%
  mutate(
    age_group = case_when(
      age < 20             ~ "Under 20",
      age >= 20 & age < 25 ~ "20-24",
      age >= 25 & age < 30 ~ "25-29",
      age >= 30            ~ "30 and above",
      TRUE                 ~ "Unknown"
    ),
    years_in_choir = as.integer(2025 - join_year)
  )

contributions <- contributions %>%
  mutate(
    payment_status   = ifelse(has_paid == 1, "Confirmed", "Pending"),
    amount_usd       = round(amount / 1350, 2),
    is_large_payment = amount > 5000
  )

cat("New member columns added: age_group, years_in_choir\n")

New member columns added: age_group, years_in_choir

head(members[, c("name", "age", "age_group", "years_in_choir")], 6)

name	age	age_group
Niyomuhoza Samuel	25	25-29
Patience Manizabayo	26	25-29
Jonas Izabayo	22	20-24
KURINTATI Emmanuel	24	20-24
Claudine NIYIGENA	26	25-29
Lawson Cyizere	27	25-29

cat("New contribution columns added: payment_status, amount_usd, is_large_payment\n")

New contribution columns added: payment_status, amount_usd, is_large_payment

head(contributions[, c("id", "amount", "amount_usd",
                        "payment_status", "is_large_payment")], 6)

id	amount	amount_usd	payment_status	is_large_payment
5	20000	14.81	Confirmed	TRUE
6	6000	4.44	Confirmed	TRUE
7	6000	4.44	Confirmed	TRUE
8	22000	16.30	Confirmed	TRUE
9	22000	16.30	Pending	TRUE
10	22000	16.30	Confirmed	TRUE

`arrange()` — sort rows

arrange() sorts rows ascending by default. Wrap in desc() for descending. You can sort by multiple columns — the second column breaks ties in the first.

cat("5 youngest members:\n")

5 youngest members:

members %>%
  select(name, age, gender, voice_type) %>%
  arrange(age) %>%
  head(5)

name	age	gender	voice_type
Ndikumana Elysee	0	male	bass
UTABARUTSE JEAN DE DIEU	1	male	bass
Divin Irafasha	18	male	bass
Mugisha Aimable	18	male	NA
IRUMVA Elichadaie	18	female	alto

cat("5 oldest members:\n")

5 oldest members:

members %>%
  select(name, age, gender, voice_type) %>%
  arrange(desc(age)) %>%
  head(5)

name	age	gender	voice_type
Abel MUGIRANEZA	46	male	bass
Aminadab TUYISENGE	40	male	tenor
Niyonsenga Schadrack	36	male	tenor
NIYITEGEKA Olive	34	female	soprano
Laurent MUNYAMBO	32	male	tenor

cat("Top 8 payments — largest amount first, then earliest date:\n")

Top 8 payments — largest amount first, then earliest date:

contributions %>%
  select(id, member_id, amount, payment_date, payment_status) %>%
  arrange(desc(amount), payment_date) %>%
  head(8)

id	member_id	amount	payment_date	payment_status
10	20	22000	2026-05-07	Confirmed
8	67	22000	2026-05-10	Confirmed
9	76	22000	2026-05-11	Pending
5	14	20000	2026-05-12	Confirmed
7	18	6000	2026-05-14	Confirmed
6	41	6000	2026-05-24	Confirmed

`distinct()` — remove duplicate rows

distinct() returns unique rows. Pass column names to get unique combinations of those specific columns only.

cat("Distinct voice types:\n")

Distinct voice types:

members %>% distinct(voice_type)

voice_type
bass
NA
tenor
alto
soprano
unsure

cat("Unique gender x voice type combinations:\n")

Unique gender x voice type combinations:

members %>%
  filter(!is.na(voice_type)) %>%
  distinct(gender, voice_type) %>%
  arrange(gender, voice_type)

gender	voice_type
female	alto
female	soprano
male	bass
male	tenor
male	unsure

cat("Distinct payment methods used:\n")

Distinct payment methods used:

contributions %>%
  filter(!is.na(payment_method)) %>%
  distinct(payment_method)

payment_method
cash
mobile_money

`slice()` — select rows by position

slice() picks rows by index number. slice_max() and slice_min() select the rows with the highest or lowest values in a given column.

cat("Rows 1-5 by position:\n")

Rows 1-5 by position:

members %>%
  select(name, age, voice_type, status) %>%
  slice(1:5)

name	age	voice_type	status
Niyomuhoza Samuel	25	bass	active
Patience Manizabayo	26	NA	active
Jonas Izabayo	22	NA	active
KURINTATI Emmanuel	24	tenor	active
Claudine NIYIGENA	26	alto	active

cat("Top 5 oldest members:\n")

Top 5 oldest members:

members %>%
  select(name, age, gender, voice_type) %>%
  slice_max(order_by = age, n = 5)

name	age	gender	voice_type
Abel MUGIRANEZA	46	male	bass
Aminadab TUYISENGE	40	male	tenor
Niyonsenga Schadrack	36	male	tenor
NIYITEGEKA Olive	34	female	soprano
Laurent MUNYAMBO	32	male	tenor

cat("5 youngest members:\n")

5 youngest members:

members %>%
  select(name, age, gender, voice_type) %>%
  slice_min(order_by = age, n = 5)

name	age	gender	voice_type
Ndikumana Elysee	0	male	bass
UTABARUTSE JEAN DE DIEU	1	male	bass
Divin Irafasha	18	male	bass
Mugisha Aimable	18	male	NA
IRUMVA Elichadaie	18	female	alto

cat("Top 5 largest contributions:\n")

Top 5 largest contributions:

contributions %>%
  select(id, member_id, amount, payment_status, payment_method) %>%
  slice_max(order_by = amount, n = 5)

id	member_id	amount	payment_status	payment_method
8	67	22000	Confirmed	mobile_money
9	76	22000	Pending	mobile_money
10	20	22000	Confirmed	mobile_money
5	14	20000	Confirmed	NA
6	41	6000	Confirmed	NA
7	18	6000	Confirmed	cash

`relocate()` — move columns to a new position

relocate() reorders columns without dropping any. .before and .after control exactly where the column lands.

members_reordered <- members %>%
  select(id, member_id, first_name, last_name,
         age, gender, voice_type, status) %>%
  relocate(age, gender, .before = first_name)

cat("Column order after relocate():\n")

Column order after relocate():

cat(paste(names(members_reordered), collapse = " | "), "\n")

id | member_id | age | gender | first_name | last_name | voice_type | status

`transmute()` — keep only derived columns

transmute() is like mutate() but drops all original columns and returns only the new ones you define. Use it when you want a clean derived data frame.

contrib_summary_cols <- contributions %>%
  transmute(
    contrib_id    = id,
    member_ref    = member_id,
    rwf_amount    = amount,
    usd_amount    = round(amount / 1350, 2),
    status_label  = ifelse(has_paid == 1, "PAID", "UNPAID"),
    payment_month = month,
    method_used   = payment_method
  )

cat("transmute() — only derived columns are kept:\n")

transmute() — only derived columns are kept:

cat("Columns:", paste(names(contrib_summary_cols), collapse = ", "), "\n\n")

Columns: contrib_id, member_ref, rwf_amount, usd_amount, status_label, payment_month, method_used

head(contrib_summary_cols, 8)

contrib_id	member_ref	rwf_amount	usd_amount	status_label	payment_month	method_used
5	14	20000	14.81	PAID	2026-05	NA
6	41	6000	4.44	PAID	2026-05	NA
7	18	6000	4.44	PAID	2026-05	cash
8	67	22000	16.30	PAID	2026-05	mobile_money
9	76	22000	16.30	UNPAID	2026-05	mobile_money
10	20	22000	16.30	PAID	2026-05	mobile_money

member_cards <- members %>%
  transmute(
    code      = member_id,
    full_name = paste(first_name, last_name),
    voice     = voice_type,
    age_years = age,
    age_band  = age_group,
    active    = ifelse(is_active_chorister == 1, "Yes", "No")
  )

head(member_cards, 8)

code	full_name	voice	age_years	age_band	active
GF2025992	Niyomuhoza Samuel	bass	25	25-29	Yes
GF2025170	Patience Manizabayo	NA	26	25-29	Yes
GF2025B48F4EB7	Jonas Izabayo	NA	22	20-24	Yes
GF2025B1013BE3	KURINTATI Emmanuel	tenor	24	20-24	Yes
GF202586748B76	Claudine NIYIGENA	alto	26	25-29	Yes
GF202564F1F33D	Lawson Cyizere	bass	27	25-29	Yes
GF2025F4C46674	David SIGENIYO	tenor	21	20-24	Yes
GF202568B82B10	Josue KANANI	bass	27	25-29	Yes

Assignment 4 — Grouped Summaries with `group_by %>%`

What is the pipe `%>%`?

The pipe operator %>% passes the output of one step as the first input of the next, letting you chain operations in a readable top-to-bottom sequence:

data %>% filter() %>% group_by() %>% summarise() %>% arrange()

What does `group_by()` do?

group_by() labels each row with its group. Any summarise() that follows computes its statistics separately per group and collapses the result to one row per group. The original data frame is not changed.

4a — Total contributions per member

contrib_per_member <- merged_inner %>%
  group_by(id, name, gender, voice_type) %>%
  summarise(
    num_payments   = n(),
    total_paid     = sum(amount,        na.rm = TRUE),
    avg_payment    = round(mean(amount, na.rm = TRUE), 2),
    confirmed_pays = sum(has_paid,      na.rm = TRUE),
    .groups = "drop"
  ) %>%
  arrange(desc(total_paid))

cat("Members with contribution records:", nrow(contrib_per_member), "\n\n")

Members with contribution records: 6

head(contrib_per_member, 10)

id	name	gender	voice_type	num_payments	total_paid	avg_payment	confirmed_pays
20	Claudine NIYIGENA	female	alto	1	22000	22000	1
67	Benie Solange DUSABIMANA	female	soprano	1	22000	22000	1
76	Seraphin BYIRINGIRO	male	bass	1	22000	22000	0
14	Niyomuhoza Samuel	male	bass	1	20000	20000	1
18	Jonas Izabayo	male	NA	1	6000	6000	1
41	Dany TUYIRINGIRE	male	tenor	1	6000	6000	1

4b — Total amount by voice type

by_voice <- merged_inner %>%
  filter(!is.na(voice_type)) %>%
  group_by(voice_type) %>%
  summarise(
    members        = n_distinct(id),
    total_paid     = sum(amount,                 na.rm = TRUE),
    avg_per_member = round(total_paid / members, 2),
    confirmed      = sum(has_paid,               na.rm = TRUE)
  ) %>%
  arrange(desc(total_paid))

by_voice

voice_type	members	total_paid	avg_per_member	confirmed
bass	2	42000	21000	1
alto	1	22000	22000	1
soprano	1	22000	22000	1
tenor	1	6000	6000	1

4c — By payment method

by_method <- merged_inner %>%
  filter(!is.na(payment_method)) %>%
  group_by(payment_method) %>%
  summarise(
    transactions = n(),
    total_amount = sum(amount,        na.rm = TRUE),
    avg_amount   = round(mean(amount, na.rm = TRUE), 2)
  ) %>%
  arrange(desc(total_amount))

by_method

payment_method	transactions	total_amount	avg_amount
mobile_money	3	66000	22000
cash	1	6000	6000

4d — Payment type × confirmed/pending (two grouping variables)

Grouping by two columns gives one row for every unique combination of payment_type and has_paid.

by_type_paid <- merged_inner %>%
  group_by(payment_type, has_paid) %>%
  summarise(
    count        = n(),
    total_amount = sum(amount, na.rm = TRUE),
    .groups      = "drop"
  ) %>%
  mutate(has_paid = ifelse(has_paid == 1, "Confirmed", "Pending")) %>%
  arrange(payment_type, has_paid)

by_type_paid

payment_type	has_paid	count	total_amount
one_time	Confirmed	5	76000
one_time	Pending	1	22000

4e — By gender

by_gender <- merged_inner %>%
  group_by(gender) %>%
  summarise(
    members      = n_distinct(id),
    transactions = n(),
    total_paid   = sum(amount,        na.rm = TRUE),
    avg_per_tx   = round(mean(amount, na.rm = TRUE), 2)
  ) %>%
  arrange(desc(total_paid))

by_gender

gender	members	transactions	total_paid	avg_per_tx
male	4	4	54000	13500
female	2	2	44000	22000

Visualisations

# Plot 1 — Total paid per voice type
ggplot(by_voice, aes(x = reorder(voice_type, -total_paid),
                      y = total_paid, fill = voice_type)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = scales::comma(total_paid)),
            vjust = -0.4, size = 3.5) +
  labs(title = "Total Contributions by Voice Type",
       x = "Voice Type", y = "Total Amount (RWF)") +
  scale_y_continuous(labels = scales::comma) +
  theme_minimal() +
  theme(legend.position = "none")

# Plot 2 — Distribution of payment amounts
ggplot(merged_inner, aes(x = amount)) +
  geom_histogram(binwidth = 500, fill = "#10B981", color = "white") +
  labs(title = "Distribution of Individual Payment Amounts",
       x = "Amount (RWF)", y = "Number of Payments") +
  scale_x_continuous(labels = scales::comma) +
  theme_minimal()

# Plot 3 — Confirmed vs pending by payment type
ggplot(by_type_paid,
       aes(x = payment_type, y = total_amount, fill = has_paid)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Confirmed vs Pending Amounts by Payment Type",
       x = "Payment Type", y = "Total Amount (RWF)", fill = "Status") +
  scale_y_continuous(labels = scales::comma) +
  theme_minimal()

# Plot 4 — Age distribution coloured by age group
ggplot(members, aes(x = age, fill = age_group)) +
  geom_histogram(binwidth = 2, color = "white") +
  labs(title = "Age Distribution of Members by Age Group",
       x = "Age (years)", y = "Count", fill = "Age Group") +
  theme_minimal()

Assignment 5 — Debugging with `trace()` and `recover()`

`trace()` — monitoring when a function is called

trace() attaches extra code to any existing function without modifying its source. Every time that function is called the injected code runs first. This is useful for confirming a function is being invoked, counting calls, or logging the arguments it receives.

trace("function_name", quote( code_to_inject ))
untrace("function_name")   # remove the trace when done

compute_contribution_stats <- function(data, col) {
  vals <- as.numeric(data[[col]])
  vals <- vals[!is.na(vals)]
  list(mean = mean(vals), sd = sd(vals), n = length(vals))
}

trace(
  "compute_contribution_stats",
  quote(cat("  [trace] compute_contribution_stats was called\n"))
)

[1] "compute_contribution_stats"

cat("--- First call (on amount) ---\n")

--- First call (on amount) ---

r1 <- compute_contribution_stats(contributions, "amount")

Tracing compute_contribution_stats(contributions, "amount") on entry 
  [trace] compute_contribution_stats was called

cat("  mean =", round(r1$mean, 2), "| sd =", round(r1$sd, 2),
    "| n =", r1$n, "\n")

  mean = 16333.33 | sd = 8041.56 | n = 6

cat("\n--- Second call (on months_covered) ---\n")


--- Second call (on months_covered) ---

r2 <- compute_contribution_stats(contributions, "months_covered")

Tracing compute_contribution_stats(contributions, "months_covered") on entry 
  [trace] compute_contribution_stats was called

cat("  mean =", round(r2$mean, 2), "| sd =", round(r2$sd, 2),
    "| n =", r2$n, "\n")

  mean = 1 | sd = 0 | n = 6

untrace("compute_contribution_stats")

Notice [trace] compute_contribution_stats was called appears before our own output each time — this is the injected code running at function entry. After untrace() the function runs with no extra output.

`recover()` — inspecting the call stack on error

When options(error = recover) is set, R pauses on any error and shows an interactive menu of every function active on the call stack. You can type a frame number to inspect local variables at that point in the execution — exactly what each variable held right before the crash.

Because recover() opens an interactive prompt it cannot run inside a knitted document. We use tryCatch() to catch the same error safely and show what would have been reported.

options(error = recover)

safe_avg_contribution <- function(data, group_col, amount_col) {
  if (!group_col %in% names(data)) {
    stop(paste("Column not found:", group_col))
  }
  tapply(data[[amount_col]], data[[group_col]], mean, na.rm = TRUE)
}

tryCatch(
  expr = {
    result <- safe_avg_contribution(contributions, "payment_method", "amount")
    cat("Average amount by payment method:\n")
    print(round(result, 2))

    safe_avg_contribution(contributions, "nonexistent_column", "amount")
  },
  error = function(e) {
    cat("\nError caught:", conditionMessage(e), "\n")
    cat("In a live R session with options(error = recover),\n")
    cat("R would now show the call stack:\n\n")
    cat("  Frame 1: tryCatch(...)\n")
    cat("  Frame 2: safe_avg_contribution(contributions, 'nonexistent_column', ...)\n")
    cat("  Frame 3: stop(paste('Column not found:', group_col))\n\n")
    cat("You would type '2' to enter safe_avg_contribution and inspect\n")
    cat("'group_col', 'data', and 'amount_col' at the point of failure.\n")
  }
)

Average amount by payment method:
        cash mobile_money 
        6000        22000 

Error caught: Column not found: nonexistent_column 
In a live R session with options(error = recover),
R would now show the call stack:

  Frame 1: tryCatch(...)
  Frame 2: safe_avg_contribution(contributions, 'nonexistent_column', ...)
  Frame 3: stop(paste('Column not found:', group_col))

You would type '2' to enter safe_avg_contribution and inspect
'group_col', 'data', and 'amount_col' at the point of failure.

options(error = NULL)

Practical rule: - Use trace() to verify when a function runs. - Use options(error = recover) when you need to look inside the call stack to understand why a crash happened.

Assignment 6 — Custom Summary Analytics Function

Design goal

A single function that accepts any data frame and any column name and returns the right statistics automatically — numeric stats for number columns, frequency counts for text or factor columns. The same function works on age, amount, voice_type, payment_method, or any other column without rewriting code.

column_summary <- function(data, col_name) {
  
  x <- data[[col_name]]
  
  # Numeric columns
  if (is.numeric(x)) {
    
    cat("\nSummary for", col_name, "\n")
    cat("Mean:", mean(x, na.rm = TRUE), "\n")
    cat("Median:", median(x, na.rm = TRUE), "\n")
    cat("Minimum:", min(x, na.rm = TRUE), "\n")
    cat("Maximum:", max(x, na.rm = TRUE), "\n")
    cat("Standard Deviation:", sd(x, na.rm = TRUE), "\n")
    
  } else {
    
    # Categorical columns
    cat("\nFrequency table for", col_name, "\n")
    print(table(x))
  }
}

`On my dataset`

column_summary(contributions, "amount")


Summary for amount 
Mean: 16333.33 
Median: 21000 
Minimum: 6000 
Maximum: 22000 
Standard Deviation: 8041.559

column_summary(members, "age")


Summary for age 
Mean: 23.43 
Median: 23 
Minimum: 0 
Maximum: 46 
Standard Deviation: 5.521775

column_summary(contributions, "payment_method")


Frequency table for payment_method 
x
        cash mobile_money 
           1            3

column_summary(members, "voice_type")


Frequency table for voice_type 
x
   alto    bass soprano   tenor  unsure 
      7      20      28      32       1


---

## Assignment 7 — The Apply


### `sapply()` — simplified apply

`sapply()` runs a function on every element of a vector and simplifies the
result into a named vector. Use it when you expect one number back per item.


``` r
numeric_cols <- c("amount", "months_covered", "has_paid", "is_recurring")

# Mean of each numeric column
col_means <- sapply(numeric_cols, function(col) {
  round(mean(contributions[[col]], na.rm = TRUE), 3)
})

cat("Column means:\n")

Column means:

print(col_means)

        amount months_covered       has_paid   is_recurring 
     16333.333          1.000          0.833          0.000

# NA count per column
na_counts <- sapply(numeric_cols, function(col) {
  sum(is.na(contributions[[col]]))
})

cat("\nNA counts:\n")


NA counts:

print(na_counts)

        amount months_covered       has_paid   is_recurring 
             0              0              0              0

# Confirmation rate % by payment type
paid_rate <- sapply(
  split(contributions$has_paid, contributions$payment_type),
  function(x) round(mean(x, na.rm = TRUE) * 100, 1)
)
cat("\nPayment confirmation rate (%) by type:\n")


Payment confirmation rate (%) by type:

print(paid_rate)

one_time 
    83.3

`lapply()` — list apply

lapply() always returns a list — one element per input item. Use it when the result of each call is complex and cannot be flattened into a vector, such as the list returned by column_summary().

cols_to_summarise <- c("amount", "months_covered", "age")

all_summaries <- lapply(cols_to_summarise, function(col) {
  df <- if (col == "age") members else contributions
  column_summary(df, col)
})


Summary for amount 
Mean: 16333.33 
Median: 21000 
Minimum: 6000 
Maximum: 22000 
Standard Deviation: 8041.559 

Summary for months_covered 
Mean: 1 
Median: 1 
Minimum: 1 
Maximum: 1 
Standard Deviation: 0 

Summary for age 
Mean: 23.43 
Median: 23 
Minimum: 0 
Maximum: 46 
Standard Deviation: 5.521775

names(all_summaries) <- cols_to_summarise

for (nm in names(all_summaries)) {
  s <- all_summaries[[nm]]
  cat(sprintf("%-16s | mean: %8.2f | sd: %7.2f | min: %5.0f | max: %5.0f\n",
              nm, s$mean, s$sd, s$min, s$max))
}

all_summaries is a named list of three elements, each itself a list of statistics. sapply() would have failed here because the items cannot be collapsed into a simple vector.

`mapply()` — multivariate apply

mapply() takes two or more vectors of equal length and calls the function once per position, passing the i-th element of each vector as a separate argument — processing pairs simultaneously.

cols   <- c("amount", "months_covered", "age",     "voice_type",   "payment_method")
frames <- c("contrib", "contrib",       "members", "members",      "contrib")

mapply(function(col, frame_name) {
  df    <- if (frame_name == "members") members else contributions
  n_na  <- sum(is.na(df[[col]]))
  dtype <- if (is.numeric(df[[col]])) "numeric" else "categorical"
  cat(sprintf("%-16s | %-11s | table: %-10s | NAs: %d\n",
              col, dtype, frame_name, n_na))
}, cols, frames)

amount           | numeric     | table: contrib    | NAs: 0
months_covered   | numeric     | table: contrib    | NAs: 0
age              | numeric     | table: members    | NAs: 0
voice_type       | categorical | table: members    | NAs: 12
payment_method   | categorical | table: contrib    | NAs: 2

$amount
NULL

$months_covered
NULL

$age
NULL

$voice_type
NULL

$payment_method
NULL

`tapply()` — table apply (split–apply–combine)

tapply() splits a numeric vector into subsets defined by a grouping factor, applies a function to each subset, and returns a named array. It is the base-R equivalent of group_by %>% summarise.

cat("Total amount per payment method:\n")

Total amount per payment method:

total_by_method <- tapply(
  contributions$amount,
  contributions$payment_method,
  function(x) round(sum(x, na.rm = TRUE), 2)
)
print(total_by_method)

        cash mobile_money 
        6000        66000

cat("\nAverage contribution per voice type:\n")


Average contribution per voice type:

avg_by_voice <- tapply(
  merged_inner$amount,
  merged_inner$voice_type,
  function(x) round(mean(x, na.rm = TRUE), 2)
)
print(avg_by_voice)

   alto    bass soprano   tenor 
  22000   21000   22000    6000

cat("\nNumber of payment records per payment type:\n")


Number of payment records per payment type:

count_by_type <- tapply(
  contributions$id,
  contributions$payment_type,
  length
)
print(count_by_type)

one_time 
       6

Close the Connection

Every open database connection holds a slot on the MySQL server. Always release it with dbDisconnect() when the analysis is finished.

dbDisconnect(con)

[1] TRUE

cat("Connection closed.\n")

Connection closed.

Published By Samuel Niyomuhoza | 2025MBI049*

R Assignments

Samuel Niyomuhoza | 2025MBI049

2026-05-24

Introduction

Assignment 1 — Loading Datasets from RDBMS

Packages

Loading credentials from .env

Opening the database connection

Loading the members table

Loading the contributions table

Assignment 2 — Merging Two Datasets

Why merge tables?

Preparing the member profile for the join

Inner join — members with at least one contribution

Left join — all members, contributions where available

Join comparison summary

Assignment 3 — dplyr

select() — pick columns by name

filter() — keep rows that match a condition

mutate() — add or transform columns

arrange() — sort rows

distinct() — remove duplicate rows

slice() — select rows by position

relocate() — move columns to a new position

transmute() — keep only derived columns

Assignment 4 — Grouped Summaries with group_by %>%

What is the pipe %>%?

What does group_by() do?