-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
17 changed files
with
617 additions
and
34 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,140 @@ | ||
| #' ridgereg function | ||
| #' | ||
| #' Performs ridge regression on a given formula and dataset. | ||
| #' It normalizes the covariates and calculates the ridge regression coefficients. | ||
| #' | ||
| #' @param formula A formula object describing the model to be fitted. | ||
| #' @param data A data frame containing the variables in the model. | ||
| #' @param lambda A numeric value specifying the ridge regularization parameter. | ||
| #' | ||
| #' @return An S3 object of class ridgereg containing the fitted model. | ||
| #' | ||
| #' @export ridgereg | ||
| #' @importFrom stats model.response | ||
| #' @importFrom stats model.frame | ||
| #' @importFrom stats sd | ||
| #' | ||
| ridgereg <- function(formula, data, lambda) { | ||
| # Validate the input | ||
| if (!inherits(formula, "formula")) { | ||
| stop("The formula argument must be a formula object.") | ||
| } | ||
|
|
||
| if (!is.data.frame(data)) { | ||
| stop("The data argument must be a data frame.") | ||
| } | ||
|
|
||
| if (!is.numeric(lambda)) { | ||
| stop("The lambda argument must be numeric.") | ||
| } | ||
|
|
||
| # Parse the formula and extract the response and predictor variables | ||
| X <- model.matrix(formula, data) | ||
| y <- model.response(model.frame(formula, data)) | ||
|
|
||
| # Standardize predictor variables (excluding intercept) | ||
| X_mean <- colMeans(X[, -1]) | ||
| X_sd <- apply(X[, -1], 2, sd) | ||
| X[, -1] <- scale(X[, -1], center = X_mean, scale = X_sd) | ||
|
|
||
| # Calculate ridge regression coefficients: (X'X + lambda*I)^(-1) X'y | ||
| p <- ncol(X) | ||
| I_lambda <- diag(lambda, p, p) | ||
| I_lambda[1, 1] <- 0 # Do not regularize intercept term | ||
|
|
||
| # Ridge regression coefficients | ||
| beta <- solve(t(X) %*% X + I_lambda) %*% t(X) %*% y | ||
|
|
||
| # Calculate fitted values | ||
| fits <- X %*% beta | ||
|
|
||
| # Create output object with class ridgereg | ||
| ridgereg_obj <- list( | ||
| coefficients = beta, | ||
| fitted_values = fits, | ||
| lambda = lambda, | ||
| formula = formula, | ||
| data = data, | ||
| X_mean = X_mean, | ||
| X_sd = X_sd | ||
| ) | ||
|
|
||
| # Assign S3 class "ridgereg" to the output object | ||
| class(ridgereg_obj) <- "ridgereg" | ||
| return(ridgereg_obj) | ||
| } | ||
|
|
||
| #' Print method for ridgereg class | ||
| #' | ||
| #' Prints out the coefficients and coefficient names. | ||
| #' | ||
| #' @param x An S3 object of class ridgereg. | ||
| #' @export print | ||
| print <- function(x) { | ||
| UseMethod("print") | ||
| } | ||
|
|
||
| #' @rdname print | ||
| #' | ||
| #' @method print ridgereg | ||
| print.ridgereg <- function(x) { | ||
| if (!inherits(x, "ridgereg")) { | ||
| stop("This method is only for objects of class ridgereg.") | ||
| } | ||
| cat("\n\nCall:\n") | ||
| cat(paste0("ridgereg(formula = ", deparse(x$formula), ", data = ", x$name, ")")) | ||
| cat("\n\nCoefficients:\n") | ||
| cat(names(x$coefficients)) | ||
| cat(paste0("\n", t(x$coefficients))) | ||
| } | ||
|
|
||
| #' Predict method for ridgereg class | ||
| #' | ||
| #' Returns the preducted values. | ||
| #' | ||
| #' @param x An S3 object of class ridgereg. | ||
| #' @param newdata A data frame with new data (optional) | ||
| #' @export | ||
| predict <- function(x, newdata = NULL) { | ||
| UseMethod("predict") | ||
| } | ||
|
|
||
| #' @rdname predict | ||
| #' | ||
| #' @export | ||
| predict.ridgereg <- function(x, newdata = NULL) { | ||
| if (!inherits(x, "ridgereg")) { | ||
| stop("This method is only for objects of class ridgereg.") | ||
| } | ||
| if (is.null(newdata)) { | ||
| return(x$fitted_values) | ||
| } else { | ||
| # Normalize the new data using the training data's mean and sd | ||
| X_new <- model.matrix(x$formula, newdata) | ||
| X_new[, -1] <- scale(X_new[, -1], center = x$X_mean, scale = x$X_sd) | ||
|
|
||
| # Predict using the ridge regression coefficients | ||
| return(X_new %*% x$coefficients) | ||
| } | ||
| } | ||
|
|
||
| #' Coefficients method for ridgereg class | ||
| #' | ||
| #' @param x An S3 object of class ridgereg. | ||
| #' @return A named vector of coefficients. | ||
| #' @export | ||
| coef <- function(x) { | ||
| UseMethod("coef") | ||
| } | ||
|
|
||
| #' @rdname coef | ||
| #' | ||
| #' @method coef ridgereg | ||
| coef.ridgereg <- function(x) { | ||
| if (!inherits(x, "ridgereg")) { | ||
| stop("This method is only for objects of class ridgereg.") | ||
| } | ||
| coeff <- as.vector(x$coefficients) | ||
| names(coeff) <- "Coefficients" | ||
| return(coeff) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,33 @@ | ||
| #' Visualize Mean Airport Delays by Location | ||
| #' | ||
| #' Creates a scatter plot that visualizes the mean departure delay of flights | ||
| #' at different destination airports across the United States. The plot shows | ||
| #' each airport's mean delay by longitude and latitude, with both color and size | ||
| #' representing the average delay in minutes. | ||
| #' | ||
| #' @return A ggplot object representing the mean delays at airports across the United States. | ||
| #' | ||
| #' @export visualize_airport_delays | ||
| #' @importFrom dplyr filter group_by summarize inner_join %>% | ||
| #' @importFrom ggplot2 ggplot aes geom_point scale_color_viridis_c scale_size_continuous labs theme_minimal theme | ||
| #' @importFrom rlang .data | ||
| visualize_airport_delays <- function() { | ||
| # Join the flights and airports datasets | ||
| delay_data <- nycflights13::flights %>% | ||
| filter(!is.na(.data$dep_delay)) %>% | ||
| group_by(.data$dest) %>% | ||
| summarize(mean_delay = mean(.data$dep_delay, na.rm = TRUE)) %>% | ||
| inner_join(nycflights13::airports, by = c("dest" = "faa")) | ||
|
|
||
| # Create the plot | ||
| ggplot(delay_data, aes(x = .data$lon, y = .data$lat, size = .data$mean_delay, color = .data$mean_delay)) + | ||
| geom_point(alpha = 0.7) + | ||
| scale_color_viridis_c(option = "C", name = "Mean Delay (min)") + | ||
| scale_size_continuous(name = "Mean Delay (min)") + | ||
| labs( | ||
| title = "Mean Flight Delays by Destination Airport", | ||
| x = "Longitude", y = "Latitude" | ||
| ) + | ||
| theme_minimal() + | ||
| theme(legend.position = "right") | ||
| } |
Oops, something went wrong.