{"id":15360401,"url":"https://github.com/alexhallam/media_mix_sim","last_synced_at":"2026-01-07T07:14:10.822Z","repository":{"id":110217472,"uuid":"134457664","full_name":"alexhallam/media_mix_sim","owner":"alexhallam","description":"Media Mix Model with simulated data and stan","archived":false,"fork":false,"pushed_at":"2020-02-16T05:28:57.000Z","size":2827,"stargazers_count":6,"open_issues_count":1,"forks_count":5,"subscribers_count":4,"default_branch":"master","last_synced_at":"2025-02-01T22:29:21.234Z","etag":null,"topics":["media","media-mix-modeling","roi","simulation"],"latest_commit_sha":null,"homepage":null,"language":"Stan","has_issues":true,"has_wiki":null,"has_pages":null,"mirror_url":null,"source_name":null,"license":null,"status":null,"scm":"git","pull_requests_enabled":true,"icon_url":"https://github.com/alexhallam.png","metadata":{"files":{"readme":"README.Rmd","changelog":null,"contributing":null,"funding":null,"license":null,"code_of_conduct":null,"threat_model":null,"audit":null,"citation":null,"codeowners":null,"security":null,"support":null,"governance":null}},"created_at":"2018-05-22T18:20:32.000Z","updated_at":"2023-04-14T20:08:37.000Z","dependencies_parsed_at":"2023-04-26T02:17:27.130Z","dependency_job_id":null,"html_url":"https://github.com/alexhallam/media_mix_sim","commit_stats":{"total_commits":8,"total_committers":4,"mean_commits":2.0,"dds":0.625,"last_synced_commit":"ee4cb271cf0f1bdda350fe3118b720d0ebdda261"},"previous_names":[],"tags_count":0,"template":false,"template_full_name":null,"repository_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/alexhallam%2Fmedia_mix_sim","tags_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/alexhallam%2Fmedia_mix_sim/tags","releases_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/alexhallam%2Fmedia_mix_sim/releases","manifests_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/alexhallam%2Fmedia_mix_sim/manifests","owner_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners/alexhallam","download_url":"https://codeload.github.com/alexhallam/media_mix_sim/tar.gz/refs/heads/master","host":{"name":"GitHub","url":"https://github.com","kind":"github","repositories_count":245916321,"owners_count":20693389,"icon_url":"https://github.com/github.png","version":null,"created_at":"2022-05-30T11:31:42.601Z","updated_at":"2022-07-04T15:15:14.044Z","host_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub","repositories_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories","repository_names_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repository_names","owners_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners"}},"keywords":["media","media-mix-modeling","roi","simulation"],"created_at":"2024-10-01T12:49:46.071Z","updated_at":"2026-01-07T07:14:10.790Z","avatar_url":"https://github.com/alexhallam.png","language":"Stan","funding_links":[],"categories":[],"sub_categories":[],"readme":"---\noutput: github_document\n---\n\n\u003c!-- README.md is generated from README.Rmd. Please edit that file --\u003e\n\n```{r, include = FALSE}\nknitr::opts_chunk$set(\n  collapse = TRUE,\n  comment = \"#\u003e\"\n)\n```\n\n```{r media data}\nlibrary(tidyverse)\nlibrary(corrr)\nlibrary(hrbrthemes)\n# -------------------------------------\n# Generate Media Data\n# Equation: y=a*sin(b*t)+c.unif*amp\n# -------------------------------------\nset.seed(1)\nn \u003c- 52 * 2 # number of data points\nt \u003c- seq(0, 4*pi, length.out = n)\nb \u003c- 8 # essentially the number of pillars in a year\nc.norm1 \u003c- rnorm(n,0,0.5)\nc.norm2 \u003c- rnorm(n,0, 0.75)\nc.norm3 \u003c- rnorm(n,0, 0.75)\namp \u003c- 2\n# generate data and calculate \"y\"\nmedia_tv \u003c- 1*sin(b*t)+c.norm1*amp # Gaussian/normal error\nmedia_radio \u003c- 1*sin(b*t)+c.norm2*amp # Gaussian/normal error\nmedia_online \u003c- 1*sin(b*t)+c.norm3*amp # Gaussian/normal error\nweek \u003c- seq(1:104)\n\nsim_df \u003c- as.data.frame(list(week = week,\n                            media_tv = media_tv,\n                            media_radio = media_radio,\n                            media_online = media_online)) %\u003e% \n  mutate_at(vars(media_tv, media_radio,media_online), percent_rank)\n\nsim_df %\u003e% \n  ggplot(aes(x = week)) +\n  geom_line(aes(y = media_tv, color = \"tv\")) +\n  geom_line(aes(y = media_radio, color = \"radio\")) +\n  geom_line(aes(y = media_online, color = \"online\")) +\n  theme_ipsum()\n```\n\n```{r price data}\n# -----------------------------------------------------------------------------\n# Generate Menu Price Data\n# Equation: y=ARIMA(1,1,0) with AR = 0.50\n# Interpretation: Price has increased by 3 dollars in the last year\n# -----------------------------------------------------------------------------\nprice \u003c- arima.sim(n = n, list(ar = c(0.8897, -0.4858), ma = c(0.279, 0.2488)), sd = sqrt(0.001))\nmean(price); sd(price)\nhist(price)\nplot(price)\n\n#price \u003c- as.numeric(scale(price))\nsim_df \u003c- add_column(sim_df, price) \n\nsim_df %\u003e% \n  gather(key = vartype, value = value, -week) %\u003e% \n  ggplot(aes(x = week, y = value)) +\n  geom_col()+\n  facet_wrap(~vartype) +\n  hrbrthemes::theme_ipsum()\n```\n\n```{r}\n# --------------------------------------------------\n# Scale media to [0, 1] as per paper\n# media_i = x_i - min(x) / max(x) - min(x)\n# --------------------------------------------------\nmy_normalizer \u003c- function(x) (x - min(x)) / (max(x) - min(x))\n\nsim_df \u003c- sim_df %\u003e% \n  mutate_at(vars(-week,-price), my_normalizer)\n\nsim_df %\u003e% write_csv(\"sim_df.csv\")\n\nsim_df %\u003e% \n  gather(key = vartype, value = value, -week) %\u003e% \n  ggplot(aes(x = week, y = value)) +\n  geom_col()+\n  facet_wrap(~vartype) +\n  hrbrthemes::theme_ipsum()\n```\n\n```{r adstock}\n#----------------------------------------------------------------------------- \n# Generate adstock as described in the Google Paper:\n# Bayesian Methods for Media Mix Modeling with Carryover and Shape Effects\n#----------------------------------------------------------------------------- \nlibrary(tidyquant)\n\n# fake data\ndate \u003c- seq(from = as.Date(\"2018-01-01\"), length.out = 104, by = \"1 week\")\nx    \u003c- c(rep(100,5), rep(0,99)) %\u003e% \n  as_tibble() %\u003e% \n  add_column(date) %\u003e%\n  rename(x = value)\n\n# -----------------------------------------------------------------------------\n# Name:            Carryover Effect\n#\n# Description:    Two functions are provided for modeling the decay of ad \n#                 effect. \n#\n# Geometric:      This function assumes that week 1 is the most impactfull\n#                 week of the the promo. Subsequent weeks have a slow decline\n#                 as defined by the rate. A larger rate give a slower decline\n#\n# Delayed:        This function assumes that a week after week 1 is the most\n#                 impactfull week. It has a weight that is proportional to \n#                 The normal distribution around the week of impact defined\n#                 by theta\n# -----------------------------------------------------------------------------\ngeom_decay    \u003c- function(rate,l,...) sum((rate^l) *...) / sum(rate^l)\ndelayed_decay \u003c- function(rate,l,theta,...){\n  sum((rate^(l-theta)^2) *...) / sum(rate^(l-theta)^2) \n}\n\n# Examples of calculating adstock from both functions\n# Since the values are calculated on a rolling window\n# it is neccesary to used something like tq_mutate\n# to get values for a given time-series\n\nL = 13\nx %\u003e% \n  tq_mutate(select = x, mutate_fun = rollapply, width = L, align = \"right\",\n    FUN = geom_decay,\n    #function args\n    rate = 0.8,\n    l = seq(from = 0 , to = L-1),\n    #ts_mutate\n    col_rename = \"adstock_geometric_decay\"\n  )\nx %\u003e% \n  tq_mutate(select = x, mutate_fun = rollapply, width = L, align = \"right\",\n    FUN = delayed_decay,\n    #function args\n    rate = 0.8, # rate of 0.4 to 0.8 is sensible  \n    theta = 1,   # theta should be about 1 to 3 \n    l = seq(from = 0 , to = L-1),\n    #ts_mutate\n    col_rename = \"adstock_delayed_decay\"\n  )\n  \n```\n\n\n\n```{r bhill}\n# -----------------------------------------------------------------------------\n# Name:            Shape Effect\n#\n# Description:    It is not enough to model the decay and the lag of an ad.\n#                 The shape of its saturation is also an important funtion\n#                 that deserves attention.\n#\n# Hill Function:  Marketing Mix Modelers often chose between S-curves and\n#                 C-curves when modeling media impact on sales. \n#                 Pharmacology uses the Hill function to model receptors.\n#                 It provides a flexible functional form that may take the \n#                 form of both an S-curve and a C-curve which provides a\n#                 convinient solution to parameterizing the function \n#                 representing shape effect.\n# K:              Half Saturation\n# S:              Slope\n# B:              Beta\n#\n# Problem:        It may be the case that the Slope parameter \"S\" may have to \n#                 be set to 1 (S = 1). This is an issue with identifiability\n# -----------------------------------------------------------------------------\n\n# Define Function\nBHill \u003c- function(B,K,S,...) B - ((K^S * B)/(...^S + K^S))\n\n# set up example data\nx \u003c- seq(0,1, length.out = 100) # media must be transformed to [0, 1] scale\n                                # for ease of use\n\nparams \u003c- tribble(\n  ~K,   ~S,   ~B,  ~type,\n  0.5,  1,    0.3, \"simple_c\",\n  0.5,  2,    0.3, \"simple_s\",\n  0.5,  0.25,  0.3, \"sharp_c\"\n)\n\nbhill_df \u003c- crossing(x,params) %\u003e% \n  mutate(y = BHill(B,K,S,x))\n\nbhill_df %\u003e% \n  ggplot(aes(x = x, y = y, color = type)) +\n  geom_line() +\n  labs(title = \"Flexible Shape Function\") +\n  hrbrthemes::theme_ipsum()\n```\n\n```{r}\n# ============================================================================= \n# Simulation\n# Description:  With simulated media data as \"media variables\" and \n#               simulated price as a \"control variable\" I applied the neccesary\n#               transfomations (adstock \u0026 shape) to the input variables with\n#               various parameters to test the ability of this model to \n#               discover the parameters I set\n#\n# Equation:     Weekly sales have the following form:\n#\n#               sales_wk = tau + BHill_tv_wk + BHill_online_wk + BHill_radio_wk \n#                          + gamma*price_wk + e_wk\n# ============================================================================= \n\n#------------------------------------------------------------ \n#\n# Media Parameters\n# ----------------\n# Parameter | Media_tv  | Media_radio  | Media_online\n#  rate         0.6         0.8            0.8\n#  theta        5           3              4\n#  K            0.2         0.2            0.2\n#  S            1           2              2\n#  B            0.8         0.6            0.3\n#\n# Other variables\n# ----------------\n# Parameter | Value   \n#  L          13 \n#  tau        4      \n#  gamma      0.05   \n#  e          normal(0,0.05^2)     \n#------------------------------------------------------------ \nfat_data \u003c- sim_df %\u003e% \n  add_column(date = seq(as.Date(\"2017-01-01\"), length.out = n, by = \"week\")) %\u003e%  \n  # adstocks\n  tq_mutate(select = media_tv, mutate_fun = rollapply, width = L, align = \"right\",\n    FUN = delayed_decay,rate = 0.6, theta = 1,   \n    l = seq(from = 0 , to = L-1),col_rename = \"adstk_tv\"\n  )%\u003e% \n  tq_mutate(select = media_radio, mutate_fun = rollapply, width = L, align = \"right\",\n    FUN = delayed_decay,rate = 0.8, theta = 1,   \n    l = seq(from = 0 , to = L-1),col_rename = \"adstk_radio\"\n  )%\u003e% \n  tq_mutate(select = media_online, mutate_fun = rollapply, width = L, align = \"right\",\n    FUN = delayed_decay,rate = 0.8, theta = 1,   \n    l = seq(from = 0 , to = L-1),col_rename = \"adstk_online\"\n  )%\u003e% \n  # Shape\n  mutate(m_tv = BHill(K = 0.2, S = 1, B = 0.8,adstk_tv)) %\u003e% \n  mutate(m_rd = BHill(K = 0.2, S = 1, B = 0.6,adstk_radio)) %\u003e% \n  mutate(m_online = BHill(K = 0.2, S = 1, B = 0.3,adstk_online)) %\u003e% \n  #and errors\n  mutate(e = rnorm(n = n(), mean = 0, sd = 0.25^2)) %\u003e% \n  mutate(sales = 4 + m_tv + m_rd + m_online + .5 * price + e)\n\nclean_data \u003c- fat_data %\u003e% \n  select(date, sales,m_tv,m_rd,m_online,price,e) %\u003e% \n  na.omit()\nclean_data\n```\n\n```{r}\nlibrary(hrbrthemes)\n# some plots of the data. see if it matches the paper okay\nclean_data %\u003e% \n  ggplot(aes(date, sales)) + geom_line() + theme_ipsum()\n```\n\n\n```{r}\nclean_data %\u003e% \n  select(price, m_tv, m_rd, m_online) %\u003e% \n  correlate()\n```\n\n```{r}\nclean_data %\u003e% \n  select(sales, m_tv, m_rd, m_online, e, price) %\u003e% \n  summarise_all(var) %\u003e% \n  transmute(var_tv = m_tv / sales, \n         var_rd =   m_rd / sales, \n         var_online = m_online / sales,\n         var_noise = e / sales,\n         price = price / sales)\n```\n```{r}\nclean_data %\u003e% write_csv(\"clean_data.csv\")\n```\n\n```{r}\nmedia_data \u003c- clean_data %\u003e% select(contains(\"m_\"))\n# data Prep\nN \u003c- nrow(clean_data)\nY \u003c- clean_data$sales\nmax_lag \u003c- 13\nnum_media \u003c- 3\nlag_vec \u003c- seq(0, max_lag - 1)\nX_media \u003c- array(data = media_data, dim = c(num_media))\nnum_ctrl \u003c- 1\nX_ctrl \u003c- clean_data$price\n\nstan_data \u003c- list(N=N, Y=Y, max_lag=max_lag, num_media=num_media,\n                  lag_vec=lag_vec,X_media=X_media,\n                  num_ctrl=num_ctrl,X_ctrl=X_ctrl)\n\nstan_data %\u003e% str\n```\n\n```{r}\nlibrary(rstan)\nclean_data \u003c- read_csv(\"clean_data.csv\")\nmedia_data \u003c- clean_data %\u003e% select(contains(\"m_\"))\nlong_media_array \u003c- c(clean_data$m_tv,clean_data$m_rd,clean_data$m_online)\n# data Prep\nN \u003c- nrow(clean_data)\nY \u003c- clean_data$sales\nmax_lag \u003c- 13\nnum_media \u003c- 3\nlag_vec \u003c- seq(0, max_lag - 1)\nX_media \u003c- array(data = media_data, dim = c(3,13))\nX_media \u003c- array(data = long_media_array, dim = c(92,3,13))\nnum_ctrl \u003c- 1\nX_ctrl \u003c- clean_data %\u003e% select(price) %\u003e% as.vector()\n\nstan_data \u003c- list(N=N, Y=Y, max_lag=max_lag, num_media=num_media,\n                  lag_vec=lag_vec,X_media=X_media,\n                  num_ctrl=num_ctrl,X_ctrl=X_ctrl)\n\nm.stan \u003c- stan(file = \"model.stan\",data = stan_data, iter = 3000, chains = 1, control = list(max_treedepth = 15))\n\n#summary(m.stan)\n```\n\n```{r}\nm.stan\n```\n\n```{r}\nrstan::get_posterior_mean(m.stan)\nlist_of_draws \u003c- extract(m.stan)\n\npredicted_sales \u003c- summary(m.stan, pars = \"mu\", probs = NULL)$summary %\u003e% \n  as_tibble() %\u003e% \n  select(mean) %\u003e% \n  rename(pred_sales = mean)\n\npred_and_sales \u003c- predicted_sales %\u003e% \n  add_column(sales = clean_data$sales) %\u003e% \n  mutate(index = row_number())\n\n\npred_and_sales %\u003e% \n  ggplot(aes(x = index)) +\n  geom_line(aes(y = sales), color = \"black\") +\n  geom_line(aes(y = pred_sales), color = \"red\")\n```\n\n\n\n```{r}\n#look at functions learned from model\n\nx \u003c- seq(0,1, length.out = 100)\n\ntv_pred \u003c- BHill(B = 1.20, K = 0.50, S = 2.23,x)\nrd_pred \u003c- BHill(B = 0.95, K = 0.50, S = 2.45,x)\nonline_pred \u003c- BHill(B = 0.90, K = 0.50, S = 1.59,x)\n\nm_tv \u003c- BHill(K = 0.2, S = 1, B = 0.8,x)\nm_rd \u003c-  BHill(K = 0.2, S = 1, B = 0.6,x)\nm_online \u003c-  BHill(K = 0.2, S = 1, B = 0.3,x)\n\nas_tibble(list(tv_actual = m_tv, tv_pred = tv_pred)) %\u003e% \n  mutate(index = row_number()) %\u003e% \n  ggplot(aes(x = index)) +\n  geom_line(aes(y = tv_actual, color = \"actual\")) +\n  geom_line(aes(y = tv_pred, color = \"pred\"))\n\nas_tibble(list(rd_actual = m_rd, rd_pred = rd_pred)) %\u003e% \n  mutate(index = row_number()) %\u003e% \n  ggplot(aes(x = index)) +\n  geom_line(aes(y = rd_actual, color = \"actual\")) +\n  geom_line(aes(y = rd_pred, color = \"pred\"))\n\nas_tibble(list(online_actual = m_online, online_pred = online_pred)) %\u003e% \n  mutate(index = row_number()) %\u003e% \n  ggplot(aes(x = index)) +\n  geom_line(aes(y = online_actual, color = \"actual\")) +\n  geom_line(aes(y = online_pred, color = \"pred\"))\n```\n\n```{r}\nrgamma(n = 100, shape = 2, scale = .25) %\u003e% hist()\n```\n\n","project_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Falexhallam%2Fmedia_mix_sim","html_url":"https://awesome.ecosyste.ms/projects/github.com%2Falexhallam%2Fmedia_mix_sim","lists_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Falexhallam%2Fmedia_mix_sim/lists"}