forked from facebook/prophet
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add regressor_coefficients function for R (facebook#1803)
* function code * add tests for regressor coefficients utility * add documentation for regressor_coefficients util function * generate Rd docs * add regressor_coefficients to R namespace * minor formatting nit * fix bugs
- Loading branch information
Cuong Duong
authored
Mar 2, 2021
1 parent
e95d7c5
commit 2d56e71
Showing
6 changed files
with
185 additions
and
26 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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,67 @@ | ||
| # Copyright (c) Facebook, Inc. and its affiliates. | ||
|
|
||
| # This source code is licensed under the MIT license found in the | ||
| # LICENSE file in the root directory of this source tree. | ||
|
|
||
| #' Summarise the coefficients of the extra regressors used in the model. | ||
| #' For additive regressors, the coefficient represents the incremental impact | ||
| #' on \code{y} of a unit increase in the regressor. For multiplicative regressors, | ||
| #' the incremental impact is equal to \code{trend(t)} multiplied by the coefficient. | ||
| #' | ||
| #' \textbf{Coefficients are measured on the original scale of the training data.} | ||
| #' | ||
| #' @param m Prophet model object, after fitting. | ||
| #' | ||
| #' @return Dataframe with one row per regressor. | ||
| #' @details Output dataframe columns: | ||
| #' \itemize{ | ||
| #' \item{regressor: Name of the regressor} | ||
| #' \item{regressor_mode: Whether the regressor has an additive or multiplicative | ||
| #' effect on \code{y}.} | ||
| #' \item{center: The mean of the regressor if it was standardized. Otherwise 0.} | ||
| #' \item{coef_lower: Lower bound for the coefficient, estimated from the MCMC samples. | ||
| #' Only different to \code{coef} if \code{mcmc_samples > 0}. | ||
| #' } | ||
| #' \item{coef: Expected value of the coefficient.} | ||
| #' \item{coef_upper: Upper bound for the coefficient, estimated from MCMC samples. | ||
| #' Only to different to \code{coef} if \code{mcmc_samples > 0}. | ||
| #' } | ||
| #' } | ||
| #' | ||
| #' @export | ||
| regressor_coefficients <- function(m){ | ||
| if (length(m$extra_regressors) == 0) { | ||
| stop("No extra regressors found.") | ||
| } | ||
| regr_names <- names(m$extra_regressors) | ||
| regr_modes <- unlist(lapply(m$extra_regressors, function(x) x$mode)) | ||
| regr_mus <- unlist(lapply(m$extra_regressors, function (x) x$mu)) | ||
| regr_stds <- unlist(lapply(m$extra_regressors, function(x) x$std)) | ||
|
|
||
| beta_indices <- which(m$train.component.cols[, regr_names] == 1, arr.ind = TRUE)[, "row"] | ||
| betas <- m$params$beta[, beta_indices, drop = FALSE] | ||
| # If regressor is additive, multiply by the scale factor to put coefficients on the original training data scale. | ||
| y_scale_indicator <- matrix( | ||
| data = ifelse(regr_modes == "additive", m$y.scale, 1), | ||
| nrow = nrow(betas), | ||
| ncol = ncol(betas), | ||
| byrow = TRUE | ||
| ) | ||
| coefs <- betas * y_scale_indicator / regr_stds | ||
|
|
||
| percentiles = c((1 - m$interval.width) / 2, 1 - (1 - m$interval.width) / 2) | ||
| bounds <- apply(betas, 2, quantile, probs = percentiles) | ||
|
|
||
| df <- data.frame( | ||
| regressor = regr_names, | ||
| regressor_mode = regr_modes, | ||
| center = regr_mus, | ||
| coef_lower = bounds[1, ], | ||
| coef = apply(betas, 2, mean), | ||
| coef_upper = bounds[2, ], | ||
| stringsAsFactors = FALSE, | ||
| row.names = NULL | ||
| ) | ||
|
|
||
| return(df) | ||
| } |
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
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,48 @@ | ||
| # Copyright (c) Facebook, Inc. and its affiliates. | ||
|
|
||
| # This source code is licensed under the MIT license found in the | ||
| # LICENSE file in the root directory of this source tree. | ||
|
|
||
| library(prophet) | ||
| context("Prophet utilities tests") | ||
|
|
||
| DATA <- read.csv('data.csv') | ||
| DATA$ds <- as.Date(DATA$ds) | ||
|
|
||
| build_model_with_regressors <- function(data, mcmc.samples = 0) { | ||
| m <- prophet(mcmc.samples = mcmc.samples) | ||
| m <- add_regressor(m, 'binary_feature', prior.scale=0.2) | ||
| m <- add_regressor(m, 'numeric_feature', prior.scale=0.5) | ||
| m <- add_regressor( | ||
| m, 'numeric_feature2', prior.scale=0.5, mode = 'multiplicative') | ||
| m <- add_regressor(m, 'binary_feature2', standardize=TRUE) | ||
|
|
||
| df <- data | ||
| df$binary_feature <- c(rep(0, 255), rep(1, 255)) | ||
| df$numeric_feature <- 0:509 | ||
| df$numeric_feature2 <- 0:509 | ||
| df$binary_feature2 <- c(rep(1, 100), rep(0, 410)) | ||
| m <- fit.prophet(m, df) | ||
|
|
||
| return(m) | ||
| } | ||
|
|
||
| test_that("regressor_coefficients_no_uncertainty", { | ||
| skip_if_not(Sys.getenv('R_ARCH') != '/i386') | ||
| m <- build_model_with_regressors(DATA, mcmc.samples = 0) | ||
| coefs <- regressor_coefficients(m) | ||
|
|
||
| expect_equal(dim(coefs), c(4, 6)) | ||
| expect_equal(coefs[, "coef_lower"], coefs[, "coef"]) | ||
| expect_equal(coefs[, "coef_upper"], coefs[, "coef"]) | ||
| }) | ||
|
|
||
| test_that("regressor_coefficients_with_uncertainty", { | ||
| skip_if_not(Sys.getenv('R_ARCH') != '/i386') | ||
| suppressWarnings(m <- build_model_with_regressors(DATA, mcmc.samples = 100)) | ||
| coefs <- regressor_coefficients(m) | ||
|
|
||
| expect_equal(dim(coefs), c(4, 6)) | ||
| expect_true(all(coefs[, "coef_lower"] < coefs[, "coef"])) | ||
| expect_true(all(coefs[, "coef_upper"] > coefs[, "coef"])) | ||
| }) |
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