"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "R/R/diagnostics.R" between
prophet-1.0.tar.gz and prophet-1.1.tar.gz

About: Prophet is a tool for producing high quality forecasts for time series data that has multiple seasonality with linear or non-linear growth.

diagnostics.R  (prophet-1.0):diagnostics.R  (prophet-1.1)
skipping to change at line 350 skipping to change at line 350
#' #'
#' @return Dataframe with columns horizon and name, the rolling mean of x. #' @return Dataframe with columns horizon and name, the rolling mean of x.
#' #'
#' @importFrom dplyr "%>%" #' @importFrom dplyr "%>%"
#' @keywords internal #' @keywords internal
rolling_mean_by_h <- function(x, h, w, name) { rolling_mean_by_h <- function(x, h, w, name) {
# Aggregate over h # Aggregate over h
df <- data.frame(x=x, h=h) df <- data.frame(x=x, h=h)
df2 <- df %>% df2 <- df %>%
dplyr::group_by(h) %>% dplyr::group_by(h) %>%
dplyr::summarise(mean = mean(x), n = dplyr::n()) dplyr::summarise(sum = sum(x), n = dplyr::n())
xm <- df2$mean xs <- df2$sum
ns <- df2$n ns <- df2$n
hs <- df2$h hs <- df2$h
res <- data.frame(horizon=c()) trailing_i <- length(hs)
res[[name]] <- c() x_sum <- 0
n_sum <- 0
# We don't know output size but it is bounded by length(hs)
res_x <- vector("double", length=length(hs))
# Start from the right and work backwards # Start from the right and work backwards
i <- length(hs) for(i in length(hs):1) {
while (i > 0) { x_sum <- x_sum + xs[i]
# Construct a mean of at least w samples n_sum <- n_sum + ns[i]
n <- ns[i] while (n_sum >= w) {
xbar <- xm[i] # Include points from the previous horizon. All of them if still
j <- i - 1 # less than w, otherwise weight the mean by the difference
while ((n < w) & (j > 0)) { excess_n <- n_sum - w
# Include points from the previous horizon. All of them if still less excess_x <- excess_n * xs[i]/ ns[i]
# than w, otherwise just enough to get to w. res_x[trailing_i] <- (x_sum - excess_x) / w
n2 <- min(w - n, ns[j]) x_sum <- x_sum - xs[trailing_i]
xbar <- xbar * (n / (n + n2)) + xm[j] * (n2 / (n + n2)) n_sum <- n_sum - ns[trailing_i]
n <- n + n2 trailing_i <- trailing_i - 1
j <- j - 1
}
if (n < w) {
# Ran out of horizons before enough points.
break
} }
res.i <- data.frame(horizon=hs[i])
res.i[[name]] <- xbar
res <- rbind(res.i, res)
i <- i - 1
} }
# R handles subsetting weirdly
if(trailing_i == 0) {
res_h <- hs
} else {
res_h <- hs[-(1:trailing_i)]
res_x <- res_x[-(1:trailing_i)]
}
res <- data.frame(horizon=res_h)
res[[name]] <- res_x
return(res) return(res)
} }
#' Compute a rolling median of x, after first aggregating by h #' Compute a rolling median of x, after first aggregating by h
#' #'
#' Right-aligned. Computes a single median for each unique value of h. Each medi an #' Right-aligned. Computes a single median for each unique value of h. Each medi an
#' is over at least w samples. #' is over at least w samples.
#' #'
#' For each h where there are fewer than w samples, we take samples from the pre vious h, #' For each h where there are fewer than w samples, we take samples from the pre vious h,
# moving backwards. (In other words, we ~ assume that the x's are shuffled with in each h.) # moving backwards. (In other words, we ~ assume that the x's are shuffled with in each h.)
 End of changes. 6 change blocks. 
25 lines changed or deleted 32 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)