├── CONTRIBUTING ├── ChangeLog ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── R ├── attribution.R ├── migrate.R ├── misc_helper.R ├── module_media.R ├── module_natural_migration.R ├── module_sales.R ├── optimize.R ├── random_number_generator.R ├── s3_amss_sim.R ├── segmentation_consts.R ├── simulate.R ├── simulate_time_series.R └── startup_message.R ├── README.md ├── inst └── doc │ ├── amss-manual.pdf │ └── amss-vignette.pdf ├── man ├── AdjustPopulation.Rd ├── ApplyTransitionMatrix.Rd ├── CalculateROAS.Rd ├── CalculateSampleROAS.Rd ├── Capitalize.Rd ├── CheckLength.Rd ├── CheckListNames.Rd ├── CheckSalesActivity.Rd ├── DefaultNatMigModule.Rd ├── DefaultSalesModule.Rd ├── DefaultSearchMediaModule.Rd ├── DefaultTraditionalMediaModule.Rd ├── Desatiate.Rd ├── EvalText.Rd ├── GenerateDataUnderNewBudget.Rd ├── GetBrandStates.Rd ├── GetBudget.Rd ├── GetBudgetIdx.Rd ├── GetCategoryStates.Rd ├── GetInterior.Rd ├── GetPopulation.Rd ├── HillTrans.Rd ├── InitPop.Rd ├── InitStateData.Rd ├── MigrateMarginal.Rd ├── MigrateMultiple.Rd ├── MultiplyBySegment.Rd ├── OptimizeSpend.Rd ├── ParseT.Rd ├── PasteD.Rd ├── RBinom.Rd ├── RHyper.Rd ├── RMultinom.Rd ├── RNBinom.Rd ├── RPois.Rd ├── ReadRepeatingVector.Rd ├── ReduceDimension.Rd ├── SimulateAMSS.Rd ├── SimulateAR1.Rd ├── SimulateCorrelated.Rd ├── SimulateData.Rd ├── SimulateDummy.Rd ├── SimulateNotEmptyUrns.Rd ├── SimulateSinusoidal.Rd ├── SurfaceData.Rd ├── UpdateMarket.Rd ├── UpdateMarketingResponsiveStates.Rd ├── amss.sim.Rd └── population-segmentation.Rd ├── tests ├── testthat.R └── testthat │ ├── helper_testdata.R │ ├── test_attribution.R │ ├── test_migrate.R │ ├── test_misc_helper.R │ ├── test_module_media.R │ ├── test_module_natural_migration.R │ ├── test_module_sales.R │ ├── test_optimize.R │ ├── test_random_number_generator.R │ ├── test_simulate.R │ └── test_simulate_time_series.R └── vignettes └── amss-vignette.Rmd /CONTRIBUTING: -------------------------------------------------------------------------------- 1 | Please send any reports to amss-opensource@google.com. -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 2017-05-15: Google 2 | * Version 1.0.0 3 | * Initial commit. 4 | 2017-06-06: Google 5 | * Version 1.0.1 6 | * New feature: ground truth for optimal media budget. 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: amss 2 | Version: 1.0.1 3 | Date: 2017-06-06 4 | Title: Agreggate Marketing System Simulator 5 | Author: Google Inc. 6 | Maintainer: Google Inc. 7 | Depends: 8 | R (>= 3.2.2) 9 | Imports: 10 | assertthat (>= 0.1.0.99), 11 | data.table (>= 1.9.6) 12 | Suggests: 13 | knitr (>= 1.14), 14 | testthat (>= 1.0.2) 15 | VignetteBuilder: knitr 16 | Description: Implementation of the Aggregate Marketing System Simulator. 17 | Functions for simulating aggregate time series marketing data, and for 18 | calculating associated ground truth for some relevant metrics. 19 | License: Apache License 2.0 | file LICENSE 20 | Copyright: Copyright (C) 2017 Google, Inc. 21 | RoxygenNote: 5.0.1 22 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Apache License 3 | Version 2.0, January 2004 4 | http://www.apache.org/licenses/ 5 | 6 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 7 | 8 | 1. Definitions. 9 | 10 | "License" shall mean the terms and conditions for use, reproduction, 11 | and distribution as defined by Sections 1 through 9 of this document. 12 | 13 | "Licensor" shall mean the copyright owner or entity authorized by 14 | the copyright owner that is granting the License. 15 | 16 | "Legal Entity" shall mean the union of the acting entity and all 17 | other entities that control, are controlled by, or are under common 18 | control with that entity. For the purposes of this definition, 19 | "control" means (i) the power, direct or indirect, to cause the 20 | direction or management of such entity, whether by contract or 21 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 22 | outstanding shares, or (iii) beneficial ownership of such entity. 23 | 24 | "You" (or "Your") shall mean an individual or Legal Entity 25 | exercising permissions granted by this License. 26 | 27 | "Source" form shall mean the preferred form for making modifications, 28 | including but not limited to software source code, documentation 29 | source, and configuration files. 30 | 31 | "Object" form shall mean any form resulting from mechanical 32 | transformation or translation of a Source form, including but 33 | not limited to compiled object code, generated documentation, 34 | and conversions to other media types. 35 | 36 | "Work" shall mean the work of authorship, whether in Source or 37 | Object form, made available under the License, as indicated by a 38 | copyright notice that is included in or attached to the work 39 | (an example is provided in the Appendix below). 40 | 41 | "Derivative Works" shall mean any work, whether in Source or Object 42 | form, that is based on (or derived from) the Work and for which the 43 | editorial revisions, annotations, elaborations, or other modifications 44 | represent, as a whole, an original work of authorship. For the purposes 45 | of this License, Derivative Works shall not include works that remain 46 | separable from, or merely link (or bind by name) to the interfaces of, 47 | the Work and Derivative Works thereof. 48 | 49 | "Contribution" shall mean any work of authorship, including 50 | the original version of the Work and any modifications or additions 51 | to that Work or Derivative Works thereof, that is intentionally 52 | submitted to Licensor for inclusion in the Work by the copyright owner 53 | or by an individual or Legal Entity authorized to submit on behalf of 54 | the copyright owner. For the purposes of this definition, "submitted" 55 | means any form of electronic, verbal, or written communication sent 56 | to the Licensor or its representatives, including but not limited to 57 | communication on electronic mailing lists, source code control systems, 58 | and issue tracking systems that are managed by, or on behalf of, the 59 | Licensor for the purpose of discussing and improving the Work, but 60 | excluding communication that is conspicuously marked or otherwise 61 | designated in writing by the copyright owner as "Not a Contribution." 62 | 63 | "Contributor" shall mean Licensor and any individual or Legal Entity 64 | on behalf of whom a Contribution has been received by Licensor and 65 | subsequently incorporated within the Work. 66 | 67 | 2. Grant of Copyright License. Subject to the terms and conditions of 68 | this License, each Contributor hereby grants to You a perpetual, 69 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 70 | copyright license to reproduce, prepare Derivative Works of, 71 | publicly display, publicly perform, sublicense, and distribute the 72 | Work and such Derivative Works in Source or Object form. 73 | 74 | 3. Grant of Patent License. Subject to the terms and conditions of 75 | this License, each Contributor hereby grants to You a perpetual, 76 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 77 | (except as stated in this section) patent license to make, have made, 78 | use, offer to sell, sell, import, and otherwise transfer the Work, 79 | where such license applies only to those patent claims licensable 80 | by such Contributor that are necessarily infringed by their 81 | Contribution(s) alone or by combination of their Contribution(s) 82 | with the Work to which such Contribution(s) was submitted. If You 83 | institute patent litigation against any entity (including a 84 | cross-claim or counterclaim in a lawsuit) alleging that the Work 85 | or a Contribution incorporated within the Work constitutes direct 86 | or contributory patent infringement, then any patent licenses 87 | granted to You under this License for that Work shall terminate 88 | as of the date such litigation is filed. 89 | 90 | 4. Redistribution. You may reproduce and distribute copies of the 91 | Work or Derivative Works thereof in any medium, with or without 92 | modifications, and in Source or Object form, provided that You 93 | meet the following conditions: 94 | 95 | (a) You must give any other recipients of the Work or 96 | Derivative Works a copy of this License; and 97 | 98 | (b) You must cause any modified files to carry prominent notices 99 | stating that You changed the files; and 100 | 101 | (c) You must retain, in the Source form of any Derivative Works 102 | that You distribute, all copyright, patent, trademark, and 103 | attribution notices from the Source form of the Work, 104 | excluding those notices that do not pertain to any part of 105 | the Derivative Works; and 106 | 107 | (d) If the Work includes a "NOTICE" text file as part of its 108 | distribution, then any Derivative Works that You distribute must 109 | include a readable copy of the attribution notices contained 110 | within such NOTICE file, excluding those notices that do not 111 | pertain to any part of the Derivative Works, in at least one 112 | of the following places: within a NOTICE text file distributed 113 | as part of the Derivative Works; within the Source form or 114 | documentation, if provided along with the Derivative Works; or, 115 | within a display generated by the Derivative Works, if and 116 | wherever such third-party notices normally appear. The contents 117 | of the NOTICE file are for informational purposes only and 118 | do not modify the License. You may add Your own attribution 119 | notices within Derivative Works that You distribute, alongside 120 | or as an addendum to the NOTICE text from the Work, provided 121 | that such additional attribution notices cannot be construed 122 | as modifying the License. 123 | 124 | You may add Your own copyright statement to Your modifications and 125 | may provide additional or different license terms and conditions 126 | for use, reproduction, or distribution of Your modifications, or 127 | for any such Derivative Works as a whole, provided Your use, 128 | reproduction, and distribution of the Work otherwise complies with 129 | the conditions stated in this License. 130 | 131 | 5. Submission of Contributions. Unless You explicitly state otherwise, 132 | any Contribution intentionally submitted for inclusion in the Work 133 | by You to the Licensor shall be under the terms and conditions of 134 | this License, without any additional terms or conditions. 135 | Notwithstanding the above, nothing herein shall supersede or modify 136 | the terms of any separate license agreement you may have executed 137 | with Licensor regarding such Contributions. 138 | 139 | 6. Trademarks. This License does not grant permission to use the trade 140 | names, trademarks, service marks, or product names of the Licensor, 141 | except as required for reasonable and customary use in describing the 142 | origin of the Work and reproducing the content of the NOTICE file. 143 | 144 | 7. Disclaimer of Warranty. Unless required by applicable law or 145 | agreed to in writing, Licensor provides the Work (and each 146 | Contributor provides its Contributions) on an "AS IS" BASIS, 147 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 148 | implied, including, without limitation, any warranties or conditions 149 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 150 | PARTICULAR PURPOSE. You are solely responsible for determining the 151 | appropriateness of using or redistributing the Work and assume any 152 | risks associated with Your exercise of permissions under this License. 153 | 154 | 8. Limitation of Liability. In no event and under no legal theory, 155 | whether in tort (including negligence), contract, or otherwise, 156 | unless required by applicable law (such as deliberate and grossly 157 | negligent acts) or agreed to in writing, shall any Contributor be 158 | liable to You for damages, including any direct, indirect, special, 159 | incidental, or consequential damages of any character arising as a 160 | result of this License or out of the use or inability to use the 161 | Work (including but not limited to damages for loss of goodwill, 162 | work stoppage, computer failure or malfunction, or any and all 163 | other commercial damages or losses), even if such Contributor 164 | has been advised of the possibility of such damages. 165 | 166 | 9. Accepting Warranty or Additional Liability. While redistributing 167 | the Work or Derivative Works thereof, You may choose to offer, 168 | and charge a fee for, acceptance of support, warranty, indemnity, 169 | or other liability obligations and/or rights consistent with this 170 | License. However, in accepting such obligations, You may act only 171 | on Your own behalf and on Your sole responsibility, not on behalf 172 | of any other Contributor, and only if You agree to indemnify, 173 | defend, and hold each Contributor harmless for any liability 174 | incurred by, or claims asserted against, such Contributor by reason 175 | of your accepting any such warranty or additional liability. 176 | 177 | END OF TERMS AND CONDITIONS 178 | 179 | APPENDIX: How to apply the Apache License to your work. 180 | 181 | To apply the Apache License to your work, attach the following 182 | boilerplate notice, with the fields enclosed by brackets "[]" 183 | replaced with your own identifying information. (Don't include 184 | the brackets!) The text should be enclosed in the appropriate 185 | comment syntax for the file format. We also recommend that a 186 | file or class name and description of purpose be included on the 187 | same "printed page" as the copyright notice for easier 188 | identification within third-party archives. 189 | 190 | Copyright [yyyy] [name of copyright owner] 191 | 192 | Licensed under the Apache License, Version 2.0 (the "License"); 193 | you may not use this file except in compliance with the License. 194 | You may obtain a copy of the License at 195 | 196 | http://www.apache.org/licenses/LICENSE-2.0 197 | 198 | Unless required by applicable law or agreed to in writing, software 199 | distributed under the License is distributed on an "AS IS" BASIS, 200 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 201 | See the License for the specific language governing permissions and 202 | limitations under the License. 203 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(CalculateROAS) 4 | export(DefaultNatMigModule) 5 | export(DefaultSalesModule) 6 | export(DefaultSearchMediaModule) 7 | export(DefaultTraditionalMediaModule) 8 | export(OptimizeSpend) 9 | export(SimulateAMSS) 10 | export(SimulateAR1) 11 | export(SimulateCorrelated) 12 | export(SimulateDummy) 13 | export(SimulateSinusoidal) 14 | export(kActivityStates) 15 | export(kAllStates) 16 | export(kAvailabilityStates) 17 | export(kBrandStates) 18 | export(kCategoryStates) 19 | export(kFavorabilityStates) 20 | export(kLoyaltyStates) 21 | export(kMarketStates) 22 | export(kSatiationStates) 23 | import(data.table) 24 | -------------------------------------------------------------------------------- /R/attribution.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | utils::globalVariables(c("pop", "revenue", "rep.index", "V1", "total.spend")) 16 | 17 | #' Calculate ROAS or mROAS. 18 | #' 19 | #' This functions takes the original budget settings and a 20 | #' counterfactual budget setting. It reports the expected ratio between 21 | #' the total difference in revenue over all time points and the total 22 | #' difference in media spend over all time points. 23 | #' 24 | #' @param object amss.sim object containing simulated data 25 | #' @param new.budget table of new budgets for each budget period (row) and 26 | #' media channel (column) 27 | #' @param media.names if new.budget is NULL, adjust original budget of the 28 | #' media named here. 29 | #' @param budget.periods budget.periods over which to modify the budget. 30 | #' Default \code{NULL} will lead to all budget periods being modified. 31 | #' @param budget.proportion nonnegative numeric. When \code{new.budget} is 32 | #' NULL, it is calculated by setting the budget of the media channels 33 | #' specified in \code{media.names} to \code{budget.proportion} 34 | #' proportion of the original budget during the budget periods specified 35 | #' in \code{budget.periods}. The default proportion of 0 is used to 36 | #' calculate the average ROAS over the entire spend in the channel. 37 | #' Values such as 0.99 can be used to calculate the marginal ROAS. 38 | #' @param t.start time point to start generating data according to the new 39 | #' settings. 40 | #' @param t.end last time point to generate data according to the new settings. 41 | #' In scenarios with lag, this should extend past the last time point in 42 | #' the modified budget periods in order to include lagged effects in the 43 | #' calculation. 44 | #' @param scaled.pop.size \code{CalculateROAS} scales up the population size to 45 | #' reduce the variability of its estimates. This is equivalent to running 46 | #' the simulation for multiple repetitions to reduce variability. The 47 | #' default value should provide sufficient accuracy in most use cases. 48 | #' Extremely large values may result in numerical issues. 49 | #' @param min.reps integer representing the initial number of datasets to 50 | #' generate from each budget setting. The default value of 2 allows the user 51 | #' to make a rough check that the accuracy is indeed good under the chosen 52 | #' settings. This default was chosen under the assumption that the default 53 | #' \code{scaled.pop.size} is large enough to accurately measure ROAS using 1 54 | #' repetition, with the 2nd being used as confirmation of the accuracy. Higher 55 | #' precision and more accurate measurement of the precision can be achieved 56 | #' with more repetitions. 57 | #' @param max.coef.var numeric, the target coefficient of variation. The 58 | #' function takes additional samples of the ROAS until it runs out of 59 | #' time, attains the target coefficient of variation, or attains the 60 | #' target margin of error. 61 | #' @param max.margin.error numeric, the target margin of error. The function 62 | #' takes additional samples of the ROAS until it runs out of time, 63 | #' attains the target coefficient of variation, or attains the target 64 | #' margin of error. 65 | #' @param max.time numeric, the number of minutes at which to cut off the 66 | #' function from taking additional samples beyond the initial sample 67 | #' generated according to \code{min.reps}. The function takes additional 68 | #' samples of the ROAS until it runs out of time, attains the target 69 | #' coefficient of variation, or attains the target margin of error. The 70 | #' default value of 0 forces the function to use precisely \code{min.reps} 71 | #' repetitions. 72 | #' @param verbose boolean. If TRUE, output measures of the accuracy of the 73 | #' reported ROAS, including the full sample of ROAS values. 74 | #' @return numeric value for ROAS, or, if \code{verbose = TRUE}, a list with 75 | #' the roas, the 95% margin of error, the coefficient of variation, and the 76 | #' sample ROAS values. 77 | #' @export 78 | 79 | CalculateROAS <- function( 80 | object, 81 | new.budget = NULL, 82 | media.names = object$params$media.names, 83 | budget.periods = NULL, 84 | budget.proportion = rep(0, length(media.names)), 85 | t.start = 1, 86 | t.end = object$params$time.n, 87 | scaled.pop.size = 1e18, 88 | min.reps = 2, 89 | max.coef.var = 0.01, max.margin.error = 0.01, max.time = 0, 90 | verbose = FALSE) { 91 | 92 | if (is.null(object$params$media.names) || 93 | length(object$params$media.names) == 0) { 94 | warning("Cannot calculate ROAS: no media channels in this simulation.") 95 | return(NULL) 96 | } 97 | 98 | # Check that the object is an AMSS simulation object. 99 | assertthat::assert_that(inherits(object, "amss.sim")) 100 | 101 | # Get the original budget settings. 102 | orig.budget <- GetBudget(object) 103 | 104 | # Check the other parameters. 105 | if (!is.null(new.budget)) { 106 | assertthat::assert_that(all(dim(new.budget) == dim(orig.budget))) 107 | } 108 | assertthat::assert_that(all(media.names %in% object$params$media.names)) 109 | assertthat::assert_that(all(budget.periods >= 1)) 110 | assertthat::assert_that(all(budget.periods <= nrow(orig.budget))) 111 | assertthat::assert_that(all(budget.proportion >= 0)) 112 | assertthat::assert_that(t.start >= 1) 113 | assertthat::assert_that(t.end >= t.start) 114 | assertthat::assert_that(scaled.pop.size >= 1) 115 | assertthat::assert_that(min.reps >= 1) 116 | assertthat::assert_that(assertthat::is.flag(verbose)) 117 | 118 | # Set the new budget. 119 | if (missing(new.budget) || is.null(new.budget)) { 120 | new.budget <- orig.budget 121 | if (missing(budget.periods) || is.null(budget.periods)) { 122 | budget.periods <- 1:nrow(new.budget) 123 | } 124 | for (iter.media in 1:length(media.names)) { 125 | new.budget[budget.periods, media.names[iter.media]] <- 126 | new.budget[budget.periods, media.names[iter.media]] * 127 | budget.proportion[iter.media] 128 | } 129 | } 130 | 131 | # Modified the object with an updated population size, to reduce runtime. 132 | # Note that, since only values in column "pop" affect the values in the 133 | # regenerated data. That is the only column that needs updating. 134 | orig.pop <- GetPopulation(object) 135 | mod.object <- data.table::copy(object) 136 | lapply(mod.object$data.full, 137 | function(dt) dt[, pop := AdjustPopulation(pop, scaled.pop.size)]) 138 | scaled.pop.size <- mod.object$data.full[[1]][, sum(pop)] 139 | pop.multiplier <- scaled.pop.size / orig.pop 140 | mod.object$params$nat.mig.params$population <- scaled.pop.size 141 | 142 | # Generate data from counterfactual budget settings. 143 | start.time <- Sys.time() 144 | new.data <- GenerateDataUnderNewBudget( 145 | mod.object, new.budget * pop.multiplier, 146 | reps = min.reps, t.start = t.start, t.end = t.end) 147 | # Generate more data from the original budget settings to average out noise. 148 | orig.data <- GenerateDataUnderNewBudget( 149 | mod.object, orig.budget * pop.multiplier, 150 | reps = min.reps, t.start = t.start, t.end = t.end) 151 | 152 | # Calculate the ROAS based on the current sample. 153 | roas.sample <- CalculateSampleROAS(new.data, orig.data) 154 | # Get the estimate. 155 | roas.est <- mean(roas.sample) 156 | # Get its precision as a standard error. 157 | if (min.reps < 2) { 158 | roas.standard.error <- Inf 159 | } else { 160 | roas.standard.error <- sd(roas.sample) / sqrt(length(roas.sample)) 161 | } 162 | # Get the margin of error. 163 | roas.margin.error <- roas.standard.error * qt(0.975, length(roas.sample)) 164 | # Get the coefficient of variation. 165 | roas.coef.var <- roas.standard.error / abs(roas.est) 166 | 167 | # While time is available and the requested precision has not yet been 168 | # achieved, generate additional samples. 169 | counter <- min.reps + 1 170 | while(roas.margin.error > max.margin.error && 171 | roas.coef.var > max.coef.var) { 172 | if (difftime(Sys.time(), start.time, units = "mins") > max.time) { 173 | warning("Warning: requested precision not achieved.") 174 | break 175 | } 176 | print(paste("Running additional sample", counter, "for more accuracy.")) 177 | print(paste(round(difftime(Sys.time(), start.time, units = "mins")), 178 | "minutes elapsed.")) 179 | new.data.1 <- GenerateDataUnderNewBudget( 180 | object = mod.object, new.budget = new.budget * pop.multiplier, 181 | t.start = t.start, t.end = t.end) 182 | orig.data.1 <- GenerateDataUnderNewBudget( 183 | object = mod.object, new.budget = orig.budget * pop.multiplier, 184 | t.start = t.start, t.end = t.end) 185 | roas.sample <- c(roas.sample, 186 | CalculateSampleROAS(new.data.1, orig.data.1)) 187 | roas.est <- mean(roas.sample) 188 | roas.standard.error <- sd(roas.sample) / sqrt(length(roas.sample)) 189 | roas.margin.error <- roas.standard.error * qt(0.975, length(roas.sample)) 190 | roas.coef.var <- roas.standard.error / abs(roas.est) 191 | counter <- counter + 1 192 | } 193 | 194 | # Return the ROAS, plus precision information if verbose = TRUE. 195 | if (verbose) { 196 | return(list(roas = roas.est, 197 | margin.error = roas.margin.error, 198 | coef.var = roas.coef.var, 199 | sample = roas.sample)) 200 | } else { 201 | return(roas.est) 202 | } 203 | } 204 | 205 | #' Calculate ROAS from a pair of datasets. 206 | #' 207 | #' Calculate the ROAS estimated from a sample of datasets generated from two 208 | #' budget settings 209 | #' 210 | #' @param dt1 data.table of data generated from the first budget setting. The 211 | #' data.table must include "revenue" and "total.spend" columns, and have 212 | #' the different datasets indexed by column "rep.index." 213 | #' @param dt2 data.table of data generated from the second budget setting. The 214 | #' data.table must include "revenue" and "total.spend" columns, and have 215 | #' the different datasets indexed by column "rep.index." the number of 216 | #' unique values of "rep.index" in \code{dt1} and \code{dt2} should 217 | #' match. 218 | #' @return vector of ROAS estimates from each pair of sample datasets in dt1 219 | #' and dt2. 220 | #' @keywords internal 221 | 222 | CalculateSampleROAS <- function(dt1, dt2) { 223 | 224 | return((dt1[, sum(revenue), by = rep.index][, V1] - 225 | dt2[, sum(revenue), by = rep.index][, V1]) / 226 | (dt1[, sum(total.spend), by = rep.index][, V1] - 227 | dt2[, sum(total.spend), by = rep.index][, V1])) 228 | } 229 | 230 | #' Generate data under a new budget 231 | #' 232 | #' Simulate multiple datasets from a counterfactual simulation setting with 233 | #' new budget settings. 234 | #' 235 | #' @param object object of class \code{amss.sim} to do prediction on. 236 | #' @param new.budget new budget levels for each media 237 | #' @param response.metric string specifying what observable value to predict. 238 | #' defaults to NULL, which results in entire dataset. Values such as 239 | #' "log(brand.sales)" will make the prediction function return the 240 | #' average log(brand.sales) over all reps, for ex. 241 | #' @param reps number of replicates to generate 242 | #' @param t.start time point at which to start generating new data 243 | #' @param t.end time point at which to stop generating new data 244 | #' @return The list of all generated datasets or a vector of averaged values. 245 | #' @keywords internal 246 | 247 | GenerateDataUnderNewBudget <- function( 248 | object, 249 | new.budget = GetBudget(object), 250 | response.metric = NULL, 251 | reps = 1, 252 | t.start = 1, 253 | t.end = object$params$time.n) { 254 | 255 | if (is.null(object$params$media.names) || 256 | length(object$params$media.names) == 0) { 257 | warning("No media channels to adjust") 258 | new.params <- c(list(starting.dts = list()), 259 | object$params) 260 | } else { 261 | # Keep original data from before start time. 262 | if (t.start > 1) { 263 | starting.dts <- data.table::copy(object$data.full[1:(t.start - 1)]) 264 | } else { 265 | starting.dts <- list() 266 | } 267 | new.params <- c( 268 | list(starting.dts = starting.dts), 269 | object$params) 270 | # Adjust data generating end time. 271 | new.params$time.n <- t.end 272 | # Adjust media budgets. 273 | for (iter.media in 1:length(new.params$media.params)) { 274 | new.params$media.params[[iter.media]]$budget <- new.budget[, iter.media] 275 | } 276 | } 277 | 278 | # Generate data. 279 | new.data <- lapply( 280 | 1:reps, 281 | function(r) SurfaceData( 282 | do.call(`SimulateData`, new.params[formalArgs(`SimulateData`)]), 283 | new.params$names.agg.const, 284 | new.params$names.agg.sum)[, rep.index := r]) 285 | new.data <- rbindlist(new.data) 286 | if (is.null(response.metric)) { 287 | return(new.data) 288 | } else { 289 | return(new.data[, 290 | eval(ParseT(paste0("mean(", response.metric, ")"))), 291 | by = "time.index"][, V1]) 292 | } 293 | } 294 | 295 | #' Adjust population vector to a new total 296 | #' 297 | #' Adjust population proportionally to a new total population size, rounding up 298 | #' when necessary. 299 | #' 300 | #' @param orig.pop original population vector 301 | #' @param new.total.pop new total population size 302 | #' @return new population vector of class integer 303 | #' @keywords internal 304 | 305 | AdjustPopulation <- function(orig.pop, new.total.pop) { 306 | 307 | pop.multiplier <- ceiling(new.total.pop / sum(orig.pop)) 308 | return(orig.pop * pop.multiplier) 309 | } 310 | -------------------------------------------------------------------------------- /R/migrate.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | utils::globalVariables(c("pop", "pop.in", "pop.out")) 16 | 17 | #' Apply transition matrix to vector of population counts by state. 18 | #' 19 | #' Applies transition matrix to vector of population counts by state. 20 | #' Option to select transition matrix that matches length of vector when given 21 | #' multiple transition matrices. 22 | #' 23 | #' @param vector.counts vector of counts in each state 24 | #' @param transition.matrices transition matrix, or list of transition 25 | #' matrices. When multiple transition matrices are supplied, the first 26 | #' transition matrix whose dimensionality matches the number of states 27 | #' in vector.counts is used. 28 | #' @return number of individuals in each state after migration 29 | #' @keywords internal 30 | 31 | ApplyTransitionMatrix <- function(vector.counts, transition.matrices) { 32 | 33 | # Given a transition matrix, simulate the migration process. 34 | if (!is.list(transition.matrices)) { 35 | # Check inputs. 36 | if (length(vector.counts) != nrow(transition.matrices)) { 37 | stop("Dimension mismatch between vector and transition matrix.") 38 | } 39 | if (length(vector.counts) == 1 || 40 | identical(transition.matrices, diag(nrow(transition.matrices)))) { 41 | return(vector.counts) 42 | } 43 | 44 | # Calculate migration behavior of the population originating from each 45 | # segment 46 | migrated.pop <- integer(length(vector.counts)) 47 | for (iter in 1:length(vector.counts)) { 48 | migrated.pop <- migrated.pop + 49 | drop(RMultinom(1, vector.counts[iter], transition.matrices[iter, ])) 50 | } 51 | 52 | # Return new population segmentation. 53 | return(migrated.pop) 54 | } 55 | 56 | # If multiple transition matrices are provided, choose the correct one 57 | # based on the dimensionality of the matrix and the length of the vector of 58 | # counts. 59 | num.states <- sapply(transition.matrices, nrow) 60 | transition.matrix <- 61 | transition.matrices[[match(length(vector.counts), num.states)]] 62 | return(ApplyTransitionMatrix(vector.counts, transition.matrix)) 63 | } 64 | 65 | #' Simulate migration in a single dimension of population segmentation. 66 | #' 67 | #' Simulate migration of indivduals between different states in single 68 | #' dimension of population segmentation, such as "brand favorability." 69 | #' 70 | #' @param data.dt data.table with rows representing population segments and 71 | #' columns representing specific variables. 72 | #' @param migrating.pop.size migrating population size 73 | #' @param migration.dim name dimension of migration, must be a column of 74 | #' kAllStates. 75 | #' @param transition.matrix transition matrix specifying probabilities of 76 | #' migration between states. 77 | #' @return \code{invisible(NULL)}. \code{data.dt} is updated by reference. 78 | #' @keywords internal 79 | 80 | MigrateMarginal <- function(data.dt, migrating.pop.size, 81 | migration.dim, transition.matrix) { 82 | 83 | # Check input. 84 | func.env <- environment() 85 | data.dt[, pop.out := func.env$migrating.pop.size] 86 | if (!(migration.dim %in% names(kAllStates))) { 87 | stop("Invalid dimension of migration.") 88 | } 89 | 90 | if (migration.dim %in% c("market", "satiation")) { 91 | # For market and satiation state, make sure segments that are 92 | # not inactive also transition to the 'out.market' or 'satiated' state, 93 | # simultaneously becoming inactive. 94 | 95 | # The transition matrix for these cases is specified by column, i.e., 96 | # destination state 97 | expanded.transition.matrix <- matrix( 98 | # (out.market XOR unsatiated), inactive 99 | c(transition.matrix[, 1], transition.matrix[2, 1], 100 | transition.matrix[2, 1], 101 | # in.market, unsatiated, inactive 102 | transition.matrix[, 2], 0, 0, 103 | # in.market, unsatiated, exploratory 104 | 0, 0, transition.matrix[2, 2], 0, 105 | # in.market, unsatiated, purchase 106 | 0, 0, 0, transition.matrix[2, 2]), 4) 107 | transition.matrices <- list(transition.matrix, expanded.transition.matrix) 108 | # Activity state (dimension 3) may change. 109 | changing.dimensions <- c(migration.dim, "activity") 110 | } else if (migration.dim %in% c("activity", "favorability", "availability")) { 111 | transition.matrices <- list(transition.matrix, matrix(1)) 112 | changing.dimensions <- migration.dim 113 | } else { # Special case for loyalty transitions. 114 | # Favorable consumers transition freely. 115 | # Not favorable consumers cannot become loyal. Thus, in the restricted 116 | # transition matrix, the probability of becoming loyal is reassigned to 117 | # becoming a switcher. 118 | restricted.transition.matrix <- 119 | # Take the original transition probabilities of becoming a switcher or 120 | # competitor-loyal. 121 | transition.matrix[c(1, 3), c(1, 3)] + 122 | # Instead of becoming loyal, become a switcher 123 | matrix(c(transition.matrix[c(1, 3), 2], 0, 0), 2) 124 | transition.matrices <- list(transition.matrix, restricted.transition.matrix) 125 | changing.dimensions <- migration.dim 126 | } 127 | data.dt[, 128 | pop.in := ApplyTransitionMatrix(pop.out, transition.matrices), 129 | by = eval(setdiff(key(data.dt), changing.dimensions))] 130 | data.dt[, pop := pop - pop.out + pop.in] 131 | return(invisible(NULL)) 132 | } 133 | 134 | #' Simulate migration in multiple dimensions of population segmentation. 135 | #' 136 | #' Perform successive migrations of consumers between population segments, with 137 | #' each migration focusing on changes in a particular dimension of population 138 | #' segmentation. 139 | #' 140 | #' @param data.dt data.table with rows representing population segments and 141 | #' columns representing specific variables. 142 | #' @param migrating.pop.size migrating population size 143 | #' @param migration.dims a character vector of dimensions of migration, by 144 | #' name. 145 | #' @param transition.matrices a list of transition matrices for each dimension. 146 | #' @return \code{invisible(NULL)}. \code{data.dt} is updated by reference. 147 | #' @keywords internal 148 | 149 | MigrateMultiple <- function(data.dt, migrating.pop.size, 150 | migration.dims = character(), 151 | transition.matrices = list()) { 152 | 153 | # Check input. 154 | stopifnot(length(transition.matrices) == length(migration.dims)) 155 | 156 | # Perform each migration in sequence. 157 | if (length(migration.dims) > 0) { 158 | for (iter.dim in 1:length(migration.dims)) { 159 | MigrateMarginal(data.dt, migrating.pop.size, migration.dims[iter.dim], 160 | transition.matrices[[iter.dim]]) 161 | migrating.pop.size <- data.dt[, pop.in] 162 | } 163 | } 164 | return(invisible(NULL)) 165 | } 166 | -------------------------------------------------------------------------------- /R/misc_helper.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | #' Define the Hill transformation function. 16 | #' 17 | #' The Hill function is one option for parameterizing a flexible set of S-shaped 18 | #' curves. 19 | #' 20 | #' @param x original input. 21 | #' @param ec effective concentration parameter. 22 | #' @param slope slope parameter 23 | #' @param beta vertical scale parameter, defaults to 1 24 | #' @return tranformed value = beta / (1 + (x / ec) ^ (-slope)) 25 | #' @keywords internal 26 | 27 | HillTrans <- function(x, ec, slope, beta = 1) { 28 | 29 | # check input 30 | assertthat::assert_that(is.numeric(x)) 31 | 32 | # If x is vector, do calculation. 33 | if (is.null(dim(x))) { 34 | assertthat::assert_that(is.numeric(ec), ec >= 0) 35 | assertthat::assert_that(is.numeric(slope)) 36 | assertthat::assert_that(is.numeric(beta)) 37 | return(beta / (1 + (x / ec) ^ (-slope))) 38 | } 39 | 40 | # Else, x has columns. Calculate HillTrans for each column. 41 | x <- as.matrix(x) 42 | ec <- CheckLength(ec, ncol(x)) 43 | slope <- CheckLength(slope, ncol(x)) 44 | beta <- CheckLength(beta, ncol(x)) 45 | return.val <- as.matrix(sapply( 46 | 1:ncol(x), 47 | function(iter) HillTrans(x[, iter], ec[iter], slope[iter], beta[iter]))) 48 | colnames(return.val) <- colnames(x) 49 | return(return.val) 50 | } 51 | 52 | #' Paste with "." separator. 53 | #' 54 | #' Function to simplify pasting with . as separator. 55 | #' 56 | #' @param ... vector of strings to concatenate. 57 | #' @return concatenated string. 58 | #' @keywords internal 59 | 60 | PasteD <- function(...) { 61 | 62 | paste(..., sep = '.') 63 | } 64 | 65 | #' Parse text string. 66 | #' 67 | #' Shorthand for parse(text = ...), frequently used with data.table This 68 | #' saves us from having to redo row selection in the env argument of 69 | #' EvalText(). 70 | #' 71 | #' @param text string to be sent as \code{text} argument to \code{parse}. 72 | #' @return the text as an expression, result of calling 73 | #' \code{parse(text = text)}. 74 | #' @keywords internal 75 | #' 76 | #' @examples 77 | #' dt <- data.table::as.data.table(mtcars) 78 | #' colname <- "mpg" 79 | #' dt[1:5, eval(amss:::ParseT(colname))] 80 | #' dt[, (amss:::PasteD(colname, "plus1")) := eval(amss:::ParseT(colname)) + 1] 81 | #' 82 | #' @note 83 | #' Including outer \code{eval()} call in the shorthand caused errors, 84 | #' and needs to be done separately. 85 | 86 | ParseT <- function(text) { 87 | 88 | return(parse(text = text)) 89 | } 90 | 91 | #' Parse and evaluate a text string. 92 | #' 93 | #' Shorthand for eval(parse(text = x, env)), frequently used with data.table, 94 | #' with env set to the data.table. 95 | #' 96 | #' @param x string to be sent as \code{text} argument to \code{parse}. 97 | #' @param env environment to use for evaluation. the default parent.frame() 98 | #' refers to the calling environment. See note for further details. 99 | #' @return the evaluated expression \code{eval(parse(text = x, env))}. 100 | #' @keywords internal 101 | #' 102 | #' @examples 103 | #' # Example 1 104 | #' dt <- data.table::as.data.table(mtcars) 105 | #' colname <- "mpg" 106 | #' dt[, amss:::EvalText(colname, dt)] 107 | #' dt[, (amss:::PasteD(colname, "plus1")) := amss:::EvalText(colname, dt) + 1] 108 | #' 109 | #' # Example 2. 110 | #' x <- 1 111 | #' fn <- function() { 112 | #' x <- 2 113 | #' return(c(amss:::EvalText("x"), amss:::EvalText("x", parent.frame()))) 114 | #' } 115 | #' fn() 116 | #' 117 | #' @note 118 | #' \code{parent.frame()} is a good default for env, but may lead to unusual 119 | #' behavior if passed to \code{EvalText()} explicitly. Default arguments are 120 | #' evaluated inside the execution environment of the function where they 121 | #' are used. However, explicitly passed arguments are evaluated inside the 122 | #' calling environment instead. Thus, in Example 2, \code{EvalText("x")} 123 | #' evaluates \code{parent.frame()} from within the execution environment of 124 | #' \code{EvalText()}, and finds the execution environment of \code{fn()}, where 125 | #' \code{x = 2}. This is the generally desired behavior. However, 126 | #' \code{EvalText("x", parent.frame())} evaluates \code{parent.frame()} from 127 | #' within the calling environment of \code{EvalText()}, i.e. from within the 128 | #' execution environment of \code{fn()}. This gives the global environment, 129 | #' where \code{x = 1}. 130 | 131 | EvalText <- function(x, env = parent.frame()) { 132 | 133 | return(eval(parse(text = x), env)) 134 | } 135 | 136 | #' Check and adjust object length. 137 | #' 138 | #' Function that checks length of x. It may throw a stop(), warning(), and/or 139 | #' repeat the variable to create the desired length. 140 | #' 141 | #' @param x object to check/adjust length of 142 | #' @param len desired length of object 143 | #' @param hard.stop if TRUE, stop when length(x) is neither 1 nor len. else, 144 | #' throw a warning and use repeat() to adjust length of x. 145 | #' @param warn.single if TRUE, through a warning when length(x) is 1 and it is 146 | #' being extended to a new length. 147 | #' @param par.name Character, used in the warning or stop message to indicate 148 | #' which parameter this warning is meant for. 149 | #' @return x updated to have length len, or throws exception 150 | #' @keywords internal 151 | 152 | CheckLength <- function(x, len, hard.stop = TRUE, warn.single = FALSE, 153 | par.name = character()) { 154 | 155 | # If x has the correct length, keep it as is. 156 | if (length(x) == len) { 157 | return(x) 158 | } 159 | 160 | # If x has length 1, repeat it to the desired length. 161 | if (length(x) == 1L) { 162 | if (isTRUE(warn.single)) { 163 | warning(paste(c("repeating argument", par.name, 164 | "from single value to vector of requested length."), 165 | collapse = " ")) 166 | } 167 | return(rep(x, len)) 168 | } 169 | 170 | # Otherwise, signal a problem with the vector length. 171 | if (hard.stop) { 172 | stop(paste(c("Argument", par.name, "of incorrect length"), 173 | collapse = " ")) 174 | } 175 | warnings(paste(c("Argument", par.name, 176 | "of incorrect length. repeating/truncating."), 177 | collapse = " ")) 178 | return(rep(x, length.out = len)) 179 | } 180 | 181 | #' Calculate the product of population segmentation dimension-specific factors. 182 | #' 183 | #' Multiplies factors corresponding to dimensions of segmentation. 184 | #' 185 | #' @param multiplicand.list list of named numeric vectors. Each vector 186 | #' corresponds to the named dimension of population segmentation. It 187 | #' specifies the value assigned to every state possible in that 188 | #' dimension. Dimensions other than 'activity', 'favorability', 189 | #' 'loyalty', and 'availailability' are ignored. Dimensions missing from 190 | #' the list do not affect the product. 191 | #' @param starting.multiplicand numeric constant, additional factor to multiply 192 | #' every product by. Default 1. 193 | #' @return numeric vector. For each population segment, the vector holds the 194 | #' product of multiplying all factors corresponding to that segment. 195 | #' @keywords internal 196 | 197 | MultiplyBySegment <- function( 198 | multiplicand.list = list(), starting.multiplicand = 1) { 199 | 200 | # Check parameters. 201 | CheckListNames(multiplicand.list) 202 | assertthat::assert_that(all(sapply(multiplicand.list, is.numeric))) 203 | assertthat::assert_that(is.numeric(starting.multiplicand)) 204 | 205 | if (length(multiplicand.list) == 0) { 206 | return(starting.multiplicand) 207 | } 208 | 209 | # Perform multiplication. 210 | for (iter.dim in names(multiplicand.list)) { 211 | multiplicand.list[[iter.dim]] <- 212 | multiplicand.list[[iter.dim]][kAllStates[[iter.dim]]] 213 | } 214 | return(Reduce(`*`, multiplicand.list, starting.multiplicand)) 215 | } 216 | 217 | #' Read entry from repeated vector. 218 | #' 219 | #' Read an entry of a vector, under the assumption that it repeats to the 220 | #' necessary length. 221 | #' 222 | #' @param v the vector being read 223 | #' @param idx the index to read the value from. 224 | #' @return the \code{idx}-th entry of \code{v}, under the assumption that 225 | #' \code{v} repeats as necessary to reach length \code{idx}. 226 | #' @keywords internal 227 | 228 | ReadRepeatingVector <- function(v, idx) { 229 | 230 | assertthat::assert_that(is.numeric(idx), idx >= 1) 231 | return(v[(idx - 1) %% length(v) + 1]) 232 | } 233 | 234 | #' Capitalize the first letter of a string. 235 | #' 236 | #' Capitalize the first letter of a string. This function is meant for single 237 | #' strings only. 238 | #' 239 | #' @param s the string to be capitalized. 240 | #' @return the string \code{s} with its first letter capitalized. 241 | #' @keywords internal 242 | 243 | Capitalize <- function(s) { 244 | 245 | assertthat::assert_that(assertthat::is.string(s)) 246 | paste0(toupper(substring(s, 1, 1)), substring(s, 2)) 247 | } 248 | 249 | #' Check the names of a list. 250 | #' 251 | #' Check that a list has names, and that all these names are valid. 252 | #' 253 | #' @param l the list to be checked. 254 | #' @param valid.names a character vector of valid nmaes. 255 | #' @return This function checks the value of \code{l} and will signal an error 256 | #' if the check fails. Else, it returns \code{TRUE}. 257 | #' @keywords internal 258 | 259 | CheckListNames <- function(l, valid.names = colnames(kAllStates)) { 260 | 261 | assertthat::assert_that(is.list(l)) 262 | assertthat::assert_that(is.character(valid.names)) 263 | if (length(l) > 0) { 264 | assertthat::assert_that(!is.null(names(l))) 265 | assertthat::assert_that(all(names(l) %in% valid.names)) 266 | } 267 | return(TRUE) 268 | } 269 | -------------------------------------------------------------------------------- /R/module_natural_migration.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | utils::globalVariables(c("pop", "satiation", ".", "market", "time.index")) 16 | 17 | #' Model natural consumer behavior in the absence of marketing interventions. 18 | #' 19 | #' This function models natural consumer behavior in the absence of marketing 20 | #' interventions. In particular, it models changes in consumer mindset over 21 | #' time that are outside of advertiser control, such as seasonal changes. 22 | #' 23 | #' @param data.dt data.table with rows corresponding to segments and columns 24 | #' corresponding to variables; column \code{pop} for the number of 25 | #' people in each segment must be included. 26 | #' @param population constant specifying population size 27 | #' @param market.rate.trend the trend in market size, written as the proportion 28 | #' of the population to be considered potentially in the market, pending 29 | #' seasonal adjustments. If a vector, should match time.n in length. 30 | #' Defaults to 1, for full population participation in market. 31 | #' @param market.rate.seas the seasonal variation in market size, written as 32 | #' the proportion of the post-market-trend population in the market. For 33 | #' example, for market.rate.trend = 0.8 and market.rate.seas = 0.5, 34 | #' seasonal variation leaves 40% = 50% of the 80% of the population 35 | #' potentially in market according to market.rate.trend actually in 36 | #' market. If a vector, should match time.n in length. Defaults to 1 for 37 | #' full population participation in market. 38 | #' @param sat.decay single numeric value between 0 and 1, representing the 39 | #' geometric decay rate at which satiated individuals become unsatiated. 40 | #' Defaults to 1 for satiation lasting 1 time period for all 41 | #' individuals. 42 | #' @param prop.activity vector of nonnegative values summing to 1, representing 43 | #' the proportion of the population to be assigned to each activity 44 | #' state, given they are "responsive," i.e., "in.market" and 45 | #' "unsatiated." 46 | #' @param prop.favorability vector of nonnegative values summing to 1, 47 | #' representing the proportion of the population to be assigned to each 48 | #' favorability state, given they are not "loyal." 49 | #' @param prop.loyalty vector of nonnegative values summing to 1, representing 50 | #' the proportion of the population to be assigned to each loyalty 51 | #' state. 52 | #' @param prop.availability vector of nonnegative values summing to 1, 53 | #' representing the proportion of the population to be assigned to each 54 | #' availability state. 55 | #' @param transition.matrices list of matrices for each dimension of population 56 | #' segmentation that may be affected by marketing interventions. A named 57 | #' list with members 'activity', 'favorability', 'loyalty', and 58 | #' 'availability' is expected. By default, any missing members will have 59 | #' no effect. The transition matrices represent natural migration in 60 | #' these dimensions, and control how quickly the population returns to 61 | #' its equilibrium allocation across segments after marketing 62 | #' interventions. 63 | #' @return \code{invisible(NULL)}. \code{data.dt} is updated by reference. 64 | #' @export 65 | 66 | DefaultNatMigModule <- function( 67 | data.dt, 68 | population, 69 | market.rate.trend = 1, market.rate.seas = 1, 70 | sat.decay = 1, 71 | prop.activity = rep(1 / length(kActivityStates), length(kActivityStates)), 72 | prop.favorability = rep(1 / length(kFavorabilityStates), 73 | length(kFavorabilityStates)), 74 | prop.loyalty = rep(1 / length(kLoyaltyStates), length(kLoyaltyStates)), 75 | prop.availability = rep(1 / length(kAvailabilityStates), 76 | length(kAvailabilityStates)), 77 | transition.matrices = list()) { 78 | 79 | # Update time index. 80 | data.dt[, time.index := time.index + 1] 81 | curr.time <- data.dt[1, time.index] 82 | 83 | # Check parameters. 84 | if (curr.time == 1) { 85 | assertthat::assert_that(is.numeric(population), length(population) == 1, 86 | population > 0) 87 | assertthat::assert_that(is.numeric(market.rate.trend), 88 | is.numeric(market.rate.seas)) 89 | assertthat::assert_that(is.numeric(sat.decay), length(sat.decay) == 1, 90 | sat.decay >= 0, sat.decay <= 1) 91 | for (iter.dim in setdiff(colnames(kAllStates), c("market", "satiation"))) { 92 | curr.prop <- get(PasteD("prop", iter.dim)) 93 | curr.states <- get(paste0("k", Capitalize(iter.dim), "States")) 94 | assertthat::assert_that( 95 | is.numeric(curr.prop), length(curr.prop) == length(curr.states), 96 | all(curr.prop >= 0), all(curr.prop <= 1)) 97 | } 98 | CheckListNames(transition.matrices) 99 | } 100 | 101 | # Calculate market rate. 102 | if (max(length(market.rate.trend), length(market.rate.seas)) == 1) { 103 | market.rate <- market.rate.trend * market.rate.seas 104 | } else { 105 | market.rate.trend <- rep(market.rate.trend, length = curr.time) 106 | market.rate.seas <- rep(market.rate.seas, length = curr.time) 107 | market.rate <- market.rate.trend[curr.time] * 108 | market.rate.seas[curr.time] 109 | assertthat::assert_that(market.rate >= 0, market.rate <= 1) 110 | } 111 | 112 | # If this is the first timepoint, initialize population. 113 | if (curr.time == 1) { 114 | InitPop(data.dt, population, market.rate, 115 | prop.activity, prop.favorability, 116 | prop.loyalty, prop.availability) 117 | } 118 | # Update each dimension of population segmentation, one at a time. 119 | UpdateMarket(data.dt, market.rate, prop.activity) 120 | Desatiate(data.dt, sat.decay, prop.activity) 121 | UpdateMarketingResponsiveStates(data.dt, transition.matrices) 122 | 123 | return(invisible(NULL)) 124 | } 125 | 126 | #' Initialize population segmentation. 127 | #' 128 | #' @param data.dt data.table containing all state-related data 129 | #' @param pop.total total population 130 | #' @param market.rate target proportion of consumers in 'in-market' market 131 | #' state. 132 | #' @param prop.activity vector of nonnegative values summing to 1, representing 133 | #' the proportion of the population to be assigned to each activity 134 | #' state, given they are "responsive," i.e., "in.market" and 135 | #' "unsatiated." 136 | #' @param prop.favorability vector of nonnegative values summing to 1, 137 | #' representing the proportion of the population to be assigned to each 138 | #' favorability state, given they are not "loyal." 139 | #' @param prop.loyalty vector of nonnegative values summing to 1, representing 140 | #' the proportion of the population to be assigned to each loyalty 141 | #' state. 142 | #' @param prop.availability vector of nonnegative values summing to 1, 143 | #' representing the proportion of the population to be assigned to each 144 | #' availability state. 145 | #' @return \code{invisible(NULL)}. \code{data.dt} is updated by reference. 146 | #' @keywords internal 147 | 148 | InitPop <- function( 149 | data.dt, pop.total, 150 | market.rate = 1, 151 | prop.activity = rep(1 / length(kActivityStates), length(kActivityStates)), 152 | prop.favorability = rep(1 / length(kFavorabilityStates), 153 | length(kFavorabilityStates)), 154 | prop.loyalty = rep(1 / length(kLoyaltyStates), 155 | length(kLoyaltyStates)), 156 | prop.availability = rep(1 / length(kAvailabilityStates), 157 | length(kAvailabilityStates))) { 158 | 159 | # Check input. 160 | stopifnot(data.dt[, sum(pop)] == 0) 161 | 162 | # Start everyone together in one state. 163 | # Everyone is unsatiated. 164 | # Start as favorable so that prop.loyalty will be applied to everyone. 165 | # Start out of market so that `UpdateMarket` will assign market and 166 | # activity states to everyone in specified proportions. 167 | data.dt[.("out.market", "unsatiated", "inactive", 168 | "favorable", "switcher", "average"), 169 | pop := pop.total] 170 | UpdateMarket(data.dt, market.rate, prop.activity) 171 | MigrateMultiple(data.dt, data.dt[, pop], 172 | c("loyalty", "favorability", "availability"), 173 | list(matrix(prop.loyalty, length(kLoyaltyStates), 174 | length(kLoyaltyStates), TRUE), 175 | matrix(prop.favorability, length(kFavorabilityStates), 176 | length(kFavorabilityStates), TRUE), 177 | matrix(prop.availability, length(kAvailabilityStates), 178 | length(kAvailabilityStates), TRUE))) 179 | return(invisible(NULL)) 180 | } 181 | 182 | #' Updates in/out of market status by moving mimimal population in/out of the 183 | #' market necessary to match on requested proportion of "in.market" 184 | #' individuals. 185 | #' 186 | #' @param data.dt data.table containing all state-related data 187 | #' @param target.rate target proportion of consumers 'in-market' 188 | #' @param prop.activity single value between 0 and 1, representing proportion 189 | #' of population to be assigned to each activity state, given they are 190 | #' "responsive," i.e., "in.market" and "unsatiated." 191 | #' @return \code{invisible(NULL)}. \code{data.dt} is updated by reference. 192 | #' @keywords internal 193 | 194 | UpdateMarket <- function( 195 | data.dt, target.rate, 196 | prop.activity = rep(1 / length(kActivityStates), length(kActivityStates))) { 197 | 198 | # Calculate current market rate 199 | current.rate <- data.dt[market == "in.market", sum(pop)] / data.dt[, sum(pop)] 200 | 201 | # Case: target.rate > current.rate, so move population from "out.of.market" 202 | # to "in.market" state. 203 | if (target.rate > current.rate) { 204 | mig.rate <- (target.rate - current.rate) / (1 - current.rate) 205 | MigrateMultiple( 206 | data.dt, data.dt[, pop * (market == "out.market")], 207 | c("market", "activity"), 208 | list(matrix(c(1 - mig.rate, mig.rate, 0, 1), 2, 2, TRUE), 209 | matrix(prop.activity, 3, 3, TRUE))) 210 | } 211 | 212 | # Case: target.rate < current.rate, so move population from "in.market" to 213 | # "out.of.market" state. 214 | if (target.rate < current.rate){ 215 | mig.rate <- (current.rate - target.rate) / current.rate 216 | MigrateMarginal( 217 | data.dt, data.dt[, pop * (market == "in.market")], 218 | "market", 219 | matrix(c(1, 0, 220 | mig.rate, 1 - mig.rate), 221 | 2, 2, TRUE)) 222 | } 223 | return(invisible(NULL)) 224 | } 225 | 226 | #' Implement desatiation. 227 | #' 228 | #' @param data.dt data.table to update 229 | #' @param sat.decay rate for the geometric decay of satiation 230 | #' @param prop.activity proportion of population assigned to each activity 231 | #' state, given that they are responsive. 232 | #' @return \code{invisible(NULL)}. \code{data.dt} is updated by reference. 233 | #' @keywords internal 234 | #' 235 | #' @note 236 | #' Satiation has geometric decay with rate \code{sat.decay}. Thus, 237 | #' during any time interval, \code{sat.decay} proportion of currently 238 | #' satiated individuals desatiate. Individuals put into a responsive state 239 | #' by desatiation are assigned activity states at rates defined by 240 | #' prop.activity. 241 | 242 | Desatiate <- function( 243 | data.dt, sat.decay, 244 | prop.activity = rep(1 / length(kActivityStates), length(kActivityStates))) { 245 | 246 | # Currently satiated individuals become unsatiated with probability 247 | # "sat.decay". If the desatiated individuals were "in.market", their activity 248 | # state also updates. 249 | MigrateMultiple( 250 | data.dt, data.dt[, pop * (satiation == "satiated")], 251 | c("satiation", "activity"), 252 | list(matrix(c(1 - sat.decay, sat.decay, 0, 1), 2, 2, TRUE), 253 | matrix(prop.activity, 3, 3, TRUE))) 254 | return(invisible(NULL)) 255 | } 256 | 257 | #' Update segmentation in marketing-responsive states (activity, 258 | #' favorability, loyalty, and availability) according to specified 259 | #' transition matrices. 260 | #' 261 | #' @param data.dt data.table with column 'pop' for population segment size. 262 | #' @param transition.matrices list of transition matrices for each dimension of 263 | #' population segmentation that may be affected by marketing 264 | #' interventions. A named list with members 'activity', 'favorability', 265 | #' 'loyalty', and 'availability' is expected. By default, any missing 266 | #' members will have no effect. 267 | #' @return \code{invisible(NULL)}. \code{data.dt} is updated by reference. 268 | #' @keywords internal 269 | 270 | UpdateMarketingResponsiveStates <- function( 271 | data.dt, transition.matrices = list()) { 272 | 273 | # Check input. 274 | CheckListNames(transition.matrices, 275 | setdiff(colnames(kAllStates), c("market", "satiation"))) 276 | 277 | # Perform migration. 278 | MigrateMultiple(data.dt, data.dt[, pop], 279 | names(transition.matrices), 280 | transition.matrices) 281 | return(invisible(NULL)) 282 | } 283 | -------------------------------------------------------------------------------- /R/module_sales.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | utils::globalVariables(c( 16 | "time.index", "pop", "brand.sales", "competitor.sales", "revenue", 17 | "profit", "total.spend")) 18 | 19 | #' Model advertiser and competitor sales. 20 | #' 21 | #' Simulate consumer purchase behavior, and thus the advertiser's and its 22 | #' competitors' sales. 23 | #' 24 | #' @param data.dt data.table with rows corresponding to population segments and 25 | #' columns corresponding to specific variables 26 | #' @param price numeric vector of product price over time. If the vector is 27 | #' shorter than the number of timepoints, it is repeated as necessary. 28 | #' @param mean.price numeric scaler, the mean of price over time. Defaults to 29 | #' zero. 30 | #' @param advertiser.demand.intercept list of numeric vectors corresponding to 31 | #' each brand state (favorability, loyalty, and availability). The 32 | #' product of multiplicands corresponding to a particular segment with 33 | #' 'purchase' activity state is the probability consumers in that 34 | #' segment will purchase the advertiser's product if the price is 35 | #' mean.price and there is no competition. Missing members of the list have no 36 | #' effect on the calculation. 37 | #' @param advertiser.demand.slope list of numeric vectors corresponding to each 38 | #' brand state (favorability, loyalty, and availability). The product of 39 | #' multiplicands corresponding to a particular segment with 'purchase' 40 | #' activity state is the linear decrease in the probability consumers in 41 | #' that segment will purchase the advertiser's product when the price 42 | #' increases by 1, when there is no competition. Missing members of the 43 | #' list have no effect on the calculation. 44 | #' @param competitor.demand.max list of numeric vectors corresponding to each 45 | #' brand state (favorability, loyalty, and availability). The product of 46 | #' multiplicands corresponding to a particular segment with 'purchase' 47 | #' activity state is the probability consumers in that segment will 48 | #' purchase a competitor's product when advertiser's product is too 49 | #' expensive to be a feasible choice. Missing members of the list have 50 | #' no effect on the calculation. 51 | #' @param competitor.demand.replacement list of numeric vectors corresponding 52 | #' to each brand state (favorability, loyalty, and availability). The 53 | #' product of multiplicands corresponding to a particular segment 54 | #' specifies the degree to which advertiser and competitor sales are 55 | #' replacements for each other. At 1, competitor sales are unaffected by 56 | #' advertiser pricing, and competitor sales replace advertiser sales to 57 | #' the greatest degree possible. At 0, advertiser sales are unaffected 58 | #' by the presence of the competitor, and advertiser sales replace 59 | #' competitor sales to the greatest degree possible. Thus, a reasonble 60 | #' interpretation of consumer loyalty might set this parameter to 61 | #' \code{list(loyalty = c(0.5, 0.1, 0.9)}. Missing members of the list 62 | #' have no effect on the calculation. 63 | #' @param purchase.quantity.intercept numeric, at least 1. Represents the 64 | #' average number of units bought by each consumer purchasing from the 65 | #' advertiser's brand, if price is mean.price. 66 | #' @param purchase.quantity.slope numeric, generally >= 0. Represents the 67 | #' decrease in the average purchase quantity per consumer purchasing 68 | #' from the advertiser's brand given a unit increase in price. Missing 69 | #' members of the list have no effect on the calculation. 70 | #' @param purchase.quantity.competitor average number of units bought by 71 | #' consumers purchasing a comeptitor's product. Must be at the least the 72 | #' default value of 1. 73 | #' @param unit.cost numeric greater than 0, cost of goods sold, for one unit of 74 | #' the advertiser's product. 75 | #' @param advertiser.transitions list of transition matrices for each brand 76 | #' state, specifying post-purchase changes in consumer mindset for those 77 | #' who purchased the advertiser's brand. A named list with members 78 | #' 'favorability', 'loyalty', and 'availability' is expected. Any 79 | #' missing members will have no effect. The default value, \code{list()} 80 | #' results in no post-purchase migration. 81 | #' @param competitor.transitions list of transition matrices for each brand 82 | #' state, specifying post-purchase changes in consumer mindset for those 83 | #' who purchased a competitor's brand. A named list with members 84 | #' 'favorability', 'loyalty', and 'availability' is expected. Any 85 | #' missing members will have no effect. The default value, \code{list()} 86 | #' results in no post-purchase migration. 87 | #' @return \code{invisible(NULL)}. \code{data.dt} updated by reference. 88 | #' @export 89 | 90 | DefaultSalesModule <- function( 91 | data.dt, price, mean.price = 0, 92 | advertiser.demand.intercept = list(), 93 | advertiser.demand.slope = list( 94 | favorability = rep(0, length(kFavorabilityStates))), 95 | competitor.demand.max = list(loyalty = c(1, 0, 1)), 96 | competitor.demand.replacement = list(loyalty = c(0.5, 0, 1)), 97 | purchase.quantity.intercept = 1, 98 | purchase.quantity.slope = 0, 99 | purchase.quantity.competitor = 1, 100 | unit.cost = 0, 101 | advertiser.transitions = list(), 102 | competitor.transitions = list()) { 103 | 104 | # Setup. 105 | fn.env <- environment() 106 | current.time <- data.dt[1, time.index] 107 | if (!("activity" %in% names(advertiser.demand.intercept))) { 108 | advertiser.demand.intercept <- c(advertiser.demand.intercept, 109 | list(activity = c(0, 0, 1))) 110 | } 111 | if (!("activity" %in% names(advertiser.demand.slope))) { 112 | advertiser.demand.slope <- c(advertiser.demand.slope, 113 | list(activity = c(0, 0, 1))) 114 | } 115 | if (!("activity" %in% names(competitor.demand.max))) { 116 | competitor.demand.max <- c(competitor.demand.max, 117 | list(activity = c(0, 0, 1))) 118 | } 119 | 120 | # Check parameters. 121 | if (current.time == 1) { 122 | assertthat::assert_that(is.numeric(price), all(price >= 0)) 123 | CheckSalesActivity(advertiser.demand.intercept) 124 | CheckSalesActivity(advertiser.demand.slope) 125 | CheckSalesActivity(competitor.demand.max) 126 | assertthat::assert_that(is.numeric(purchase.quantity.intercept)) 127 | assertthat::assert_that(is.numeric(purchase.quantity.slope)) 128 | if (any(purchase.quantity.slope < 0)) { 129 | warning("Generally, the user should specify positive", 130 | " for a negative price vs. quantity", 131 | " purchased by each purchaser relationship.") 132 | } 133 | CheckListNames(advertiser.transitions, colnames(kBrandStates)) 134 | CheckListNames(competitor.transitions, colnames(kBrandStates)) 135 | } 136 | 137 | # Get product price. 138 | current.price <- price[(current.time - 1) %% length(price) + 1] 139 | 140 | # Calculate the probability of purchasing the advertiser's brand, given no 141 | # competition. 142 | advertiser.demand.intercept <- MultiplyBySegment(advertiser.demand.intercept) 143 | advertiser.demand.slope <- MultiplyBySegment(advertiser.demand.slope) 144 | if (current.time == 1 && any(advertiser.demand.slope < 0)) { 145 | warning("Generally, the user should specify positive", 146 | " for a negative relationship", 147 | " between price and the number of purchasers.") 148 | } 149 | nocompetition.advertiser.demand <- pmin( 150 | 1, 151 | pmax(0, 152 | advertiser.demand.intercept - 153 | advertiser.demand.slope * (current.price - mean.price))) 154 | 155 | # Add competition, and calculate final probabilities of consumers 156 | # purchasing from the advertiser vs. competitor brands. 157 | competitor.demand.max <- 158 | pmax(0, pmin(1, MultiplyBySegment(competitor.demand.max))) 159 | competitor.demand.replacement <- 160 | pmax(0, pmin(1, MultiplyBySegment(competitor.demand.replacement))) 161 | competitor.demand <- pmax( 162 | 0, 163 | competitor.demand.max - 164 | (1 - competitor.demand.replacement) * nocompetition.advertiser.demand) 165 | advertiser.demand <- pmax( # Subtract competitor demand from total demand. 166 | pmax(nocompetition.advertiser.demand, 167 | competitor.demand.max) - competitor.demand, 168 | 0) # Avoid the numerical error of 'negative' 0. 169 | 170 | # Simulate the number of people making advertiser, competitor purchases. 171 | n.purchasing <- matrix(0L, nrow(data.dt), 2) 172 | for (iter.seg in 1:nrow(data.dt)) { 173 | n.purchasing[iter.seg, ] <- 174 | RMultinom(1, data.dt[iter.seg, pop], 175 | c(advertiser.demand[iter.seg], competitor.demand[iter.seg], 176 | 1 - advertiser.demand[iter.seg] - 177 | competitor.demand[iter.seg]))[1:2] 178 | 179 | } 180 | 181 | # Calculate the average number of units sold per purchaser. 182 | advertiser.units.per.purchaser <- max( 183 | 1, 184 | purchase.quantity.intercept - 185 | purchase.quantity.slope * (current.price - mean.price)) 186 | competitor.units.per.purchaser <- max(1, purchase.quantity.competitor) 187 | # Simulate the total number of sales. 188 | data.dt[, 189 | brand.sales := fn.env$n.purchasing[, 1] + 190 | RPois(nrow(n.purchasing), 191 | n.purchasing[, 1] * (advertiser.units.per.purchaser - 1))] 192 | data.dt[, 193 | competitor.sales := fn.env$n.purchasing[, 2] + 194 | RPois(nrow(n.purchasing), 195 | n.purchasing[, 2] * (competitor.units.per.purchaser - 1))] 196 | 197 | # Calculate the revenue and profit. 198 | data.dt[, revenue := brand.sales * fn.env$current.price] 199 | data.dt[, profit := revenue - unit.cost * brand.sales - total.spend] 200 | 201 | # Simulate post-purchase population migration. 202 | # Simulate changes in people who bought the advertiser's brand. 203 | advertiser.transitions <- c( # All purchasers satiate. 204 | advertiser.transitions, 205 | list(satiation = matrix(c(1, 1, 0, 0), 2))) 206 | MigrateMultiple(data.dt, n.purchasing[, 1], 207 | names(advertiser.transitions), advertiser.transitions) 208 | # Simulate changes in people who bought the competitor's brand. 209 | competitor.transitions <- c( # All purchasers satiate. 210 | competitor.transitions, 211 | list(satiation = matrix(c(1, 1, 0, 0), 2))) 212 | MigrateMultiple(data.dt, n.purchasing[, 2], 213 | names(competitor.transitions), competitor.transitions) 214 | } 215 | 216 | #' Warn users of possibility of consumers outside the 'purchase' state 217 | #' purchasing. 218 | #' 219 | #' Checks parameters in the sales module to make sure that the probability of 220 | #' consumers who are not in the 'purchase' activity state is 0. 221 | #' 222 | #' @param x the parameters being checked 223 | #' @return \code{NULL}. If the parameter specification breaks enforcement of 224 | #' only consumers who have attained the 'purchase' state being able to make a 225 | #' purchase, the function signals a warning. 226 | #' @keywords internal 227 | 228 | CheckSalesActivity <- function(x) { 229 | 230 | # Check condition, and output warning if failed. 231 | if (any(x$activity[1:2] != 0)) { 232 | warning("It is recommended to limit purchasing to individuals in", 233 | " the 'purchase' activity state. The current specification of", 234 | " 'advertiser.demand.intercept$activity' overwrites the code", 235 | " enforcing this. Consider removing this member of the list.") 236 | } 237 | return(NULL) 238 | } 239 | -------------------------------------------------------------------------------- /R/s3_amss_sim.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | #' Create AMSS simulation objects. 16 | #' 17 | #' Creates objects of class \code{amss.sim}. 18 | #' 19 | #' @param data a \code{data.table} containing the observed data. 20 | #' @param data.full the full data, as list of \code{data.tables} with rows 21 | #' corresponding to each segment and columns corresponding to specific 22 | #' variables. Each \code{data.table} corresponds to a single time interval. 23 | #' @param params parameters used in specifying the simulation settings. 24 | #' @return An object of class \code{amss.sim}, is a list with the following 25 | #' elements: 26 | #' \describe{ 27 | #' \item{data}{the observed data.} 28 | #' \item{data.full}{the full dataset, as a list of data.tables. Each 29 | #' \code{data.table} contains the data at the end of a time interval, by 30 | #' by population segment (row) and variable (column).} 31 | #' \item{params}{the parameters used to generate the data.} 32 | #' } 33 | #' @keywords internal 34 | 35 | amss.sim <- function(data = NULL, data.full = NULL, params = NULL) { 36 | 37 | # Check input type is correct. 38 | assertthat::assert_that(is.data.table(data)) 39 | assertthat::assert_that(is.list(data.full)) 40 | assertthat::assert_that(all(sapply(data.full, is.data.table))) 41 | assertthat::assert_that(is.list(params)) 42 | 43 | # Assemble object. 44 | sim.object <- list(data = data, 45 | data.full = data.full, 46 | params = params) 47 | 48 | # Update object class. 49 | class(sim.object) <- "amss.sim" 50 | return(sim.object) 51 | } 52 | 53 | #' Get budget information from a simulation object. 54 | #' 55 | #' Retrieves information on media budgets from an object of class 56 | #' \code{amss.sim}. 57 | #' 58 | #' @param object object of class amss.sim 59 | #' @return matrix of budgets by budget period (row) and media name (column) 60 | #' @keywords internal 61 | 62 | GetBudget <- function(object) { 63 | 64 | # Check input. 65 | assertthat::assert_that(inherits(object, "amss.sim")) 66 | 67 | # Return NULL if there are no media budgets. 68 | if (length(object$params$media.params) == 0) { 69 | return(NULL) 70 | } 71 | 72 | # Get budget values. 73 | budget.matrix <- sapply(object$params$media.params, function(x) x$budget) 74 | 75 | # Label each column with the media name. 76 | colnames(budget.matrix) <- object$params$media.names 77 | return(budget.matrix) 78 | } 79 | 80 | #' Get population size from a simulation object. 81 | #' 82 | #' Retrieves population size from an object of class \code{amss.sim}. 83 | #' 84 | #' @param object object of class amss.sim 85 | #' @return integer population size 86 | #' @keywords internal 87 | 88 | GetPopulation <- function(object) { 89 | 90 | # Check input. 91 | assertthat::assert_that(inherits(object, "amss.sim")) 92 | 93 | # Return population size, as read from the parameters. 94 | return(object$params$nat.mig.params$population) 95 | } 96 | 97 | #' Get the budget period assigned to each time interval. 98 | #' 99 | #' Read the budget indices from an \code{amss.sim} object. 100 | #' 101 | #' The budget indices specify which time intervals belong to the same budget 102 | #' period. 103 | 104 | GetBudgetIdx <- function(object) { 105 | 106 | return(object$params$media.params[[1]]$budget.index) 107 | } 108 | -------------------------------------------------------------------------------- /R/segmentation_consts.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | #' @import data.table 16 | NULL 17 | 18 | #' Population segmentation constants 19 | #' 20 | #' AMSS segments the population segments the population into groups based 21 | #' on each consumer's current mindset with regards to the category and the 22 | #' advertiser's brand. Aggregate changes in the population are tracked through 23 | #' the size of, i.e., the number of individuals belonging to, each population 24 | #' segment. 25 | #' 26 | #' The consumer minset is defined along six dimensions. The first three specify 27 | #' the consumer's relationship with the category: 28 | #' \describe{ 29 | #' \item{Market state}{describes whether the consumer should be 30 | #' considered part of the market for this category. Consumers with no 31 | #' interest are \code{out.of.market}; the rest are \code{in.market}. A 32 | #' consumer's market state may vary over time due to seasonal changes in 33 | #' consumer demand, but generally should not be affected by marketing 34 | #' interventions.} 35 | #' \item{Satiation state}{tracks whether a consumer's demand for the 36 | #' product category is temporarily satisfied by a recent purchase.} 37 | #' \item{Activity state}{tracks the consumer's progress along the path to 38 | #' purchase. Consumers may be in the \code{inactive}, \code{exploratory}, or 39 | #' \code{purchase} state. Consumers in different activity states will have 40 | #' different behaviors. For example, by default consumers outside the 41 | #' \code{purchase} state will never make a purchase. Activity state also 42 | #' affects media consumption; for example, individuals who are not 43 | #' \code{inactive} are generally more likely to make generic or branded 44 | #' search queries.} 45 | #' } 46 | #' The last three dimensions describe the consumer's relationships with the 47 | #' advertiser's brand. 48 | #' \describe{ 49 | #' \item{Brand favorability state}{specifies a consumer's awareness of and 50 | #' opinion of the advertiser's brand. Consumers are either \code{unaware}, 51 | #' or are aware and have an opinion of the brand ranging from 52 | #' \code{negative} to \code{favorable}, with intermediate favorabilitiy 53 | #' levels \code{neutral} and \code{somewhat favorable}.} 54 | #' \item{Brand loyalty state}{specifies a consumer's loyalty status. A 55 | #' consumer may be a \code{switcher}, in which case he or she has no brand 56 | #' loyalty. Otherwise the consumer is either \code{loyal}, i.e., loyal to 57 | #' the advertiser's brand, or \code{competitor.loyal}.} 58 | #' \item{Brand availability state}{refers to whether the advertiser's product 59 | #' is easily available to a particular consumer. For example, if the 60 | #' advertiser's distribution efforts only cover seventy percent of the 61 | #' population, then the thirty percent of the population not covered would 62 | #' be in the \code{low} brand availability state. The other options are 63 | #' \code{average} and \code{high} brand availability. Availability can 64 | #' refer to physical availability, i.e. the presence of the advertiser's 65 | #' product on store shelves. It could also refer to the mental availability 66 | #' (convenience) of the advertiser's brand. Thus brand availability can 67 | #' be affected by, say search ads that make the advertiser's brand the most 68 | #' prominent on the search results page, or by having the advertiser's 69 | #' product at eye-level in a store shelf.} 70 | #' } 71 | #' 72 | #' The constants \code{kMarketStates}, \code{kSatiationStates}, 73 | #' \code{kActivityStates}, \code{kFavorabilityStates}, \code{kLoyaltyStates}, 74 | #' and \code{kAvailabilityStates} list the the possible states a consumer may 75 | #' take in each dimension as character vectors. 76 | #' 77 | #' A consumer's mindset is summarized by the combination of states they take 78 | #' in each dimension. There are certain restrictions on which combinations of 79 | #' consumer states are possible. For example, only consumers who are both 80 | #' \code{in.market} and \code{unsatiated} can leave the \code{inactive} activity 81 | #' state. The \code{data.frame} \code{kCategoryStates} describes all valid 82 | #' combinations of market state, satiation state, and activity state, and thus 83 | #' lists all possible consumer mindsets with respect to the category in general. 84 | #' The \code{data.frame} \code{kBrandStates} describes all valid combinations of 85 | #' brand favorability, loyalty, and availability, given that only consumers 86 | #' with a \code{favorable} opinion of the brand can be \code{loyal}. Thus, 87 | #' \code{kBrandStates} lists all possible consumer mindsets with regards to the 88 | #' advertiser's brand. 89 | #' 90 | #' A \code{data.table} of all valid consumer states is provided as 91 | #' \code{kAllStates}. It is the cross product of all category and brand states. 92 | #' Every consumer is assigned to one of these 198 states. 93 | #' 94 | #' @format An object of class \code{character} (all possible states in a single 95 | #' dimension) or \code{data.table} (each row specifying a valid combination of 96 | #' states in different dimensions). 97 | #' @name population segmentation 98 | #' @aliases kMarketStates kSatiationStates kActivityStates kFavorabilityStates 99 | #' kLoyaltyStates kAvailabilityStates kCategoryStates kBrandStates kAllStates 100 | NULL 101 | 102 | #' Vector of all market states. 103 | #' 104 | #' @rdname population segmentation 105 | #' @export 106 | 107 | kMarketStates <- c("out.market", "in.market") 108 | 109 | #' Vector of all satiation states. 110 | #' 111 | #' @rdname population segmentation 112 | #' @export 113 | 114 | kSatiationStates <- c("satiated", "unsatiated") 115 | 116 | #' Vector of all activity states. 117 | #' 118 | #' @rdname population segmentation 119 | #' @export 120 | 121 | kActivityStates <- c("inactive", "exploration", "purchase") 122 | 123 | #' Vector of all brand favorability states. 124 | #' 125 | #' @rdname population segmentation 126 | #' @export 127 | 128 | kFavorabilityStates <- c("unaware", "negative", "neutral", 129 | "somewhat favorable", "favorable") 130 | 131 | #' Vector of all brand loyalty states. 132 | #' 133 | #' @rdname population segmentation 134 | #' @export 135 | 136 | kLoyaltyStates <- c("switcher", "loyal", "competitor-loyal") 137 | 138 | #' Vector of all brand availability states. 139 | #' 140 | #' @rdname population segmentation 141 | #' @export 142 | 143 | kAvailabilityStates <- c("low", "average", "high") 144 | 145 | #' Generate the list of category states. 146 | #' 147 | #' Category states are a combination of market, satation, and activity state. 148 | #' This functions produces a list all valid combinations of these three 149 | #' dimensions of population segmentation. 150 | #' 151 | #' @return \code{data.frame} with columns \code{market}, \code{satiation}, and 152 | #' \code{activity}, listing all valid combinations of market, satiation, 153 | #' and activity states 154 | #' @keywords internal 155 | 156 | GetCategoryStates <- function() { 157 | 158 | # Find all combinations of states. 159 | category.states <- expand.grid( 160 | activity = factor(kActivityStates, kActivityStates), 161 | satiation = factor(kSatiationStates, kSatiationStates), 162 | market = factor(kMarketStates, kMarketStates)) 163 | 164 | # Remove invalid combinations. 165 | return(category.states[category.states$activity == "inactive" | 166 | (category.states$market == "in.market" & 167 | category.states$satiation == "unsatiated"), ]) 168 | } 169 | 170 | #' All category states. 171 | #' 172 | #' @rdname population segmentation 173 | #' @export 174 | 175 | kCategoryStates <- setDT(GetCategoryStates()) 176 | 177 | #' Generate the list of brand states. 178 | #' 179 | #' Brand states are a combination of brand favorability, brand loyalty, and 180 | #' brand availability. This functions produces a list all valid combinations 181 | #' of these three dimensions of population segmentation. 182 | #' 183 | #' @return \code{data.frame} with column \code{brand} containing all valid 184 | #' values for brand state. 185 | #' @keywords internal 186 | 187 | GetBrandStates <- function() { 188 | 189 | # Find all combinations of states. 190 | brand.states <- expand.grid( 191 | availability = factor(kAvailabilityStates, kAvailabilityStates), 192 | loyalty = factor(kLoyaltyStates, kLoyaltyStates), 193 | favorability = factor(kFavorabilityStates, kFavorabilityStates)) 194 | 195 | # Remove invalid combinations. 196 | return(brand.states[!(brand.states$favorability != "favorable" & 197 | brand.states$loyalty == "loyal"), ]) 198 | } 199 | 200 | #' All brand states. 201 | #' 202 | #' @rdname population segmentation 203 | #' @export 204 | 205 | kBrandStates <- setDT(GetBrandStates()) 206 | 207 | #' All consumer states. 208 | #' 209 | #' @rdname population segmentation 210 | #' @export 211 | 212 | kAllStates <- data.table::setDT(merge.data.frame(kBrandStates, kCategoryStates)) 213 | data.table::setkey(kAllStates, market, satiation, activity, 214 | favorability, loyalty, availability) 215 | data.table::setcolorder(kAllStates, data.table::key(kAllStates)) 216 | -------------------------------------------------------------------------------- /R/simulate.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | utils::globalVariables(c("pop", "total.spend")) 16 | 17 | #' Generate simulation objects under the AMSS framework. 18 | #' 19 | #' Produces an \code{amss.sim} object that contains the simulated data and can 20 | #' be used to derive ground truth about the scenario. 21 | #' 22 | #' Objects of class \code{amss.sim} contain the full output from running a 23 | #' simulation scenario. This output includes the observed data, the complete 24 | #' dataset generated during the simulation process, and the parameters passed 25 | #' to the simulation function in order to generate the simulated data. The 26 | #' observed data is meant to be used by modelers. The complete dataset can be 27 | #' useful for users who want a more complete understanding of the forces 28 | #' operating in a simulation scenario. The parameter list is essential for 29 | #' generating future datasets based on the same, or slightly modified, 30 | #' simulation settings in order to obtain ground truth about the simulation 31 | #' scenario. 32 | #' 33 | #' @param time.n number of timepoints. 34 | #' @param nat.mig.module specifications of class \code{seq.specs}, to be used 35 | #' to create the non-actionable drivers module and then generate its 36 | #' variables 37 | #' @param nat.mig.params any parameter values to pass to \code{nat.mig.module} 38 | #' @param media.names character vector of unique names of all media modules. 39 | #' ex: c("tv", "search") 40 | #' @param media.modules list of functions that simulate the behavior of each 41 | #' marketing intervention. 42 | #' @param media.params list of parameter value lists for each media module. 43 | #' @param sales.module function that models the sales in the category. 44 | #' @param sales.params list of any parameter values to pass to the sales module 45 | #' @param ping the spacing between time points at which to print a message 46 | #' updating the user on simulation progress. 47 | #' @param names.agg.const character vector of names of variables to surface in 48 | #' the observed data, aggregated using the first entry, since they are 49 | #' constant over the hidden states. By default, if not specified, 50 | #' \code{SurfaceData()} will pick up variables with names containing 51 | #' "price" and/or "budget", and the "pop.total" variable. 52 | #' @param names.agg.sum character vector of names of variables to surface in 53 | #' the observed data, aggregated using the function \code{sum()}. By 54 | #' default, \code{SurfaceData()} will pick up variables with names 55 | #' matching "revenue", "profit", "sales", "volume", and/or "spend". 56 | #' @return an object of class \code{amss.sim}, containing 57 | #' \describe{ 58 | #' \item{data}{the observed data.} 59 | #' \item{data.full}{the full dataset, as a list of data.tables. Each 60 | #' \code{data.table} contains the data at the end of a time interval, by 61 | #' by population segment (row) and variable (column).} 62 | #' \item{params}{the parameters used to generate the data.} 63 | #' } 64 | #' @export 65 | 66 | SimulateAMSS <- function( 67 | time.n, 68 | nat.mig.module = `DefaultNatMigModule`, 69 | nat.mig.params = list(), 70 | media.names = character(), 71 | media.modules = rep(list(`DefaultTraditionalMediaModule`), 72 | length(media.names)), 73 | media.params = rep(list(list()), length(media.names)), 74 | sales.module = `DefaultSalesModule`, 75 | sales.params = list(), 76 | ping = max(10, floor(time.n / 10)), 77 | names.agg.const = NULL, 78 | names.agg.sum = NULL) { 79 | 80 | # Check inputs. 81 | assertthat::assert_that(time.n >= 1) 82 | # Different media channels must have different names. 83 | assertthat::assert_that(!anyDuplicated(media.names)) 84 | 85 | # Save the parameter list. 86 | params <- as.list(match.call())[-1] 87 | default.params <- as.list(formals(`SimulateAMSS`)) 88 | default.params[names(params)] <- NULL 89 | params <- c(params, default.params) 90 | eval.env <- environment() 91 | params <- lapply(params, function(x) eval(x, eval.env)) 92 | 93 | # Simulate data. 94 | data.full <- do.call( 95 | SimulateData, 96 | c(list(starting.dts = list()), params)[formalArgs(`SimulateData`)]) 97 | 98 | # Return an object of class amss.sim. 99 | return(amss.sim( 100 | data = SurfaceData(data.full, names.agg.const, names.agg.sum), 101 | data.full = data.full, 102 | params = params)) 103 | } 104 | 105 | #' Simulate data using the AMSS framework. 106 | #' 107 | #' Data generating function for AMSS. Responsible for sequentially simulating 108 | #' the value of each variable at each time point by population segment, given 109 | #' the simulation settings. 110 | #' 111 | #' @param starting.dts previously generated data that we can start with. data 112 | #' will only be generated for later timepoints 113 | #' @param time.n total number of timepoints, including the timepoints already 114 | #' existing in starting.dts. 115 | #' @param nat.mig.module function used to simulate effects of natural migration 116 | #' on population segmentation. 117 | #' @param nat.mig.params list of any parameter values to pass to 118 | #' \code{nat.mig.module} 119 | #' @param media.names character vector of unique names of all media modules. 120 | #' ex: c("tv", "search") 121 | #' @param media.modules list of functions that simulate the behavior of each 122 | #' marketing intervention. 123 | #' @param media.params list of parameter value lists for each media module. 124 | #' @param sales.module function that generate sales variables. 125 | #' @param sales.params list of any parameter values to pass to the sales module 126 | #' @param ping the spacing between time points at which to print a message 127 | #' updating the user on simulation progress. 128 | #' @return a list of data sets, one per timepoint. Each is a data.table with 129 | #' rows corresponding to population segments and columns corresponding 130 | #' to specific variables. 131 | #' @keywords internal 132 | 133 | SimulateData <- function( 134 | starting.dts = list(), 135 | time.n, 136 | nat.mig.module, nat.mig.params, 137 | media.names, media.modules, media.params, 138 | sales.module, sales.params, 139 | ping) { 140 | 141 | # Initialize data with the starting.dts provided. 142 | all.dt <- data.table::copy(starting.dts) 143 | 144 | # Handle the special case: no new data to generate. 145 | if (time.n <= length(all.dt)) { 146 | return(all.dt[1:time.n]) 147 | } 148 | 149 | # Generate data for each time interval sequentially. 150 | # Initialize curr.dt variable to store the most recent values for each 151 | # variable. 152 | t.start <- length(all.dt) + 1L 153 | if (t.start == 1) { 154 | curr.dt <- InitStateData(time.index = 0) 155 | } else { 156 | curr.dt <- data.table::copy(all.dt[[t.start - 1]]) 157 | } 158 | # Iteratively simulate data for each time interval. 159 | for (iter.t in t.start:time.n) { 160 | if ((iter.t %% ping) == 1) { 161 | print(paste("Simulating data. t =", iter.t)) 162 | } 163 | # Run the natural migration module. 164 | do.call(nat.mig.module, c(list(curr.dt), nat.mig.params)) 165 | 166 | # Run the media modules. 167 | for (iter.media in 1:length(media.names)) { 168 | existing.var.names <- data.table::copy(names(curr.dt)) 169 | do.call(media.modules[[iter.media]], 170 | c(list(curr.dt), media.params[[iter.media]])) 171 | # Since the module updated the data.table without specifying the media 172 | # name, variables such as "volume" must be updated to "tv.volume". 173 | var.names <- setdiff(names(curr.dt), existing.var.names) 174 | new.var.names <- PasteD(media.names[iter.media], var.names) 175 | # Delete data from the previous time interval to avoid duplicate columns. 176 | if (iter.t > 1) { 177 | curr.dt[, (new.var.names) := NULL] 178 | } 179 | setnames(curr.dt, var.names, new.var.names) 180 | } 181 | curr.dt[, 182 | total.spend := 183 | EvalText(paste(PasteD(media.names, "spend"), 184 | collapse = " + "), 185 | curr.dt)] 186 | # Run the sales module. 187 | do.call(sales.module, c(list(curr.dt), sales.params)) 188 | 189 | # Save progress, and stop if done. 190 | all.dt[[iter.t]] <- copy(curr.dt) 191 | } 192 | return(all.dt) 193 | } 194 | 195 | #' Initialize data. 196 | #' 197 | #' Initialize the updating \code{data.table} containing current data on each 198 | #' population segment. 199 | #' 200 | #' @param time.index time index to intialize the data table to 201 | #' @return data.table with one column for each state variable (market, 202 | #' satiation, activity, brand) and one row per each valid combination of 203 | #' states for the above state variables. Also initializes the population 204 | #' count at timepoint 1 as 0. 205 | #' @keywords internal 206 | 207 | InitStateData <- function(time.index = 0) { 208 | 209 | # Create a copy of the data.table listing all population segments. 210 | data.dt <- data.table::copy(kAllStates) 211 | 212 | # Set the time index, geo index, and population size 213 | data.dt[, time.index := time.index][, pop := 0] 214 | return(data.dt) 215 | } 216 | 217 | #' Surface observable data. 218 | #' 219 | #' Extract observable data from the full dataset. 220 | #' 221 | #' @param full.data \code{data.table} of full data. each row contains 222 | #' information for a particular timepoint + hidden state 223 | #' @param names.const character names of variables with constant values over 224 | #' the state, to be aggregated by taking the first entry. 225 | #' @param names.sum character names of variables with numeric values, to be 226 | #' aggregated by \code{sum()}. 227 | #' @return observable data, aggregated over the hidden states as specified. 228 | #' Variables not included in names.const or names.sum are assumed to be 229 | #' hidden variables and not surfaced. 230 | #' @keywords internal 231 | 232 | SurfaceData <- function(full.data, names.const, names.sum) { 233 | 234 | # Check the full.data argument. 235 | full.data <- rbindlist(full.data, use.names = TRUE) 236 | data.table::setkeyv(full.data, 237 | c("time.index", colnames(kAllStates))) 238 | # The data.table keys should be unique 239 | assertthat::assert_that(identical(full.data, unique(full.data))) 240 | 241 | # Check the arguments specifying names of variables. 242 | if (missing(names.const) || is.null(names.const)) { 243 | names.const <- c( 244 | grep("price|budget", names(full.data), value = TRUE)) 245 | } 246 | if (missing(names.sum) || is.null(names.sum)) { 247 | names.sum <- c(grep(paste0("revenue$|^profit$|\\.sales$|", 248 | "\\.volume$|", 249 | "\\.spend$|\\.imps$|\\.clicks$"), 250 | names(full.data), value = TRUE)) 251 | } 252 | assertthat::assert_that( 253 | identical(character(), intersect(names.const, names.sum)), 254 | msg = "The same variable cannot be aggregated in multiple ways.") 255 | if (!identical(character(), 256 | setdiff(names.const, 257 | setdiff(names(full.data), key(full.data))))) { 258 | warning(paste("Cannot aggregate nonexistent or index columns.", 259 | "Removing from names.const.")) 260 | names.const <- intersect(names(full.data), names.const) 261 | } 262 | if (!identical(character(), 263 | setdiff(names.sum, 264 | setdiff(names(full.data), key(full.data))))) { 265 | warning(paste("Cannot aggregate nonexistent or index columns.", 266 | "Removing from names.sum.")) 267 | names.sum <- intersect(names(full.data), names.sum) 268 | } 269 | 270 | # Perform the data aggregation. 271 | if (identical(character(), names.sum)) { 272 | vals.sum <- 273 | unique(full.data[, "time.index", with = FALSE]) 274 | } else { 275 | vals.sum <- full.data[, lapply(.SD, sum), 276 | by = "time.index", 277 | .SDcols = names.sum] 278 | } 279 | if (identical(character(), names.const)) { 280 | vals.const <- 281 | unique(full.data[, "time.index", with = FALSE]) 282 | } else { 283 | vals.const <- full.data[, lapply(.SD, function(x) x[1]), 284 | by = "time.index", 285 | .SDcols = names.const] 286 | } 287 | surfaced.data <- vals.sum[vals.const] 288 | return(surfaced.data) 289 | } 290 | -------------------------------------------------------------------------------- /R/simulate_time_series.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | #' Simulate correlated vectors. 16 | #' 17 | #' Simulates a new vector x with a specified mean, standard deviation, and 18 | #' correlation with some other vector \code{v} by adding white noise and 19 | #' scaling. 20 | #' 21 | #' @param v vector to which the new data will be correlated. 22 | #' @param cor.vx numeric specifying correlation between v and the new vector x. 23 | #' @param mu.x numeric, mean of the new vector x. 24 | #' @param sigma.x numeric, standard deviation of the new vector x. 25 | #' @return a vector x with the specified mean, standard deviation, and 26 | #' correlation. 27 | #' @family Simulate time series 28 | #' @export 29 | 30 | SimulateCorrelated <- function(v, cor.vx = 1, mu.x = 0, sigma.x = 1) { 31 | 32 | # Check inputs. 33 | assertthat::assert_that(is.numeric(v)) 34 | assertthat::assert_that(is.numeric(cor.vx), length(cor.vx) == 1, 35 | abs(cor.vx) <= 1) 36 | assertthat::assert_that(is.numeric(mu.x), length(mu.x) == 1) 37 | assertthat::assert_that(is.numeric(sigma.x), length(sigma.x) == 1, 38 | sigma.x >= 0) 39 | 40 | # If v is constant, then x is just noise. 41 | if (min(v) == max(v)) { 42 | x <- rnorm(length(v)) 43 | } else { # Else, add the appropriate level of noise. 44 | x <- scale(v) * cor.vx + rnorm(n = length(v), sd = sqrt(1 - cor.vx ^ 2)) 45 | } 46 | return(mu.x + sigma.x * x) 47 | } 48 | 49 | #' Simulate dummy (0-1) variables. 50 | #' 51 | #' Create dummy (0-1) variables that repeat a requested pattern of 0's and 1's, 52 | #' with the option to scale. 53 | #' 54 | #' @param n integer number of time points 55 | #' @param pos.idx vector of indices where simulated vector should take positive 56 | #' values (as opposed to zero) 57 | #' @param period integer controlling periodicity. 58 | #' @param amplitude numeric value > 0 specifying the value of all postive 59 | #' entries in the return vector. 60 | #' @return specified vector 61 | #' @family Simulate time series 62 | #' @export 63 | 64 | SimulateDummy <- function(n, pos.idx = NULL, period = n, amplitude = 1) { 65 | 66 | # Check inputs. 67 | assertthat::assert_that(is.numeric(n), length(n) == 1, 68 | as.integer(n) == n, n >= 0) 69 | assertthat::assert_that(is.null(pos.idx) || is.numeric(pos.idx)) 70 | assertthat::assert_that(is.numeric(period), length(period) == 1, 71 | as.integer(period) == period, period >= 1) 72 | assertthat::assert_that(is.numeric(amplitude), length(amplitude) == 1, 73 | amplitude >= 0) 74 | 75 | # Return the specified vector. 76 | return(amplitude * as.numeric(((1:n) %% period) %in% pos.idx)) 77 | } 78 | 79 | #' Generate sinusoidal time series. 80 | #' 81 | #' Function that outputs specified sinusoidal waves. 82 | #' 83 | #' @param n the length of the simulated vector. 84 | #' @param period the length of one full sinusoidal period. 85 | #' @param max.loc the index of the maximum of the sinusoidal curve. 86 | #' @param vert.translation a numeric for the vertical displacement of the 87 | #' sinusoidal curve from 0. 88 | #' @param amplitude numeric for the amplitude of the sinusoidal curve. Must be 89 | #' nonnegative. 90 | #' @param scale.x boolean. If TRUE, scale the sinusoidal curve to have mean 0 91 | #' and standard deviation 1 before returning. 92 | #' 93 | #' @return specified sinusoidal curve as a vector 94 | #' @family Simulate time series 95 | #' @export 96 | 97 | SimulateSinusoidal <- function(n, period, max.loc = 1, 98 | vert.translation = 0, amplitude = 1, 99 | scale.x = FALSE) { 100 | 101 | # Check inputs. 102 | assertthat::assert_that(is.numeric(n), length(n) == 1, 103 | as.integer(n) == n, n >= 0) 104 | assertthat::assert_that(is.numeric(period), length(period) == 1, 105 | period > 0) 106 | assertthat::assert_that(is.numeric(max.loc), length(max.loc) == 1) 107 | assertthat::assert_that(is.numeric(amplitude), length(amplitude) == 1, 108 | amplitude >= 0) 109 | assertthat::assert_that(assertthat::is.flag(scale.x)) 110 | 111 | # Calculate the values of the sinusoidal curve. 112 | x <- cos(((1:n) - max.loc) / period * 2 * pi) * amplitude + vert.translation 113 | 114 | # Scale x if flagged, and then return. 115 | if (scale.x) { 116 | return(scale(x)) 117 | } else { 118 | return(x) 119 | } 120 | } 121 | 122 | #' Simulate AR1 time series 123 | #' 124 | #' Function that outputs simulated AR1 time series with specified means, 125 | #' variances, and autocorrelations 126 | #' 127 | #' @param n integer number of time points 128 | #' @param stable.mu means of the stable distribution for each variable 129 | #' @param stable.sd standard deviations of the stable distributions 130 | #' @param autocor autocorrelations for each time series 131 | #' @return vector realization of specified AR1 times series 132 | #' @family Simulate time series 133 | #' @export 134 | 135 | SimulateAR1 <- function(n, stable.mu = 0, stable.sd = 1, autocor = 0) { 136 | 137 | # Check inputs. 138 | assertthat::assert_that(is.numeric(n), length(n) == 1, 139 | as.integer(n) == n, n >= 0) 140 | assertthat::assert_that(is.numeric(stable.mu), length(stable.mu) == 1) 141 | assertthat::assert_that(is.numeric(stable.sd), length(stable.sd) == 1, 142 | stable.sd >= 0) 143 | assertthat::assert_that(is.numeric(autocor), length(autocor) == 1, 144 | abs(autocor) < 1) 145 | 146 | # Translate the stable distribution into AR1 parameters, then generate time 147 | # series. 148 | if (stable.sd == 0) { 149 | return(rep(stable.mu, n)) 150 | } 151 | if (autocor == 0) { 152 | return(rnorm(n, stable.mu, stable.sd)) 153 | } 154 | c <- (1 - autocor) * stable.mu 155 | sigma <- sqrt(1 - autocor ^ 2) * stable.sd 156 | return(as.vector(arima.sim(list(ar = autocor), n, sd = sigma, mean = c))) 157 | } 158 | -------------------------------------------------------------------------------- /R/startup_message.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | .onAttach <- function(libname, pkgname) { 16 | packageStartupMessage("This software is not an official Google product.", 17 | " For research purposes only.", 18 | " Copyright 2017 Google, Inc.") 19 | } 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # R package amss version 1.0.1 2 | 3 | Copyright (C) 2017 Google, Inc. 4 | License: Apache 2.0 5 | 6 | ## Disclaimer 7 | 8 | This is not an official Google product. For research purposes only. 9 | 10 | ## What is this R package for? 11 | 12 | This R package (`amss`) is an open-source implementation of the Aggregate 13 | Marketing System Simulator developed at Google [1]. 14 | 15 | This package provides object classes, methods, and functions related to 16 | simulated aggregate time series marketing data. It provides functionality to 17 | generate both simulated data and associated ground truth metrics. Version 1.0 18 | implements the simulation framework presented in [1]. 19 | 20 | ## Documentation 21 | 22 | See the vignette and the manual in this package (in the subdirectory `inst/doc/` 23 | in the source package). 24 | 25 | ## References 26 | 27 | [1] Zhang, S. and Vaver, J. (2017) 28 | [Introduction to the Aggregate Marketing System Simulator](https://research.google.com/pubs/pub45996.html). 29 | -------------------------------------------------------------------------------- /inst/doc/amss-manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/google/amss/cbf5e7f6c668de493077ce1d08a2ab963891f0cc/inst/doc/amss-manual.pdf -------------------------------------------------------------------------------- /inst/doc/amss-vignette.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/google/amss/cbf5e7f6c668de493077ce1d08a2ab963891f0cc/inst/doc/amss-vignette.pdf -------------------------------------------------------------------------------- /man/AdjustPopulation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/attribution.R 3 | \name{AdjustPopulation} 4 | \alias{AdjustPopulation} 5 | \title{Adjust population vector to a new total} 6 | \usage{ 7 | AdjustPopulation(orig.pop, new.total.pop) 8 | } 9 | \arguments{ 10 | \item{orig.pop}{original population vector} 11 | 12 | \item{new.total.pop}{new total population size} 13 | } 14 | \value{ 15 | new population vector of class integer 16 | } 17 | \description{ 18 | Adjust population proportionally to a new total population size, rounding up 19 | when necessary. 20 | } 21 | \keyword{internal} 22 | 23 | -------------------------------------------------------------------------------- /man/ApplyTransitionMatrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/migrate.R 3 | \name{ApplyTransitionMatrix} 4 | \alias{ApplyTransitionMatrix} 5 | \title{Apply transition matrix to vector of population counts by state.} 6 | \usage{ 7 | ApplyTransitionMatrix(vector.counts, transition.matrices) 8 | } 9 | \arguments{ 10 | \item{vector.counts}{vector of counts in each state} 11 | 12 | \item{transition.matrices}{transition matrix, or list of transition 13 | matrices. When multiple transition matrices are supplied, the first 14 | transition matrix whose dimensionality matches the number of states 15 | in vector.counts is used.} 16 | } 17 | \value{ 18 | number of individuals in each state after migration 19 | } 20 | \description{ 21 | Applies transition matrix to vector of population counts by state. 22 | Option to select transition matrix that matches length of vector when given 23 | multiple transition matrices. 24 | } 25 | \keyword{internal} 26 | 27 | -------------------------------------------------------------------------------- /man/CalculateROAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/attribution.R 3 | \name{CalculateROAS} 4 | \alias{CalculateROAS} 5 | \title{Calculate ROAS or mROAS.} 6 | \usage{ 7 | CalculateROAS(object, new.budget = NULL, 8 | media.names = object$params$media.names, budget.periods = NULL, 9 | budget.proportion = rep(0, length(media.names)), t.start = 1, 10 | t.end = object$params$time.n, scaled.pop.size = 1e+18, min.reps = 2, 11 | max.coef.var = 0.01, max.margin.error = 0.01, max.time = 0, 12 | verbose = FALSE) 13 | } 14 | \arguments{ 15 | \item{object}{amss.sim object containing simulated data} 16 | 17 | \item{new.budget}{table of new budgets for each budget period (row) and 18 | media channel (column)} 19 | 20 | \item{media.names}{if new.budget is NULL, adjust original budget of the 21 | media named here.} 22 | 23 | \item{budget.periods}{budget.periods over which to modify the budget. 24 | Default \code{NULL} will lead to all budget periods being modified.} 25 | 26 | \item{budget.proportion}{nonnegative numeric. When \code{new.budget} is 27 | NULL, it is calculated by setting the budget of the media channels 28 | specified in \code{media.names} to \code{budget.proportion} 29 | proportion of the original budget during the budget periods specified 30 | in \code{budget.periods}. The default proportion of 0 is used to 31 | calculate the average ROAS over the entire spend in the channel. 32 | Values such as 0.99 can be used to calculate the marginal ROAS.} 33 | 34 | \item{t.start}{time point to start generating data according to the new 35 | settings.} 36 | 37 | \item{t.end}{last time point to generate data according to the new settings. 38 | In scenarios with lag, this should extend past the last time point in 39 | the modified budget periods in order to include lagged effects in the 40 | calculation.} 41 | 42 | \item{scaled.pop.size}{\code{CalculateROAS} scales up the population size to 43 | reduce the variability of its estimates. This is equivalent to running 44 | the simulation for multiple repetitions to reduce variability. The 45 | default value should provide sufficient accuracy in most use cases. 46 | Extremely large values may result in numerical issues.} 47 | 48 | \item{min.reps}{integer representing the initial number of datasets to 49 | generate from each budget setting. The default value of 2 allows the user 50 | to make a rough check that the accuracy is indeed good under the chosen 51 | settings. This default was chosen under the assumption that the default 52 | \code{scaled.pop.size} is large enough to accurately measure ROAS using 1 53 | repetition, with the 2nd being used as confirmation of the accuracy. Higher 54 | precision and more accurate measurement of the precision can be achieved 55 | with more repetitions.} 56 | 57 | \item{max.coef.var}{numeric, the target coefficient of variation. The 58 | function takes additional samples of the ROAS until it runs out of 59 | time, attains the target coefficient of variation, or attains the 60 | target margin of error.} 61 | 62 | \item{max.margin.error}{numeric, the target margin of error. The function 63 | takes additional samples of the ROAS until it runs out of time, 64 | attains the target coefficient of variation, or attains the target 65 | margin of error.} 66 | 67 | \item{max.time}{numeric, the number of minutes at which to cut off the 68 | function from taking additional samples beyond the initial sample 69 | generated according to \code{min.reps}. The function takes additional 70 | samples of the ROAS until it runs out of time, attains the target 71 | coefficient of variation, or attains the target margin of error. The 72 | default value of 0 forces the function to use precisely \code{min.reps} 73 | repetitions.} 74 | 75 | \item{verbose}{boolean. If TRUE, output measures of the accuracy of the 76 | reported ROAS, including the full sample of ROAS values.} 77 | } 78 | \value{ 79 | numeric value for ROAS, or, if \code{verbose = TRUE}, a list with 80 | the roas, the 95% margin of error, the coefficient of variation, and the 81 | sample ROAS values. 82 | } 83 | \description{ 84 | This functions takes the original budget settings and a 85 | counterfactual budget setting. It reports the expected ratio between 86 | the total difference in revenue over all time points and the total 87 | difference in media spend over all time points. 88 | } 89 | 90 | -------------------------------------------------------------------------------- /man/CalculateSampleROAS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/attribution.R 3 | \name{CalculateSampleROAS} 4 | \alias{CalculateSampleROAS} 5 | \title{Calculate ROAS from a pair of datasets.} 6 | \usage{ 7 | CalculateSampleROAS(dt1, dt2) 8 | } 9 | \arguments{ 10 | \item{dt1}{data.table of data generated from the first budget setting. The 11 | data.table must include "revenue" and "total.spend" columns, and have 12 | the different datasets indexed by column "rep.index."} 13 | 14 | \item{dt2}{data.table of data generated from the second budget setting. The 15 | data.table must include "revenue" and "total.spend" columns, and have 16 | the different datasets indexed by column "rep.index." the number of 17 | unique values of "rep.index" in \code{dt1} and \code{dt2} should 18 | match.} 19 | } 20 | \value{ 21 | vector of ROAS estimates from each pair of sample datasets in dt1 22 | and dt2. 23 | } 24 | \description{ 25 | Calculate the ROAS estimated from a sample of datasets generated from two 26 | budget settings 27 | } 28 | \keyword{internal} 29 | 30 | -------------------------------------------------------------------------------- /man/Capitalize.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{Capitalize} 4 | \alias{Capitalize} 5 | \title{Capitalize the first letter of a string.} 6 | \usage{ 7 | Capitalize(s) 8 | } 9 | \arguments{ 10 | \item{s}{the string to be capitalized.} 11 | } 12 | \value{ 13 | the string \code{s} with its first letter capitalized. 14 | } 15 | \description{ 16 | Capitalize the first letter of a string. This function is meant for single 17 | strings only. 18 | } 19 | \keyword{internal} 20 | 21 | -------------------------------------------------------------------------------- /man/CheckLength.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{CheckLength} 4 | \alias{CheckLength} 5 | \title{Check and adjust object length.} 6 | \usage{ 7 | CheckLength(x, len, hard.stop = TRUE, warn.single = FALSE, 8 | par.name = character()) 9 | } 10 | \arguments{ 11 | \item{x}{object to check/adjust length of} 12 | 13 | \item{len}{desired length of object} 14 | 15 | \item{hard.stop}{if TRUE, stop when length(x) is neither 1 nor len. else, 16 | throw a warning and use repeat() to adjust length of x.} 17 | 18 | \item{warn.single}{if TRUE, through a warning when length(x) is 1 and it is 19 | being extended to a new length.} 20 | 21 | \item{par.name}{Character, used in the warning or stop message to indicate 22 | which parameter this warning is meant for.} 23 | } 24 | \value{ 25 | x updated to have length len, or throws exception 26 | } 27 | \description{ 28 | Function that checks length of x. It may throw a stop(), warning(), and/or 29 | repeat the variable to create the desired length. 30 | } 31 | \keyword{internal} 32 | 33 | -------------------------------------------------------------------------------- /man/CheckListNames.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{CheckListNames} 4 | \alias{CheckListNames} 5 | \title{Check the names of a list.} 6 | \usage{ 7 | CheckListNames(l, valid.names = colnames(kAllStates)) 8 | } 9 | \arguments{ 10 | \item{l}{the list to be checked.} 11 | 12 | \item{valid.names}{a character vector of valid nmaes.} 13 | } 14 | \value{ 15 | This function checks the value of \code{l} and will signal an error 16 | if the check fails. Else, it returns \code{TRUE}. 17 | } 18 | \description{ 19 | Check that a list has names, and that all these names are valid. 20 | } 21 | \keyword{internal} 22 | 23 | -------------------------------------------------------------------------------- /man/CheckSalesActivity.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_sales.R 3 | \name{CheckSalesActivity} 4 | \alias{CheckSalesActivity} 5 | \title{Warn users of possibility of consumers outside the 'purchase' state 6 | purchasing.} 7 | \usage{ 8 | CheckSalesActivity(x) 9 | } 10 | \arguments{ 11 | \item{x}{the parameters being checked} 12 | } 13 | \value{ 14 | \code{NULL}. If the parameter specification breaks enforcement of 15 | only consumers who have attained the 'purchase' state being able to make a 16 | purchase, the function signals a warning. 17 | } 18 | \description{ 19 | Checks parameters in the sales module to make sure that the probability of 20 | consumers who are not in the 'purchase' activity state is 0. 21 | } 22 | \keyword{internal} 23 | 24 | -------------------------------------------------------------------------------- /man/DefaultNatMigModule.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_natural_migration.R 3 | \name{DefaultNatMigModule} 4 | \alias{DefaultNatMigModule} 5 | \title{Model natural consumer behavior in the absence of marketing interventions.} 6 | \usage{ 7 | DefaultNatMigModule(data.dt, population, market.rate.trend = 1, 8 | market.rate.seas = 1, sat.decay = 1, 9 | prop.activity = rep(1/length(kActivityStates), length(kActivityStates)), 10 | prop.favorability = rep(1/length(kFavorabilityStates), 11 | length(kFavorabilityStates)), prop.loyalty = rep(1/length(kLoyaltyStates), 12 | length(kLoyaltyStates)), 13 | prop.availability = rep(1/length(kAvailabilityStates), 14 | length(kAvailabilityStates)), transition.matrices = list()) 15 | } 16 | \arguments{ 17 | \item{data.dt}{data.table with rows corresponding to segments and columns 18 | corresponding to variables; column \code{pop} for the number of 19 | people in each segment must be included.} 20 | 21 | \item{population}{constant specifying population size} 22 | 23 | \item{market.rate.trend}{the trend in market size, written as the proportion 24 | of the population to be considered potentially in the market, pending 25 | seasonal adjustments. If a vector, should match time.n in length. 26 | Defaults to 1, for full population participation in market.} 27 | 28 | \item{market.rate.seas}{the seasonal variation in market size, written as 29 | the proportion of the post-market-trend population in the market. For 30 | example, for market.rate.trend = 0.8 and market.rate.seas = 0.5, 31 | seasonal variation leaves 40% = 50% of the 80% of the population 32 | potentially in market according to market.rate.trend actually in 33 | market. If a vector, should match time.n in length. Defaults to 1 for 34 | full population participation in market.} 35 | 36 | \item{sat.decay}{single numeric value between 0 and 1, representing the 37 | geometric decay rate at which satiated individuals become unsatiated. 38 | Defaults to 1 for satiation lasting 1 time period for all 39 | individuals.} 40 | 41 | \item{prop.activity}{vector of nonnegative values summing to 1, representing 42 | the proportion of the population to be assigned to each activity 43 | state, given they are "responsive," i.e., "in.market" and 44 | "unsatiated."} 45 | 46 | \item{prop.favorability}{vector of nonnegative values summing to 1, 47 | representing the proportion of the population to be assigned to each 48 | favorability state, given they are not "loyal."} 49 | 50 | \item{prop.loyalty}{vector of nonnegative values summing to 1, representing 51 | the proportion of the population to be assigned to each loyalty 52 | state.} 53 | 54 | \item{prop.availability}{vector of nonnegative values summing to 1, 55 | representing the proportion of the population to be assigned to each 56 | availability state.} 57 | 58 | \item{transition.matrices}{list of matrices for each dimension of population 59 | segmentation that may be affected by marketing interventions. A named 60 | list with members 'activity', 'favorability', 'loyalty', and 61 | 'availability' is expected. By default, any missing members will have 62 | no effect. The transition matrices represent natural migration in 63 | these dimensions, and control how quickly the population returns to 64 | its equilibrium allocation across segments after marketing 65 | interventions.} 66 | } 67 | \value{ 68 | \code{invisible(NULL)}. \code{data.dt} is updated by reference. 69 | } 70 | \description{ 71 | This function models natural consumer behavior in the absence of marketing 72 | interventions. In particular, it models changes in consumer mindset over 73 | time that are outside of advertiser control, such as seasonal changes. 74 | } 75 | 76 | -------------------------------------------------------------------------------- /man/DefaultSalesModule.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_sales.R 3 | \name{DefaultSalesModule} 4 | \alias{DefaultSalesModule} 5 | \title{Model advertiser and competitor sales.} 6 | \usage{ 7 | DefaultSalesModule(data.dt, price, mean.price = 0, 8 | advertiser.demand.intercept = list(), 9 | advertiser.demand.slope = list(favorability = rep(0, 10 | length(kFavorabilityStates))), competitor.demand.max = list(loyalty = c(1, 11 | 0, 1)), competitor.demand.replacement = list(loyalty = c(0.5, 0, 1)), 12 | purchase.quantity.intercept = 1, purchase.quantity.slope = 0, 13 | purchase.quantity.competitor = 1, unit.cost = 0, 14 | advertiser.transitions = list(), competitor.transitions = list()) 15 | } 16 | \arguments{ 17 | \item{data.dt}{data.table with rows corresponding to population segments and 18 | columns corresponding to specific variables} 19 | 20 | \item{price}{numeric vector of product price over time. If the vector is 21 | shorter than the number of timepoints, it is repeated as necessary.} 22 | 23 | \item{mean.price}{numeric scaler, the mean of price over time. Defaults to 24 | zero.} 25 | 26 | \item{advertiser.demand.intercept}{list of numeric vectors corresponding to 27 | each brand state (favorability, loyalty, and availability). The 28 | product of multiplicands corresponding to a particular segment with 29 | 'purchase' activity state is the probability consumers in that 30 | segment will purchase the advertiser's product if the price is 31 | mean.price and there is no competition. Missing members of the list have no 32 | effect on the calculation.} 33 | 34 | \item{advertiser.demand.slope}{list of numeric vectors corresponding to each 35 | brand state (favorability, loyalty, and availability). The product of 36 | multiplicands corresponding to a particular segment with 'purchase' 37 | activity state is the linear decrease in the probability consumers in 38 | that segment will purchase the advertiser's product when the price 39 | increases by 1, when there is no competition. Missing members of the 40 | list have no effect on the calculation.} 41 | 42 | \item{competitor.demand.max}{list of numeric vectors corresponding to each 43 | brand state (favorability, loyalty, and availability). The product of 44 | multiplicands corresponding to a particular segment with 'purchase' 45 | activity state is the probability consumers in that segment will 46 | purchase a competitor's product when advertiser's product is too 47 | expensive to be a feasible choice. Missing members of the list have 48 | no effect on the calculation.} 49 | 50 | \item{competitor.demand.replacement}{list of numeric vectors corresponding 51 | to each brand state (favorability, loyalty, and availability). The 52 | product of multiplicands corresponding to a particular segment 53 | specifies the degree to which advertiser and competitor sales are 54 | replacements for each other. At 1, competitor sales are unaffected by 55 | advertiser pricing, and competitor sales replace advertiser sales to 56 | the greatest degree possible. At 0, advertiser sales are unaffected 57 | by the presence of the competitor, and advertiser sales replace 58 | competitor sales to the greatest degree possible. Thus, a reasonble 59 | interpretation of consumer loyalty might set this parameter to 60 | \code{list(loyalty = c(0.5, 0.1, 0.9)}. Missing members of the list 61 | have no effect on the calculation.} 62 | 63 | \item{purchase.quantity.intercept}{numeric, at least 1. Represents the 64 | average number of units bought by each consumer purchasing from the 65 | advertiser's brand, if price is mean.price.} 66 | 67 | \item{purchase.quantity.slope}{numeric, generally >= 0. Represents the 68 | decrease in the average purchase quantity per consumer purchasing 69 | from the advertiser's brand given a unit increase in price. Missing 70 | members of the list have no effect on the calculation.} 71 | 72 | \item{purchase.quantity.competitor}{average number of units bought by 73 | consumers purchasing a comeptitor's product. Must be at the least the 74 | default value of 1.} 75 | 76 | \item{unit.cost}{numeric greater than 0, cost of goods sold, for one unit of 77 | the advertiser's product.} 78 | 79 | \item{advertiser.transitions}{list of transition matrices for each brand 80 | state, specifying post-purchase changes in consumer mindset for those 81 | who purchased the advertiser's brand. A named list with members 82 | 'favorability', 'loyalty', and 'availability' is expected. Any 83 | missing members will have no effect. The default value, \code{list()} 84 | results in no post-purchase migration.} 85 | 86 | \item{competitor.transitions}{list of transition matrices for each brand 87 | state, specifying post-purchase changes in consumer mindset for those 88 | who purchased a competitor's brand. A named list with members 89 | 'favorability', 'loyalty', and 'availability' is expected. Any 90 | missing members will have no effect. The default value, \code{list()} 91 | results in no post-purchase migration.} 92 | } 93 | \value{ 94 | \code{invisible(NULL)}. \code{data.dt} updated by reference. 95 | } 96 | \description{ 97 | Simulate consumer purchase behavior, and thus the advertiser's and its 98 | competitors' sales. 99 | } 100 | 101 | -------------------------------------------------------------------------------- /man/DefaultSearchMediaModule.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_media.R 3 | \name{DefaultSearchMediaModule} 4 | \alias{DefaultSearchMediaModule} 5 | \title{Model paid and/or organic search.} 6 | \usage{ 7 | DefaultSearchMediaModule(data.dt, budget.index, budget, 8 | spend.cap.fn = function(time, budget, budget.indices) { Inf }, 9 | bid.fn = function(time, per.capita.budget, budget.indices) { Inf }, 10 | kwl.fn = function(time, per.capita.budget, budget.indices) { 1 }, 11 | audience.membership = list(), query.rate = 1, cpc.min = 0, 12 | cpc.max = 1, ctr = list(), relative.effectiveness = c(0, 0, 1), 13 | transition.matrices = list()) 14 | } 15 | \arguments{ 16 | \item{data.dt}{data.table with rows corresponding to population segments and 17 | columns corresponding to specific variables} 18 | 19 | \item{budget.index}{vector specifying budget period each time point belongs 20 | to. For example, rep(1:4, each = 52) would correspond to 4 years of 21 | yearly budget periods.} 22 | 23 | \item{budget}{vector specifying the target spend for each budget period. For 24 | example, given the example \code{budget.index} from above, 25 | \code{budget = rep(1e6, 4)} would specify a budget of 1 million for 26 | each year.} 27 | 28 | \item{spend.cap.fn}{function mapping the current time, the budget, and the 29 | budget period to a spend cap for the current week. By default this is 30 | set to \code{Inf}, representing uncapped spend.} 31 | 32 | \item{bid.fn}{function mapping the current time, the per-capita budget over 33 | the population, and the budget period to a bid for the current week. 34 | By default this is set to \code{Inf}, so that the advertiser wins all 35 | auctions and will pay the maximum CPC.} 36 | 37 | \item{kwl.fn}{function mapping the current time, the per-capita budget over 38 | the population, and the budget period to the proportion of queries. 39 | that match the keyword list. By default this is the maximum value of 40 | 1. To specify the proportion of matching queries by population 41 | segment, have kwl.fn return a vector with entries for each segment.} 42 | 43 | \item{audience.membership}{list of multipliers used to calculate probability 44 | of audience membership. Each element of the list corresponds to a 45 | specific dimension of population segmentation. Multipliers 46 | corresponding to each dimension are multiplied to derive audience 47 | membership probability for each segment. A named list with members 48 | 'activity', 'favorability', 'loyalty', and 'availability' is 49 | expected. Each member is a numeric vector containing the multipliers 50 | to use for each state in the dimension. For example, if member 51 | "activity" is c(1, 0.5, 0.7), a multiplier of 0.7 should be used for 52 | all segments with activity state "purchase." By default, any missing 53 | members will have no effect.} 54 | 55 | \item{query.rate}{nonnegative numeric, or vector. Each member of the 56 | audience makes matching queries according to a Poisson process with 57 | this rate. A vector rate specifies the query rate at each time. Note 58 | that rate is the expected number of queries per person in the 59 | audience. Defaults to 1. Vector repeats as necessary, so that 60 | repeating patterns can be specified more simply.} 61 | 62 | \item{cpc.min}{minimum CPC, defaults to 1. Must be nonnegative. vector 63 | values are interpreted as the vector of minimum CPC's over time.} 64 | 65 | \item{cpc.max}{maximum CPC. Must be at least as large as cpc.min. vector 66 | values are interpreted as the vector of maximum CPC's over time.} 67 | 68 | \item{ctr}{list of multipliers for each dimension with an effect on the 69 | clickthrough rate (ctr). Values in each state are multiplied to 70 | derive the ctr for each population segment. A named list with members 71 | 'activity', 'favorability', 'loyalty', and 'availability' is 72 | expected. Each member is a numeric vector of the values for each 73 | state in that dimension. By default, any missing members will have no 74 | effect.} 75 | 76 | \item{relative.effectiveness}{effectiveness, relative to the maximum 77 | effectiveness specified by the transition matrices, by volume type: 78 | organic only, paid impressions w/o paid click (click on organic 79 | result included), and paid clicks. Default to maximum (1) 80 | effectiveness for paid clicks, and no effect otherwise.} 81 | 82 | \item{transition.matrices}{list of transition matrices for each dimension of 83 | population segmentation that may be affected by marketing 84 | interventions. A named list with members 'activity', 'favorability', 85 | 'loyalty', and 'availability' is expected. By default, any missing 86 | members will have no effect.} 87 | } 88 | \value{ 89 | \code{invisible(NULL)}. \code{data.dt} updated by reference. 90 | } 91 | \description{ 92 | Simulate the behavior of a paid and/or organic search, including observable 93 | variables (e.g., query volume, paid clicks, spend) and the effect on 94 | consumer mindset. 95 | } 96 | 97 | -------------------------------------------------------------------------------- /man/DefaultTraditionalMediaModule.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_media.R 3 | \name{DefaultTraditionalMediaModule} 4 | \alias{DefaultTraditionalMediaModule} 5 | \title{Model the effect of a traditional media channel.} 6 | \usage{ 7 | DefaultTraditionalMediaModule(data.dt, budget.index, budget, 8 | audience.membership = list(), flighting = rep(1, length(budget.index)), 9 | unit.cost = 1, effectiveness.function = NULL, hill.ec = 1, 10 | hill.slope = 1, transition.matrices = list()) 11 | } 12 | \arguments{ 13 | \item{data.dt}{data.table with rows corresponding to population segments and 14 | columns corresponding to specific variables} 15 | 16 | \item{budget.index}{vector specifying budget period each time point belongs 17 | to. For example, rep(1:4, each = 52) would correspond to 4 years of 18 | yearly budget periods.} 19 | 20 | \item{budget}{vector specifying the target spend for each budget period. For 21 | example, given the example \code{budget.index} from above, 22 | \code{budget = rep(1e6, 4)} would specify a budget of 1 million for 23 | each year.} 24 | 25 | \item{audience.membership}{list of multipliers used to calculate probability 26 | of audience membership. Each element of the list corresponds to a 27 | specific dimension of population segmentation. Multipliers 28 | corresponding to each dimension are multiplied to derive audience 29 | membership probability for each segment. A named list with members 30 | 'activity', 'favorability', 'loyalty', and 'availability' is 31 | expected. Each member is a numeric vector containing the multipliers 32 | to use for each state in the dimension. For example, if member 33 | "activity" is c(1, 0.5, 0.7), a multiplier of 0.7 should be used for 34 | all segments with activity state "purchase." By default, any missing 35 | members will have no effect.} 36 | 37 | \item{flighting}{specifies the relative amount to be spent on each time 38 | point within a budget period. For example, in a budget period of two 39 | weeks, \code{flighting = c(1,2)} specifies that twice 1/3 of the 40 | budget should be spent in the first week, and 2/3 in the second.} 41 | 42 | \item{unit.cost}{positive numeric specifying expected unit cost per 43 | exposure.} 44 | 45 | \item{effectiveness.function}{vectorized function mapping frequency to media 46 | effect (relative to transition matrices specifying maximum effect). 47 | The range of the function should be bounded between 0 and 1. Given 48 | the default value of NULL, the module will used the Hill 49 | transformation with parameters hill.ec and hill.slope.} 50 | 51 | \item{hill.ec}{parameter controlling the scaling of frequency vs. effect. 52 | This is the EC50 of the Hill transformation.} 53 | 54 | \item{hill.slope}{parameter controlling the scaling of frequency vs. effect. 55 | This is the maximum slope of the Hill transformation.} 56 | 57 | \item{transition.matrices}{list of transition matrices for each dimension of 58 | population segmentation that may be affected by marketing 59 | interventions. A named list with members 'activity', 'favorability', 60 | 'loyalty', and 'availability' is expected. By default, any missing 61 | members will have no effect.} 62 | } 63 | \value{ 64 | \code{invisible(NULL)}. \code{data.dt} updated by reference. 65 | } 66 | \description{ 67 | Simulate the behavior of a traditional media channel, and generate 68 | associated observable variables such as media volume and spend. 69 | } 70 | 71 | -------------------------------------------------------------------------------- /man/Desatiate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_natural_migration.R 3 | \name{Desatiate} 4 | \alias{Desatiate} 5 | \title{Implement desatiation.} 6 | \usage{ 7 | Desatiate(data.dt, sat.decay, prop.activity = rep(1/length(kActivityStates), 8 | length(kActivityStates))) 9 | } 10 | \arguments{ 11 | \item{data.dt}{data.table to update} 12 | 13 | \item{sat.decay}{rate for the geometric decay of satiation} 14 | 15 | \item{prop.activity}{proportion of population assigned to each activity 16 | state, given that they are responsive.} 17 | } 18 | \value{ 19 | \code{invisible(NULL)}. \code{data.dt} is updated by reference. 20 | } 21 | \description{ 22 | Implement desatiation. 23 | } 24 | \note{ 25 | Satiation has geometric decay with rate \code{sat.decay}. Thus, 26 | during any time interval, \code{sat.decay} proportion of currently 27 | satiated individuals desatiate. Individuals put into a responsive state 28 | by desatiation are assigned activity states at rates defined by 29 | prop.activity. 30 | } 31 | \keyword{internal} 32 | 33 | -------------------------------------------------------------------------------- /man/EvalText.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{EvalText} 4 | \alias{EvalText} 5 | \title{Parse and evaluate a text string.} 6 | \usage{ 7 | EvalText(x, env = parent.frame()) 8 | } 9 | \arguments{ 10 | \item{x}{string to be sent as \code{text} argument to \code{parse}.} 11 | 12 | \item{env}{environment to use for evaluation. the default parent.frame() 13 | refers to the calling environment. See note for further details.} 14 | } 15 | \value{ 16 | the evaluated expression \code{eval(parse(text = x, env))}. 17 | } 18 | \description{ 19 | Shorthand for eval(parse(text = x, env)), frequently used with data.table, 20 | with env set to the data.table. 21 | } 22 | \note{ 23 | \code{parent.frame()} is a good default for env, but may lead to unusual 24 | behavior if passed to \code{EvalText()} explicitly. Default arguments are 25 | evaluated inside the execution environment of the function where they 26 | are used. However, explicitly passed arguments are evaluated inside the 27 | calling environment instead. Thus, in Example 2, \code{EvalText("x")} 28 | evaluates \code{parent.frame()} from within the execution environment of 29 | \code{EvalText()}, and finds the execution environment of \code{fn()}, where 30 | \code{x = 2}. This is the generally desired behavior. However, 31 | \code{EvalText("x", parent.frame())} evaluates \code{parent.frame()} from 32 | within the calling environment of \code{EvalText()}, i.e. from within the 33 | execution environment of \code{fn()}. This gives the global environment, 34 | where \code{x = 1}. 35 | } 36 | \examples{ 37 | # Example 1 38 | dt <- data.table::as.data.table(mtcars) 39 | colname <- "mpg" 40 | dt[, amss:::EvalText(colname, dt)] 41 | dt[, (amss:::PasteD(colname, "plus1")) := amss:::EvalText(colname, dt) + 1] 42 | 43 | # Example 2. 44 | x <- 1 45 | fn <- function() { 46 | x <- 2 47 | return(c(amss:::EvalText("x"), amss:::EvalText("x", parent.frame()))) 48 | } 49 | fn() 50 | 51 | } 52 | \keyword{internal} 53 | 54 | -------------------------------------------------------------------------------- /man/GenerateDataUnderNewBudget.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/attribution.R 3 | \name{GenerateDataUnderNewBudget} 4 | \alias{GenerateDataUnderNewBudget} 5 | \title{Generate data under a new budget} 6 | \usage{ 7 | GenerateDataUnderNewBudget(object, new.budget = GetBudget(object), 8 | response.metric = NULL, reps = 1, t.start = 1, 9 | t.end = object$params$time.n) 10 | } 11 | \arguments{ 12 | \item{object}{object of class \code{amss.sim} to do prediction on.} 13 | 14 | \item{new.budget}{new budget levels for each media} 15 | 16 | \item{response.metric}{string specifying what observable value to predict. 17 | defaults to NULL, which results in entire dataset. Values such as 18 | "log(brand.sales)" will make the prediction function return the 19 | average log(brand.sales) over all reps, for ex.} 20 | 21 | \item{reps}{number of replicates to generate} 22 | 23 | \item{t.start}{time point at which to start generating new data} 24 | 25 | \item{t.end}{time point at which to stop generating new data} 26 | } 27 | \value{ 28 | The list of all generated datasets or a vector of averaged values. 29 | } 30 | \description{ 31 | Simulate multiple datasets from a counterfactual simulation setting with 32 | new budget settings. 33 | } 34 | \keyword{internal} 35 | 36 | -------------------------------------------------------------------------------- /man/GetBrandStates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/segmentation_consts.R 3 | \name{GetBrandStates} 4 | \alias{GetBrandStates} 5 | \title{Generate the list of brand states.} 6 | \usage{ 7 | GetBrandStates() 8 | } 9 | \value{ 10 | \code{data.frame} with column \code{brand} containing all valid 11 | values for brand state. 12 | } 13 | \description{ 14 | Brand states are a combination of brand favorability, brand loyalty, and 15 | brand availability. This functions produces a list all valid combinations 16 | of these three dimensions of population segmentation. 17 | } 18 | \keyword{internal} 19 | 20 | -------------------------------------------------------------------------------- /man/GetBudget.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s3_amss_sim.R 3 | \name{GetBudget} 4 | \alias{GetBudget} 5 | \title{Get budget information from a simulation object.} 6 | \usage{ 7 | GetBudget(object) 8 | } 9 | \arguments{ 10 | \item{object}{object of class amss.sim} 11 | } 12 | \value{ 13 | matrix of budgets by budget period (row) and media name (column) 14 | } 15 | \description{ 16 | Retrieves information on media budgets from an object of class 17 | \code{amss.sim}. 18 | } 19 | \keyword{internal} 20 | 21 | -------------------------------------------------------------------------------- /man/GetBudgetIdx.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s3_amss_sim.R 3 | \name{GetBudgetIdx} 4 | \alias{GetBudgetIdx} 5 | \title{Get the budget period assigned to each time interval.} 6 | \usage{ 7 | GetBudgetIdx(object) 8 | } 9 | \description{ 10 | Read the budget indices from an \code{amss.sim} object. 11 | } 12 | \details{ 13 | The budget indices specify which time intervals belong to the same budget 14 | period. 15 | } 16 | 17 | -------------------------------------------------------------------------------- /man/GetCategoryStates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/segmentation_consts.R 3 | \name{GetCategoryStates} 4 | \alias{GetCategoryStates} 5 | \title{Generate the list of category states.} 6 | \usage{ 7 | GetCategoryStates() 8 | } 9 | \value{ 10 | \code{data.frame} with columns \code{market}, \code{satiation}, and 11 | \code{activity}, listing all valid combinations of market, satiation, 12 | and activity states 13 | } 14 | \description{ 15 | Category states are a combination of market, satation, and activity state. 16 | This functions produces a list all valid combinations of these three 17 | dimensions of population segmentation. 18 | } 19 | \keyword{internal} 20 | 21 | -------------------------------------------------------------------------------- /man/GetInterior.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/optimize.R 3 | \name{GetInterior} 4 | \alias{GetInterior} 5 | \title{Find an interior point in a bounding box.} 6 | \usage{ 7 | GetInterior(lower.bound, upper.bound, sum.lower.bound, sum.upper.bound) 8 | } 9 | \arguments{ 10 | \item{lower.bound:}{vector of lower bounds for each coordinate.} 11 | 12 | \item{upper.bound:}{vector of upper bounds for each coordinate.} 13 | 14 | \item{sum.lower.bound:}{numeric, lower bound on the sum of all coordinates.} 15 | 16 | \item{sum.upper.bound:}{numeric, upper bound on the sum of all coordinates.} 17 | } 18 | \value{ 19 | \code{GetInterior} returns a vector representing an interior point in 20 | the set. 21 | } 22 | \description{ 23 | The current optimization tool requires an interior point of the 24 | set we are optimizing over. We assume that the constraints consist of a 25 | bounding box (lower and upper bounds on each coordinate) and bounds on the 26 | vector sum. 27 | } 28 | \details{ 29 | This function finds an interior point of the set bounded in each coordinate 30 | by lower bounds \code{lower.bound} and upper bounds \code{upper.bound}, and 31 | with sum bounded between \code{sum.lower.bound} and \code{sum.upper.bound}. 32 | It firsts modifies the constraints to be finite, and then finds the point x 33 | along the line passing from lower.bound to upper.bound such that 34 | sum(x) = (sum.lower.bound + sum.upper.bound) / 2. 35 | } 36 | \keyword{internal} 37 | 38 | -------------------------------------------------------------------------------- /man/GetPopulation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s3_amss_sim.R 3 | \name{GetPopulation} 4 | \alias{GetPopulation} 5 | \title{Get population size from a simulation object.} 6 | \usage{ 7 | GetPopulation(object) 8 | } 9 | \arguments{ 10 | \item{object}{object of class amss.sim} 11 | } 12 | \value{ 13 | integer population size 14 | } 15 | \description{ 16 | Retrieves population size from an object of class \code{amss.sim}. 17 | } 18 | \keyword{internal} 19 | 20 | -------------------------------------------------------------------------------- /man/HillTrans.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{HillTrans} 4 | \alias{HillTrans} 5 | \title{Define the Hill transformation function.} 6 | \usage{ 7 | HillTrans(x, ec, slope, beta = 1) 8 | } 9 | \arguments{ 10 | \item{x}{original input.} 11 | 12 | \item{ec}{effective concentration parameter.} 13 | 14 | \item{slope}{slope parameter} 15 | 16 | \item{beta}{vertical scale parameter, defaults to 1} 17 | } 18 | \value{ 19 | tranformed value = beta / (1 + (x / ec) ^ (-slope)) 20 | } 21 | \description{ 22 | The Hill function is one option for parameterizing a flexible set of S-shaped 23 | curves. 24 | } 25 | \keyword{internal} 26 | 27 | -------------------------------------------------------------------------------- /man/InitPop.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_natural_migration.R 3 | \name{InitPop} 4 | \alias{InitPop} 5 | \title{Initialize population segmentation.} 6 | \usage{ 7 | InitPop(data.dt, pop.total, market.rate = 1, 8 | prop.activity = rep(1/length(kActivityStates), length(kActivityStates)), 9 | prop.favorability = rep(1/length(kFavorabilityStates), 10 | length(kFavorabilityStates)), prop.loyalty = rep(1/length(kLoyaltyStates), 11 | length(kLoyaltyStates)), 12 | prop.availability = rep(1/length(kAvailabilityStates), 13 | length(kAvailabilityStates))) 14 | } 15 | \arguments{ 16 | \item{data.dt}{data.table containing all state-related data} 17 | 18 | \item{pop.total}{total population} 19 | 20 | \item{market.rate}{target proportion of consumers in 'in-market' market 21 | state.} 22 | 23 | \item{prop.activity}{vector of nonnegative values summing to 1, representing 24 | the proportion of the population to be assigned to each activity 25 | state, given they are "responsive," i.e., "in.market" and 26 | "unsatiated."} 27 | 28 | \item{prop.favorability}{vector of nonnegative values summing to 1, 29 | representing the proportion of the population to be assigned to each 30 | favorability state, given they are not "loyal."} 31 | 32 | \item{prop.loyalty}{vector of nonnegative values summing to 1, representing 33 | the proportion of the population to be assigned to each loyalty 34 | state.} 35 | 36 | \item{prop.availability}{vector of nonnegative values summing to 1, 37 | representing the proportion of the population to be assigned to each 38 | availability state.} 39 | } 40 | \value{ 41 | \code{invisible(NULL)}. \code{data.dt} is updated by reference. 42 | } 43 | \description{ 44 | Initialize population segmentation. 45 | } 46 | \keyword{internal} 47 | 48 | -------------------------------------------------------------------------------- /man/InitStateData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate.R 3 | \name{InitStateData} 4 | \alias{InitStateData} 5 | \title{Initialize data.} 6 | \usage{ 7 | InitStateData(time.index = 0) 8 | } 9 | \arguments{ 10 | \item{time.index}{time index to intialize the data table to} 11 | } 12 | \value{ 13 | data.table with one column for each state variable (market, 14 | satiation, activity, brand) and one row per each valid combination of 15 | states for the above state variables. Also initializes the population 16 | count at timepoint 1 as 0. 17 | } 18 | \description{ 19 | Initialize the updating \code{data.table} containing current data on each 20 | population segment. 21 | } 22 | \keyword{internal} 23 | 24 | -------------------------------------------------------------------------------- /man/MigrateMarginal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/migrate.R 3 | \name{MigrateMarginal} 4 | \alias{MigrateMarginal} 5 | \title{Simulate migration in a single dimension of population segmentation.} 6 | \usage{ 7 | MigrateMarginal(data.dt, migrating.pop.size, migration.dim, transition.matrix) 8 | } 9 | \arguments{ 10 | \item{data.dt}{data.table with rows representing population segments and 11 | columns representing specific variables.} 12 | 13 | \item{migrating.pop.size}{migrating population size} 14 | 15 | \item{migration.dim}{name dimension of migration, must be a column of 16 | kAllStates.} 17 | 18 | \item{transition.matrix}{transition matrix specifying probabilities of 19 | migration between states.} 20 | } 21 | \value{ 22 | \code{invisible(NULL)}. \code{data.dt} is updated by reference. 23 | } 24 | \description{ 25 | Simulate migration of indivduals between different states in single 26 | dimension of population segmentation, such as "brand favorability." 27 | } 28 | \keyword{internal} 29 | 30 | -------------------------------------------------------------------------------- /man/MigrateMultiple.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/migrate.R 3 | \name{MigrateMultiple} 4 | \alias{MigrateMultiple} 5 | \title{Simulate migration in multiple dimensions of population segmentation.} 6 | \usage{ 7 | MigrateMultiple(data.dt, migrating.pop.size, migration.dims = character(), 8 | transition.matrices = list()) 9 | } 10 | \arguments{ 11 | \item{data.dt}{data.table with rows representing population segments and 12 | columns representing specific variables.} 13 | 14 | \item{migrating.pop.size}{migrating population size} 15 | 16 | \item{migration.dims}{a character vector of dimensions of migration, by 17 | name.} 18 | 19 | \item{transition.matrices}{a list of transition matrices for each dimension.} 20 | } 21 | \value{ 22 | \code{invisible(NULL)}. \code{data.dt} is updated by reference. 23 | } 24 | \description{ 25 | Perform successive migrations of consumers between population segments, with 26 | each migration focusing on changes in a particular dimension of population 27 | segmentation. 28 | } 29 | \keyword{internal} 30 | 31 | -------------------------------------------------------------------------------- /man/MultiplyBySegment.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{MultiplyBySegment} 4 | \alias{MultiplyBySegment} 5 | \title{Calculate the product of population segmentation dimension-specific factors.} 6 | \usage{ 7 | MultiplyBySegment(multiplicand.list = list(), starting.multiplicand = 1) 8 | } 9 | \arguments{ 10 | \item{multiplicand.list}{list of named numeric vectors. Each vector 11 | corresponds to the named dimension of population segmentation. It 12 | specifies the value assigned to every state possible in that 13 | dimension. Dimensions other than 'activity', 'favorability', 14 | 'loyalty', and 'availailability' are ignored. Dimensions missing from 15 | the list do not affect the product.} 16 | 17 | \item{starting.multiplicand}{numeric constant, additional factor to multiply 18 | every product by. Default 1.} 19 | } 20 | \value{ 21 | numeric vector. For each population segment, the vector holds the 22 | product of multiplying all factors corresponding to that segment. 23 | } 24 | \description{ 25 | Multiplies factors corresponding to dimensions of segmentation. 26 | } 27 | \keyword{internal} 28 | 29 | -------------------------------------------------------------------------------- /man/OptimizeSpend.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/optimize.R 3 | \name{OptimizeSpend} 4 | \alias{OptimizeSpend} 5 | \title{Optimize the media budgets in a specified budget period.} 6 | \usage{ 7 | OptimizeSpend(object, budget.period = max(GetBudgetIdx(object)), 8 | t.start = match(budget.period, GetBudgetIdx(object)), 9 | t.end = object$params$time.n, lower.bound = 0, upper.bound = Inf, 10 | sum.lower.bound = 0, sum.upper.bound = Inf, scaled.pop.size = 1e+18) 11 | } 12 | \arguments{ 13 | \item{object}{an object of class \code{amss.sim}} 14 | 15 | \item{budget.period}{numeric, the budget period to be optimized, the default 16 | being the most current budget period.} 17 | 18 | \item{t.start}{integer, the first time interval over which the result 19 | (profit) of the budget settings should be calculated.} 20 | 21 | \item{t.end}{integer, the last time interval over which the result (profit) 22 | of the budget settings should be calculated.} 23 | 24 | \item{lower.bound}{numeric vector, the lower bound on the budget for each 25 | media channel.} 26 | 27 | \item{upper.bound}{numeric vector, the upper bound on the budget for each 28 | media channel.} 29 | 30 | \item{sum.lower.bound}{numeric, the lower bound on the total advertising 31 | spend.} 32 | 33 | \item{sum.upper.bound}{numeric, the upper bound on the total advertising 34 | spend.} 35 | 36 | \item{scaled.pop.size}{numeric, the population is scaled to this size in 37 | order to increase the accuracy of estimated expected profit.} 38 | } 39 | \value{ 40 | \code{OptimizeBudget} returns a \code{list} with elemtnts 41 | \describe{ 42 | \item{opt.spend}{the optimal spend in each media channel.} 43 | \item{opt.budget}{the optimal budget in the specified budget period.} 44 | \item{opt.profit}{the profit resulting from the optimal budget.} 45 | \item{orig.profit}{the profit in the original dataset.} 46 | } 47 | } 48 | \description{ 49 | Given a budget period and a set of constraints, find the budget setting and 50 | the associated media spend that maximizes the profit (revenue minus cost of 51 | production and advertising spend). 52 | } 53 | \details{ 54 | See \code{DefaultSalesModule} for details on how the relationship between 55 | revenue, profit, units sold, and advertising spend is specified. 56 | } 57 | \note{ 58 | A module does not necessarily force the spend in a budget period to 59 | match the budget. For example, in the paid search module, the budget is used 60 | as the lever that leads to increasing/decreasing search spend. 61 | Users should expect a monotonic relationship between budget and spend, but 62 | no more. The budget is useful as a parameter in simulation and optimization, 63 | as it is the lever moving advertiser-controlled settings in each media 64 | channel. The spend, which may depend on other factors outside of the 65 | advertiser's control, cannot be directly optimized; it is not a direct 66 | input into the simulator. However, any budget settings can be mapped to a 67 | corresponding media spend, and this is reported as the optimal spend. The 68 | optimal spend is more meaningful than the budget as a reporting metric, and 69 | is the key output of \code{OptimizeSpend}. 70 | } 71 | \examples{ 72 | \dontrun{ 73 | # Use the amss.sim object test.data from the testing suite. 74 | # Find the optimal budget for the third budget period. 75 | OptimizeSpend(test.data, budget.period = 3) 76 | } 77 | } 78 | 79 | -------------------------------------------------------------------------------- /man/ParseT.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{ParseT} 4 | \alias{ParseT} 5 | \title{Parse text string.} 6 | \usage{ 7 | ParseT(text) 8 | } 9 | \arguments{ 10 | \item{text}{string to be sent as \code{text} argument to \code{parse}.} 11 | } 12 | \value{ 13 | the text as an expression, result of calling 14 | \code{parse(text = text)}. 15 | } 16 | \description{ 17 | Shorthand for parse(text = ...), frequently used with data.table This 18 | saves us from having to redo row selection in the env argument of 19 | EvalText(). 20 | } 21 | \note{ 22 | Including outer \code{eval()} call in the shorthand caused errors, 23 | and needs to be done separately. 24 | } 25 | \examples{ 26 | dt <- data.table::as.data.table(mtcars) 27 | colname <- "mpg" 28 | dt[1:5, eval(amss:::ParseT(colname))] 29 | dt[, (amss:::PasteD(colname, "plus1")) := eval(amss:::ParseT(colname)) + 1] 30 | 31 | } 32 | \keyword{internal} 33 | 34 | -------------------------------------------------------------------------------- /man/PasteD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{PasteD} 4 | \alias{PasteD} 5 | \title{Paste with "." separator.} 6 | \usage{ 7 | PasteD(...) 8 | } 9 | \arguments{ 10 | \item{...}{vector of strings to concatenate.} 11 | } 12 | \value{ 13 | concatenated string. 14 | } 15 | \description{ 16 | Function to simplify pasting with . as separator. 17 | } 18 | \keyword{internal} 19 | 20 | -------------------------------------------------------------------------------- /man/RBinom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/random_number_generator.R 3 | \name{RBinom} 4 | \alias{RBinom} 5 | \title{Simulate random number from the binomial distribution.} 6 | \usage{ 7 | RBinom(n, size, prob) 8 | } 9 | \arguments{ 10 | \item{n}{number of observations. If \code{length(n) > 1}, the length is 11 | taken to be the number required.} 12 | 13 | \item{size}{number of trials (zero or more). When \code{size} is a vector, 14 | the number of trials for each observation. Conflicts between the number of 15 | observations \code{n} and the length of the size vector are resolved by 16 | truncating or repeating it to length \code{n}. This matches the behavior of 17 | the original \code{rbinom()}.} 18 | 19 | \item{prob}{probability of success on each trial. When \code{prob} is a 20 | vector, each entry refers to the probability of success for trials 21 | associated with the corresponding observation. Conflicts between the 22 | number of observations \code{n} and the length of the probability vector 23 | are resolved by truncating or repeating it to length \code{n}. This matches 24 | the behavior of the original \code{rbinom()}.} 25 | } 26 | \value{ 27 | Random numbers from the binomial distribution, or its normal 28 | approximation. The function will return a numeric value, rather than an 29 | integer. 30 | } 31 | \description{ 32 | Generate random integers from the binomial distribution when possible within 33 | integer overflow constraints. Otherwise, approximate with the normal 34 | distribution. 35 | } 36 | \keyword{internal} 37 | 38 | -------------------------------------------------------------------------------- /man/RHyper.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/random_number_generator.R 3 | \name{RHyper} 4 | \alias{RHyper} 5 | \title{Simulate random number from the hypergeometric distribution.} 6 | \usage{ 7 | RHyper(nn, m, n, k) 8 | } 9 | \arguments{ 10 | \item{nn}{number of observations. If \code{length(nn) > 1}, the length is 11 | taken to be the number required.} 12 | 13 | \item{m}{the number of white balls in the urn.} 14 | 15 | \item{n}{the number of black balls in the urn.} 16 | 17 | \item{k}{the number of balls drawn from the urn.} 18 | } 19 | \value{ 20 | Random numbers from the binomial distribution, or its normal 21 | approximation. The function will a numeric value, rather than an integer. 22 | } 23 | \description{ 24 | Generate random integers from the hypergeometric distribution when possible 25 | within integer overflow constraints. Otherwise, approximate with the normal 26 | distribution. 27 | } 28 | \details{ 29 | The hypergeometric distribution is used for sampling the number of white 30 | balls drawn when a fixed number of balls is drawn without replacement from 31 | an urn which contains both black and white balls. 32 | } 33 | \keyword{internal} 34 | 35 | -------------------------------------------------------------------------------- /man/RMultinom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/random_number_generator.R 3 | \name{RMultinom} 4 | \alias{RMultinom} 5 | \title{Simulate random number from the multinomial distribution.} 6 | \usage{ 7 | RMultinom(n, size, prob) 8 | } 9 | \arguments{ 10 | \item{n}{the number of random vectors to draw} 11 | 12 | \item{size}{integer, say \eqn{N}, specifying the total number of objects 13 | that are put into \eqn{K} boxes in the typical multinomial experiment.} 14 | 15 | \item{prob}{numeric non-negative vector of length \eqn{K}, specifying the 16 | probability for the \eqn{K} classes; is internally normalized to sum 1. 17 | Infinite and missing values are not allowed.} 18 | } 19 | \value{ 20 | Matrix of random numbers from the multinomial distribution, or its 21 | normal approximation. The function will return a numeric value, rather than 22 | an integer. 23 | } 24 | \description{ 25 | Generate random integers from the binomial distribution when possible within 26 | integer overflow constraints. Otherwise, approximate with the normal 27 | distribution. 28 | } 29 | \keyword{internal} 30 | 31 | -------------------------------------------------------------------------------- /man/RNBinom.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/random_number_generator.R 3 | \name{RNBinom} 4 | \alias{RNBinom} 5 | \title{Simulate random number from the negative binomial distribution.} 6 | \usage{ 7 | RNBinom(n, size, prob, mu) 8 | } 9 | \arguments{ 10 | \item{n}{number of observations. If \code{length(n) > 1}, the length is 11 | taken to be the number required.} 12 | 13 | \item{size}{number of trials (zero or more). When \code{size} is a vector, 14 | the number of trials for each observation.} 15 | 16 | \item{prob}{probability of success on each trial. When \code{prob} is a 17 | vector, each entry refers to the probability of success for trials 18 | associated with the corresponding observation.} 19 | 20 | \item{mu}{alternative parametrization via mean: see 'Details' in 21 | documentation for \code{rnbinom()}.} 22 | } 23 | \value{ 24 | Random numbers from the negative binomial distribution, or its normal 25 | approximation. The function will return a numeric value, rather than an 26 | integer. 27 | } 28 | \description{ 29 | Generate random integers from the negative binomial distribution when 30 | possible within integer overflow constraints. Otherwise, approximate with the 31 | normal distribution. 32 | } 33 | \keyword{internal} 34 | 35 | -------------------------------------------------------------------------------- /man/RPois.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/random_number_generator.R 3 | \name{RPois} 4 | \alias{RPois} 5 | \title{Simulate random number from the Poisson distribution.} 6 | \usage{ 7 | RPois(n, lambda) 8 | } 9 | \arguments{ 10 | \item{n}{number of random values to return. If \code{length(n) > 1}, the 11 | length is taken to be the number required.} 12 | 13 | \item{lambda}{vector of (non-negative) means.} 14 | } 15 | \value{ 16 | RPois returns random numbers from the Poisson distribution, or its 17 | normal approximation. The function will return a numeric value, rather than 18 | an integer. 19 | } 20 | \description{ 21 | Generate random integers from the Poisson distribution if possible, given 22 | integer overflow constraints. Otherwise, approximate the Poisson with the 23 | normal distribution. 24 | } 25 | \keyword{internal} 26 | 27 | -------------------------------------------------------------------------------- /man/ReadRepeatingVector.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/misc_helper.R 3 | \name{ReadRepeatingVector} 4 | \alias{ReadRepeatingVector} 5 | \title{Read entry from repeated vector.} 6 | \usage{ 7 | ReadRepeatingVector(v, idx) 8 | } 9 | \arguments{ 10 | \item{v}{the vector being read} 11 | 12 | \item{idx}{the index to read the value from.} 13 | } 14 | \value{ 15 | the \code{idx}-th entry of \code{v}, under the assumption that 16 | \code{v} repeats as necessary to reach length \code{idx}. 17 | } 18 | \description{ 19 | Read an entry of a vector, under the assumption that it repeats to the 20 | necessary length. 21 | } 22 | \keyword{internal} 23 | 24 | -------------------------------------------------------------------------------- /man/ReduceDimension.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/optimize.R 3 | \name{ReduceDimension} 4 | \alias{ReduceDimension} 5 | \title{Reduce the dimensionality of the optimization} 6 | \usage{ 7 | ReduceDimension(n.dim, lower.bound, upper.bound, sum.lower.bound, 8 | sum.upper.bound) 9 | } 10 | \arguments{ 11 | \item{n.dim}{integer, original dimensionality of the optimization.} 12 | 13 | \item{lower.bound}{numeric vector, the constraint specifying the lower bound 14 | in each dimension.} 15 | 16 | \item{upper.bound}{numeric vector, the constraint specifying the upper bound 17 | in each dimension.} 18 | 19 | \item{sum.lower.bound}{numeric, the lower bound on the vector sum.} 20 | 21 | \item{sum.upper.bound}{numeric, the upper bound on the vector sum.} 22 | } 23 | \value{ 24 | \code{ReduceDimension} returns \code{NULL} if the constrained set 25 | is empty. Else, it returns a code{list} with elements 26 | \describe{ 27 | \item{lower.bound}{the new lower bound.} 28 | \item{upper.bound}{the new upper bound.} 29 | \item{sum.lower.bound}{the new lower bound on the vector sum.} 30 | \item{sum.upper.bound}{the new upper bound on the vector sum.} 31 | \item{decoder}{function mapping values in the new search space to values 32 | in the original search space.} 33 | \item{encoder}{function mapping values in the original search space to 34 | values in the new search space.} 35 | } 36 | } 37 | \description{ 38 | Reduce the dimensionality of the optimization and find a function that 39 | maps the new search space of the optimization to the original search space. 40 | } 41 | \details{ 42 | The search space is assumed to be the intersection of a bounding box and an 43 | upper/lower bound on the vector sum. If possible, the function finds an 44 | equivalent lower-dimensional search space of the same type, and provides a 45 | function mapping the new search space to the old search space. 46 | } 47 | \keyword{internal} 48 | 49 | -------------------------------------------------------------------------------- /man/SimulateAMSS.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate.R 3 | \name{SimulateAMSS} 4 | \alias{SimulateAMSS} 5 | \title{Generate simulation objects under the AMSS framework.} 6 | \usage{ 7 | SimulateAMSS(time.n, nat.mig.module = DefaultNatMigModule, 8 | nat.mig.params = list(), media.names = character(), 9 | media.modules = rep(list(DefaultTraditionalMediaModule), 10 | length(media.names)), media.params = rep(list(list()), length(media.names)), 11 | sales.module = DefaultSalesModule, sales.params = list(), ping = max(10, 12 | floor(time.n/10)), names.agg.const = NULL, names.agg.sum = NULL) 13 | } 14 | \arguments{ 15 | \item{time.n}{number of timepoints.} 16 | 17 | \item{nat.mig.module}{specifications of class \code{seq.specs}, to be used 18 | to create the non-actionable drivers module and then generate its 19 | variables} 20 | 21 | \item{nat.mig.params}{any parameter values to pass to \code{nat.mig.module}} 22 | 23 | \item{media.names}{character vector of unique names of all media modules. 24 | ex: c("tv", "search")} 25 | 26 | \item{media.modules}{list of functions that simulate the behavior of each 27 | marketing intervention.} 28 | 29 | \item{media.params}{list of parameter value lists for each media module.} 30 | 31 | \item{sales.module}{function that models the sales in the category.} 32 | 33 | \item{sales.params}{list of any parameter values to pass to the sales module} 34 | 35 | \item{ping}{the spacing between time points at which to print a message 36 | updating the user on simulation progress.} 37 | 38 | \item{names.agg.const}{character vector of names of variables to surface in 39 | the observed data, aggregated using the first entry, since they are 40 | constant over the hidden states. By default, if not specified, 41 | \code{SurfaceData()} will pick up variables with names containing 42 | "price" and/or "budget", and the "pop.total" variable.} 43 | 44 | \item{names.agg.sum}{character vector of names of variables to surface in 45 | the observed data, aggregated using the function \code{sum()}. By 46 | default, \code{SurfaceData()} will pick up variables with names 47 | matching "revenue", "profit", "sales", "volume", and/or "spend".} 48 | } 49 | \value{ 50 | an object of class \code{amss.sim}, containing 51 | \describe{ 52 | \item{data}{the observed data.} 53 | \item{data.full}{the full dataset, as a list of data.tables. Each 54 | \code{data.table} contains the data at the end of a time interval, by 55 | by population segment (row) and variable (column).} 56 | \item{params}{the parameters used to generate the data.} 57 | } 58 | } 59 | \description{ 60 | Produces an \code{amss.sim} object that contains the simulated data and can 61 | be used to derive ground truth about the scenario. 62 | } 63 | \details{ 64 | Objects of class \code{amss.sim} contain the full output from running a 65 | simulation scenario. This output includes the observed data, the complete 66 | dataset generated during the simulation process, and the parameters passed 67 | to the simulation function in order to generate the simulated data. The 68 | observed data is meant to be used by modelers. The complete dataset can be 69 | useful for users who want a more complete understanding of the forces 70 | operating in a simulation scenario. The parameter list is essential for 71 | generating future datasets based on the same, or slightly modified, 72 | simulation settings in order to obtain ground truth about the simulation 73 | scenario. 74 | } 75 | 76 | -------------------------------------------------------------------------------- /man/SimulateAR1.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_time_series.R 3 | \name{SimulateAR1} 4 | \alias{SimulateAR1} 5 | \title{Simulate AR1 time series} 6 | \usage{ 7 | SimulateAR1(n, stable.mu = 0, stable.sd = 1, autocor = 0) 8 | } 9 | \arguments{ 10 | \item{n}{integer number of time points} 11 | 12 | \item{stable.mu}{means of the stable distribution for each variable} 13 | 14 | \item{stable.sd}{standard deviations of the stable distributions} 15 | 16 | \item{autocor}{autocorrelations for each time series} 17 | } 18 | \value{ 19 | vector realization of specified AR1 times series 20 | } 21 | \description{ 22 | Function that outputs simulated AR1 time series with specified means, 23 | variances, and autocorrelations 24 | } 25 | \seealso{ 26 | Other Simulate.time.series: \code{\link{SimulateCorrelated}}, 27 | \code{\link{SimulateDummy}}, 28 | \code{\link{SimulateSinusoidal}} 29 | } 30 | 31 | -------------------------------------------------------------------------------- /man/SimulateCorrelated.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_time_series.R 3 | \name{SimulateCorrelated} 4 | \alias{SimulateCorrelated} 5 | \title{Simulate correlated vectors.} 6 | \usage{ 7 | SimulateCorrelated(v, cor.vx = 1, mu.x = 0, sigma.x = 1) 8 | } 9 | \arguments{ 10 | \item{v}{vector to which the new data will be correlated.} 11 | 12 | \item{cor.vx}{numeric specifying correlation between v and the new vector x.} 13 | 14 | \item{mu.x}{numeric, mean of the new vector x.} 15 | 16 | \item{sigma.x}{numeric, standard deviation of the new vector x.} 17 | } 18 | \value{ 19 | a vector x with the specified mean, standard deviation, and 20 | correlation. 21 | } 22 | \description{ 23 | Simulates a new vector x with a specified mean, standard deviation, and 24 | correlation with some other vector \code{v} by adding white noise and 25 | scaling. 26 | } 27 | \seealso{ 28 | Other Simulate.time.series: \code{\link{SimulateAR1}}, 29 | \code{\link{SimulateDummy}}, 30 | \code{\link{SimulateSinusoidal}} 31 | } 32 | 33 | -------------------------------------------------------------------------------- /man/SimulateData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate.R 3 | \name{SimulateData} 4 | \alias{SimulateData} 5 | \title{Simulate data using the AMSS framework.} 6 | \usage{ 7 | SimulateData(starting.dts = list(), time.n, nat.mig.module, nat.mig.params, 8 | media.names, media.modules, media.params, sales.module, sales.params, ping) 9 | } 10 | \arguments{ 11 | \item{starting.dts}{previously generated data that we can start with. data 12 | will only be generated for later timepoints} 13 | 14 | \item{time.n}{total number of timepoints, including the timepoints already 15 | existing in starting.dts.} 16 | 17 | \item{nat.mig.module}{function used to simulate effects of natural migration 18 | on population segmentation.} 19 | 20 | \item{nat.mig.params}{list of any parameter values to pass to 21 | \code{nat.mig.module}} 22 | 23 | \item{media.names}{character vector of unique names of all media modules. 24 | ex: c("tv", "search")} 25 | 26 | \item{media.modules}{list of functions that simulate the behavior of each 27 | marketing intervention.} 28 | 29 | \item{media.params}{list of parameter value lists for each media module.} 30 | 31 | \item{sales.module}{function that generate sales variables.} 32 | 33 | \item{sales.params}{list of any parameter values to pass to the sales module} 34 | 35 | \item{ping}{the spacing between time points at which to print a message 36 | updating the user on simulation progress.} 37 | } 38 | \value{ 39 | a list of data sets, one per timepoint. Each is a data.table with 40 | rows corresponding to population segments and columns corresponding 41 | to specific variables. 42 | } 43 | \description{ 44 | Data generating function for AMSS. Responsible for sequentially simulating 45 | the value of each variable at each time point by population segment, given 46 | the simulation settings. 47 | } 48 | \keyword{internal} 49 | 50 | -------------------------------------------------------------------------------- /man/SimulateDummy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_time_series.R 3 | \name{SimulateDummy} 4 | \alias{SimulateDummy} 5 | \title{Simulate dummy (0-1) variables.} 6 | \usage{ 7 | SimulateDummy(n, pos.idx = NULL, period = n, amplitude = 1) 8 | } 9 | \arguments{ 10 | \item{n}{integer number of time points} 11 | 12 | \item{pos.idx}{vector of indices where simulated vector should take positive 13 | values (as opposed to zero)} 14 | 15 | \item{period}{integer controlling periodicity.} 16 | 17 | \item{amplitude}{numeric value > 0 specifying the value of all postive 18 | entries in the return vector.} 19 | } 20 | \value{ 21 | specified vector 22 | } 23 | \description{ 24 | Create dummy (0-1) variables that repeat a requested pattern of 0's and 1's, 25 | with the option to scale. 26 | } 27 | \seealso{ 28 | Other Simulate.time.series: \code{\link{SimulateAR1}}, 29 | \code{\link{SimulateCorrelated}}, 30 | \code{\link{SimulateSinusoidal}} 31 | } 32 | 33 | -------------------------------------------------------------------------------- /man/SimulateNotEmptyUrns.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/random_number_generator.R 3 | \name{SimulateNotEmptyUrns} 4 | \alias{SimulateNotEmptyUrns} 5 | \title{Simulate the number of urns.} 6 | \usage{ 7 | SimulateNotEmptyUrns(m, n, exact.n = 20) 8 | } 9 | \arguments{ 10 | \item{m}{the number of balls, single integer or vector of integers.} 11 | 12 | \item{n}{the number of urns, single integer or vector of integers.} 13 | 14 | \item{exact.n}{single integer, the maximum number of urns for which to use 15 | exact calculations instead of a normal approximation.} 16 | } 17 | \value{ 18 | the simulated number of non-empty urns 19 | } 20 | \description{ 21 | Simulate the number of non-empty urns when m balls placed into n urns. 22 | } 23 | \keyword{internal} 24 | 25 | -------------------------------------------------------------------------------- /man/SimulateSinusoidal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate_time_series.R 3 | \name{SimulateSinusoidal} 4 | \alias{SimulateSinusoidal} 5 | \title{Generate sinusoidal time series.} 6 | \usage{ 7 | SimulateSinusoidal(n, period, max.loc = 1, vert.translation = 0, 8 | amplitude = 1, scale.x = FALSE) 9 | } 10 | \arguments{ 11 | \item{n}{the length of the simulated vector.} 12 | 13 | \item{period}{the length of one full sinusoidal period.} 14 | 15 | \item{max.loc}{the index of the maximum of the sinusoidal curve.} 16 | 17 | \item{vert.translation}{a numeric for the vertical displacement of the 18 | sinusoidal curve from 0.} 19 | 20 | \item{amplitude}{numeric for the amplitude of the sinusoidal curve. Must be 21 | nonnegative.} 22 | 23 | \item{scale.x}{boolean. If TRUE, scale the sinusoidal curve to have mean 0 24 | and standard deviation 1 before returning.} 25 | } 26 | \value{ 27 | specified sinusoidal curve as a vector 28 | } 29 | \description{ 30 | Function that outputs specified sinusoidal waves. 31 | } 32 | \seealso{ 33 | Other Simulate.time.series: \code{\link{SimulateAR1}}, 34 | \code{\link{SimulateCorrelated}}, 35 | \code{\link{SimulateDummy}} 36 | } 37 | 38 | -------------------------------------------------------------------------------- /man/SurfaceData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/simulate.R 3 | \name{SurfaceData} 4 | \alias{SurfaceData} 5 | \title{Surface observable data.} 6 | \usage{ 7 | SurfaceData(full.data, names.const, names.sum) 8 | } 9 | \arguments{ 10 | \item{full.data}{\code{data.table} of full data. each row contains 11 | information for a particular timepoint + hidden state} 12 | 13 | \item{names.const}{character names of variables with constant values over 14 | the state, to be aggregated by taking the first entry.} 15 | 16 | \item{names.sum}{character names of variables with numeric values, to be 17 | aggregated by \code{sum()}.} 18 | } 19 | \value{ 20 | observable data, aggregated over the hidden states as specified. 21 | Variables not included in names.const or names.sum are assumed to be 22 | hidden variables and not surfaced. 23 | } 24 | \description{ 25 | Extract observable data from the full dataset. 26 | } 27 | \keyword{internal} 28 | 29 | -------------------------------------------------------------------------------- /man/UpdateMarket.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_natural_migration.R 3 | \name{UpdateMarket} 4 | \alias{UpdateMarket} 5 | \title{Updates in/out of market status by moving mimimal population in/out of the 6 | market necessary to match on requested proportion of "in.market" 7 | individuals.} 8 | \usage{ 9 | UpdateMarket(data.dt, target.rate, 10 | prop.activity = rep(1/length(kActivityStates), length(kActivityStates))) 11 | } 12 | \arguments{ 13 | \item{data.dt}{data.table containing all state-related data} 14 | 15 | \item{target.rate}{target proportion of consumers 'in-market'} 16 | 17 | \item{prop.activity}{single value between 0 and 1, representing proportion 18 | of population to be assigned to each activity state, given they are 19 | "responsive," i.e., "in.market" and "unsatiated."} 20 | } 21 | \value{ 22 | \code{invisible(NULL)}. \code{data.dt} is updated by reference. 23 | } 24 | \description{ 25 | Updates in/out of market status by moving mimimal population in/out of the 26 | market necessary to match on requested proportion of "in.market" 27 | individuals. 28 | } 29 | \keyword{internal} 30 | 31 | -------------------------------------------------------------------------------- /man/UpdateMarketingResponsiveStates.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/module_natural_migration.R 3 | \name{UpdateMarketingResponsiveStates} 4 | \alias{UpdateMarketingResponsiveStates} 5 | \title{Update segmentation in marketing-responsive states (activity, 6 | favorability, loyalty, and availability) according to specified 7 | transition matrices.} 8 | \usage{ 9 | UpdateMarketingResponsiveStates(data.dt, transition.matrices = list()) 10 | } 11 | \arguments{ 12 | \item{data.dt}{data.table with column 'pop' for population segment size.} 13 | 14 | \item{transition.matrices}{list of transition matrices for each dimension of 15 | population segmentation that may be affected by marketing 16 | interventions. A named list with members 'activity', 'favorability', 17 | 'loyalty', and 'availability' is expected. By default, any missing 18 | members will have no effect.} 19 | } 20 | \value{ 21 | \code{invisible(NULL)}. \code{data.dt} is updated by reference. 22 | } 23 | \description{ 24 | Update segmentation in marketing-responsive states (activity, 25 | favorability, loyalty, and availability) according to specified 26 | transition matrices. 27 | } 28 | \keyword{internal} 29 | 30 | -------------------------------------------------------------------------------- /man/amss.sim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/s3_amss_sim.R 3 | \name{amss.sim} 4 | \alias{amss.sim} 5 | \title{Create AMSS simulation objects.} 6 | \usage{ 7 | amss.sim(data = NULL, data.full = NULL, params = NULL) 8 | } 9 | \arguments{ 10 | \item{data}{a \code{data.table} containing the observed data.} 11 | 12 | \item{data.full}{the full data, as list of \code{data.tables} with rows 13 | corresponding to each segment and columns corresponding to specific 14 | variables. Each \code{data.table} corresponds to a single time interval.} 15 | 16 | \item{params}{parameters used in specifying the simulation settings.} 17 | } 18 | \value{ 19 | An object of class \code{amss.sim}, is a list with the following 20 | elements: 21 | \describe{ 22 | \item{data}{the observed data.} 23 | \item{data.full}{the full dataset, as a list of data.tables. Each 24 | \code{data.table} contains the data at the end of a time interval, by 25 | by population segment (row) and variable (column).} 26 | \item{params}{the parameters used to generate the data.} 27 | } 28 | } 29 | \description{ 30 | Creates objects of class \code{amss.sim}. 31 | } 32 | \keyword{internal} 33 | 34 | -------------------------------------------------------------------------------- /man/population-segmentation.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/segmentation_consts.R 3 | \name{population segmentation} 4 | \alias{kActivityStates} 5 | \alias{kAllStates} 6 | \alias{kAvailabilityStates} 7 | \alias{kBrandStates} 8 | \alias{kCategoryStates} 9 | \alias{kFavorabilityStates} 10 | \alias{kLoyaltyStates} 11 | \alias{kMarketStates} 12 | \alias{kSatiationStates} 13 | \alias{population segmentation} 14 | \title{Population segmentation constants} 15 | \format{An object of class \code{character} (all possible states in a single 16 | dimension) or \code{data.table} (each row specifying a valid combination of 17 | states in different dimensions).} 18 | \description{ 19 | AMSS segments the population segments the population into groups based 20 | on each consumer's current mindset with regards to the category and the 21 | advertiser's brand. Aggregate changes in the population are tracked through 22 | the size of, i.e., the number of individuals belonging to, each population 23 | segment. 24 | } 25 | \details{ 26 | The consumer minset is defined along six dimensions. The first three specify 27 | the consumer's relationship with the category: 28 | \describe{ 29 | \item{Market state}{describes whether the consumer should be 30 | considered part of the market for this category. Consumers with no 31 | interest are \code{out.of.market}; the rest are \code{in.market}. A 32 | consumer's market state may vary over time due to seasonal changes in 33 | consumer demand, but generally should not be affected by marketing 34 | interventions.} 35 | \item{Satiation state}{tracks whether a consumer's demand for the 36 | product category is temporarily satisfied by a recent purchase.} 37 | \item{Activity state}{tracks the consumer's progress along the path to 38 | purchase. Consumers may be in the \code{inactive}, \code{exploratory}, or 39 | \code{purchase} state. Consumers in different activity states will have 40 | different behaviors. For example, by default consumers outside the 41 | \code{purchase} state will never make a purchase. Activity state also 42 | affects media consumption; for example, individuals who are not 43 | \code{inactive} are generally more likely to make generic or branded 44 | search queries.} 45 | } 46 | The last three dimensions describe the consumer's relationships with the 47 | advertiser's brand. 48 | \describe{ 49 | \item{Brand favorability state}{specifies a consumer's awareness of and 50 | opinion of the advertiser's brand. Consumers are either \code{unaware}, 51 | or are aware and have an opinion of the brand ranging from 52 | \code{negative} to \code{favorable}, with intermediate favorabilitiy 53 | levels \code{neutral} and \code{somewhat favorable}.} 54 | \item{Brand loyalty state}{specifies a consumer's loyalty status. A 55 | consumer may be a \code{switcher}, in which case he or she has no brand 56 | loyalty. Otherwise the consumer is either \code{loyal}, i.e., loyal to 57 | the advertiser's brand, or \code{competitor.loyal}.} 58 | \item{Brand availability state}{refers to whether the advertiser's product 59 | is easily available to a particular consumer. For example, if the 60 | advertiser's distribution efforts only cover seventy percent of the 61 | population, then the thirty percent of the population not covered would 62 | be in the \code{low} brand availability state. The other options are 63 | \code{average} and \code{high} brand availability. Availability can 64 | refer to physical availability, i.e. the presence of the advertiser's 65 | product on store shelves. It could also refer to the mental availability 66 | (convenience) of the advertiser's brand. Thus brand availability can 67 | be affected by, say search ads that make the advertiser's brand the most 68 | prominent on the search results page, or by having the advertiser's 69 | product at eye-level in a store shelf.} 70 | } 71 | 72 | The constants \code{kMarketStates}, \code{kSatiationStates}, 73 | \code{kActivityStates}, \code{kFavorabilityStates}, \code{kLoyaltyStates}, 74 | and \code{kAvailabilityStates} list the the possible states a consumer may 75 | take in each dimension as character vectors. 76 | 77 | A consumer's mindset is summarized by the combination of states they take 78 | in each dimension. There are certain restrictions on which combinations of 79 | consumer states are possible. For example, only consumers who are both 80 | \code{in.market} and \code{unsatiated} can leave the \code{inactive} activity 81 | state. The \code{data.frame} \code{kCategoryStates} describes all valid 82 | combinations of market state, satiation state, and activity state, and thus 83 | lists all possible consumer mindsets with respect to the category in general. 84 | The \code{data.frame} \code{kBrandStates} describes all valid combinations of 85 | brand favorability, loyalty, and availability, given that only consumers 86 | with a \code{favorable} opinion of the brand can be \code{loyal}. Thus, 87 | \code{kBrandStates} lists all possible consumer mindsets with regards to the 88 | advertiser's brand. 89 | 90 | A \code{data.table} of all valid consumer states is provided as 91 | \code{kAllStates}. It is the cross product of all category and brand states. 92 | Every consumer is assigned to one of these 198 states. 93 | } 94 | 95 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | library(testthat) 16 | library(amss) 17 | 18 | test_check("amss") 19 | -------------------------------------------------------------------------------- /tests/testthat/helper_testdata.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | set.seed(1) 16 | 17 | GetArgs <- function(period.length = 10, pop.size = 1e6) { 18 | # Produces arguments to pass to SimulateAMSS(). 19 | # 20 | # Args: 21 | # period.length: changes the number of time periods in a "year" of 22 | # simulation. 23 | # 24 | # Returns: 25 | # arguments to pass to SimulateAMSS() 26 | 27 | time.n <- period.length * 4 28 | 29 | # Parameters controlling natural migration 30 | # a sinusoidal pattern 31 | market.rate.nonoise <- 32 | SimulateSinusoidal(4 * period.length, period.length, 33 | vert.trans = 0.6, amplitude = 0.25) 34 | # with some added noise 35 | market.rate.seas <- pmax( 36 | 0, pmin(1, 37 | market.rate.nonoise * 38 | SimulateAR1(length(market.rate.nonoise), 1, 0.1, 0.3))) 39 | activity.transition <- matrix( 40 | c(0.60, 0.30, 0.10, # migration originating from inactive state 41 | 0.60, 0.30, 0.10, # exploratory state 42 | 0.60, 0.30, 0.10), # purchase state 43 | nrow = length(kActivityStates), byrow = TRUE) 44 | favorability.transition <- matrix( 45 | c(0.03, 0.07, 0.65, 0.20, 0.05, # migration from the unaware state 46 | 0.03, 0.07, 0.65, 0.20, 0.05, # negative state 47 | 0.03, 0.07, 0.65, 0.20, 0.05, # neutral state 48 | 0.03, 0.07, 0.65, 0.20, 0.05, # somewhat favorable state 49 | 0.03, 0.07, 0.65, 0.20, 0.05), # favorable state 50 | nrow = length(kFavorabilityStates), byrow = TRUE) 51 | nat.mig.params <- list( 52 | population = pop.size, 53 | market.rate.trend = 0.68, 54 | market.rate.seas = market.rate.seas, 55 | # activity states for newly responsive (in-market & un-satiated) 56 | prop.activity = c(0.375, 0.425, 0.2), 57 | # brand favorability, initial proportions. 58 | prop.favorability = c(0.03, 0.07, 0.65, 0.20, 0.05), 59 | # everyone is a switcher 60 | prop.loyalty = c(1, 0, 0), 61 | transition.matrices = list( 62 | activity = activity.transition, 63 | favorability = favorability.transition)) 64 | 65 | # Parameters controlling sales module 66 | sales.params <- list( 67 | competitor.demand.max = list(loyalty = c(0.8, 0, 0.8)), 68 | advertiser.demand.slope = list(favorability = rep(0, 5)), 69 | advertiser.demand.intercept = list( 70 | favorability = c(0.014, 0, 0.2, 0.3, 0.9)), 71 | price = 55) 72 | 73 | # media parameters 74 | tv.budget <- c(0, .005 * period.length, .01 * period.length, 0) * pop.size 75 | budget.index <- rep(1:4, each = period.length) 76 | tv.flighting <- 77 | pmax(0, 78 | market.rate.seas + 79 | SimulateAR1(length(market.rate.seas), -0.7, 0.7, -0.7)) 80 | tv.flighting <- tv.flighting[c(3:length(tv.flighting), 1:2)] 81 | tv.activity.trans.mat <- matrix( 82 | c(0.99, 0.01, 0.00, # migration originating from the inactive state 83 | 0.00, 0.99, 0.01, # exploratory state 84 | 0.00, 0.00, 1.00), # purchase state 85 | nrow = length(kActivityStates), byrow = TRUE) 86 | tv.favorability.trans.mat <- matrix( 87 | c(0.4, 0.0, 0.4, 0.2, 0.0, # migration from the unaware state 88 | 0.0, 0.9, 0.1, 0.0, 0.0, # negative state 89 | 0.0, 0.0, 0.5, 0.5, 0.0, # neutral state 90 | 0.0, 0.0, 0.0, 0.8, 0.2, # somewhat favorable state 91 | 0.0, 0.0, 0.0, 0.0, 1.0), # favorable state 92 | nrow = length(kFavorabilityStates), byrow = TRUE) 93 | params.m1 <- list( 94 | audience.membership = list(activity = rep(0.5, 3)), 95 | budget = tv.budget, 96 | budget.index = budget.index, 97 | flighting = tv.flighting, 98 | unit.cost = 0.002, 99 | hill.ec = 1.56, 100 | hill.slope = 1, 101 | transition.matrices = list( 102 | activity = tv.activity.trans.mat, 103 | favorability = tv.favorability.trans.mat)) 104 | 105 | # search 106 | cpc.min <- 0.8 107 | cpc.max <- 1.1 108 | spend.cap.fn <- function(time.index, budget, budget.index) { 109 | if ((time.index %% 3) > 0) { 110 | return(Inf) 111 | } else { 112 | return(0) 113 | } 114 | } 115 | bid.fn <- function(time.index, per.capita.budget, budget.index) { 116 | return(1.1) 117 | } 118 | kwl.fn <- function(time.index, per.capita.budget, budget.index) { 119 | return(per.capita.budget) 120 | } 121 | 122 | search.activity.trans.mat <- matrix( 123 | c(0.05, 0.95, 0.00, # starting state: inactive 124 | 0.00, 0.85, 0.15, # starting state: exploratory 125 | 0.00, 0.00, 1.00), # starting: purchase 126 | nrow = length(kActivityStates), byrow = TRUE) 127 | search.favorability.trans.mat <- matrix( 128 | c(1.0, 0.0, 0.0, 0.0, 0.0, # unaware 129 | 0.0, 1.0, 0.0, 0.0, 0.0, # negative 130 | 0.0, 0.0, 1.0, 0.0, 0.0, # neutral 131 | 0.0, 0.0, 0.0, 1.0, 0.0, # favorable 132 | 0.0, 0.0, 0.0, 0.0, 1.0), # loyal 133 | nrow = length(kFavorabilityStates), byrow = TRUE) 134 | params.m2 <- list( 135 | audience.membership = list(activity = c(0.01, 0.3, 0.4)), 136 | budget = (pop.size / 4.1) * (1:4), 137 | budget.index = budget.index, 138 | spend.cap.fn = spend.cap.fn, 139 | bid.fn = bid.fn, 140 | kwl.fn = kwl.fn, 141 | query.rate = 1, 142 | cpc.min = cpc.min, 143 | cpc.max = cpc.max, 144 | ctr = list(activity = c(0.005, 0.08, 0.10)), 145 | relative.effectiveness = c(0, 0.1, 1), 146 | transition.matrices = list( 147 | activity = search.activity.trans.mat, 148 | favorability = search.favorability.trans.mat)) 149 | 150 | return(list( 151 | time.n = time.n, 152 | nat.mig.params = nat.mig.params, 153 | media.names = c("traditional", "search"), 154 | media.modules = c(`DefaultTraditionalMediaModule`, 155 | `DefaultSearchMediaModule`), 156 | media.params = list(params.m1, params.m2), 157 | sales.params = sales.params)) 158 | } 159 | 160 | GetData <- function(arglist) { 161 | sim.data <- do.call(SimulateAMSS, arglist) 162 | return(sim.data) 163 | } 164 | 165 | test.args <- GetArgs() 166 | test.data <- GetData(test.args) 167 | -------------------------------------------------------------------------------- /tests/testthat/test_attribution.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("CalculateROAS") 16 | 17 | test_that("Attribution results are reasonable", { 18 | set.seed(100) 19 | roas <- CalculateROAS(test.data, 20 | media.names = "traditional", 21 | budget.periods = 3, 22 | t.start = 21, t.end = 30, 23 | budget.proportion = 0) 24 | mroas <- CalculateROAS(test.data, 25 | media.names = "search", 26 | budget.periods = 3, 27 | t.start = 21, t.end = 30, 28 | budget.proportion = 0.99) 29 | expect_true(roas > 2.12 & roas < 2.14) 30 | expect_true(mroas> 0.96 & mroas < 0.98) 31 | }) 32 | 33 | context(".GenerateDataUnderNewBudget") 34 | 35 | test_that("data regeneration starts and ends at the correct time", { 36 | new.data.1 <- GenerateDataUnderNewBudget(test.data) 37 | expect_identical(names(new.data.1), c(names(test.data$data), "rep.index")) 38 | # Start after first time period. 39 | new.data.2 <- GenerateDataUnderNewBudget( 40 | test.data, t.start = 11, t.end = 20) 41 | id.idx <- test.args$media.params[[1]]$budget.index == 1 42 | expect_equal(new.data.2[id.idx, brand.sales], 43 | test.data$data[id.idx, brand.sales]) 44 | # Multiple reps, and response metric instead of entire dataset. 45 | set.seed(100) 46 | new.data.4 <- GenerateDataUnderNewBudget( 47 | test.data, t.start = 31, reps = 2) 48 | set.seed(100) 49 | new.data.5 <- GenerateDataUnderNewBudget( 50 | test.data, t.start = 31, 51 | reps = 2, response.metric = "brand.sales") 52 | expect_identical(nrow(new.data.4), 2L * nrow(new.data.1)) 53 | expect_equal( 54 | new.data.4[, mean(brand.sales), by = "time.index"][, V1], 55 | new.data.5) 56 | }) 57 | -------------------------------------------------------------------------------- /tests/testthat/test_migrate.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("MigrateMarginal") 16 | 17 | test_that("one-dimensional migration is handled correctly", { 18 | dt <- InitStateData() 19 | dt[, pop := rbinom(nrow(dt), 2000, 0.5)] 20 | aff.pop <- sapply(dt[, pop], function(n) rbinom(1, n, 0.5)) 21 | copy.dt <- data.table::copy(dt) 22 | 23 | # Dimension 1: market state. 24 | MigrateMarginal(copy.dt, aff.pop, "market", matrix(c(0, 1), 2, 2, TRUE)) 25 | expect_equal(copy.dt[market == "out.market", pop], 26 | dt[market == "out.market", pop] - 27 | aff.pop[dt[, market == "out.market"]]) 28 | expect_equal(dt[, sum(pop)], copy.dt[, sum(pop)]) 29 | 30 | # Dimension 5: loyalty state. 31 | copy.dt <- data.table::copy(dt) 32 | MigrateMarginal(copy.dt, aff.pop, "loyalty", matrix(c(0, 1, 0), 3, 3, TRUE)) 33 | dt[, aff.pop := aff.pop] 34 | expect_equal( 35 | copy.dt[favorability != "favorable", sum(pop), by = "loyalty"][, V1], 36 | c(dt[favorability != "favorable", sum(aff.pop)], 0) + 37 | dt[favorability != "favorable", sum(pop - aff.pop), by = "loyalty"][, V1]) 38 | expect_equal(copy.dt[favorability == "favorable" & loyalty == "loyal", 39 | pop.in], 40 | copy.dt[favorability == "favorable", sum(pop.out), 41 | by = eval(key(copy.dt)[-5])][, V1]) 42 | expect_equal(dt[, sum(pop)], copy.dt[, sum(pop)]) 43 | }) 44 | -------------------------------------------------------------------------------- /tests/testthat/test_misc_helper.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("tests for miscellaneous helper functions") 16 | 17 | test_that("HillTrans functions correctly on both vectors and matrices", { 18 | expect_equal(HillTrans(1:9, ec = 4, slope = 4, beta = 2), 19 | HillTrans(1:9, ec = 4, slope = 4) * 2) 20 | expect_equal( 21 | HillTrans(matrix(1:6, 3), 22 | ec = c(100, 40), slope = c(4, 6)), 23 | cbind(HillTrans(matrix(1:3), ec = 100, slope = 4), 24 | HillTrans(matrix(4:6), ec = 40, slope = 6))) 25 | }) 26 | 27 | 28 | context("PasteD") 29 | 30 | test_that("strings concatenate correctly", { 31 | expect_identical(PasteD('tmp', 'var'), 'tmp.var') 32 | }) 33 | 34 | 35 | context("ParseT, EvalText") 36 | 37 | test_that("shortcutting parse(text = ...) works inside data.table", { 38 | test.dt <- data.table(col.1 = 1:5, col.2 = 11:15) 39 | for (iter.col in 1:2) { 40 | colname <- PasteD("col", iter.col) 41 | expect_equal(test.dt[, eval(ParseT(colname))], 42 | 10 * (iter.col - 1) + 1:5) 43 | } 44 | test.dt[, 45 | (PasteD(colname, "plus1")) := 46 | eval(ParseT(colname)) + 1] 47 | expect_equal(test.dt[, col.2.plus1], 12:16) 48 | # only a subset of rows 49 | expect_equal(2, test.dt[col.1 == 2, eval(ParseT("col.1"))]) 50 | }) 51 | 52 | test_that("evaluation shortcut works inside and outside of data.tables", { 53 | test.dt <- data.table(col.1 = 1:5, col.2 = 11:15) 54 | for (iter.col in 1:2) { 55 | colname <- PasteD("col", iter.col) 56 | expect_equal(test.dt[, EvalText(colname, test.dt)], 57 | 10 * (iter.col - 1) + 1:5) 58 | } 59 | test.dt[, 60 | (PasteD(colname, "plus1")) := 61 | EvalText(colname, test.dt) + 1] 62 | expect_equal(test.dt[, col.2.plus1], 12:16) 63 | # Default environment: parent.frame(). 64 | x <- 1 65 | fn <- function() { 66 | x <- 2 67 | return(c(EvalText("x"), EvalText("x", parent.frame()))) 68 | } 69 | expect_identical(c(2, 1), fn()) 70 | }) 71 | 72 | context("CheckLength") 73 | 74 | test_that("vector lengths are updated, or errors are thrown", { 75 | expect_error(CheckLength(1:4, 1), "Argument of incorrect length") 76 | expect_identical(CheckLength(1:4, 3, FALSE), 1:3) 77 | expect_identical(CheckLength(2, 4), rep(2, 4)) 78 | expect_identical(CheckLength(1:4, 4), 1:4) 79 | }) 80 | 81 | context("MultiplyBySegment") 82 | 83 | test_that("factors are mapped correctly to segments", { 84 | expect_identical(1, MultiplyBySegment()) 85 | expect_identical(as.numeric(kAllStates[, activity]) / 10, 86 | MultiplyBySegment(list(activity = (1:3) / 10))) 87 | expect_identical(as.numeric(kAllStates[, activity]) / 20, 88 | MultiplyBySegment(list(activity = (1:3) / 10), 0.5)) 89 | }) 90 | 91 | context("ReadRepeatingVector") 92 | 93 | test_that("the function finds the correct entry", { 94 | expect_identical(ReadRepeatingVector(1:5, 3), 3L) 95 | expect_identical(ReadRepeatingVector(1:5, 19), 4L) 96 | expect_error(ReadRepeatingVector(1:5, 0), 97 | "idx not greater than or equal to 1") 98 | }) 99 | -------------------------------------------------------------------------------- /tests/testthat/test_module_media.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("DefaultTraditionalMediaModule") 16 | 17 | test_that("the specified amount of spend is generated", { 18 | traditional.spend <- 19 | sapply(test.data$data.full, 20 | function(x) x[, sum(traditional.spend)]) 21 | expect_equal(sum(traditional.spend[1:10]), 0) 22 | media.params <- test.args$media.params[[1]] 23 | for (idx in unique(media.params$budget.index)) { 24 | curr.timepoints <- media.params$budget.index == idx 25 | expect_equal(media.params$budget[idx], 26 | sum(traditional.spend[curr.timepoints])) 27 | expect_equal( 28 | media.params$flighting[curr.timepoints] / 29 | sum(media.params$flighting[curr.timepoints]) * 30 | media.params$budget[idx], 31 | traditional.spend[curr.timepoints]) 32 | } 33 | }) 34 | 35 | context("DefaultSearchMediaModule") 36 | 37 | test_that("the function completes successfully", { 38 | dt <- InitStateData(time.index = 13) 39 | InitPop(data.dt = dt, pop.total = test.args$nat.mig.params$population, 40 | market.rate = 0.7, 41 | prop.activity = c(0.5, 0.3, 0.2), 42 | prop.favorability = c(0.15, 0.1, 0.2, 0.35, 0.2)) 43 | do.call(DefaultSearchMediaModule, 44 | c(list(dt), test.args$media.params[[2]])) 45 | expect_true(setequal(names(dt), 46 | c(names(kAllStates), 47 | "time.index", 48 | "pop", "pop.out", "pop.in", 49 | "budget.index", "budget", 50 | "audience", "ctr", 51 | "clicks", "imps", "matching.query.volume", "query.volume", 52 | "spend"))) 53 | }) 54 | -------------------------------------------------------------------------------- /tests/testthat/test_module_natural_migration.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("DefaultNatMigModule") 16 | 17 | test_that("migration results in approximately the expected segmentation", { 18 | curr.dt <- InitStateData() 19 | DefaultNatMigModule( 20 | curr.dt, 21 | population = 7e8, 22 | market.rate.trend = 0.8, 23 | market.rate.seas = 1, 24 | sat.decay = 0.5) 25 | expect_equal(curr.dt[, sum(pop)], 7e8) 26 | expect_equal(curr.dt[satiation == "satiated", sum(pop)], 0) 27 | activity.prop <- curr.dt[market == "in.market" & satiation == "unsatiated", 28 | sum(pop), by = "activity"][, V1 / sum(V1)] 29 | availability.prop <- curr.dt[, sum(pop), by = "availability"][, V1 / sum(V1)] 30 | expect_true(all(activity.prop %between% c(0.30, 0.37))) 31 | expect_true(all(availability.prop %between% c(0.30, 0.37))) 32 | }) 33 | 34 | context("InitPop") 35 | 36 | test_that("the data is initialized correctly", { 37 | testpop.dt <- InitStateData() 38 | testpop.dt[, pop.total := 100][, market.rate := 0.3] 39 | InitPop(testpop.dt, pop.total = 100, market.rate = 0.3, 40 | prop.activity = c(0.5, 0.3, 0.2), 41 | prop.favorability = c(0.15, 0.1, 0.2, 0.35, 0.2)) 42 | # Population. 43 | expect_equal(100, testpop.dt[, sum(pop)]) 44 | # Satiation is 0. 45 | expect_true(all( 46 | testpop.dt[.(c("out.market", "in.market"), "satiated"), pop == 0])) 47 | }) 48 | 49 | context("UpdateMarketingResponsiveStates") 50 | 51 | test_that("migration happens in the correct sequence and proportions", { 52 | orig.data <- InitStateData(time.index = 10) 53 | orig.data[, pop := RBinom(nrow(orig.data), 2000, 0.5)] 54 | copied.data <- data.table::copy(orig.data) 55 | 56 | # Use 0-1 matrices for testing since that removes randomness. 57 | activity.trans <- matrix(c(0, 1, 0, 0, 0, 1, 1, 0, 0), 3, 58 | byrow = TRUE) 59 | UpdateMarketingResponsiveStates( 60 | copied.data, 61 | transition.matrices = list(activity = activity.trans)) 62 | 63 | # Check there is no effect on distribution of other state types. 64 | expect_equal(orig.data[, sum(pop), 65 | by = eval(key(orig.data)[-3])], 66 | copied.data[, sum(pop), 67 | by = eval(key(orig.data)[-3])]) 68 | # No effect on out of market or satiated individuals. 69 | expect_equal(orig.data["out.market", pop], 70 | copied.data["out.market", pop]) 71 | expect_equal(orig.data[.("in.market", "satiated"), pop], 72 | copied.data[.("in.market", "satiated"), pop]) 73 | # Check transition rates applied correctly. 74 | expect_equal( 75 | orig.data[.("in.market", "unsatiated"), 76 | pop %*% activity.trans, 77 | by = names(kBrandStates)][, V1], 78 | copied.data[.("in.market", "unsatiated"), 79 | pop, 80 | by = names(kBrandStates)][, pop]) 81 | }) 82 | 83 | context("UpdateMarket") 84 | 85 | test_that("migration in one dimension does not affect unrelated dimensions", { 86 | test.data <- InitStateData(time.index = 10) 87 | test.data[, pop := rbinom(nrow(test.data), 2000, 0.5)] 88 | GetRate <- function(dt) { 89 | return(dt[market == "in.market", sum(pop)] / dt[, sum(pop)]) 90 | } 91 | curr.rate <- GetRate(test.data) 92 | # Try increasing. 93 | copy.data <- data.table::copy(test.data) 94 | UpdateMarket(copy.data, 1) 95 | expect_equal(1, GetRate(copy.data)) 96 | expect_equal(test.data[, sum(pop), 97 | by = c("satiation", "favorability", 98 | "loyalty", "availability")], 99 | copy.data[, sum(pop), 100 | by = c("satiation", "favorability", 101 | "loyalty", "availability")]) 102 | # Try decreasing. 103 | copy.data <- data.table::copy(test.data) 104 | UpdateMarket(copy.data, 0) 105 | expect_equal(0, GetRate(copy.data)) 106 | expect_equal(test.data[, sum(pop), 107 | by = c("satiation", "favorability", 108 | "loyalty", "availability")], 109 | copy.data[, sum(pop), 110 | by = c("satiation", "favorability", 111 | "loyalty", "availability")]) 112 | }) 113 | -------------------------------------------------------------------------------- /tests/testthat/test_module_sales.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("DefaultSalesModule") 16 | 17 | test_that("advertiser and competitor sales are calculated correctly", { 18 | dt <- InitStateData(time.index = 13) 19 | dt[, pop := RBinom(nrow(kAllStates), 2000, 0.5)] 20 | init.pop <- dt[, pop] 21 | dt[, total.spend := pop * 0.5] 22 | DefaultSalesModule( 23 | data.dt = dt, price = 20, 24 | advertiser.demand.intercept = list( 25 | favorability = c(0, 0, 0, 1, 1))) 26 | expect_identical(dt[, brand.sales + competitor.sales], 27 | init.pop * kAllStates[, activity == "purchase"]) 28 | # By default, the competitor replacement parameter is c(0.5, 0, 1) 29 | # and competitor strength is 1. Since the non-competitive advertiser demand 30 | # is 1. Then: 31 | # Competitor-loyal consumers should not purchase the advertiser's brand. 32 | expect_true(all( 33 | dt[activity == "purchase" & loyalty == "competitor-loyal", 34 | brand.sales == 0])) 35 | # Loyal consumers should not purchase any competitor brands. 36 | expect_true(all( 37 | dt[activity == "purchase" & loyalty == "loyal", 38 | competitor.sales == 0])) 39 | }) 40 | -------------------------------------------------------------------------------- /tests/testthat/test_optimize.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("GetInterior") 16 | 17 | test_that("Interior points are correctly identified.", { 18 | # Finite and infinite bounds both result in interior points being returned. 19 | x1 <- GetInterior(1, 2, 1, 2) 20 | expect_true(x1 > 1 && x1 < 2) 21 | x2 <- GetInterior(rep(-Inf, 5), rep(Inf, 5), -Inf, Inf) 22 | expect_true(is.numeric(x2) && length(x2) == 5) 23 | x3 <- GetInterior(c(-Inf, 1, 4), c(-5, 100, Inf), -Inf, Inf) 24 | expect_true(x3[1] < -5 && x3[2] > 1 && x3[2] < 100 && x3[3] > 4) 25 | 26 | # settings with no interior return NULL 27 | expect_identical(NULL, GetInterior(1, -1, 0, 0)) 28 | expect_identical(NULL, GetInterior(1:2, 3:4, -9, 0)) 29 | expect_identical(NULL, GetInterior(1:2, 3:4, 5, 5)) 30 | }) 31 | 32 | context("ReduceDimension") 33 | 34 | test_that("Optimization complexity successfully reduced when appropriate.", { 35 | # Number of dimensions must be specified correctly. 36 | expect_error(ReduceDimension(3, 1:5, 1:5, 15, 15)) 37 | 38 | # Reduce dimension. This case includes equality constraints in both the 39 | # individual bounds on single dimensions and the bounds on the vector sum. 40 | lower.bound <- 1:7 41 | upper.bound <- c(1:5, 7, 9) 42 | object <- ReduceDimension(7, 1:7, c(1:5, 7, 9), 29.5, 29.5) 43 | expect_identical(length(object$lower.bound), 1L) 44 | v <- (max(object$lower.bound, object$sum.lower.bound) + 45 | min(object$upper.bound, object$sum.upper.bound)) / 2 46 | x <- object$decoder(v) 47 | expect_true(all(x >= 1:7) && all(x <= c(1:5, 7, 9)) && sum(x) == 29.5) 48 | }) 49 | -------------------------------------------------------------------------------- /tests/testthat/test_random_number_generator.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("RBinom") 16 | 17 | test_that("Binomial samples are generated for a large number of trials.", { 18 | M <- .Machine$integer.max 19 | expect_true(!is.na(RBinom(1, 100 * M, 0.5))) 20 | expect_identical(class(RBinom(1, 2 * M, 0.1)), "numeric") 21 | expect_identical(class(RBinom(1, 100 * M, 0.1)), "numeric") 22 | # Check that the sample p.hat is close to p for large values of size. 23 | expect_true(all(abs(RBinom(2, 2 * M, c(0.01, 0.99)) / (2 * M) / 24 | c(0.01, 0.99) - 1) < 0.01)) 25 | expect_true(all(abs(RBinom(2, 1e5 * M, c(0.1, 0.9)) / 26 | (1e5 * M) / c(0.1, 0.9) - 1) < 0.01)) 27 | # rbinom() only works on even values of size in this range. 28 | # Check that the fix that forces size to be even works. 29 | expect_true(!is.na(RBinom(1, 5151515151515151, 3e-8))) 30 | }) 31 | 32 | context("RHyper") 33 | 34 | test_that("Hypergeometric samples are generated for a large population size.", { 35 | # Remove test flakiness. 36 | set.seed(0) 37 | M <- .Machine$integer.max 38 | # Check approximation accuracy through probability of sample quantile under 39 | # exact distribution 40 | # Check a binomial approximation. 41 | x <- RHyper(1e5, 1e5, M, 1000) 42 | expect_true(binom.test(sum(x == 0), 1e5, phyper(0, 1e5, M, 1000))$p.value > 43 | 0.01) 44 | # Check a normal approximation. 45 | k <- round(600 * M * 4 / 5) 46 | x <- RHyper(1e5, 100 * M, 500 * M, k) 47 | q <- quantile(x, 0.1) 48 | expect_true(binom.test(sum(x <= q), 1e5, 49 | phyper(q, 100 * M, 500 * M, k))$p.value > 0.01) 50 | }) 51 | 52 | context("RMultinom") 53 | 54 | test_that("Multinomial samples are generated for a large number of trials.", { 55 | x <- RMultinom(10, .Machine$integer.max * 2, rep(1 / 5, 5)) 56 | expect_identical(class(x[1]), "numeric") 57 | x <- RMultinom(10, .Machine$integer.max * 10, 1:5) 58 | expect_identical(class(x[1]), "numeric") 59 | # Column sums should equal the size parameter. 60 | expect_equal(apply(x, 2, sum), rep(.Machine$integer.max * 10, 10)) 61 | # Row sums should be approximately proportional to the probability vector. 62 | x.prop <- apply(x, 1, sum) 63 | x.prop <- x.prop / sum(x.prop) 64 | expect_true(all(abs(x.prop - (1:5) / sum(1:5)) < 0.01)) 65 | }) 66 | 67 | context("RNBinom") 68 | 69 | test_that("NBinom samples are generated for a large number of trials.", { 70 | size <- c(1e-4, 1e-2, 1, 1e2, 1e4) * .Machine$integer.max * 2 71 | expect_true(!any(is.na(RNBinom(5, size, 0.5)))) 72 | expect_identical(class(RNBinom(5, size, 0.5)), "numeric") 73 | expect_identical(class(RNBinom(2, size, 0.5)), "numeric") 74 | # Check the 10% quantile of the approximate samples. 75 | x <- RNBinom(1e5, size[5], 0.5) 76 | q <- quantile(x, 0.10) 77 | expect_true(binom.test(sum(x <= q), 1e5, pnbinom(q, size[5], 0.5))$p.value > 78 | 0.1) 79 | }) 80 | 81 | context("RPois") 82 | 83 | test_that("Poisson samples are generated for a large mean.", { 84 | lambda <- c(1e-4, 1e-2, 1, 1e2, 1e4) * .Machine$integer.max 85 | expect_true(!any(is.na(RPois(5, lambda)))) 86 | expect_identical(class(RPois(5, lambda)), "numeric") 87 | expect_identical(class(RPois(2, lambda)), "numeric") 88 | # Check the 10% quantile of the approximate samples. 89 | x <- RPois(1e5, lambda[5]) 90 | q <- quantile(x, 0.10) 91 | expect_true(binom.test(sum(x <= q), 1e5, ppois(q, lambda[5]))$p.value > 92 | 0.1) 93 | }) 94 | -------------------------------------------------------------------------------- /tests/testthat/test_simulate.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("SimulateAMSS") 16 | 17 | test_that("variables have reasonable values", { 18 | # Test that simulated data achieves specified population. 19 | expect_true(all(sapply( 20 | test.data$data.full, 21 | function(x) x[, sum(pop) == test.args$nat.mig.params$population]))) 22 | expect_true(cor(test.data$data[, revenue], 23 | test.args$nat.mig.params$market.rate.seas) > 0.5) 24 | }) 25 | 26 | context("SimulateData") 27 | 28 | test_that("data generates correctly, starting from an arbitrary time", { 29 | # Parameter values. 30 | for (iter.arg in names(test.args)) { 31 | EvalText(paste0(iter.arg, " <- test.args$", iter.arg)) 32 | } 33 | 34 | # Data generation: Complete data generated for TestSimulateAMSS(). 35 | # Here, first try simulating less data than the original time.n 36 | data.first10 <- SimulateData( 37 | starting.dts = list(), 38 | time.n = 10, 39 | nat.mig.module = DefaultNatMigModule, 40 | nat.mig.params = nat.mig.params, 41 | media.names = media.names[1], 42 | media.modules = list(DefaultTraditionalMediaModule), 43 | media.params = media.params[1], 44 | sales.module = DefaultSalesModule, 45 | sales.params = sales.params, 46 | ping = 10) 47 | # Then, try simulating additional data following up. 48 | data.next10 <- SimulateData( 49 | starting.dts = data.first10, 50 | time.n = 20, 51 | nat.mig.module = DefaultNatMigModule, 52 | nat.mig.params = nat.mig.params, 53 | media.names = media.names[1], 54 | media.modules = list(DefaultTraditionalMediaModule), 55 | media.params = media.params[1], 56 | sales.module = DefaultSalesModule, 57 | sales.params = sales.params, 58 | ping = 10) 59 | 60 | # First 10 elements should be identical. 61 | expect_equal(data.first10[1:10], data.next10[1:10]) 62 | 63 | # The two data tables are indeed different (copy() worked correctly), 64 | # i.e., they map to different memory locations. 65 | data.first10[[1]][, profit := 0] 66 | expect_true(all(data.first10[[1]][, profit == 0])) 67 | expect_true(!isTRUE(data.next10[[1]][, profit == 0])) 68 | 69 | # Check that the latter data set generated numbers appropriately. 70 | expect_equal(media.params[[1]]$flighting[1:10] * 71 | media.params[[1]]$budget[1], 72 | SurfaceData(data.first10)[, traditional.spend]) 73 | expect_equal(media.params[[1]]$flighting[1:20] * 74 | rep(media.params[[1]]$budget[1:2], each = 10) / 75 | rep(c(sum(media.params[[1]]$flighting[1:10]), 76 | sum(media.params[[1]]$flighting[11:20])), 77 | each = 10), 78 | SurfaceData(data.next10)[, traditional.spend]) 79 | }) 80 | 81 | context("SurfaceData") 82 | 83 | test_that("observed data is aggregated correctly", { 84 | obs.data <- SurfaceData(full.data = test.data$data.full) 85 | 86 | # Check values in some 'sum' rows. 87 | # Profit = revenue - spend. 88 | expect_equal(rep(0, nrow(obs.data)), 89 | obs.data[, profit - (revenue - total.spend)]) 90 | 91 | # Spend in media equals budget. 92 | expect_equal(test.args$media.params[[1]]$budget, 93 | obs.data[, sum(traditional.spend), 94 | by = traditional.budget.index][, V1]) 95 | 96 | # Exceptions for bad arguments: 97 | # Aggregate one column both ways. 98 | expect_error(SurfaceData(test.data$data.full, 99 | "total.spend", "total.spend"), 100 | "The same variable cannot be aggregated in multiple ways.") 101 | 102 | # Having 0 columns aggregated one or both ways is fine. 103 | expect_equal( 104 | as.matrix(obs.data[, .(time.index)]), 105 | as.matrix(SurfaceData(test.data$data.full, 106 | character(), character()))) 107 | dt1 <- SurfaceData(full.data = test.data$data.full, 108 | names.const = character()) 109 | dt2 <- SurfaceData(full.data = test.data$data.full, 110 | names.sum = character()) 111 | expect_equal(as.matrix(obs.data), 112 | as.matrix(dt1[dt2])) 113 | }) 114 | 115 | context("InitStateData") 116 | 117 | test_that("the population segmentation states are generated correctly", { 118 | # Test package constants have correct value along the way. 119 | init.data <- InitStateData() 120 | expect_identical(nrow(init.data), nrow(kAllStates)) 121 | expect_identical(nrow(kAllStates), nrow(kBrandStates) * nrow(kCategoryStates)) 122 | expect_identical(nrow(kCategoryStates), 6L) 123 | expect_identical(nrow(kBrandStates), 33L) 124 | expect_identical(names(init.data), 125 | c("market", "satiation", "activity", 126 | "favorability", "loyalty", "availability", 127 | "time.index", "pop")) 128 | expect_identical(key(init.data), 129 | c("market", "satiation", "activity", 130 | "favorability", "loyalty", "availability")) 131 | expect_identical(levels(init.data[, market]), 132 | c("out.market", "in.market")) 133 | expect_identical(levels(init.data[, satiation]), 134 | c("satiated", "unsatiated")) 135 | expect_identical(levels(init.data[, activity]), 136 | c("inactive", "exploration", "purchase")) 137 | expect_identical(levels(init.data[, favorability]), 138 | c("unaware", "negative", "neutral", 139 | "somewhat favorable", "favorable")) 140 | expect_identical(levels(init.data[, loyalty]), 141 | c("switcher", "loyal", "competitor-loyal")) 142 | expect_identical(levels(init.data[, availability]), 143 | c("low", "average", "high")) 144 | expect_identical(init.data[, pop], rep(0, nrow(init.data))) 145 | }) 146 | -------------------------------------------------------------------------------- /tests/testthat/test_simulate_time_series.R: -------------------------------------------------------------------------------- 1 | # Copyright 2017 Google Inc. All Rights Reserved. 2 | # 3 | # Licensed under the Apache License, Version 2.0 (the "License"); 4 | # you may not use this file except in compliance with the License. 5 | # You may obtain a copy of the License at 6 | # 7 | # http://www.apache.org/licenses/LICENSE-2.0 8 | # 9 | # Unless required by applicable law or agreed to in writing, software 10 | # distributed under the License is distributed on an "AS IS" BASIS, 11 | # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | # See the License for the specific language governing permissions and 13 | # limitations under the License. 14 | 15 | context("SimulateCorrelated") 16 | 17 | test_that("constant v results in pure noise", { 18 | set.seed(100) 19 | # Even without seed set, keep test flakiness to a minimum with large n, 20 | # small alpha. 21 | n <- 5000 22 | alpha <- 0.0001 23 | # correlate with constant should be a regular normal distribution 24 | # with the specified mean and variance 25 | expect_true(ks.test( 26 | SimulateCorrelated(v = rep(0, n), cor.vx= 0.2, 27 | mu.x = 77, sigma.x = 2.3), 28 | function(q) pnorm(q, 77, 2.3))$p.value >= alpha) 29 | }) 30 | 31 | context("SimulateDummy") 32 | 33 | test_that("dummy variables repeat, scale, and signal errors correctly", { 34 | expect_error(SimulateDummy(n = -4)) 35 | expect_error(SimulateDummy(n = 10, pos.idx = NULL, period = -2)) 36 | expect_error(SimulateDummy(n = 4, pos.idx = 1, period = 2.3)) 37 | expect_equal(SimulateDummy(n = 4), rep(0, 4)) 38 | expect_equal(SimulateDummy(n = 10, pos.idx = 1:2, period = 5), 39 | rep(c(1, 1, 0, 0, 0), 2)) 40 | expect_equal(SimulateDummy(n = 2, pos.idx = 1, amplitude = 2), c(2, 0)) 41 | }) 42 | 43 | context("SimulateSinusoidal") 44 | test_that("sinusoidals translate, scale, and signal errors correctly", { 45 | expect_error(SimulateSinusoidal(n = -4, period = 0)) 46 | expect_error(SimulateSinusoidal(n = 100, period = 0:10)) 47 | expect_error(SimulateSinusoidal(n = 100, period = -1, 1)) 48 | expect_equal(SimulateSinusoidal(n = 100, period = 1), rep(1, 100)) 49 | expect_error(SimulateSinusoidal(n = 100, period = 1, amplitude = -1)) 50 | expect_equal(SimulateSinusoidal(n = 100, period = 2, max.loc = 4, 51 | vert.translation = 1, amplitude = 2), 52 | rep(c(-1, 3), 50)) 53 | expect_equal(mean(SimulateSinusoidal(n = 100, period = 2, max.loc = 4, 54 | vert.translation = 1, amplitude = 2, 55 | scale.x = TRUE)), 0) 56 | expect_equal(sd(SimulateSinusoidal(n = 100, period = 2, max.loc = 4, 57 | vert.translation = 1, amplitude= 2, 58 | scale.x = TRUE)), 1) 59 | }) 60 | 61 | context("SimulateAR1") 62 | 63 | test_that("errors are signalled as appropriate", { 64 | expect_error(SimulateAR1(n = -4)) 65 | expect_error(SimulateAR1(n = 100, stable.mu = 1, stable.sd = 3, autocor = -1)) 66 | expect_error(SimulateAR1(n = 100, stable.mu = 0, stable.sd = -1)) 67 | }) 68 | 69 | test_that("output vectors follow the specified distribution", { 70 | expect_equal(SimulateAR1(n = 100, stable.mu = 0, 71 | stable.sd = 0, autocor = 0.2), 72 | rep(0, 100)) 73 | NearEnoughAR1 <- function(ts, mu, sd, ac, c.level = 0.9999) { 74 | y <- ts[2:length(ts)] 75 | x <- ts[1:(length(ts) - 1)] 76 | lm.obj <- lm(y ~ x) 77 | s2 <- crossprod(lm.obj$resid) / (length(y) - 2) 78 | est.bds <- rbind(confint(lm.obj, level = c.level), 79 | s2 = c(s2 / (length(y) - 2) * 80 | qchisq((1 - c.level) / 2, length(y) - 2), 81 | s2 / (length(y) - 2) * 82 | qchisq((1 - c.level) / 2, length(y) - 2, 83 | lower.tail = FALSE))) 84 | row.names(est.bds) <- c("c", "phi", "sigma2") 85 | theta <- c((1 - ac) * mu, ac, (1 - ac^2) * sd^2) 86 | return(theta >= est.bds[, 1] & theta <= est.bds[, 2]) 87 | } 88 | expect_true(all(NearEnoughAR1(SimulateAR1(5000, 8, 8, 0.8), 89 | 8, 8, 0.8))) 90 | }) 91 | --------------------------------------------------------------------------------