moai-lang-r

Original source / Raw SKILL.md

---
name: moai-lang-r
description: R 4.4+ development specialist covering tidyverse, ggplot2, Shiny, and data science patterns. Use when developing data analysis pipelines, visualizations, or Shiny applications.
version: 1.0.0
updated: 2025-12-07
status: active
allowed-tools: Read, Grep, Glob, Bash, mcp__context7__resolve-library-id, mcp__context7__get-library-docs
---

## Quick Reference (30 seconds)

R 4.4+ Development Specialist - tidyverse, ggplot2, Shiny, renv, and modern R patterns.

Auto-Triggers: `.R` files, `.Rmd`, `.qmd`, `DESCRIPTION`, `renv.lock`, Shiny/ggplot2 discussions

Core Capabilities:
- R 4.4 Features: Native pipe |>, lambda syntax \(x), improved error messages
- Data Manipulation: dplyr, tidyr, purrr, stringr, forcats
- Visualization: ggplot2, plotly, scales, patchwork
- Web Applications: Shiny, reactivity, modules, bslib
- Testing: testthat 3.0, snapshot testing, mocking
- Package Management: renv, pak, DESCRIPTION
- Reproducible Reports: R Markdown, Quarto
- Database: DBI, dbplyr, pool

### Quick Patterns

dplyr Data Pipeline:
```r
library(tidyverse)

result <- data |>
  filter(year >= 2020) |>
  mutate(
    revenue_k = revenue / 1000,
    growth = (revenue - lag(revenue)) / lag(revenue)
  ) |>
  group_by(category) |>
  summarise(
    total_revenue = sum(revenue_k, na.rm = TRUE),
    avg_growth = mean(growth, na.rm = TRUE),
    .groups = "drop"
  )
```

ggplot2 Visualization:
```r
library(ggplot2)

ggplot(data, aes(x = date, y = value, color = category)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2) +
  scale_color_viridis_d() +
  labs(
    title = "Trend Analysis",
    x = "Date", y = "Value",
    color = "Category"
  ) +
  theme_minimal()
```

Shiny Basic App:
```r
library(shiny)

ui <- fluidPage(
  selectInput("var", "Variable:", choices = names(mtcars)),
  plotOutput("plot")
)

server <- function(input, output, session) {
  output$plot <- renderPlot({
    ggplot(mtcars, aes(.data[[input$var]])) +
      geom_histogram()
  })
}

shinyApp(ui, server)
```

---

## Implementation Guide (5 minutes)

### R 4.4 Modern Features

Native Pipe Operator |>:
```r
result <- data |>
  filter(!is.na(value)) |>
  mutate(log_value = log(value)) |>
  summarise(mean_log = mean(log_value))

# Placeholder _ for non-first argument
data |>
  lm(formula = y ~ x, data = _)
```

Lambda Syntax with Backslash:
```r
map(data, \(x) x^2)
map2(list1, list2, \(x, y) x + y)

# In dplyr contexts
data |>
  mutate(across(where(is.numeric), \(x) scale(x)[,1]))
```

### tidyverse Data Manipulation

dplyr Core Verbs:
```r
library(dplyr)

processed <- raw_data |>
  filter(status == "active", amount > 0) |>
  select(id, date, amount, category) |>
  mutate(
    month = floor_date(date, "month"),
    amount_scaled = amount / max(amount)
  ) |>
  arrange(desc(date))

# group_by with summarise
summary <- processed |>
  group_by(category, month) |>
  summarise(
    n = n(),
    total = sum(amount),
    avg = mean(amount),
    .groups = "drop"
  )

# across for multiple columns
data |>
  mutate(across(starts_with("price"), \(x) round(x, 2)))
```

tidyr Reshaping:
```r
library(tidyr)

# pivot_longer (wide to long)
wide_data |>
  pivot_longer(
    cols = starts_with("year_"),
    names_to = "year",
    names_prefix = "year_",
    values_to = "value"
  )

# pivot_wider (long to wide)
long_data |>
  pivot_wider(
    names_from = category,
    values_from = value,
    values_fill = 0
  )
```

purrr Functional Programming:
```r
library(purrr)

files |> map(\(f) read_csv(f))
files |> map_dfr(\(f) read_csv(f), .id = "source")
values |> map_dbl(\(x) mean(x, na.rm = TRUE))

# safely for error handling
safe_read <- safely(read_csv)
results <- files |> map(safe_read)
successes <- results |> map("result") |> compact()
```

### ggplot2 Visualization Patterns

Complete Plot Structure:
```r
library(ggplot2)
library(scales)

p <- ggplot(data, aes(x = x, y = y, color = group)) +
  geom_point(alpha = 0.7, size = 3) +
  geom_smooth(method = "lm", se = TRUE) +
  scale_x_continuous(labels = comma) +
  scale_y_log10(labels = dollar) +
  scale_color_brewer(palette = "Set2") +
  facet_wrap(~ category, scales = "free_y") +
  labs(
    title = "Analysis Title",
    subtitle = "Descriptive subtitle",
    x = "X Axis Label",
    y = "Y Axis Label"
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom")

ggsave("output.png", p, width = 10, height = 6, dpi = 300)
```

Multiple Plots with patchwork:
```r
library(patchwork)

p1 <- ggplot(data, aes(x)) + geom_histogram()
p2 <- ggplot(data, aes(x, y)) + geom_point()
p3 <- ggplot(data, aes(group, y)) + geom_boxplot()

combined <- (p1 | p2) / p3 +
  plot_annotation(title = "Combined Analysis", tag_levels = "A")
```

### Shiny Application Patterns

Modular Shiny App:
```r
dataFilterUI <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("category"), "Category:", choices = NULL),
    sliderInput(ns("range"), "Range:", min = 0, max = 100, value = c(0, 100))
  )
}

dataFilterServer <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    observe({
      categories <- unique(data()$category)
      updateSelectInput(session, "category", choices = categories)
    })

    reactive({
      req(input$category)
      data() |>
        filter(
          category == input$category,
          value >= input$range[1],
          value <= input$range[2]
        )
    })
  })
}
```

Reactive Patterns:
```r
server <- function(input, output, session) {
  # reactive: Cached computation
  processed_data <- reactive({
    raw_data() |>
      filter(year == input$year)
  })

  # reactiveVal: Mutable state
  counter <- reactiveVal(0)
  observeEvent(input$increment, {
    counter(counter() + 1)
  })

  # eventReactive: Trigger on specific event
  analysis <- eventReactive(input$run_analysis, {
    expensive_computation(processed_data())
  })

  # debounce for rapid inputs
  search_term <- reactive(input$search) |> debounce(300)
}
```

### testthat Testing Framework

Test Structure:
```r
library(testthat)

test_that("calculate_growth returns correct values", {
  data <- tibble(year = 2020:2022, value = c(100, 110, 121))

  result <- calculate_growth(data)

  expect_equal(nrow(result), 3)
  expect_equal(result$growth[2], 0.1, tolerance = 0.001)
  expect_true(is.na(result$growth[1]))
})

test_that("calculate_growth handles edge cases", {
  expect_error(calculate_growth(NULL), "data cannot be NULL")
})
```

### renv Dependency Management

Project Setup:
```r
renv::init()
renv::install("tidyverse")
renv::install("shiny")
renv::snapshot()
renv::restore()
```

---

## Advanced Implementation (10+ minutes)

For comprehensive coverage including:
- Advanced Shiny patterns (async, caching, deployment)
- Complex ggplot2 extensions and custom themes
- Database integration with dbplyr and pool
- R package development patterns
- Performance optimization techniques
- Production deployment (Docker, Posit Connect)

See:
- [Advanced Patterns](modules/advanced-patterns.md) - Complete advanced patterns guide

---

## Context7 Library Mappings

```
/tidyverse/dplyr - Data manipulation verbs
/tidyverse/ggplot2 - Grammar of graphics visualization
/tidyverse/purrr - Functional programming toolkit
/tidyverse/tidyr - Data tidying functions
/rstudio/shiny - Web application framework
/r-lib/testthat - Unit testing framework
/rstudio/renv - Dependency management
```

---

## Works Well With

- `moai-lang-python` - Python/R interoperability with reticulate
- `moai-domain-database` - SQL patterns and database optimization
- `moai-workflow-testing` - TDD and testing strategies
- `moai-essentials-debug` - AI-powered debugging
- `moai-foundation-quality` - TRUST 5 quality principles

---

## Troubleshooting

Common Issues:

R Version Check:
```r
R.version.string  # Should be 4.4+
packageVersion("dplyr")
```

Native Pipe Not Working:
- Ensure R version is 4.1+ for |>
- Check RStudio settings: Tools > Global Options > Code > Use native pipe

renv Issues:
```r
renv::clean()
renv::rebuild()
renv::snapshot(force = TRUE)
```

Shiny Reactivity Debug:
```r
options(shiny.reactlog = TRUE)
reactlog::reactlog_enable()
shiny::reactlogShow()
```

ggplot2 Font Issues:
```r
library(showtext)
font_add_google("Roboto", "roboto")
showtext_auto()
```

---

Last Updated: 2025-12-07
Status: Active (v1.0.0)


---

## Referenced Files

> The following files are referenced in this skill and included for context.

### modules/advanced-patterns.md

```markdown
# R Advanced Patterns

## Advanced Shiny Patterns

Async Processing:
```r
library(shiny)
library(promises)
library(future)
plan(multisession)

server <- function(input, output, session) {
  output$result <- renderText({
    future({
      # Long-running computation
      Sys.sleep(5)
      expensive_calculation()
    }) %...>%
      as.character()
  })
}
```

Caching with memoise:
```r
library(memoise)

# Cache expensive calculations
expensive_function <- memoise(function(data) {
  # Complex computation
  result <- heavy_processing(data)
  result
})

# In Shiny
server <- function(input, output, session) {
  cached_data <- reactive({
    expensive_function(input$data_source)
  }) |> bindCache(input$data_source)
}
```

Shiny Modules Advanced:
```r
# Advanced module with return values
filterModuleUI <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("category"), "Category:", choices = NULL),
    sliderInput(ns("range"), "Range:", min = 0, max = 100, value = c(0, 100)),
    actionButton(ns("apply"), "Apply Filter")
  )
}

filterModuleServer <- function(id, data, default_category = NULL) {
  moduleServer(id, function(input, output, session) {
    # Update choices based on data
    observe({
      categories <- unique(data()$category)
      selected <- if (!is.null(default_category) && default_category %in% categories) {
        default_category
      } else {
        categories[1]
      }
      updateSelectInput(session, "category", choices = categories, selected = selected)
    })

    # Return reactive values
    filtered_data <- eventReactive(input$apply, {
      req(input$category)
      data() |>
        filter(
          category == input$category,
          value >= input$range[1],
          value <= input$range[2]
        )
    }, ignoreNULL = FALSE)

    # Return both data and metadata
    list(
      data = filtered_data,
      selected_category = reactive(input$category),
      range = reactive(input$range)
    )
  })
}
```

## Complex ggplot2 Extensions

Custom Theme:
```r
library(ggplot2)

theme_custom <- function(base_size = 12, base_family = "") {
  theme_minimal(base_size = base_size, base_family = base_family) %+replace%
    theme(
      # Plot elements
      plot.title = element_text(face = "bold", size = rel(1.2), hjust = 0),
      plot.subtitle = element_text(color = "grey40", hjust = 0),
      plot.caption = element_text(color = "grey60", hjust = 1),
      plot.margin = margin(10, 10, 10, 10),

      # Panel elements
      panel.grid.major = element_line(color = "grey90"),
      panel.grid.minor = element_blank(),
      panel.background = element_rect(fill = "white", color = NA),

      # Axis elements
      axis.title = element_text(face = "bold", size = rel(0.9)),
      axis.text = element_text(color = "grey30"),
      axis.ticks = element_line(color = "grey30"),

      # Legend elements
      legend.position = "bottom",
      legend.background = element_rect(fill = "transparent"),
      legend.key = element_rect(fill = "transparent"),
      legend.title = element_text(face = "bold"),

      # Strip elements (facets)
      strip.background = element_rect(fill = "grey95", color = NA),
      strip.text = element_text(face = "bold", size = rel(0.9))
    )
}

# Usage
ggplot(data, aes(x, y)) +
  geom_point() +
  theme_custom()
```

Custom Geom:
```r
library(ggplot2)
library(grid)

GeomTimeline <- ggproto("GeomTimeline", GeomPoint,
  required_aes = c("x", "y"),
  default_aes = aes(
    shape = 19, colour = "black", size = 3,
    fill = NA, alpha = 0.7, stroke = 0.5
  ),

  draw_panel = function(data, panel_params, coord) {
    coords <- coord$transform(data, panel_params)

    # Draw connecting lines
    line_grob <- segmentsGrob(
      x0 = min(coords$x), y0 = coords$y,
      x1 = max(coords$x), y1 = coords$y,
      gp = gpar(col = "grey70", lwd = 1)
    )

    # Draw points
    point_grob <- pointsGrob(
      coords$x, coords$y,
      pch = coords$shape,
      gp = gpar(
        col = alpha(coords$colour, coords$alpha),
        fill = alpha(coords$fill, coords$alpha),
        fontsize = coords$size * .pt + coords$stroke * .stroke / 2
      )
    )

    grobTree(line_grob, point_grob)
  }
)

geom_timeline <- function(mapping = NULL, data = NULL, stat = "identity",
                          position = "identity", ..., na.rm = FALSE,
                          show.legend = NA, inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomTimeline,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}
```

## Database Integration

dbplyr with pool:
```r
library(DBI)
library(pool)
library(dbplyr)

# Create connection pool
pool <- dbPool(
  drv = RPostgres::Postgres(),
  dbname = "mydb",
  host = "localhost",
  user = Sys.getenv("DB_USER"),
  password = Sys.getenv("DB_PASSWORD"),
  minSize = 1,
  maxSize = 5
)

# Use with dbplyr
users_db <- tbl(pool, "users")

# Query with dbplyr
result <- users_db |>
  filter(active == TRUE) |>
  group_by(department) |>
  summarise(
    count = n(),
    avg_salary = mean(salary, na.rm = TRUE)
  ) |>
  arrange(desc(count)) |>
  collect()

# Close pool on exit
onStop(function() {
  poolClose(pool)
})
```

Transaction Handling:
```r
with_transaction <- function(pool, expr) {
  conn <- poolCheckout(pool)
  on.exit(poolReturn(conn))

  dbBegin(conn)

  tryCatch({
    result <- expr
    dbCommit(conn)
    result
  }, error = function(e) {
    dbRollback(conn)
    stop(e)
  })
}

# Usage
with_transaction(pool, {
  dbExecute(conn, "UPDATE accounts SET balance = balance - 100 WHERE id = 1")
  dbExecute(conn, "UPDATE accounts SET balance = balance + 100 WHERE id = 2")
})
```

## R Package Development

Package Structure:
```r
# DESCRIPTION file
Package: mypackage
Title: What the Package Does
Version: 0.1.0
Authors@R:
    person("First", "Last", email = "[email protected]", role = c("aut", "cre"))
Description: A longer description of what the package does.
License: MIT + file LICENSE
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.2.3
Imports:
    dplyr (>= 1.0.0),
    ggplot2
Suggests:
    testthat (>= 3.0.0),
    knitr,
    rmarkdown
Config/testthat/edition: 3
```

Roxygen Documentation:
```r
#' Calculate Growth Rate
#'
#' Calculates the period-over-period growth rate for a numeric vector.
#'
#' @param x A numeric vector of values.
#' @param periods Number of periods for growth calculation. Default is 1.
#' @param na.rm Logical. Should NA values be removed? Default is TRUE.
#'
#' @return A numeric vector of growth rates.
#'
#' @examples
#' calculate_growth(c(100, 110, 121))
#' calculate_growth(c(100, 110, 121), periods = 2)
#'
#' @export
calculate_growth <- function(x, periods = 1, na.rm = TRUE) {
  if (!is.numeric(x)) {
    stop("x must be numeric")
  }

  growth <- (x - dplyr::lag(x, n = periods)) / dplyr::lag(x, n = periods)

  if (na.rm) {
    growth[is.na(growth)] <- NA_real_
  }

  growth
}
```

## Performance Optimization

data.table for Large Data:
```r
library(data.table)

# Convert and process
dt <- as.data.table(large_df)

# Fast grouping
result <- dt[, .(
  count = .N,
  mean_value = mean(value, na.rm = TRUE),
  max_value = max(value, na.rm = TRUE)
), by = .(category, year)]

# In-place updates
dt[, new_col := value * 2]

# Efficient joins
dt1[dt2, on = .(key_col)]

# Rolling operations
dt[, rolling_mean := frollmean(value, n = 7), by = category]
```

Parallel Processing:
```r
library(future)
library(furrr)

# Set up parallel backend
plan(multisession, workers = 4)

# Parallel map
results <- future_map(file_list, \(f) {
  read_csv(f) |>
    process_data()
}, .progress = TRUE)

# Parallel with error handling
safe_process <- possibly(process_data, otherwise = NULL)
results <- future_map(data_list, safe_process)

# Clean up
plan(sequential)
```

## Production Deployment

Docker for R:
```dockerfile
FROM rocker/shiny:4.4.0

RUN apt-get update && apt-get install -y \
    libcurl4-gnutls-dev \
    libssl-dev \
    libpq-dev \
    && rm -rf /var/lib/apt/lists/*

COPY renv.lock renv.lock
RUN R -e "install.packages('renv'); renv::restore()"

COPY . /srv/shiny-server/
RUN chown -R shiny:shiny /srv/shiny-server

EXPOSE 3838

CMD ["/usr/bin/shiny-server"]
```

Posit Connect Deployment:
```r
# rsconnect for deployment
library(rsconnect)

# Set up account
rsconnect::setAccountInfo(
  name = "your-account",
  token = Sys.getenv("CONNECT_TOKEN"),
  secret = Sys.getenv("CONNECT_SECRET")
)

# Deploy app
rsconnect::deployApp(
  appDir = ".",
  appName = "my-shiny-app",
  appTitle = "My Shiny Application",
  forceUpdate = TRUE
)
```

## testthat Advanced Patterns

Test Fixtures:
```r
# tests/testthat/helper.R
setup_test_db <- function() {
  conn <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
  DBI::dbExecute(conn, "CREATE TABLE users (id INTEGER, name TEXT)")
  conn
}

teardown_test_db <- function(conn) {
  DBI::dbDisconnect(conn)
}

# tests/testthat/test-db.R
test_that("database operations work correctly", {
  conn <- setup_test_db()
  on.exit(teardown_test_db(conn))

  DBI::dbExecute(conn, "INSERT INTO users VALUES (1, 'Test')")
  result <- DBI::dbGetQuery(conn, "SELECT * FROM users")

  expect_equal(nrow(result), 1)
  expect_equal(result$name, "Test")
})
```

Property-Based Testing:
```r
library(hedgehog)

test_that("reverse is involutory", {
  forall(gen.c(gen.element(letters), from = 1, to = 100), function(x) {
    expect_equal(rev(rev(x)), x)
  })
})

test_that("sort is idempotent", {
  forall(gen.c(gen.int(100), from = 1, to = 50), function(x) {
    expect_equal(sort(sort(x)), sort(x))
  })
})
```

## Error Handling

Condition System:
```r
# Define custom conditions
validation_error <- function(message, field = NULL) {
  rlang::abort(
    message,
    class = "validation_error",
    field = field
  )
}

# Handle conditions
process_input <- function(data) {
  tryCatch(
    {
      validate_data(data)
      transform_data(data)
    },
    validation_error = function(e) {
      cli::cli_alert_danger("Validation failed: {e$message}")
      cli::cli_alert_info("Field: {e$field}")
      NULL
    },
    error = function(e) {
      cli::cli_alert_danger("Unexpected error: {e$message}")
      rlang::abort("Processing failed", parent = e)
    }
  )
}

# Retry logic
retry <- function(expr, n = 3, delay = 1) {
  for (i in seq_len(n)) {
    result <- tryCatch(
      expr,
      error = function(e) {
        if (i == n) stop(e)
        Sys.sleep(delay)
        NULL
      }
    )
    if (!is.null(result)) return(result)
  }
}
```

```