summarise_kpi <- function(data, group, value) {
data |>
summarise(
observations = n(),
missing_values = sum(is.na({{ value }})),
total = sum({{ value }}, na.rm = TRUE),
average = mean({{ value }}, na.rm = TRUE),
.by = {{ group }}
)
}
transactions |>
summarise_kpi(customer_segment, net_amount)Advanced dplyr Techniques
Beyond the Basics: Advanced dplyr
Once you’ve mastered the core dplyr verbs, it’s time to explore advanced techniques that will make your code more efficient, reusable, and elegant. This section covers programming with dplyr, performance optimization, and sophisticated data manipulation patterns.
A useful reusable function accepts tidy-select columns with { } and gives its output stable names:
{ group } and { value } capture unquoted column names supplied by the caller. The companion count of missing values makes the na.rm = TRUE choice visible; otherwise a clean-looking total could conceal poor source data.
library(tidyverse)
library(lubridate)
# Create a comprehensive dataset for demonstrating advanced techniques
set.seed(123)
n_transactions <- 5000
transactions <- tibble(
transaction_id = 1:n_transactions,
customer_id = sample(paste0("CUST-", str_pad(1:500, 3, pad = "0")), n_transactions, replace = TRUE),
product_id = sample(paste0("PROD-", str_pad(1:100, 3, pad = "0")), n_transactions, replace = TRUE),
store_id = sample(paste0("STORE-", 1:20), n_transactions, replace = TRUE),
timestamp = sample(seq(ymd_hms("2024-01-01 00:00:00"), ymd_hms("2024-12-31 23:59:59"), by = "hour"), n_transactions),
quantity = sample(1:10, n_transactions, replace = TRUE, prob = c(0.4, 0.3, 0.15, 0.08, 0.04, 0.02, 0.005, 0.005, 0.005, 0.005)),
unit_price = round(rlnorm(n_transactions, meanlog = 3, sdlog = 1), 2),
discount_rate = sample(c(0, 0.05, 0.10, 0.15, 0.20, 0.25), n_transactions, replace = TRUE, prob = c(0.6, 0.2, 0.1, 0.05, 0.03, 0.02)),
payment_method = sample(c("Credit Card", "Cash", "Debit Card", "Mobile Payment"), n_transactions, replace = TRUE, prob = c(0.4, 0.25, 0.2, 0.15)),
customer_segment = sample(c("Regular", "Premium", "VIP"), n_transactions, replace = TRUE, prob = c(0.7, 0.25, 0.05))
) %>%
mutate(
date = as_date(timestamp),
hour = hour(timestamp),
day_of_week = wday(date, label = TRUE),
month = month(date, label = TRUE),
quarter = quarter(date),
gross_amount = quantity * unit_price,
discount_amount = gross_amount * discount_rate,
net_amount = gross_amount - discount_amount
)
cat("Created dataset with", format(nrow(transactions), big.mark = ","), "transactions\n")Created dataset with 5,000 transactionscat("Date range:", as.character(min(transactions$date)), "to", as.character(max(transactions$date)), "\n")Date range: 2024-01-01 to 2024-12-31 cat("Total revenue: $", format(sum(transactions$net_amount), big.mark = ",", nsmall = 2), "\n")Total revenue: $ 352,651.33 The across() Function
across() allows you to apply operations to multiple columns simultaneously:
# Summarize multiple columns at once
summary_stats <- transactions %>%
summarise(
across(
c(quantity, unit_price, gross_amount, discount_rate, net_amount),
list(
mean = ~mean(.x, na.rm = TRUE),
median = ~median(.x, na.rm = TRUE),
sd = ~sd(.x, na.rm = TRUE),
min = ~min(.x, na.rm = TRUE),
max = ~max(.x, na.rm = TRUE)
),
.names = "{.col}_{.fn}"
)
) %>%
pivot_longer(
everything(),
names_to = c("variable", "stat"),
names_sep = "_(?=mean|median|sd|min|max)",
values_to = "value"
) %>%
pivot_wider(names_from = stat, values_from = value)
print(summary_stats)# A tibble: 5 × 6
variable mean median sd min max
<chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 quantity 2.21 2 1.50 1 10
2 unit_price 33.4 20.0 45.4 0.51 953.
3 gross_amount 73.6 36.2 133. 1.02 4801.
4 discount_rate 0.0380 0 0.0600 0 0.25
5 net_amount 70.5 35.0 126. 0.867 4321. # Apply transformations to multiple columns
transactions_scaled <- transactions %>%
mutate(
across(
c(quantity, gross_amount, net_amount),
list(
log = ~log1p(.x),
sqrt = ~sqrt(.x),
z_score = ~(.x - mean(.x)) / sd(.x)
),
.names = "{.col}_{.fn}"
)
)
cat("\nCreated", ncol(transactions_scaled) - ncol(transactions), "new transformed variables\n")
Created 9 new transformed variablesColumn Selection Helpers
dplyr provides powerful helpers for selecting columns:
# Various selection methods
selection_examples <- transactions %>%
select(
# Specific columns
transaction_id, customer_id,
# Range of columns
quantity:discount_rate,
# Columns matching patterns
starts_with("customer"),
ends_with("amount"),
contains("price"),
# Columns by type
where(is.numeric),
# Exclude columns
-matches("^(timestamp|date)$")
)
# Using where() with custom functions
high_variance_cols <- transactions %>%
select(where(~is.numeric(.x) && var(.x, na.rm = TRUE) > 100))
cat("Selected columns with high variance:\n")Selected columns with high variance:names(high_variance_cols)[1] "transaction_id" "unit_price" "gross_amount" "discount_amount"
[5] "net_amount" # Complex selections with multiple conditions
financial_cols <- transactions %>%
select(
transaction_id,
where(~is.numeric(.x) && any(str_detect(names(.), "amount|price|discount")))
)
cat("\n\nFinancial columns:", paste(names(financial_cols), collapse = ", "))
Financial columns: transaction_idProgramming with dplyr
Creating reusable functions with dplyr requires understanding tidy evaluation:
# Function to analyze any grouping variable
analyze_by_category <- function(data, group_col, value_col) {
data %>%
group_by({{ group_col }}) %>%
summarise(
count = n(),
total = sum({{ value_col }}, na.rm = TRUE),
avg = mean({{ value_col }}, na.rm = TRUE),
median = median({{ value_col }}, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(
percentage = total / sum(total) * 100,
cumulative_pct = cumsum(percentage)
) %>%
arrange(desc(total))
}
# Use the function with different variables
by_segment <- analyze_by_category(transactions, customer_segment, net_amount)
by_payment <- analyze_by_category(transactions, payment_method, net_amount)
by_store <- analyze_by_category(transactions, store_id, net_amount) %>% head(10)
cat("Analysis by customer segment:\n")Analysis by customer segment:print(by_segment)# A tibble: 3 × 7
customer_segment count total avg median percentage cumulative_pct
<chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Regular 3442 242427. 70.4 34.1 68.7 94.5
2 Premium 1294 90942. 70.3 35.9 25.8 25.8
3 VIP 264 19282. 73.0 41.2 5.47 100 cat("\n\nAnalysis by payment method:\n")
Analysis by payment method:print(by_payment)# A tibble: 4 × 7
payment_method count total avg median percentage cumulative_pct
<chr> <int> <dbl> <dbl> <dbl> <dbl> <dbl>
1 Credit Card 2045 145761. 71.3 34.9 41.3 67.1
2 Cash 1194 91013. 76.2 35.1 25.8 25.8
3 Debit Card 997 64190. 64.4 34.3 18.2 85.3
4 Mobile Payment 764 51688. 67.7 35.6 14.7 100 Advanced Programming Patterns
# Function with dynamic column names
create_kpi_summary <- function(data, ..., prefix = "kpi") {
group_vars <- enquos(...)
data %>%
group_by(!!!group_vars) %>%
summarise(
"{prefix}_transactions" := n(),
"{prefix}_revenue" := sum(net_amount),
"{prefix}_units" := sum(quantity),
"{prefix}_avg_basket" := mean(net_amount),
"{prefix}_unique_customers" := n_distinct(customer_id),
"{prefix}_unique_products" := n_distinct(product_id),
.groups = "drop"
)
}
# Generate KPIs for different time periods
monthly_kpis <- transactions %>%
create_kpi_summary(month, prefix = "monthly")
quarterly_kpis <- transactions %>%
create_kpi_summary(quarter, customer_segment, prefix = "q")
cat("Monthly KPIs (first 6 months):\n")Monthly KPIs (first 6 months):print(head(monthly_kpis))# A tibble: 6 × 7
month monthly_transactions monthly_revenue monthly_units monthly_avg_basket
<ord> <int> <dbl> <int> <dbl>
1 Jan 426 33867. 986 79.5
2 Feb 388 25700. 826 66.2
3 Mar 419 29337. 939 70.0
4 Apr 418 30846. 910 73.8
5 May 441 32095. 1003 72.8
6 Jun 400 29514. 835 73.8
# ℹ 2 more variables: monthly_unique_customers <int>,
# monthly_unique_products <int># Function that accepts string inputs
summarize_columns <- function(data, cols, funs) {
data %>%
summarise(
across(all_of(cols), funs, .names = "{.col}_{.fn}")
)
}
numeric_summary <- transactions %>%
summarize_columns(
c("quantity", "net_amount"),
list(total = sum, avg = mean, sd = sd)
)
print(numeric_summary)# A tibble: 1 × 6
quantity_total quantity_avg quantity_sd net_amount_total net_amount_avg
<int> <dbl> <dbl> <dbl> <dbl>
1 11026 2.21 1.50 352651. 70.5
# ℹ 1 more variable: net_amount_sd <dbl>Row-wise Operations
Sometimes you need to perform operations across rows:
# Create a dataset with multiple score columns
performance_data <- tibble(
employee_id = paste0("EMP-", str_pad(1:100, 3, pad = "0")),
q1_score = runif(100, 60, 100),
q2_score = runif(100, 65, 100),
q3_score = runif(100, 70, 100),
q4_score = runif(100, 68, 100),
bonus_points = sample(0:10, 100, replace = TRUE)
)
# Row-wise calculations
performance_summary <- performance_data %>%
rowwise() %>%
mutate(
avg_score = mean(c(q1_score, q2_score, q3_score, q4_score)),
min_score = min(c(q1_score, q2_score, q3_score, q4_score)),
max_score = max(c(q1_score, q2_score, q3_score, q4_score)),
total_score = sum(c(q1_score, q2_score, q3_score, q4_score, bonus_points)),
score_variance = var(c(q1_score, q2_score, q3_score, q4_score))
) %>%
ungroup() %>%
mutate(
performance_category = case_when(
avg_score >= 90 ~ "Outstanding",
avg_score >= 80 ~ "Excellent",
avg_score >= 70 ~ "Good",
TRUE ~ "Needs Improvement"
)
)
# Summary by performance category
performance_summary %>%
count(performance_category) %>%
mutate(percentage = n / sum(n) * 100)# A tibble: 3 × 3
performance_category n percentage
<chr> <int> <dbl>
1 Excellent 69 69
2 Good 26 26
3 Outstanding 5 5# Alternative using c_across()
performance_alt <- performance_data %>%
rowwise() %>%
mutate(
avg_score = mean(c_across(q1_score:q4_score)),
score_range = max(c_across(q1_score:q4_score)) - min(c_across(q1_score:q4_score))
) %>%
ungroup()Complex Conditional Logic
Advanced use of case_when() and if_else():
# Multi-condition categorization
transactions_categorized <- transactions %>%
mutate(
# Complex time-based categorization
time_category = case_when(
hour >= 6 & hour < 12 ~ "Morning",
hour >= 12 & hour < 17 ~ "Afternoon",
hour >= 17 & hour < 21 ~ "Evening",
TRUE ~ "Night"
),
# Nested conditions
purchase_type = case_when(
quantity == 1 & net_amount < 20 ~ "Small Single Item",
quantity == 1 & net_amount >= 20 ~ "Large Single Item",
quantity > 1 & quantity <= 5 & net_amount < 50 ~ "Small Basket",
quantity > 1 & quantity <= 5 & net_amount >= 50 ~ "Medium Basket",
quantity > 5 ~ "Bulk Purchase",
TRUE ~ "Other"
),
# Complex business rules
customer_value = case_when(
customer_segment == "VIP" ~ "High Value",
customer_segment == "Premium" & net_amount > 100 ~ "High Value",
customer_segment == "Premium" ~ "Medium Value",
net_amount > 200 ~ "Potential High Value",
TRUE ~ "Standard"
),
# Seasonal pricing strategy
pricing_season = case_when(
month %in% c("Nov", "Dec") ~ "Holiday Premium",
month %in% c("Jun", "Jul", "Aug") ~ "Summer Sale",
month %in% c("Jan", "Feb") & discount_rate > 0.15 ~ "New Year Clearance",
day_of_week %in% c("Sat", "Sun") & time_category == "Morning" ~ "Weekend Special",
TRUE ~ "Regular Pricing"
)
)
# Analyze the categorizations
cat("Purchase type distribution:\n")Purchase type distribution:transactions_categorized %>%
count(purchase_type, sort = TRUE) %>%
mutate(percentage = n / sum(n) * 100)# A tibble: 5 × 3
purchase_type n percentage
<chr> <int> <dbl>
1 Small Basket 1409 28.2
2 Medium Basket 1395 27.9
3 Small Single Item 1019 20.4
4 Large Single Item 982 19.6
5 Bulk Purchase 195 3.9Performance Optimization
Tips for making dplyr operations faster:
# 1. Use data.table backend for large datasets
# library(dtplyr)
# transactions_dt <- lazy_dt(transactions)
# 2. Minimize grouping operations
# Inefficient: multiple group_by operations
start_time <- Sys.time()
result_slow <- transactions %>%
group_by(store_id) %>%
mutate(store_total = sum(net_amount)) %>%
ungroup() %>%
group_by(customer_id) %>%
mutate(customer_total = sum(net_amount)) %>%
ungroup()
time_slow <- Sys.time() - start_time
# Efficient: calculate summaries separately and join
start_time <- Sys.time()
store_totals <- transactions %>%
group_by(store_id) %>%
summarise(store_total = sum(net_amount), .groups = "drop")
customer_totals <- transactions %>%
group_by(customer_id) %>%
summarise(customer_total = sum(net_amount), .groups = "drop")
result_fast <- transactions %>%
left_join(store_totals, by = "store_id") %>%
left_join(customer_totals, by = "customer_id")
time_fast <- Sys.time() - start_time
cat("Performance comparison:\n")Performance comparison:cat("Multiple group_by:", format(time_slow), "\n")Multiple group_by: 0.005902529 secs cat("Separate summaries:", format(time_fast), "\n")Separate summaries: 0.008262396 secs cat("Speedup:", round(as.numeric(time_slow) / as.numeric(time_fast), 2), "x\n")Speedup: 0.71 x# 3. Use vectorized operations
# Slow: row-wise string operations
slow_categorize <- function(df) {
df %>%
rowwise() %>%
mutate(
description = paste(customer_segment, "customer bought", quantity,
"items via", payment_method)
) %>%
ungroup()
}
# Fast: vectorized operations
fast_categorize <- function(df) {
df %>%
mutate(
description = str_c(customer_segment, " customer bought ", quantity,
" items via ", payment_method)
)
}
# Compare a subset
small_trans <- head(transactions, 1000)
time_slow <- system.time(slow_result <- slow_categorize(small_trans))
time_fast <- system.time(fast_result <- fast_categorize(small_trans))
cat("\nString operation performance (1000 rows):\n")
String operation performance (1000 rows):cat("Row-wise:", time_slow["elapsed"], "seconds\n")Row-wise: 0.007 secondscat("Vectorized:", time_fast["elapsed"], "seconds\n")Vectorized: 0.001 secondsAdvanced Joining Techniques
# Rolling joins (finding the nearest match)
price_changes <- tibble(
product_id = rep(paste0("PROD-", str_pad(1:10, 3, pad = "0")), each = 4),
effective_date = rep(c(ymd("2024-01-01"), ymd("2024-04-01"),
ymd("2024-07-01"), ymd("2024-10-01")), 10),
price = round(runif(40, 10, 100), 2)
)
# Function to find applicable price for each transaction
find_applicable_price <- function(trans_data, price_data) {
trans_data %>%
left_join(
price_data %>%
rename(price_date = effective_date),
by = "product_id"
) %>%
filter(date >= price_date) %>%
group_by(transaction_id) %>%
filter(price_date == max(price_date)) %>%
ungroup() %>%
select(-price_date)
}
# Apply to a subset of transactions
sample_trans <- transactions %>%
filter(product_id %in% paste0("PROD-", str_pad(1:10, 3, pad = "0"))) %>%
slice_sample(n = 100)
trans_with_prices <- find_applicable_price(sample_trans, price_changes)
cat("Sample of transactions with historical prices:\n")Sample of transactions with historical prices:trans_with_prices %>%
select(transaction_id, date, product_id, unit_price, price) %>%
rename(transaction_price = unit_price, catalog_price = price) %>%
slice_head(n = 5)# A tibble: 5 × 5
transaction_id date product_id transaction_price catalog_price
<int> <date> <chr> <dbl> <dbl>
1 1722 2024-10-17 PROD-004 4.08 41.6
2 3045 2024-04-21 PROD-007 18.0 55.5
3 780 2024-11-27 PROD-009 17.8 41.0
4 2745 2024-01-01 PROD-002 94.4 51.7
5 2079 2024-02-24 PROD-003 53.0 36.7Creating Custom Verb Functions
# Create a custom verb for common operations
add_time_features <- function(data, date_col) {
date_col <- enquo(date_col)
data %>%
mutate(
year = year(!!date_col),
quarter = quarter(!!date_col),
month = month(!!date_col),
week = week(!!date_col),
day_of_month = day(!!date_col),
day_of_week = wday(!!date_col, label = TRUE),
is_weekend = wday(!!date_col) %in% c(1, 7),
is_month_start = day(!!date_col) <= 7,
is_month_end = day(!!date_col) >= day(ceiling_date(!!date_col, "month") - 1) - 6
)
}
# Create business metric calculations
calculate_business_metrics <- function(data) {
data %>%
mutate(
margin = (net_amount - (net_amount * 0.7)) / net_amount, # Assume 30% margin
margin_amount = net_amount * margin,
revenue_per_unit = net_amount / quantity,
discount_impact = discount_amount / gross_amount * 100
)
}
# Chain custom functions
enhanced_transactions <- transactions %>%
slice_sample(n = 1000) %>%
add_time_features(date) %>%
calculate_business_metrics() %>%
select(transaction_id, date, is_weekend, margin, revenue_per_unit)
cat("Enhanced transactions with custom features:\n")Enhanced transactions with custom features:print(head(enhanced_transactions))# A tibble: 6 × 5
transaction_id date is_weekend margin revenue_per_unit
<int> <date> <lgl> <dbl> <dbl>
1 4407 2024-05-13 FALSE 0.3 1.36
2 2741 2024-03-07 FALSE 0.3 21.5
3 3422 2024-02-11 TRUE 0.3 38.0
4 2624 2024-08-06 FALSE 0.3 5.6
5 4961 2024-08-05 FALSE 0.3 17.2
6 3958 2024-01-12 FALSE 0.3 15.7 Advanced Reshaping Patterns
# Complex pivot with multiple value columns
monthly_metrics <- transactions %>%
mutate(year_month = floor_date(date, "month")) %>%
group_by(year_month, customer_segment) %>%
summarise(
transactions = n(),
revenue = sum(net_amount),
units = sum(quantity),
avg_basket = mean(net_amount),
.groups = "drop"
)
# Pivot with custom names
wide_metrics <- monthly_metrics %>%
pivot_wider(
names_from = customer_segment,
values_from = c(transactions, revenue, units, avg_basket),
names_glue = "{customer_segment}_{.value}"
)
cat("Wide format with custom column names:\n")Wide format with custom column names:names(wide_metrics) [1] "year_month" "Premium_transactions" "Regular_transactions"
[4] "VIP_transactions" "Premium_revenue" "Regular_revenue"
[7] "VIP_revenue" "Premium_units" "Regular_units"
[10] "VIP_units" "Premium_avg_basket" "Regular_avg_basket"
[13] "VIP_avg_basket" # Nested data structures
nested_analysis <- transactions %>%
group_by(store_id) %>%
nest() %>%
mutate(
# Perform analysis on each nested dataset
summary = map(data, ~{
.x %>%
summarise(
n_trans = n(),
revenue = sum(net_amount),
top_product = names(sort(table(.x$product_id), decreasing = TRUE)[1]),
peak_hour = as.numeric(names(sort(table(.x$hour), decreasing = TRUE)[1]))
)
}),
# Extract specific metrics
total_revenue = map_dbl(summary, ~.x$revenue),
transaction_count = map_int(summary, ~.x$n_trans)
) %>%
arrange(desc(total_revenue))
cat("\nTop 5 stores by revenue:\n")
Top 5 stores by revenue:nested_analysis %>%
select(store_id, total_revenue, transaction_count) %>%
head(5)# A tibble: 5 × 3
# Groups: store_id [5]
store_id total_revenue transaction_count
<chr> <dbl> <int>
1 STORE-8 22533. 276
2 STORE-9 21552. 285
3 STORE-1 21042. 269
4 STORE-11 19540. 245
5 STORE-20 19518. 234Error Handling and Validation
# Safe summary function with validation
safe_summarize <- function(data, group_var, value_var) {
group_var <- enquo(group_var)
value_var <- enquo(value_var)
# Validate inputs
if (!quo_name(value_var) %in% names(data)) {
stop("Value variable not found in data")
}
if (!is.numeric(data %>% pull(!!value_var))) {
warning("Value variable is not numeric, converting...")
data <- data %>%
mutate(!!value_var := as.numeric(!!value_var))
}
# Perform analysis with error handling
tryCatch({
data %>%
group_by(!!group_var) %>%
summarise(
n = n(),
mean = mean(!!value_var, na.rm = TRUE),
median = median(!!value_var, na.rm = TRUE),
sd = sd(!!value_var, na.rm = TRUE),
missing = sum(is.na(!!value_var)),
.groups = "drop"
) %>%
mutate(
cv = sd / mean, # Coefficient of variation
data_quality = case_when(
missing / n > 0.1 ~ "Poor",
cv > 1 ~ "High Variability",
TRUE ~ "Good"
)
)
}, error = function(e) {
message("Error in summarization: ", e$message)
return(NULL)
})
}
# Test the function
result <- safe_summarize(transactions, store_id, net_amount)
cat("Safe summarization completed successfully\n")Safe summarization completed successfullyBest Practices Summary
- Use across() for multiple columns: More concise than multiple mutate calls
- Leverage selection helpers: starts_with(), ends_with(), contains(), where()
- Program with {{}}: For creating reusable functions
- Optimize performance: Minimize groups, use vectorized operations
- Handle errors gracefully: Validate inputs and use tryCatch()
- Document your functions: Clear names and comments
- Test with small data first: Develop on subsets before scaling up
Practice Exercises
- Custom Analysis Function: Create a function that performs a complete analysis pipeline
- Performance Comparison: Compare different approaches to the same problem
- Complex Reshaping: Transform nested transaction data into a report format
- Error-Robust Pipeline: Build a data processing pipeline that handles various data quality issues
Conclusion
Advanced dplyr techniques enable you to write more efficient, maintainable, and powerful data manipulation code. The key is to:
- Understand tidy evaluation for programming
- Use vectorized operations whenever possible
- Create reusable functions for common patterns
- Optimize for performance with large datasets
- Handle edge cases and errors gracefully
These advanced skills will make you a more effective data analyst and allow you to tackle complex real-world data challenges with confidence.