R Interactive Applications Best Practices¶

Core Principles¶

User Experience: Prioritize intuitive and responsive interfaces
Performance: Optimize for speed and responsiveness
Scalability: Design for growing user bases and data volumes
Security: Implement proper authentication and data protection
Maintainability: Write clean, modular, and testable code

Shiny Applications¶

Basic Shiny App Structure¶

# R/01-shiny-applications.R

#' Create comprehensive Shiny application
#'
#' @param app_config Application configuration
#' @return Shiny application
create_shiny_application <- function(app_config) {
  # Create UI
  ui <- create_shiny_ui(app_config)

  # Create server
  server <- create_shiny_server(app_config)

  # Create application
  app <- shinyApp(ui = ui, server = server)

  return(app)
}

#' Create Shiny UI
#'
#' @param app_config Application configuration
#' @return Shiny UI
create_shiny_ui <- function(app_config) {
  ui <- fluidPage(
    # Application title
    titlePanel(app_config$title %||% "Shiny Application"),

    # Sidebar layout
    sidebarLayout(
      # Sidebar panel
      sidebarPanel(
        create_sidebar_controls(app_config),
        width = app_config$sidebar_width %||% 3
      ),

      # Main panel
      mainPanel(
        create_main_panel(app_config),
        width = app_config$main_width %||% 9
      )
    ),

    # Additional UI elements
    create_additional_ui_elements(app_config)
  )

  return(ui)
}

#' Create sidebar controls
#'
#' @param app_config Application configuration
#' @return Sidebar controls
create_sidebar_controls <- function(app_config) {
  controls <- list()

  # Add file input if specified
  if (app_config$file_input) {
    controls <- append(controls, list(
      fileInput("file", "Choose File", accept = app_config$accepted_formats %||% c(".csv", ".xlsx"))
    ))
  }

  # Add variable selectors
  if (app_config$variable_selectors) {
    controls <- append(controls, list(
      selectInput("x_var", "X Variable", choices = NULL),
      selectInput("y_var", "Y Variable", choices = NULL)
    ))
  }

  # Add plot controls
  if (app_config$plot_controls) {
    controls <- append(controls, list(
      sliderInput("alpha", "Transparency", min = 0, max = 1, value = 0.7),
      checkboxInput("add_trend", "Add Trend Line", value = FALSE)
    ))
  }

  # Add action buttons
  if (app_config$action_buttons) {
    controls <- append(controls, list(
      actionButton("update", "Update Plot"),
      actionButton("reset", "Reset")
    ))
  }

  return(controls)
}

#' Create main panel
#'
#' @param app_config Application configuration
#' @return Main panel
create_main_panel <- function(app_config) {
  main_panel <- list(
    # Plot output
    plotOutput("plot", height = app_config$plot_height %||% "400px"),

    # Data table output
    if (app_config$data_table) {
      DT::dataTableOutput("data_table")
    },

    # Summary output
    if (app_config$summary_output) {
      verbatimTextOutput("summary")
    }
  )

  return(main_panel)
}

#' Create additional UI elements
#'
#' @param app_config Application configuration
#' @return Additional UI elements
create_additional_ui_elements <- function(app_config) {
  elements <- list()

  # Add CSS
  if (app_config$custom_css) {
    elements <- append(elements, list(
      tags$head(tags$style(app_config$css))
    ))
  }

  # Add JavaScript
  if (app_config$custom_js) {
    elements <- append(elements, list(
      tags$head(tags$script(app_config$javascript))
    ))
  }

  return(elements)
}

Advanced Shiny Patterns¶

# R/01-shiny-applications.R (continued)

#' Create Shiny server
#'
#' @param app_config Application configuration
#' @return Shiny server function
create_shiny_server <- function(app_config) {
  server <- function(input, output, session) {
    # Reactive data
    data <- reactive({
      if (app_config$file_input) {
        req(input$file)
        read_data(input$file$datapath)
      } else {
        app_config$default_data
      }
    })

    # Update variable choices
    observe({
      if (app_config$variable_selectors) {
        updateSelectInput(session, "x_var", choices = names(data()))
        updateSelectInput(session, "y_var", choices = names(data()))
      }
    })

    # Create plot
    output$plot <- renderPlot({
      create_dynamic_plot(data(), input, app_config)
    })

    # Create data table
    if (app_config$data_table) {
      output$data_table <- DT::renderDataTable({
        data()
      })
    }

    # Create summary
    if (app_config$summary_output) {
      output$summary <- renderText({
        create_data_summary(data())
      })
    }
  }

  return(server)
}

#' Create dynamic plot
#'
#' @param data Data for plotting
#' @param input User input
#' @param app_config Application configuration
#' @return Dynamic plot
create_dynamic_plot <- function(data, input, app_config) {
  if (is.null(data) || nrow(data) == 0) {
    return(ggplot() + theme_void() + labs(title = "No data available"))
  }

  # Create base plot
  p <- ggplot(data, aes_string(x = input$x_var, y = input$y_var)) +
    geom_point(alpha = input$alpha %||% 0.7) +
    theme_minimal()

  # Add trend line if requested
  if (input$add_trend) {
    p <- p + geom_smooth(method = "lm", se = FALSE)
  }

  return(p)
}

#' Create data summary
#'
#' @param data Data to summarize
#' @return Data summary
create_data_summary <- function(data) {
  if (is.null(data) || nrow(data) == 0) {
    return("No data available")
  }

  summary_text <- paste(
    "Data Summary:",
    paste("Rows:", nrow(data)),
    paste("Columns:", ncol(data)),
    paste("Missing values:", sum(is.na(data))),
    sep = "\n"
  )

  return(summary_text)
}

Shiny Modules¶

# R/01-shiny-applications.R (continued)

#' Create Shiny module
#'
#' @param module_name Module name
#' @param module_config Module configuration
#' @return Shiny module
create_shiny_module <- function(module_name, module_config) {
  module <- list(
    name = module_name,
    ui = create_module_ui(module_name, module_config),
    server = create_module_server(module_name, module_config)
  )

  return(module)
}

#' Create module UI
#'
#' @param module_name Module name
#' @param module_config Module configuration
#' @return Module UI
create_module_ui <- function(module_name, module_config) {
  ui <- function(id) {
    ns <- NS(id)

    tagList(
      # Module-specific UI elements
      if (module_config$plot_module) {
        plotOutput(ns("plot"))
      },

      if (module_config$table_module) {
        DT::dataTableOutput(ns("table"))
      },

      if (module_config$controls_module) {
        create_module_controls(ns, module_config)
      }
    )
  }

  return(ui)
}

#' Create module server
#'
#' @param module_name Module name
#' @param module_config Module configuration
#' @return Module server
create_module_server <- function(module_name, module_config) {
  server <- function(id, data) {
    moduleServer(id, function(input, output, session) {
      # Module-specific server logic
      if (module_config$plot_module) {
        output$plot <- renderPlot({
          create_module_plot(data(), input, module_config)
        })
      }

      if (module_config$table_module) {
        output$table <- DT::renderDataTable({
          data()
        })
      }
    })
  }

  return(server)
}

#' Create module controls
#'
#' @param ns Namespace function
#' @param module_config Module configuration
#' @return Module controls
create_module_controls <- function(ns, module_config) {
  controls <- list()

  if (module_config$slider_control) {
    controls <- append(controls, list(
      sliderInput(ns("slider"), "Slider", min = 0, max = 100, value = 50)
    ))
  }

  if (module_config$select_control) {
    controls <- append(controls, list(
      selectInput(ns("select"), "Select", choices = c("Option 1", "Option 2"))
    ))
  }

  return(controls)
}

Flexdashboard Applications¶

Flexdashboard Setup¶

# R/02-flexdashboard-applications.R

#' Create Flexdashboard application
#'
#' @param dashboard_config Dashboard configuration
#' @return Flexdashboard application
create_flexdashboard_application <- function(dashboard_config) {
  # Create dashboard structure
  dashboard_structure <- create_dashboard_structure(dashboard_config)

  # Generate dashboard content
  dashboard_content <- generate_dashboard_content(dashboard_config)

  # Create Flexdashboard file
  dashboard_file <- create_dashboard_file(dashboard_structure, dashboard_content, dashboard_config)

  return(dashboard_file)
}

#' Create dashboard structure
#'
#' @param dashboard_config Dashboard configuration
#' @return Dashboard structure
create_dashboard_structure <- function(dashboard_config) {
  structure <- list(
    title = dashboard_config$title %||% "Dashboard",
    author = dashboard_config$author %||% "Author",
    date = dashboard_config$date %||% Sys.Date(),
    output_format = dashboard_config$output_format %||% "flexdashboard::flex_dashboard",
    theme = dashboard_config$theme %||% "flatly",
    orientation = dashboard_config$orientation %||% "rows",
    vertical_layout = dashboard_config$vertical_layout %||% "fill"
  )

  return(structure)
}

#' Generate dashboard content
#'
#' @param dashboard_config Dashboard configuration
#' @return Dashboard content
generate_dashboard_content <- function(dashboard_config) {
  content <- list(
    yaml_header = create_dashboard_yaml_header(dashboard_config),
    setup_chunk = create_setup_chunk(dashboard_config),
    pages = create_dashboard_pages(dashboard_config)
  )

  return(content)
}

#' Create dashboard YAML header
#'
#' @param dashboard_config Dashboard configuration
#' @return Dashboard YAML header
create_dashboard_yaml_header <- function(dashboard_config) {
  yaml_header <- c(
    "---",
    paste("title:", dashboard_config$title),
    paste("author:", dashboard_config$author),
    paste("date:", dashboard_config$date),
    paste("output:", dashboard_config$output_format),
    paste("theme:", dashboard_config$theme),
    paste("orientation:", dashboard_config$orientation),
    paste("vertical_layout:", dashboard_config$vertical_layout),
    "---",
    "",
    "```{r setup, include=FALSE}",
    "knitr::opts_chunk$set(echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE)",
    "```"
  )

  return(yaml_header)
}

#' Create setup chunk
#'
#' @param dashboard_config Dashboard configuration
#' @return Setup chunk
create_setup_chunk <- function(dashboard_config) {
  setup_chunk <- c(
    "```{r setup, include=FALSE}",
    "library(flexdashboard)",
    "library(plotly)",
    "library(DT)",
    "library(dplyr)",
    "library(ggplot2)",
    "",
    "# Load data",
    "data <- read.csv('data.csv')",
    "",
    "# Set global options",
    "options(DT.options = list(pageLength = 10))",
    "```"
  )

  return(setup_chunk)
}

#' Create dashboard pages
#'
#' @param dashboard_config Dashboard configuration
#' @return Dashboard pages
create_dashboard_pages <- function(dashboard_config) {
  pages <- list()

  # Overview page
  if (dashboard_config$overview_page) {
    pages$overview <- create_overview_page(dashboard_config)
  }

  # Analysis page
  if (dashboard_config$analysis_page) {
    pages$analysis <- create_analysis_page(dashboard_config)
  }

  # Visualizations page
  if (dashboard_config$visualizations_page) {
    pages$visualizations <- create_visualizations_page(dashboard_config)
  }

  return(pages)
}

#' Create overview page
#'
#' @param dashboard_config Dashboard configuration
#' @return Overview page
create_overview_page <- function(dashboard_config) {
  overview_page <- c(
    "# Overview",
    "",
    "## Key Metrics",
    "",
    "```{r key-metrics}",
    "# Calculate key metrics",
    "total_records <- nrow(data)",
    "missing_values <- sum(is.na(data))",
    "```",
    "",
    "## Data Summary",
    "",
    "```{r data-summary}",
    "# Display data summary",
    "summary(data)",
    "```"
  )

  return(overview_page)
}

#' Create analysis page
#'
#' @param dashboard_config Dashboard configuration
#' @return Analysis page
create_analysis_page <- function(dashboard_config) {
  analysis_page <- c(
    "# Analysis",
    "",
    "## Statistical Analysis",
    "",
    "```{r statistical-analysis}",
    "# Perform statistical analysis",
    "correlation_matrix <- cor(data, use = 'complete.obs')",
    "```",
    "",
    "## Results",
    "",
    "```{r results}",
    "# Display results",
    "print(correlation_matrix)",
    "```"
  )

  return(analysis_page)
}

#' Create visualizations page
#'
#' @param dashboard_config Dashboard configuration
#' @return Visualizations page
create_visualizations_page <- function(dashboard_config) {
  visualizations_page <- c(
    "# Visualizations",
    "",
    "## Scatter Plot",
    "",
    "```{r scatter-plot}",
    "# Create scatter plot",
    "p <- ggplot(data, aes(x = var1, y = var2)) +",
    "  geom_point() +",
    "  theme_minimal()",
    "ggplotly(p)",
    "```",
    "",
    "## Histogram",
    "",
    "```{r histogram}",
    "# Create histogram",
    "p <- ggplot(data, aes(x = var1)) +",
    "  geom_histogram() +",
    "  theme_minimal()",
    "ggplotly(p)",
    "```"
  )

  return(visualizations_page)
}

API Development¶

Plumber API¶

# R/03-api-development.R

#' Create Plumber API
#'
#' @param api_config API configuration
#' @return Plumber API
create_plumber_api <- function(api_config) {
  # Create API structure
  api_structure <- create_api_structure(api_config)

  # Generate API content
  api_content <- generate_api_content(api_config)

  # Create API file
  api_file <- create_api_file(api_structure, api_content, api_config)

  return(api_file)
}

#' Create API structure
#'
#' @param api_config API configuration
#' @return API structure
create_api_structure <- function(api_config) {
  structure <- list(
    title = api_config$title %||% "R API",
    description = api_config$description %||% "R Plumber API",
    version = api_config$version %||% "1.0.0",
    host = api_config$host %||% "0.0.0.0",
    port = api_config$port %||% 8000,
    swagger = api_config$swagger %||% TRUE
  )

  return(structure)
}

#' Generate API content
#'
#' @param api_config API configuration
#' @return API content
generate_api_content <- function(api_config) {
  content <- list(
    setup = create_api_setup(api_config),
    endpoints = create_api_endpoints(api_config),
    middleware = create_api_middleware(api_config)
  )

  return(content)
}

#' Create API setup
#'
#' @param api_config API configuration
#' @return API setup
create_api_setup <- function(api_config) {
  setup <- c(
    "library(plumber)",
    "library(jsonlite)",
    "library(httr)",
    "",
    "# Load data",
    "data <- read.csv('data.csv')",
    "",
    "# Set global options",
    "options(plumber.port = 8000)"
  )

  return(setup)
}

#' Create API endpoints
#'
#' @param api_config API configuration
#' @return API endpoints
create_api_endpoints <- function(api_config) {
  endpoints <- list()

  # Health check endpoint
  endpoints$health <- create_health_endpoint()

  # Data endpoints
  if (api_config$data_endpoints) {
    endpoints$data <- create_data_endpoints(api_config)
  }

  # Analysis endpoints
  if (api_config$analysis_endpoints) {
    endpoints$analysis <- create_analysis_endpoints(api_config)
  }

  return(endpoints)
}

#' Create health endpoint
#'
#' @return Health endpoint
create_health_endpoint <- function() {
  health_endpoint <- c(
    "#* @get /health",
    "#* @serializer json",
    "function() {",
    "  list(",
    "    status = 'healthy',",
    "    timestamp = Sys.time()",
    "  )",
    "}"
  )

  return(health_endpoint)
}

#' Create data endpoints
#'
#' @param api_config API configuration
#' @return Data endpoints
create_data_endpoints <- function(api_config) {
  data_endpoints <- c(
    "#* @get /data",
    "#* @serializer json",
    "function() {",
    "  data",
    "}",
    "",
    "#* @get /data/<id>",
    "#* @param id Data ID",
    "#* @serializer json",
    "function(id) {",
    "  data[data$id == id, ]",
    "}"
  )

  return(data_endpoints)
}

#' Create analysis endpoints
#'
#' @param api_config API configuration
#' @return Analysis endpoints
create_analysis_endpoints <- function(api_config) {
  analysis_endpoints <- c(
    "#* @post /analyze",
    "#* @param data Analysis data",
    "#* @serializer json",
    "function(data) {",
    "  # Perform analysis",
    "  result <- analyze_data(data)",
    "  result",
    "}",
    "",
    "#* @get /summary",
    "#* @serializer json",
    "function() {",
    "  # Generate summary",
    "  summary <- generate_summary(data)",
    "  summary",
    "}"
  )

  return(analysis_endpoints)
}

API Middleware¶

# R/03-api-development.R (continued)

#' Create API middleware
#'
#' @param api_config API configuration
#' @return API middleware
create_api_middleware <- function(api_config) {
  middleware <- list()

  # Authentication middleware
  if (api_config$authentication) {
    middleware$auth <- create_auth_middleware(api_config)
  }

  # CORS middleware
  if (api_config$cors) {
    middleware$cors <- create_cors_middleware(api_config)
  }

  # Logging middleware
  if (api_config$logging) {
    middleware$logging <- create_logging_middleware(api_config)
  }

  return(middleware)
}

#' Create authentication middleware
#'
#' @param api_config API configuration
#' @return Authentication middleware
create_auth_middleware <- function(api_config) {
  auth_middleware <- c(
    "# Authentication middleware",
    "#* @filter auth",
    "function(req, res) {",
    "  # Check for API key",
    "  api_key <- req$HTTP_X_API_KEY",
    "  if (is.null(api_key) || api_key != 'your-api-key') {",
    "    res$status <- 401",
    "    return(list(error = 'Unauthorized'))",
    "  }",
    "  plumber::forward()",
    "}"
  )

  return(auth_middleware)
}

#' Create CORS middleware
#'
#' @param api_config API configuration
#' @return CORS middleware
create_cors_middleware <- function(api_config) {
  cors_middleware <- c(
    "# CORS middleware",
    "#* @filter cors",
    "function(req, res) {",
    "  res$setHeader('Access-Control-Allow-Origin', '*')",
    "  res$setHeader('Access-Control-Allow-Methods', 'GET, POST, PUT, DELETE, OPTIONS')",
    "  res$setHeader('Access-Control-Allow-Headers', 'Content-Type, Authorization, X-API-Key')",
    "  if (req$REQUEST_METHOD == 'OPTIONS') {",
    "    res$status <- 200",
    "    return('')",
    "  }",
    "  plumber::forward()",
    "}"
  )

  return(cors_middleware)
}

#' Create logging middleware
#'
#' @param api_config API configuration
#' @return Logging middleware
create_logging_middleware <- function(api_config) {
  logging_middleware <- c(
    "# Logging middleware",
    "#* @filter logger",
    "function(req, res) {",
    "  # Log request",
    "  cat('Request:', req$REQUEST_METHOD, req$PATH_INFO, 'at', Sys.time(), '\\n')",
    "  plumber::forward()",
    "}"
  )

  return(logging_middleware)
}

Performance Optimization¶

Shiny Performance¶

# R/04-performance-optimization.R

#' Optimize Shiny application performance
#'
#' @param app Shiny application
#' @param optimization_config Optimization configuration
#' @return Optimized application
optimize_shiny_performance <- function(app, optimization_config) {
  # Apply performance optimizations
  optimized_app <- app

  # Optimize reactive expressions
  if (optimization_config$optimize_reactive) {
    optimized_app <- optimize_reactive_expressions(optimized_app, optimization_config)
  }

  # Optimize data processing
  if (optimization_config$optimize_data_processing) {
    optimized_app <- optimize_data_processing(optimized_app, optimization_config)
  }

  # Optimize rendering
  if (optimization_config$optimize_rendering) {
    optimized_app <- optimize_rendering(optimized_app, optimization_config)
  }

  return(optimized_app)
}

#' Optimize reactive expressions
#'
#' @param app Shiny application
#' @param optimization_config Optimization configuration
#' @return Optimized application
optimize_reactive_expressions <- function(app, optimization_config) {
  # Implement reactive expression optimizations
  # This would involve refactoring the server function
  # to use more efficient reactive patterns

  return(app)
}

#' Optimize data processing
#'
#' @param app Shiny application
#' @param optimization_config Optimization configuration
#' @return Optimized application
optimize_data_processing <- function(app, optimization_config) {
  # Implement data processing optimizations
  # This would involve caching, lazy loading, etc.

  return(app)
}

#' Optimize rendering
#'
#' @param app Shiny application
#' @param optimization_config Optimization configuration
#' @return Optimized application
optimize_rendering <- function(app, optimization_config) {
  # Implement rendering optimizations
  # This would involve debouncing, throttling, etc.

  return(app)
}

Caching Strategies¶

# R/04-performance-optimization.R (continued)

#' Implement caching strategies
#'
#' @param app Shiny application
#' @param caching_config Caching configuration
#' @return Application with caching
implement_caching_strategies <- function(app, caching_config) {
  # Implement various caching strategies
  cached_app <- app

  # Memory caching
  if (caching_config$memory_caching) {
    cached_app <- implement_memory_caching(cached_app, caching_config)
  }

  # File caching
  if (caching_config$file_caching) {
    cached_app <- implement_file_caching(cached_app, caching_config)
  }

  # Database caching
  if (caching_config$database_caching) {
    cached_app <- implement_database_caching(cached_app, caching_config)
  }

  return(cached_app)
}

#' Implement memory caching
#'
#' @param app Shiny application
#' @param caching_config Caching configuration
#' @return Application with memory caching
implement_memory_caching <- function(app, caching_config) {
  # Implement memory caching using memoise or similar
  # This would involve wrapping expensive computations

  return(app)
}

#' Implement file caching
#'
#' @param app Shiny application
#' @param caching_config Caching configuration
#' @return Application with file caching
implement_file_caching <- function(app, caching_config) {
  # Implement file-based caching
  # This would involve saving/loading results to/from files

  return(app)
}

#' Implement database caching
#'
#' @param app Shiny application
#' @param caching_config Caching configuration
#' @return Application with database caching
implement_database_caching <- function(app, caching_config) {
  # Implement database-based caching
  # This would involve storing results in a database

  return(app)
}

Security and Authentication¶

Authentication Systems¶

# R/05-security-authentication.R

#' Implement authentication system
#'
#' @param app Shiny application
#' @param auth_config Authentication configuration
#' @return Application with authentication
implement_authentication_system <- function(app, auth_config) {
  # Implement authentication system
  authenticated_app <- app

  # Basic authentication
  if (auth_config$basic_auth) {
    authenticated_app <- implement_basic_auth(authenticated_app, auth_config)
  }

  # OAuth authentication
  if (auth_config$oauth_auth) {
    authenticated_app <- implement_oauth_auth(authenticated_app, auth_config)
  }

  # Custom authentication
  if (auth_config$custom_auth) {
    authenticated_app <- implement_custom_auth(authenticated_app, auth_config)
  }

  return(authenticated_app)
}

#' Implement basic authentication
#'
#' @param app Shiny application
#' @param auth_config Authentication configuration
#' @return Application with basic authentication
implement_basic_auth <- function(app, auth_config) {
  # Implement basic authentication
  # This would involve username/password validation

  return(app)
}

#' Implement OAuth authentication
#'
#' @param app Shiny application
#' @param auth_config Authentication configuration
#' @return Application with OAuth authentication
implement_oauth_auth <- function(app, auth_config) {
  # Implement OAuth authentication
  # This would involve OAuth flow implementation

  return(app)
}

#' Implement custom authentication
#'
#' @param app Shiny application
#' @param auth_config Authentication configuration
#' @return Application with custom authentication
implement_custom_auth <- function(app, auth_config) {
  # Implement custom authentication
  # This would involve custom authentication logic

  return(app)
}

TL;DR Runbook¶

Quick Start¶

# 1. Create Shiny application
shiny_app <- create_shiny_application(app_config)

# 2. Create Flexdashboard application
dashboard <- create_flexdashboard_application(dashboard_config)

# 3. Create Plumber API
api <- create_plumber_api(api_config)

# 4. Optimize performance
optimized_app <- optimize_shiny_performance(shiny_app, optimization_config)

# 5. Implement authentication
authenticated_app <- implement_authentication_system(optimized_app, auth_config)

Essential Patterns¶

# Complete interactive application pipeline
create_interactive_application <- function(data, app_config) {
  # Create application
  app <- create_shiny_application(app_config)

  # Optimize performance
  optimized_app <- optimize_shiny_performance(app, app_config$optimization_config)

  # Implement authentication
  authenticated_app <- implement_authentication_system(optimized_app, app_config$auth_config)

  # Deploy application
  if (app_config$deploy) {
    deploy_application(authenticated_app, app_config$deployment_config)
  }

  return(authenticated_app)
}