# Copyright 2016 Google Inc. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#' Creates a GeoExperimentPreanalysisData object.
#'
#' @param obj a GeoTimeseries object.
#' @param period.lengths an integer-valued vector of length 2 or 3, denoting
#' the lengths (in days) of pre-period, test, and the (optional)
#' cooldown periods, respectively. The test period must be at least 7
#' days; the pre-period must be at least as long as the test period. The
#' cooldown period can be 0 or more days; if it is zero, it will be
#' ignored as if there were only 2 periods.
#' @param geos (GeoStrata or GeoAssignment object) object to use for choosing
#' the geo groups at the time of simulating (using
#' SimulateGeoExperimentData); if 'geos' is a GeoAssignment object, then
#' the geo assignment will be fixed; iteration; if 'geos' is a
#' GeoStrata, then the geo assignment will be generated by a call to
#' 'Randomize'.
#' @param recycle (flag) if TRUE, creates an augmented data set in order to
#' create a larger time series, reusing data from the head of the time
#' series.
#' @return A GeoExperimentPreanalysis object, which inherits from
#' GeoExperimentData, with NAs in 'geo.group', 'period', and
#' 'assignment'. The default treatment assignment (spend change only for
#' period 1 and group 2) is stored into the object.
#'
#' @note
#' A GeoExperimentPreanalysisData object stores a historical data set
#' and the information about the length of the experiment periods. It is
#' used as the generator of pseudo-data sets for simulation purposes. See
#' also: 'SimulateGeoExperimentData' to generate a GeoExperimentData
#' object.
GeoExperimentPreanalysisData <- function(obj, period.lengths, geos,
recycle=TRUE) {
kClassName <- "GeoExperimentPreanalysisData"
SetMessageContextString(kClassName)
on.exit(SetMessageContextString())
assert_that(is.integer.valued(period.lengths),
length(period.lengths) %in% c(2L, 3L),
period.lengths[2] >= 7L,
period.lengths[1] >= period.lengths[2],
length(period.lengths) == 2 || period.lengths[3] >= 0)
period.lengths <- as.integer(period.lengths)
if (length(period.lengths) == 3 && period.lengths[3] == 0) {
period.lengths <- period.lengths[-3]
}
assert_that(inherits(geos, "GeoStrata") ||
inherits(geos, "GeoAssignment"))
orig.date.range <- range(obj[[kDate]])
n.orig.days <- (as.integer(diff(orig.date.range)) + 1L)
experiment.length <- sum(period.lengths)
assert_that(experiment.length <= n.orig.days,
msg=Messagef(paste0("Not enough data (%d days max) to simulate ",
"experiments of length %d days"), n.orig.days,
experiment.length))
if (recycle) {
# Add data to the tail of time series from the head, omitting the last
# date.
obj.add <- obj[obj[[kDate]] < orig.date.range[2], , drop=FALSE]
weekday.range <- as.integer(strftime(orig.date.range, format="%u"))
# The weekday of the first date of the augmented portion of the data set
# must be equal to that of the first date of the original data set. For
# example if the original data set is from Wed to Fri the first date in
# this 2nd half must be the last date of the original data set plus (3 - 5)
# mod 7 = 5, so that the next date counted from the last date (Fri) is
# Wed. An exception: if the weekdays are the same, the shift should be 7
# and not 0, otherwise the dates would be doubled.
weekday.shift <- ((weekday.range[1] - weekday.range[2]) %% 7L)
if (weekday.shift == 0) {
weekday.shift <- 7L
}
date.shift <- (orig.date.range[2] - orig.date.range[1])
obj.add[[kDate]] <- (obj.add[[kDate]] + date.shift + weekday.shift)
obj <- rbind(obj, obj.add)
metrics <- GetInfo(obj, "metrics")
obj <- GeoTimeseries(obj, metrics=metrics)
}
# dates: all distinct dates (incl. possibly the fake ones added above).
dates <- sort(unique(obj[[kDate]]))
# i.max: number of distinct time series to obtain from this object.
i.max <- sum(dates + experiment.length - 1L <= max(dates))
day.index <- as.integer(dates - min(dates) + 1L)
if (inherits(geos, "GeoAssignment")) {
geo.assignment <- geos
} else {
geo.assignment <- NULL
}
obj.result <- GeoExperimentData(obj, periods=NULL,
geo.assignment=geo.assignment,
treat.assignment=DefaultTreatmentAssignment())
obj.result <- SetInfo(obj.result,
i.max=i.max,
dates=dates,
day.index=day.index,
experiment.length=experiment.length,
period.lengths=period.lengths,
geos=geos)
if (!inherits(obj.result, kClassName)) {
class(obj.result) <- c(kClassName, class(obj.result))
}
return(obj.result)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.