R Machine Learning Best Practices¶

Core Principles¶

Data Preprocessing: Prepare data for machine learning algorithms
Model Selection: Choose appropriate algorithms for the problem
Validation: Use proper validation techniques to assess model performance
Hyperparameter Tuning: Optimize model parameters systematically
Model Deployment: Deploy models for production use

Data Preprocessing¶

Feature Engineering¶

# R/01-data-preprocessing.R

#' Comprehensive feature engineering
#'
#' @param data Data frame
#' @param target_variable Target variable name
#' @param preprocessing_config Preprocessing configuration
#' @return Preprocessed data and preprocessing objects
feature_engineering <- function(data, target_variable, preprocessing_config) {
  # Remove target variable from features
  feature_data <- data[, !names(data) %in% target_variable, drop = FALSE]
  target_data <- data[[target_variable]]

  # Handle missing values
  if (preprocessing_config$handle_missing) {
    feature_data <- handle_missing_values(feature_data, preprocessing_config$missing_strategy)
  }

  # Encode categorical variables
  if (preprocessing_config$encode_categorical) {
    encoding_objects <- encode_categorical_variables(feature_data, preprocessing_config$encoding_method)
    feature_data <- encoding_objects$encoded_data
  }

  # Scale numerical variables
  if (preprocessing_config$scale_numerical) {
    scaling_objects <- scale_numerical_variables(feature_data, preprocessing_config$scaling_method)
    feature_data <- scaling_objects$scaled_data
  }

  # Feature selection
  if (preprocessing_config$feature_selection) {
    selection_objects <- select_features(feature_data, target_data, preprocessing_config$selection_method)
    feature_data <- selection_objects$selected_data
  }

  # Create feature engineering objects
  preprocessing_objects <- list(
    missing_handling = if (preprocessing_config$handle_missing) encoding_objects else NULL,
    encoding = if (preprocessing_config$encode_categorical) encoding_objects else NULL,
    scaling = if (preprocessing_config$scale_numerical) scaling_objects else NULL,
    selection = if (preprocessing_config$feature_selection) selection_objects else NULL
  )

  return(list(
    features = feature_data,
    target = target_data,
    preprocessing_objects = preprocessing_objects
  ))
}

#' Handle missing values
#'
#' @param data Data frame
#' @param strategy Missing value handling strategy
#' @return Data with handled missing values
handle_missing_values <- function(data, strategy) {
  if (strategy == "remove") {
    return(data[complete.cases(data), ])
  } else if (strategy == "impute_mean") {
    numeric_cols <- sapply(data, is.numeric)
    for (col in names(data)[numeric_cols]) {
      data[[col]][is.na(data[[col]])] <- mean(data[[col]], na.rm = TRUE)
    }
    return(data)
  } else if (strategy == "impute_median") {
    numeric_cols <- sapply(data, is.numeric)
    for (col in names(data)[numeric_cols]) {
      data[[col]][is.na(data[[col]])] <- median(data[[col]], na.rm = TRUE)
    }
    return(data)
  } else if (strategy == "impute_mode") {
    categorical_cols <- sapply(data, function(x) is.character(x) || is.factor(x))
    for (col in names(data)[categorical_cols]) {
      mode_value <- names(sort(table(data[[col]]), decreasing = TRUE))[1]
      data[[col]][is.na(data[[col]])] <- mode_value
    }
    return(data)
  }
}

#' Encode categorical variables
#'
#' @param data Data frame
#' @param method Encoding method
#' @return Encoded data and encoding objects
encode_categorical_variables <- function(data, method = "one_hot") {
  categorical_cols <- sapply(data, function(x) is.character(x) || is.factor(x))

  if (method == "one_hot") {
    return(one_hot_encode(data, categorical_cols))
  } else if (method == "label") {
    return(label_encode(data, categorical_cols))
  } else if (method == "target") {
    return(target_encode(data, categorical_cols))
  }
}

#' One-hot encoding
#'
#' @param data Data frame
#' @param categorical_cols Categorical column indices
#' @return One-hot encoded data
one_hot_encode <- function(data, categorical_cols) {
  encoded_data <- data

  for (col in names(data)[categorical_cols]) {
    # Create dummy variables
    dummy_vars <- model.matrix(~ . - 1, data = data.frame(data[[col]]))
    colnames(dummy_vars) <- paste0(col, "_", levels(factor(data[[col]])))

    # Remove original column and add dummy variables
    encoded_data <- encoded_data[, !names(encoded_data) %in% col, drop = FALSE]
    encoded_data <- cbind(encoded_data, dummy_vars)
  }

  return(list(
    encoded_data = encoded_data,
    encoding_method = "one_hot"
  ))
}

#' Label encoding
#'
#' @param data Data frame
#' @param categorical_cols Categorical column indices
#' @return Label encoded data
label_encode <- function(data, categorical_cols) {
  encoded_data <- data
  encoding_maps <- list()

  for (col in names(data)[categorical_cols]) {
    unique_values <- unique(data[[col]])
    encoding_map <- setNames(1:length(unique_values), unique_values)
    encoded_data[[col]] <- encoding_map[as.character(data[[col]])]
    encoding_maps[[col]] <- encoding_map
  }

  return(list(
    encoded_data = encoded_data,
    encoding_maps = encoding_maps,
    encoding_method = "label"
  ))
}

#' Target encoding
#'
#' @param data Data frame
#' @param categorical_cols Categorical column indices
#' @return Target encoded data
target_encode <- function(data, categorical_cols) {
  # This is a simplified version - in practice, you'd need the target variable
  # and proper cross-validation to avoid overfitting
  encoded_data <- data

  for (col in names(data)[categorical_cols]) {
    # Calculate mean target value for each category
    category_means <- aggregate(data[[col]], by = list(data[[col]]), FUN = mean)
    encoding_map <- setNames(category_means$x, category_means$Group.1)
    encoded_data[[col]] <- encoding_map[as.character(data[[col]])]
  }

  return(list(
    encoded_data = encoded_data,
    encoding_method = "target"
  ))
}

#' Scale numerical variables
#'
#' @param data Data frame
#' @param method Scaling method
#' @return Scaled data and scaling objects
scale_numerical_variables <- function(data, method = "standardization") {
  numeric_cols <- sapply(data, is.numeric)
  scaled_data <- data
  scaling_params <- list()

  for (col in names(data)[numeric_cols]) {
    if (method == "standardization") {
      mean_val <- mean(data[[col]], na.rm = TRUE)
      sd_val <- sd(data[[col]], na.rm = TRUE)
      scaled_data[[col]] <- (data[[col]] - mean_val) / sd_val
      scaling_params[[col]] <- list(mean = mean_val, sd = sd_val)
    } else if (method == "min_max") {
      min_val <- min(data[[col]], na.rm = TRUE)
      max_val <- max(data[[col]], na.rm = TRUE)
      scaled_data[[col]] <- (data[[col]] - min_val) / (max_val - min_val)
      scaling_params[[col]] <- list(min = min_val, max = max_val)
    }
  }

  return(list(
    scaled_data = scaled_data,
    scaling_params = scaling_params,
    scaling_method = method
  ))
}

#' Select features
#'
#' @param data Data frame
#' @param target Target variable
#' @param method Feature selection method
#' @return Selected features and selection objects
select_features <- function(data, target, method = "correlation") {
  if (method == "correlation") {
    return(select_features_by_correlation(data, target))
  } else if (method == "mutual_information") {
    return(select_features_by_mutual_information(data, target))
  } else if (method == "recursive") {
    return(select_features_recursively(data, target))
  }
}

#' Select features by correlation
#'
#' @param data Data frame
#' @param target Target variable
#' @return Selected features
select_features_by_correlation <- function(data, target) {
  numeric_cols <- sapply(data, is.numeric)
  if (sum(numeric_cols) == 0) return(data)

  numeric_data <- data[, numeric_cols, drop = FALSE]
  correlations <- abs(cor(numeric_data, target, use = "complete.obs"))

  # Select features with correlation > 0.1
  selected_cols <- rownames(correlations)[correlations > 0.1]

  if (length(selected_cols) == 0) {
    return(data)
  }

  selected_data <- data[, selected_cols, drop = FALSE]

  return(list(
    selected_data = selected_data,
    selected_features = selected_cols,
    selection_method = "correlation"
  ))
}

Model Training and Validation¶

Cross-Validation Framework¶

# R/02-model-training.R

#' Comprehensive model training and validation
#'
#' @param data Preprocessed data
#' @param target Target variable
#' @param model_config Model configuration
#' @return Model training results
train_model <- function(data, target, model_config) {
  # Split data
  data_split <- split_data(data, target, model_config$split_ratio)

  # Train model
  trained_model <- fit_model(data_split$train, data_split$train_target, model_config)

  # Validate model
  validation_results <- validate_model(trained_model, data_split$test, data_split$test_target)

  # Cross-validation
  cv_results <- cross_validate_model(data, target, model_config)

  # Hyperparameter tuning
  if (model_config$tune_hyperparameters) {
    tuning_results <- tune_hyperparameters(data, target, model_config)
    trained_model <- tuning_results$best_model
  }

  results <- list(
    model = trained_model,
    validation = validation_results,
    cross_validation = cv_results,
    tuning = if (model_config$tune_hyperparameters) tuning_results else NULL
  )

  return(results)
}

#' Split data into train and test sets
#'
#' @param data Data frame
#' @param target Target variable
#' @param split_ratio Train/test split ratio
#' @return Data split
split_data <- function(data, target, split_ratio = 0.8) {
  set.seed(123)
  n <- nrow(data)
  train_indices <- sample(1:n, floor(split_ratio * n))

  return(list(
    train = data[train_indices, ],
    test = data[-train_indices, ],
    train_target = target[train_indices],
    test_target = target[-train_indices]
  ))
}

#' Fit model based on configuration
#'
#' @param train_data Training data
#' @param train_target Training target
#' @param model_config Model configuration
#' @return Fitted model
fit_model <- function(train_data, train_target, model_config) {
  if (model_config$algorithm == "random_forest") {
    return(fit_random_forest(train_data, train_target, model_config))
  } else if (model_config$algorithm == "gradient_boosting") {
    return(fit_gradient_boosting(train_data, train_target, model_config))
  } else if (model_config$algorithm == "svm") {
    return(fit_svm(train_data, train_target, model_config))
  } else if (model_config$algorithm == "neural_network") {
    return(fit_neural_network(train_data, train_target, model_config))
  }
}

#' Fit random forest model
#'
#' @param train_data Training data
#' @param train_target Training target
#' @param model_config Model configuration
#' @return Fitted random forest model
fit_random_forest <- function(train_data, train_target, model_config) {
  library(randomForest)

  model <- randomForest(
    x = train_data,
    y = train_target,
    ntree = model_config$ntree,
    mtry = model_config$mtry,
    nodesize = model_config$nodesize,
    maxnodes = model_config$maxnodes
  )

  return(model)
}

#' Fit gradient boosting model
#'
#' @param train_data Training data
#' @param train_target Training target
#' @param model_config Model configuration
#' @return Fitted gradient boosting model
fit_gradient_boosting <- function(train_data, train_target, model_config) {
  library(gbm)

  model <- gbm(
    formula = train_target ~ .,
    data = cbind(train_data, train_target),
    distribution = model_config$distribution,
    n.trees = model_config$n_trees,
    interaction.depth = model_config$interaction_depth,
    shrinkage = model_config$shrinkage,
    bag.fraction = model_config$bag_fraction
  )

  return(model)
}

#' Fit SVM model
#'
#' @param train_data Training data
#' @param train_target Training target
#' @param model_config Model configuration
#' @return Fitted SVM model
fit_svm <- function(train_data, train_target, model_config) {
  library(e1071)

  model <- svm(
    x = train_data,
    y = train_target,
    kernel = model_config$kernel,
    cost = model_config$cost,
    gamma = model_config$gamma,
    epsilon = model_config$epsilon
  )

  return(model)
}

#' Fit neural network model
#'
#' @param train_data Training data
#' @param train_target Training target
#' @param model_config Model configuration
#' @return Fitted neural network model
fit_neural_network <- function(train_data, train_target, model_config) {
  library(nnet)

  model <- nnet(
    x = train_data,
    y = train_target,
    size = model_config$hidden_units,
    decay = model_config$decay,
    maxit = model_config$max_iterations,
    trace = FALSE
  )

  return(model)
}

Model Validation¶

# R/02-model-training.R (continued)

#' Validate model performance
#'
#' @param model Fitted model
#' @param test_data Test data
#' @param test_target Test target
#' @return Validation results
validate_model <- function(model, test_data, test_target) {
  # Make predictions
  predictions <- predict_model(model, test_data)

  # Calculate performance metrics
  performance_metrics <- calculate_performance_metrics(test_target, predictions)

  # Create confusion matrix (for classification)
  if (is.factor(test_target)) {
    confusion_matrix <- table(test_target, predictions)
    performance_metrics$confusion_matrix <- confusion_matrix
  }

  return(list(
    predictions = predictions,
    performance_metrics = performance_metrics
  ))
}

#' Make predictions using model
#'
#' @param model Fitted model
#' @param data Data to predict on
#' @return Predictions
predict_model <- function(model, data) {
  if (inherits(model, "randomForest")) {
    return(predict(model, data))
  } else if (inherits(model, "gbm")) {
    return(predict(model, data, n.trees = model$n.trees))
  } else if (inherits(model, "svm")) {
    return(predict(model, data))
  } else if (inherits(model, "nnet")) {
    return(predict(model, data))
  }
}

#' Calculate performance metrics
#'
#' @param actual Actual values
#' @param predicted Predicted values
#' @return Performance metrics
calculate_performance_metrics <- function(actual, predicted) {
  if (is.numeric(actual)) {
    # Regression metrics
    mse <- mean((actual - predicted)^2)
    rmse <- sqrt(mse)
    mae <- mean(abs(actual - predicted))
    mape <- mean(abs((actual - predicted) / actual)) * 100
    r_squared <- 1 - sum((actual - predicted)^2) / sum((actual - mean(actual))^2)

    return(list(
      mse = mse,
      rmse = rmse,
      mae = mae,
      mape = mape,
      r_squared = r_squared
    ))
  } else {
    # Classification metrics
    accuracy <- mean(actual == predicted)
    precision <- calculate_precision(actual, predicted)
    recall <- calculate_recall(actual, predicted)
    f1_score <- 2 * (precision * recall) / (precision + recall)

    return(list(
      accuracy = accuracy,
      precision = precision,
      recall = recall,
      f1_score = f1_score
    ))
  }
}

#' Calculate precision
#'
#' @param actual Actual values
#' @param predicted Predicted values
#' @return Precision
calculate_precision <- function(actual, predicted) {
  # Calculate precision for each class
  classes <- unique(actual)
  precision_values <- numeric(length(classes))

  for (i in seq_along(classes)) {
    class <- classes[i]
    true_positives <- sum(actual == class & predicted == class)
    false_positives <- sum(actual != class & predicted == class)

    if (true_positives + false_positives == 0) {
      precision_values[i] <- 0
    } else {
      precision_values[i] <- true_positives / (true_positives + false_positives)
    }
  }

  return(mean(precision_values))
}

#' Calculate recall
#'
#' @param actual Actual values
#' @param predicted Predicted values
#' @return Recall
calculate_recall <- function(actual, predicted) {
  # Calculate recall for each class
  classes <- unique(actual)
  recall_values <- numeric(length(classes))

  for (i in seq_along(classes)) {
    class <- classes[i]
    true_positives <- sum(actual == class & predicted == class)
    false_negatives <- sum(actual == class & predicted != class)

    if (true_positives + false_negatives == 0) {
      recall_values[i] <- 0
    } else {
      recall_values[i] <- true_positives / (true_positives + false_negatives)
    }
  }

  return(mean(recall_values))
}

#' Cross-validate model
#'
#' @param data Data frame
#' @param target Target variable
#' @param model_config Model configuration
#' @return Cross-validation results
cross_validate_model <- function(data, target, model_config) {
  set.seed(123)
  k <- model_config$cv_folds
  folds <- create_cv_folds(nrow(data), k)

  cv_results <- list()

  for (i in 1:k) {
    train_indices <- unlist(folds[-i])
    test_indices <- folds[[i]]

    train_data <- data[train_indices, ]
    test_data <- data[test_indices, ]
    train_target <- target[train_indices]
    test_target <- target[test_indices]

    # Train model
    model <- fit_model(train_data, train_target, model_config)

    # Validate model
    validation <- validate_model(model, test_data, test_target)

    cv_results[[i]] <- validation$performance_metrics
  }

  # Aggregate results
  aggregated_results <- aggregate_cv_results(cv_results)

  return(list(
    fold_results = cv_results,
    aggregated_results = aggregated_results
  ))
}

#' Create cross-validation folds
#'
#' @param n Number of observations
#' @param k Number of folds
#' @return List of fold indices
create_cv_folds <- function(n, k) {
  fold_size <- floor(n / k)
  remainder <- n %% k

  folds <- list()
  start <- 1

  for (i in 1:k) {
    end <- start + fold_size - 1
    if (i <= remainder) {
      end <- end + 1
    }

    folds[[i]] <- start:end
    start <- end + 1
  }

  return(folds)
}

#' Aggregate cross-validation results
#'
#' @param cv_results Cross-validation results
#' @return Aggregated results
aggregate_cv_results <- function(cv_results) {
  # Get metric names
  metric_names <- names(cv_results[[1]])

  # Calculate mean and standard deviation for each metric
  aggregated <- list()

  for (metric in metric_names) {
    values <- sapply(cv_results, function(x) x[[metric]])
    aggregated[[paste0(metric, "_mean")]] <- mean(values)
    aggregated[[paste0(metric, "_sd")]] <- sd(values)
  }

  return(aggregated)
}

Hyperparameter Tuning¶

Grid Search¶

# R/03-hyperparameter-tuning.R

#' Comprehensive hyperparameter tuning
#'
#' @param data Data frame
#' @param target Target variable
#' @param model_config Model configuration
#' @return Hyperparameter tuning results
tune_hyperparameters <- function(data, target, model_config) {
  if (model_config$tuning_method == "grid_search") {
    return(grid_search_tuning(data, target, model_config))
  } else if (model_config$tuning_method == "random_search") {
    return(random_search_tuning(data, target, model_config))
  } else if (model_config$tuning_method == "bayesian") {
    return(bayesian_tuning(data, target, model_config))
  }
}

#' Grid search hyperparameter tuning
#'
#' @param data Data frame
#' @param target Target variable
#' @param model_config Model configuration
#' @return Grid search results
grid_search_tuning <- function(data, target, model_config) {
  # Create parameter grid
  param_grid <- create_parameter_grid(model_config$hyperparameters)

  # Perform grid search
  grid_results <- perform_grid_search(data, target, param_grid, model_config)

  # Find best parameters
  best_params <- find_best_parameters(grid_results)

  # Train final model with best parameters
  best_model_config <- update_model_config(model_config, best_params)
  best_model <- fit_model(data, target, best_model_config)

  return(list(
    grid_results = grid_results,
    best_parameters = best_params,
    best_model = best_model
  ))
}

#' Create parameter grid
#'
#' @param hyperparameters Hyperparameter specifications
#' @return Parameter grid
create_parameter_grid <- function(hyperparameters) {
  param_names <- names(hyperparameters)
  param_values <- lapply(hyperparameters, function(x) x$values)

  # Create all combinations
  param_grid <- expand.grid(param_values, stringsAsFactors = FALSE)
  names(param_grid) <- param_names

  return(param_grid)
}

#' Perform grid search
#'
#' @param data Data frame
#' @param target Target variable
#' @param param_grid Parameter grid
#' @param model_config Model configuration
#' @return Grid search results
perform_grid_search <- function(data, target, param_grid, model_config) {
  results <- list()

  for (i in 1:nrow(param_grid)) {
    params <- param_grid[i, ]

    # Update model configuration with current parameters
    current_config <- update_model_config(model_config, params)

    # Perform cross-validation
    cv_results <- cross_validate_model(data, target, current_config)

    # Store results
    results[[i]] <- list(
      parameters = params,
      cv_results = cv_results$aggregated_results
    )
  }

  return(results)
}

#' Update model configuration with parameters
#'
#' @param model_config Model configuration
#' @param parameters Parameters to update
#' @return Updated model configuration
update_model_config <- function(model_config, parameters) {
  updated_config <- model_config

  for (param_name in names(parameters)) {
    updated_config[[param_name]] <- parameters[[param_name]]
  }

  return(updated_config)
}

#' Find best parameters
#'
#' @param grid_results Grid search results
#' @return Best parameters
find_best_parameters <- function(grid_results) {
  # Extract performance metrics
  performance_metrics <- lapply(grid_results, function(x) x$cv_results)

  # Find best parameters based on primary metric
  best_idx <- which.max(sapply(performance_metrics, function(x) x$accuracy_mean))

  return(grid_results[[best_idx]]$parameters)
}

Random Search¶

# R/03-hyperparameter-tuning.R (continued)

#' Random search hyperparameter tuning
#'
#' @param data Data frame
#' @param target Target variable
#' @param model_config Model configuration
#' @return Random search results
random_search_tuning <- function(data, target, model_config) {
  n_iterations <- model_config$n_iterations
  hyperparameters <- model_config$hyperparameters

  results <- list()

  for (i in 1:n_iterations) {
    # Sample random parameters
    params <- sample_parameters(hyperparameters)

    # Update model configuration
    current_config <- update_model_config(model_config, params)

    # Perform cross-validation
    cv_results <- cross_validate_model(data, target, current_config)

    # Store results
    results[[i]] <- list(
      parameters = params,
      cv_results = cv_results$aggregated_results
    )
  }

  # Find best parameters
  best_params <- find_best_parameters(results)

  # Train final model
  best_model_config <- update_model_config(model_config, best_params)
  best_model <- fit_model(data, target, best_model_config)

  return(list(
    search_results = results,
    best_parameters = best_params,
    best_model = best_model
  ))
}

#' Sample random parameters
#'
#' @param hyperparameters Hyperparameter specifications
#' @return Sampled parameters
sample_parameters <- function(hyperparameters) {
  sampled_params <- list()

  for (param_name in names(hyperparameters)) {
    param_spec <- hyperparameters[[param_name]]

    if (param_spec$type == "categorical") {
      sampled_params[[param_name]] <- sample(param_spec$values, 1)
    } else if (param_spec$type == "integer") {
      sampled_params[[param_name]] <- sample(param_spec$values, 1)
    } else if (param_spec$type == "float") {
      min_val <- param_spec$min
      max_val <- param_spec$max
      sampled_params[[param_name]] <- runif(1, min_val, max_val)
    }
  }

  return(sampled_params)
}

Model Deployment¶

Model Serialization¶

# R/04-model-deployment.R

#' Serialize model for deployment
#'
#' @param model Fitted model
#' @param preprocessing_objects Preprocessing objects
#' @param model_metadata Model metadata
#' @return Serialized model
serialize_model <- function(model, preprocessing_objects, model_metadata) {
  # Create model package
  model_package <- list(
    model = model,
    preprocessing_objects = preprocessing_objects,
    metadata = model_metadata,
    timestamp = Sys.time(),
    version = "1.0.0"
  )

  # Serialize model
  serialized_model <- serialize(model_package, NULL)

  return(serialized_model)
}

#' Save model to file
#'
#' @param model Fitted model
#' @param preprocessing_objects Preprocessing objects
#' @param model_metadata Model metadata
#' @param file_path File path to save model
save_model <- function(model, preprocessing_objects, model_metadata, file_path) {
  # Serialize model
  serialized_model <- serialize_model(model, preprocessing_objects, model_metadata)

  # Save to file
  writeBin(serialized_model, file_path)

  return(file_path)
}

#' Load model from file
#'
#' @param file_path File path to load model from
#' @return Loaded model
load_model <- function(file_path) {
  # Read serialized model
  serialized_model <- readBin(file_path, "raw", file.info(file_path)$size)

  # Deserialize model
  model_package <- unserialize(serialized_model)

  return(model_package)
}

#' Make predictions with deployed model
#'
#' @param model_package Model package
#' @param new_data New data for prediction
#' @return Predictions
predict_with_deployed_model <- function(model_package, new_data) {
  # Apply preprocessing
  preprocessed_data <- apply_preprocessing(new_data, model_package$preprocessing_objects)

  # Make predictions
  predictions <- predict_model(model_package$model, preprocessed_data)

  return(predictions)
}

#' Apply preprocessing to new data
#'
#' @param data New data
#' @param preprocessing_objects Preprocessing objects
#' @return Preprocessed data
apply_preprocessing <- function(data, preprocessing_objects) {
  preprocessed_data <- data

  # Apply missing value handling
  if (!is.null(preprocessing_objects$missing_handling)) {
    preprocessed_data <- handle_missing_values(preprocessed_data, 
                                              preprocessing_objects$missing_handling$strategy)
  }

  # Apply encoding
  if (!is.null(preprocessing_objects$encoding)) {
    preprocessed_data <- apply_encoding(preprocessed_data, preprocessing_objects$encoding)
  }

  # Apply scaling
  if (!is.null(preprocessing_objects$scaling)) {
    preprocessed_data <- apply_scaling(preprocessed_data, preprocessing_objects$scaling)
  }

  # Apply feature selection
  if (!is.null(preprocessing_objects$selection)) {
    preprocessed_data <- preprocessed_data[, preprocessing_objects$selection$selected_features, drop = FALSE]
  }

  return(preprocessed_data)
}

TL;DR Runbook¶

Quick Start¶

# 1. Data preprocessing
preprocessed_data <- feature_engineering(data, "target", preprocessing_config)

# 2. Model training
model_results <- train_model(preprocessed_data$features, preprocessed_data$target, model_config)

# 3. Hyperparameter tuning
tuning_results <- tune_hyperparameters(data, target, model_config)

# 4. Model deployment
save_model(model_results$model, preprocessed_data$preprocessing_objects, model_metadata, "model.rds")

# 5. Make predictions
loaded_model <- load_model("model.rds")
predictions <- predict_with_deployed_model(loaded_model, new_data)

Essential Patterns¶

# Complete ML pipeline
ml_pipeline <- function(data, target, model_config) {
  # Preprocess data
  preprocessed <- feature_engineering(data, target, model_config$preprocessing)

  # Train model
  model_results <- train_model(preprocessed$features, preprocessed$target, model_config$training)

  # Tune hyperparameters
  if (model_config$tune_hyperparameters) {
    tuning_results <- tune_hyperparameters(data, target, model_config$tuning)
    model_results$model <- tuning_results$best_model
  }

  # Deploy model
  save_model(model_results$model, preprocessed$preprocessing_objects, model_config$metadata, "model.rds")

  return(model_results)
}