"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

---