---
title: "Module 5 Solutions — Functions, Vectors & Iteration"
format:
  html:
    css: "../dark-theme.css"
    include-in-header: |
      <script>
        // Immediate theme application to prevent flash
        (function() {
          const savedTheme = localStorage.getItem('theme') || 'light';
          document.documentElement.setAttribute('data-bs-theme', savedTheme);
        })();
      </script>
    include-after-body: |
      <button class="theme-toggle" onclick="toggleTheme()" title="Toggle theme">🌙</button>
      <script>
        function toggleTheme() {
          const html = document.documentElement;
          const currentTheme = html.getAttribute('data-bs-theme');
          const newTheme = currentTheme === 'dark' ? 'light' : 'dark';

          html.setAttribute('data-bs-theme', newTheme);
          localStorage.setItem('theme', newTheme);

          // Update button icon
          const button = document.querySelector('.theme-toggle');
          button.innerHTML = newTheme === 'dark' ? '☀️' : '🌙';
        }

        // Initialize theme on load
        document.addEventListener('DOMContentLoaded', function() {
          const savedTheme = localStorage.getItem('theme') || 'light';
          document.documentElement.setAttribute('data-bs-theme', savedTheme);
          const button = document.querySelector('.theme-toggle');
          if (button) {
            button.innerHTML = savedTheme === 'dark' ? '☀️' : '🌙';
          }
        });
      </script>
editor: visual
---
---

# 🔧 Module 5 — Functions, Vectors & Iteration

## 📝 Solutions

## 📦 Load Libraries

```{r}
library(dplyr)
library(tibble)
library(lubridate)
library(stringr)
library(purrr)
```

------------------------------------------------------------------------

## ✅ Exercise 1 Solutions: Functions (R4DS Chapter 19)

### Task 1.1 Solution: DRY Principle - Rescale Function

```{r}
# Rescale function to normalize values to 0-1 range
rescale01 <- function(x) {
  range_x <- range(x, na.rm = TRUE)
  (x - range_x[1]) / (range_x[2] - range_x[1])
}

# Test the function
test_values <- c(10, 20, 30, NA, 40)
cat("Original values:", test_values, "\n")
cat("Rescaled values:", rescale01(test_values), "\n")
```

### Task 1.2 Solution: Function Components and Arguments

```{r}
clinical_age_category <- function(age, pediatric_cutoff = 18, elderly_cutoff = 65) {
  case_when(
    is.na(age) ~ "Unknown",
    age < pediatric_cutoff ~ "Pediatric",
    age >= pediatric_cutoff & age < elderly_cutoff ~ "Adult",
    age >= elderly_cutoff ~ "Elderly"
  )
}

# Test with different cutoffs
test_ages <- c(16, 25, 45, 67, 72, NA)
cat("Age categories (default cutoffs):\n")
print(clinical_age_category(test_ages))

cat("Age categories (pediatric: 21, elderly: 60):\n")
print(clinical_age_category(test_ages, pediatric_cutoff = 21, elderly_cutoff = 60))
```

### Task 1.3 Solution: Function with ... Argument

```{r}
clinical_summary <- function(data, ..., na.rm = TRUE, digits = 2) {
  data %>%
    summarise(
      across(c(...), list(
        mean = ~ round(mean(.x, na.rm = na.rm), digits),
        sd = ~ round(sd(.x, na.rm = na.rm), digits),
        min = ~ min(.x, na.rm = na.rm),
        max = ~ max(.x, na.rm = na.rm)
      ))
    )
}

# Create demo data for testing
demo <- tibble(
  USUBJID = paste0("001-", sprintf("%03d", 1:10)),
  AGE = c(23, 45, 67, 52, 71, 34, 58, 63, 29, 76),
  SEX = c("F", "M", "F", "M", "F", "F", "M", "F", "M", "F"),
  WEIGHT = c(65, 80, 58, 75, 62, 70, 85, 60, 78, 55),
  HEIGHT = c(160, 175, 155, 180, 158, 165, 185, 162, 172, 150),
  RFSTDTC = "2024-01-15"
)

# Test summary function
cat("Clinical summary for AGE and WEIGHT:\n")
print(clinical_summary(demo, AGE, WEIGHT))
```

### Task 1.4 Solution: BMI Function with Validation

```{r}
create_bmi_with_validation <- function(data, weight_var, height_var) {
  # Input validation
  if (!is.data.frame(data)) {
    stop("data must be a data frame")
  }

  data %>%
    mutate(
      BMI = case_when(
        is.na({{ weight_var }}) | is.na({{ height_var }}) ~ NA_real_,
        {{ weight_var }} <= 0 | {{ height_var }} <= 0 ~ NA_real_,
        TRUE ~ {{ weight_var }} / ({{ height_var }} / 100)^2
      ),
      BMI_CATEGORY = case_when(
        is.na(BMI) ~ "Unknown",
        BMI < 18.5 ~ "Underweight",
        BMI >= 18.5 & BMI < 25 ~ "Normal",
        BMI >= 25 & BMI < 30 ~ "Overweight",
        BMI >= 30 ~ "Obese"
      )
    )
}

# Test BMI function
demo_with_bmi <- demo %>%
  create_bmi_with_validation(WEIGHT, HEIGHT)

cat("BMI results:\n")
print(demo_with_bmi %>% select(USUBJID, WEIGHT, HEIGHT, BMI, BMI_CATEGORY))
```

------------------------------------------------------------------------

## ✅ Exercise 2 Solutions: Vectors (R4DS Chapter 20)

### Task 2.1 Solution: Vector Types

```{r}
# Vector types in clinical data
logical_response <- c(TRUE, FALSE, TRUE, FALSE)
visit_numbers <- c(1L, 2L, 3L, 4L)
lab_values <- c(120.5, 85.2, 95.8, 110.1)
subject_sex <- c("M", "F", "M", "F")

cat("Response vector type:", typeof(logical_response), "\n")
cat("Visit numbers type:", typeof(visit_numbers), "\n")
cat("Lab values type:", typeof(lab_values), "\n")
cat("Subject sex type:", typeof(subject_sex), "\n")
```

### Task 2.2 Solution: Safe Vector Coercion

```{r}
safe_lab_conversion <- function(x) {
  # Replace descriptive terms with NA
  cleaned <- str_replace_all(x, "normal|high|low", "")
  cleaned <- str_trim(cleaned)
  cleaned[cleaned == ""] <- NA_character_

  # Convert to numeric with suppressed warnings
  suppressWarnings(as.numeric(cleaned))
}

messy_lab_data <- c("120", "85", "normal", "95", "high", "75.5")
cleaned_labs <- safe_lab_conversion(messy_lab_data)

cat("Original messy data:\n")
print(messy_lab_data)
cat("Cleaned numeric data:\n")
print(cleaned_labs)
```

### Task 2.3 Solution: Vector Subsetting

```{r}
subject_ids <- c("001-001", "001-002", "001-003", "001-004", "001-005")
ages <- c(25, 67, 45, 72, 34)
adverse_events <- c(2, 0, 1, 3, 1)

# Name the vectors
names(ages) <- subject_ids
names(adverse_events) <- subject_ids

# Solutions
selected_subjects_pos <- subject_ids[c(1, 3, 5)]
selected_subjects_neg <- subject_ids[-c(2, 4)]
elderly_subjects <- subject_ids[ages >= 65]
multiple_ae_subjects <- subject_ids[adverse_events > 1]
specific_ages <- ages[c("001-001", "001-004")]

cat("Subjects 1, 3, 5:", selected_subjects_pos, "\n")
cat("Exclude 2, 4:", selected_subjects_neg, "\n")
cat("Elderly subjects:", elderly_subjects, "\n")
cat("Multiple AE subjects:", multiple_ae_subjects, "\n")
cat("Specific ages:", specific_ages, "\n")
```

### Task 2.4 Solution: Check Column Types

```{r}
clinical_data <- tibble(
  USUBJID = paste0("SUB-", sprintf("%03d", 1:8)),
  AGE = c(25, 45, 67, 52, 71, 34, 58, 63),
  SEX = c("F", "M", "F", "M", "F", "F", "M", "F"),
  WEIGHT = c(65.5, 80.2, 58.7, 75.1, 62.3, 70.8, 85.4, 60.2),
  HEIGHT = c(160L, 175L, 155L, 180L, 158L, 165L, 185L, 162L),
  VISIT = factor(c("Baseline", "Week 2", "Week 4", "Week 8", "Baseline", "Week 2", "Week 4", "Week 8")),
  TREATMENT_RESPONSE = c(TRUE, FALSE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE)
)

cat("Column types in clinical data:\n")
print(sapply(clinical_data, typeof))
```

------------------------------------------------------------------------

## ✅ Exercise 3 Solutions: Iteration (R4DS Chapter 21)

### Task 3.1 Solution: For Loop Summary Statistics

```{r}
numeric_vars <- c("AGE", "WEIGHT", "HEIGHT")
summary_results <- vector("list", length(numeric_vars))
names(summary_results) <- numeric_vars

for (i in seq_along(numeric_vars)) {
  var_name <- numeric_vars[[i]]
  var_data <- clinical_data[[var_name]]

  if (is.numeric(var_data)) {
    summary_results[[i]] <- list(
      variable = var_name,
      n = sum(!is.na(var_data)),
      mean = round(mean(var_data, na.rm = TRUE), 2),
      sd = round(sd(var_data, na.rm = TRUE), 2),
      min = min(var_data, na.rm = TRUE),
      max = max(var_data, na.rm = TRUE)
    )
  }
}

cat("Summary statistics using for loop:\n")
print(summary_results)
```

### Task 3.2 Solution: Text Cleaning with For Loop

```{r}
# Create AE data
ae_data <- tibble(
  USUBJID = c("001-001", "001-001", "001-002", "001-002", "001-003", "001-003"),
  AESEQ = c(1, 2, 1, 2, 1, 2),
  AEDECOD = c("  headache ", "NAUSEA", "fatigue", "  DIZZINESS  ", "rash", "COUGH"),
  CMDECOD = c("aspirin  ", "  IBUPROFEN", "acetaminophen  ", "NSAID", "  topical cream", "cough syrup"),
  AESTDTC = c("2024-01-20", "2024-01-25", "2024-01-18", "2024-01-22", "2024-01-26", "2024-01-28"),
  AEENDTC = c("2024-01-22", "2024-01-26", "2024-01-20", "2024-01-23", "2024-01-28", "2024-01-30"),
  RFSTDTC = c("2024-01-15", "2024-01-15", "2024-01-16", "2024-01-16", "2024-01-15", "2024-01-15")
)

text_cols <- c("AEDECOD", "CMDECOD")

for (col in text_cols) {
  ae_data[[col]] <- ae_data[[col]] %>%
    str_trim() %>%
    str_to_upper() %>%
    str_replace_all("\\s+", " ")
}

cat("Cleaned AE data:\n")
print(ae_data)
```

### Task 3.3 Solution: While Loop Dose Escalation

```{r}
dose_escalation <- function(starting_dose = 10, max_dose = 80, safety_prob = 0.8) {
  current_dose <- starting_dose
  doses <- current_dose
  step <- 1

  cat("Dose escalation simulation:\n")
  cat("Step", step, ": Starting dose =", current_dose, "mg\n")

  while (current_dose < max_dose) {
    # Simulate safety assessment
    safety_ok <- rbinom(1, 1, prob = safety_prob)

    if (safety_ok) {
      current_dose <- min(current_dose * 1.5, max_dose)
      step <- step + 1
      cat("Step", step, ": Escalated to", round(current_dose, 1), "mg (SAFE)\n")
    } else {
      cat("Step", step + 1, ": SAFETY ISSUE - Stop escalation\n")
      break
    }

    doses <- c(doses, current_dose)

    # Safety check to prevent infinite loop
    if (length(doses) > 10) {
      cat("Maximum escalation steps reached\n")
      break
    }
  }

  return(doses)
}

final_doses <- dose_escalation()
```

### Task 3.4 Solution: Functional Programming Alternative

```{r}
summary_functional <- clinical_data %>%
  select(where(is.numeric)) %>%
  map_dfr(~ tibble(
    n = sum(!is.na(.x)),
    mean = round(mean(.x, na.rm = TRUE), 2),
    sd = round(sd(.x, na.rm = TRUE), 2),
    min = min(.x, na.rm = TRUE),
    max = max(.x, na.rm = TRUE)
  ), .id = "variable")

cat("Summary using functional programming:\n")
print(summary_functional)
```

------------------------------------------------------------------------

## ✅ Exercise 4 Solutions: SAS Macro Translation

### Task 4.1 Solution: Study Day Calculation Function

```{r}
derive_study_day <- function(data, event_date_var, ref_date_var, new_var_name = "STUDY_DAY") {
  data %>%
    mutate(
      !!new_var_name := case_when(
        is.na(ymd({{ event_date_var }})) | is.na(ymd({{ ref_date_var }})) ~ NA_real_,
        ymd({{ event_date_var }}) >= ymd({{ ref_date_var }}) ~ as.numeric(ymd({{ event_date_var }}) - ymd({{ ref_date_var }})) + 1,
        ymd({{ event_date_var }}) < ymd({{ ref_date_var }}) ~ as.numeric(ymd({{ event_date_var }}) - ymd({{ ref_date_var }}))
      )
    )
}

# Test the function
ae_with_studyday <- ae_data %>%
  derive_study_day(AESTDTC, RFSTDTC, "AESTDY")

cat("AE data with study day:\n")
print(ae_with_studyday %>% select(USUBJID, AESTDTC, RFSTDTC, AESTDY))
```

### Task 4.2 Solution: Comprehensive AE Processing Function

```{r}
process_ae_data_complete <- function(data, ae_term_var, start_date_var, end_date_var, ref_date_var) {
  # Input validation
  if (!is.data.frame(data)) {
    stop("data must be a data frame")
  }

  # Check required columns exist
  required_cols <- c(rlang::as_name(rlang::enquo(ae_term_var)),
                    rlang::as_name(rlang::enquo(start_date_var)),
                    rlang::as_name(rlang::enquo(end_date_var)),
                    rlang::as_name(rlang::enquo(ref_date_var)))

  missing_cols <- setdiff(required_cols, names(data))
  if (length(missing_cols) > 0) {
    stop("Missing required columns: ", paste(missing_cols, collapse = ", "))
  }

  result <- data %>%
    # Standardize AE terms
    mutate(
      {{ ae_term_var }} := {{ ae_term_var }} %>%
        str_trim() %>%
        str_to_upper() %>%
        str_replace_all("\\s+", " ")
    ) %>%
    # Calculate study days
    derive_study_day({{ start_date_var }}, {{ ref_date_var }}, "AESTDY") %>%
    derive_study_day({{ end_date_var }}, {{ ref_date_var }}, "AEENDY") %>%
    # Calculate duration
    mutate(
      AE_DURATION = case_when(
        is.na(AESTDY) | is.na(AEENDY) ~ NA_real_,
        AEENDY >= AESTDY ~ AEENDY - AESTDY + 1,
        TRUE ~ NA_real_
      ),
      # Add validation flags
      missing_start_date = is.na(ymd({{ start_date_var }})),
      missing_end_date = is.na(ymd({{ end_date_var }})),
      data_complete = !missing_start_date & !missing_end_date
    )

  # Generate warnings for missing data
  n_missing_start <- sum(result$missing_start_date)
  n_missing_end <- sum(result$missing_end_date)

  if (n_missing_start > 0) {
    warning(paste(n_missing_start, "records have missing start dates"))
  }
  if (n_missing_end > 0) {
    warning(paste(n_missing_end, "records have missing end dates"))
  }

  return(result)
}

# Test comprehensive function
processed_ae <- ae_data %>%
  process_ae_data_complete(AEDECOD, AESTDTC, AEENDTC, RFSTDTC)

cat("Fully processed AE data:\n")
print(processed_ae %>% select(USUBJID, AEDECOD, AESTDY, AEENDY, AE_DURATION, data_complete))
```

------------------------------------------------------------------------

## ✅ Exercise 5 Solutions: Advanced Functional Programming

### Task 5.1 Solution: Basic map() Functions

```{r}
# Create study datasets
study_datasets <- list(
  study_a = tibble(
    USUBJID = c("A-001", "A-002", "A-003", "A-004"),
    AGE = c(45, 67, 34, 52),
    WEIGHT = c(70, 65, 75, 80),
    SEX = c("M", "F", "M", "F")
  ),
  study_b = tibble(
    USUBJID = c("B-001", "B-002", "B-003"),
    AGE = c(28, 49, 63),
    WEIGHT = c(68, 72, 58),
    SEX = c("F", "M", "F")
  ),
  study_c = tibble(
    USUBJID = c("C-001", "C-002", "C-003", "C-004", "C-005"),
    AGE = c(39, 58, 46, 62, 33),
    WEIGHT = c(74, 69, 77, 61, 73),
    SEX = c("M", "F", "M", "F", "M")
  )
)

# Solutions
mean_ages_list <- study_datasets %>%
  map(~ mean(.x$AGE))

mean_ages_vector <- study_datasets %>%
  map_dbl(~ mean(.x$AGE))

age_summaries <- study_datasets %>%
  map_chr(~ paste("Mean:", round(mean(.x$AGE), 1), "| SD:", round(sd(.x$AGE), 1)))

cat("Mean ages (list):\n")
print(mean_ages_list)
cat("Mean ages (vector):\n")
print(mean_ages_vector)
cat("Age summaries:\n")
print(age_summaries)
```

### Task 5.2 Solution: map2() for Two Inputs

```{r}
weights <- c(70, 65, 80, 75, 68)
heights <- c(175, 160, 185, 180, 155)

bmis <- map2_dbl(weights, heights, ~ .x / (.y / 100)^2)

cat("BMI calculations:\n")
print(round(bmis, 2))
```

### Task 5.3 Solution: pmap() for Multiple Inputs

```{r}
patient_profiles <- list(
  weight = c(70, 65, 80, 75),
  height = c(175, 160, 185, 180),
  age = c(45, 62, 38, 55),
  sex = c("M", "F", "M", "F")
)

calculate_risk_score <- function(weight, height, age, sex) {
  bmi <- weight / (height / 100)^2
  age_risk <- ifelse(age > 60, 1.2, 1.0)
  sex_risk <- ifelse(sex == "M", 1.1, 1.0)
  bmi_risk <- ifelse(bmi > 25, 1.3, 1.0)

  round(age_risk * sex_risk * bmi_risk, 2)
}

risk_scores <- pmap_dbl(patient_profiles, calculate_risk_score)

cat("Risk scores:\n")
print(risk_scores)
```

### Task 5.4 Solution: Process Multiple Datasets

```{r}
process_study_data <- function(data) {
  data %>%
    mutate(
      BMI = WEIGHT / (1.70^2),  # Assume height = 170cm
      AGE_GROUP = case_when(
        AGE < 40 ~ "Young",
        AGE >= 40 & AGE < 60 ~ "Middle",
        AGE >= 60 ~ "Senior"
      ),
      ELDERLY_FLAG = ifelse(AGE >= 65, "Y", "N")
    )
}

processed_studies <- study_datasets %>%
  map(process_study_data)

cat("Processed studies summary:\n")
iwalk(processed_studies, ~ {
  cat("Study", .y, "- N:", nrow(.x), "- Mean BMI:", round(mean(.x$BMI), 1), "\n")
})
```

### Task 5.5 Solution: Extract Summary Information

```{r}
elderly_counts <- processed_studies %>%
  map_int(~ sum(.x$ELDERLY_FLAG == "Y"))

cat("Elderly subjects per study:\n")
print(elderly_counts)
```

------------------------------------------------------------------------

## ✅ Exercise 6 Solutions: Predicate Functions and Advanced Patterns

### Task 6.1 Solution: keep() and discard()

```{r}
lab_results <- list(
  glucose = c(90, 95, 110, 85, 92),
  creatinine = c(1.1, 0.9, 1.3, 1.0, 1.2),
  invalid_test = c(NA, NA, NA, NA, NA),
  hemoglobin = c(13.5, 12.1, 14.2, 13.8, 12.9),
  empty_test = numeric(0),
  protein = c(7.2, 6.8, 7.5, 7.1, 6.9)
)

valid_labs <- lab_results %>%
  keep(~ length(.x) > 0 && !all(is.na(.x)))

abnormal_labs <- lab_results %>%
  keep(~ any(.x > 15 | .x < 0.5, na.rm = TRUE))

cat("Valid lab tests:", names(valid_labs), "\n")
cat("Labs with abnormal values:", names(abnormal_labs), "\n")
```

### Task 6.2 Solution: reduce() for Cumulative Operations

```{r}
daily_enrollment <- c(3, 2, 5, 1, 4, 2, 3, 6, 2, 1)

cumulative_enrollment <- daily_enrollment %>%
  accumulate(`+`)

cat("Daily enrollment:", daily_enrollment, "\n")
cat("Cumulative enrollment:", cumulative_enrollment, "\n")
```

### Task 6.3 Solution: Combine Datasets with reduce()

```{r}
enrollment_batches <- list(
  batch1 = tibble(USUBJID = c("001", "002"), SITE = "Site A"),
  batch2 = tibble(USUBJID = c("003", "004", "005"), SITE = "Site B"),
  batch3 = tibble(USUBJID = c("006", "007"), SITE = "Site C")
)

all_subjects <- enrollment_batches %>%
  reduce(bind_rows)

cat("Combined enrollment:\n")
print(all_subjects)
```

### Task 6.4 Solution: walk() for Side Effects

```{r}
create_site_report <- function(data, site_name) {
  cat("=== Site", site_name, "Report ===\n")
  cat("Subjects enrolled:", nrow(data), "\n")
  cat("Subject IDs:", paste(data$USUBJID, collapse = ", "), "\n\n")
}

walk2(enrollment_batches, names(enrollment_batches), create_site_report)
```

------------------------------------------------------------------------

## ✅ Exercise 7 Solutions: Error Handling and Function Factories

### Task 7.1 Solution: Function Factories

```{r}
create_domain_checker <- function(domain_prefix, min_length = 5) {
  function(subject_id) {
    if (nchar(subject_id) < min_length) {
      return(FALSE)
    }
    str_detect(subject_id, paste0("^", domain_prefix, "-"))
  }
}

# Create specific checkers
check_ae_subject <- create_domain_checker("AE")
check_dm_subject <- create_domain_checker("DM")

# Test function factory
test_subjects <- c("AE-001", "DM-002", "VS-003", "AE-004")
cat("AE subject validation:", map_lgl(test_subjects, check_ae_subject), "\n")
```

### Task 7.2 Solution: Error Handling with possibly() and safely()

```{r}
risky_calculation <- function(x) {
  if (x < 0) stop("Value must be positive")
  if (x > 100) stop("Value too large")
  sqrt(x)
}

# Create safe versions
safe_calc <- possibly(risky_calculation, otherwise = NA)
safe_calc_detailed <- safely(risky_calculation)

test_values <- c(4, 9, -1, 16, 150, 25)

# Test both approaches
safe_results <- map_dbl(test_values, safe_calc)
detailed_results <- map(test_values, safe_calc_detailed)

cat("Safe results:", safe_results, "\n")
cat("First error from safely():\n")
print(detailed_results[[3]])
```

------------------------------------------------------------------------

## ✅ Exercise 8 Solutions: GitHub Copilot Examples

### Solution: Function Examples with Copilot-Style Comments

```{r}
# Create function to flag subjects with multiple adverse events in clinical trial
flag_multiple_aes <- function(data) {
  data %>%
    group_by(USUBJID) %>%
    summarise(n_aes = n(), .groups = "drop") %>%
    mutate(multiple_aes_flag = ifelse(n_aes > 1, "Y", "N"))
}

# Function to calculate percent change from baseline for lab values
calc_percent_change <- function(baseline, post_baseline) {
  ((post_baseline - baseline) / baseline) * 100
}

# Derive safety population flag based on treatment exposure duration
derive_safety_flag <- function(data, min_exposure_days = 1) {
  data %>%
    mutate(
      safety_flag = case_when(
        is.na(EXPOSURE_DAYS) ~ "N",
        EXPOSURE_DAYS >= min_exposure_days ~ "Y",
        TRUE ~ "N"
      )
    )
}

# Function to create CDISC-compliant variable labels for SDTM domains
create_cdisc_labels <- function(data, domain = "AE") {
  labels <- switch(domain,
    "AE" = list(
      USUBJID = "Unique Subject Identifier",
      AETERM = "Reported Term for the Adverse Event",
      AEDECOD = "Dictionary-Derived Term",
      AESTDTC = "Start Date/Time of Adverse Event"
    ),
    "DM" = list(
      USUBJID = "Unique Subject Identifier",
      AGE = "Age",
      SEX = "Sex",
      RACE = "Race"
    )
  )

  # Apply labels to matching columns
  for (col in names(data)) {
    if (col %in% names(labels)) {
      attr(data[[col]], "label") <- labels[[col]]
    }
  }

  return(data)
}

cat("Example Copilot-assisted functions created successfully!\n")
```

------------------------------------------------------------------------

## ✅ Bonus Challenge Solution: Complete Clinical Pipeline

```{r}
create_clinical_pipeline <- function(raw_demo_data, raw_ae_data,
                                   age_cutoff = 65,
                                   output_format = "summary") {

  # Input validation (R4DS Ch. 19)
  if (!is.data.frame(raw_demo_data) || !is.data.frame(raw_ae_data)) {
    stop("Both inputs must be data frames")
  }

  # Process demographics data using vector operations (R4DS Ch. 20)
  processed_demo <- raw_demo_data %>%
    mutate(
      # Clean text variables
      across(where(is.character), ~ str_trim(str_to_upper(.x))),

      # Derive age-related variables
      ELDERLY = case_when(
        is.na(AGE) ~ "Unknown",
        AGE >= age_cutoff ~ "Yes",
        TRUE ~ "No"
      ),

      # Calculate BMI with proper vector handling
      BMI = case_when(
        is.na(WEIGHT) | is.na(HEIGHT) ~ NA_real_,
        WEIGHT <= 0 | HEIGHT <= 0 ~ NA_real_,
        TRUE ~ WEIGHT / (HEIGHT / 100)^2
      ),

      BMI_CATEGORY = case_when(
        is.na(BMI) ~ "Unknown",
        BMI < 18.5 ~ "Underweight",
        BMI >= 18.5 & BMI < 25 ~ "Normal",
        BMI >= 25 & BMI < 30 ~ "Overweight",
        BMI >= 30 ~ "Obese"
      ),

      AGE_GROUP = case_when(
        is.na(AGE) ~ "Unknown",
        AGE < 40 ~ "Young Adult",
        AGE >= 40 & AGE < 65 ~ "Middle Age",
        AGE >= 65 ~ "Senior"
      )
    )

  # Process AE data if provided
  if (nrow(raw_ae_data) > 0) {
    processed_ae <- raw_ae_data %>%
      process_ae_data_complete(AEDECOD, AESTDTC, AEENDTC, RFSTDTC)
  } else {
    processed_ae <- tibble()
  }

  # Generate summary using iteration (R4DS Ch. 21)
  if (output_format == "summary") {
    demo_summary <- processed_demo %>%
      summarise(
        n_subjects = n(),
        mean_age = round(mean(AGE, na.rm = TRUE), 1),
        sd_age = round(sd(AGE, na.rm = TRUE), 1),
        mean_bmi = round(mean(BMI, na.rm = TRUE), 1),
        n_elderly = sum(ELDERLY == "Yes", na.rm = TRUE),
        pct_elderly = round(n_elderly / n_subjects * 100, 1)
      )

    # Count by categories using functional programming
    age_group_counts <- processed_demo %>%
      count(AGE_GROUP, name = "n") %>%
      mutate(percentage = round(n / sum(n) * 100, 1))

    bmi_category_counts <- processed_demo %>%
      count(BMI_CATEGORY, name = "n") %>%
      mutate(percentage = round(n / sum(n) * 100, 1))

    return(list(
      demographics = processed_demo,
      adverse_events = processed_ae,
      summary = demo_summary,
      age_groups = age_group_counts,
      bmi_categories = bmi_category_counts
    ))

  } else if (output_format == "data_only") {
    return(list(
      demographics = processed_demo,
      adverse_events = processed_ae
    ))

  } else {
    stop("output_format must be 'summary' or 'data_only'")
  }
}

# Test the comprehensive pipeline
cat("Testing complete clinical pipeline:\n")
pipeline_results <- create_clinical_pipeline(demo, ae_data)

cat("Pipeline completed successfully!\n")
cat("Demographics processed:", nrow(pipeline_results$demographics), "subjects\n")
cat("AE data processed:", nrow(pipeline_results$adverse_events), "records\n")
```

------------------------------------------------------------------------

## 🎯 Summary

This comprehensive solution demonstrates core R programming concepts applied to clinical programming applications:

### ✅ Functions
- Function creation and structure
- Arguments and validation
- Error handling and robustness
- Function factories for reusable patterns

### ✅ Vectors (Chapter 20)
- Understanding vector types in clinical data
- Safe type coercion and conversion
- Effective subsetting for data analysis
- Proper handling of missing values

### ✅ Iteration (Chapter 21)
- For loops for systematic processing
- While loops for conditional iteration
- Functional programming with map() family
- Advanced patterns: reduce(), keep(), walk()

### ✅ Clinical Programming Applications
- SAS macro translation to modern R functions
- Vectorized operations for efficient processing
- Batch processing of multiple studies
- Error handling for robust clinical applications
- CDISC-compliant data processing workflows

The solutions provide a solid foundation for advanced clinical programming with R!

````
