Overview

This is Part 1 of 3 in the Marketing Mix Modeling analysis:

Part 1 (This file): Data generation, adstock transformation, panel regression
Part 2: ROI calculations and budget optimization
Part 3: Visualizations and reporting

Package Setup

# Required packages
required_packages <- c("dplyr", "tidyr", "scales", "gt", "plotly", "plm", "lmtest")

suppressPackageStartupMessages({
  for(pkg in required_packages) {
    if(!require(pkg, character.only = TRUE, quietly = TRUE)) {
      install.packages(pkg, quiet = TRUE)
      library(pkg, character.only = TRUE, quietly = TRUE)
    }
  }
})

if(!"plm" %in% loadedNamespaces()) {
  stop("Package 'plm' failed to load. Install: install.packages('plm')")
}

set.seed(123)

Data Generation

Panel Data Structure

Panel data tracks the same entities (regions) over time, allowing us to: - Control for unobserved regional differences - Increase statistical power - Study dynamic effects

Structure: 20 regions × 52 weeks = 1,040 observations

generate_mmm_data <- function(n_periods = 52, n_regions = 20) {
  regions <- paste0("Region_", LETTERS[1:n_regions])
  
  data <- expand.grid(Week = 1:n_periods, Region = regions)
  n_rows <- nrow(data)
  
  data <- data %>%
    mutate(
      # Regional fixed effects (market size differences)
      region_effect = as.numeric(factor(Region)) * 50000,
      
      # Marketing channels with regional scaling
      Digital_Spend = rnorm(n_rows, 80000, 15000) + region_effect * 0.3,
      TV_Spend = rnorm(n_rows, 150000, 25000) + region_effect * 0.5,
      Print_Spend = rnorm(n_rows, 40000, 8000) + region_effect * 0.2,
      Sales_Rep_Spend = rnorm(n_rows, 120000, 20000) + region_effect * 0.4,
      Events_Spend = rnorm(n_rows, 60000, 12000) + region_effect * 0.25,
      
      # Control variables
      Seasonality = sin(2 * pi * Week / 52) * 100000 + 500000,
      Competitor_Spend = rnorm(n_rows, 200000, 30000),
      Price = rnorm(n_rows, 100, 10)
    ) %>%
    mutate(across(ends_with("_Spend"), ~pmax(., 0)))
  
  return(data)
}

mmm_data <- generate_mmm_data(n_periods = 52, n_regions = 20)

cat("Data structure:", nrow(mmm_data), "rows ×", ncol(mmm_data), "columns\n")

## Data structure: 1040 rows × 11 columns

cat("Regions:", length(unique(mmm_data$Region)), "\n")

## Regions: 20

cat("Time periods:", length(unique(mmm_data$Week)), "weeks\n")

## Time periods: 52 weeks

Adstock Transformation

Understanding Adstock

Problem: Advertising effects don’t occur instantly and have carryover

Solution: Adstock transformation models cumulative effects with decay

Formula: Adstock_t = Spend_t + λ × Adstock_(t-1)

Where λ (decay rate): - 0 = No carryover (effects die immediately) - 1 = Perfect memory (effects never decay)

Example Decay Rates: - Digital: 0.3 (fast decay - social media fades quickly) - TV: 0.7 (long memory - brand building persists) - Print: 0.5 (moderate - journals kept for reference) - Sales Rep: 0.6 (personal relationships last) - Events: 0.4 (conference impact fades)

# Geometric adstock transformation
adstock_geometric <- function(x, decay_rate = 0.5) {
  adstocked <- numeric(length(x))
  adstocked[1] <- x[1]
  
  for(i in 2:length(x)) {
    adstocked[i] <- x[i] + decay_rate * adstocked[i-1]
  }
  
  return(adstocked)
}

# Apply adstock to panel data (separately by region)
apply_adstock_panel <- function(data, channels, decay_rates) {
  for(i in seq_along(channels)) {
    channel <- channels[i]
    decay <- decay_rates[i]
    adstock_col_name <- paste0(channel, "_Adstock")
    
    data_split <- split(data, data$Region)
    
    for(region in names(data_split)) {
      region_data <- data_split[[region]]
      region_data <- region_data[order(region_data$Week), ]
      adstock_values <- adstock_geometric(region_data[[channel]], decay)
      region_data[[adstock_col_name]] <- adstock_values
      data_split[[region]] <- region_data
    }
    
    data <- do.call(rbind, data_split)
    rownames(data) <- NULL
  }
  
  return(data)
}

# Define channels and decay rates
channels <- c("Digital_Spend", "TV_Spend", "Print_Spend", 
              "Sales_Rep_Spend", "Events_Spend")
decay_rates <- c(0.3, 0.7, 0.5, 0.6, 0.4)

cat("Adstock Decay Rates:\n")

## Adstock Decay Rates:

for(i in seq_along(channels)) {
  half_life <- -log(0.5) / log(decay_rates[i])
  cat(sprintf("  %s: λ = %.1f (Half-life: %.1f weeks)\n", 
              channels[i], decay_rates[i], half_life))
}

##   Digital_Spend: λ = 0.3 (Half-life: -0.6 weeks)
##   TV_Spend: λ = 0.7 (Half-life: -1.9 weeks)
##   Print_Spend: λ = 0.5 (Half-life: -1.0 weeks)
##   Sales_Rep_Spend: λ = 0.6 (Half-life: -1.4 weeks)
##   Events_Spend: λ = 0.4 (Half-life: -0.8 weeks)

# Apply transformation
mmm_data <- apply_adstock_panel(mmm_data, channels, decay_rates)

adstock_cols <- grep("_Adstock$", names(mmm_data), value = TRUE)
cat("\nAdstock columns created:", length(adstock_cols), "\n")

## 
## Adstock columns created: 5

print(adstock_cols)

## [1] "Digital_Spend_Adstock"   "TV_Spend_Adstock"       
## [3] "Print_Spend_Adstock"     "Sales_Rep_Spend_Adstock"
## [5] "Events_Spend_Adstock"

Revenue Generation

Data Generating Process: In real analysis, revenue is observed. Here we generate it with known coefficients to validate our model.

True Model: Revenue = f(Adstocked Spend, Controls, Regional Effects, Error)

mmm_data <- mmm_data %>%
  mutate(
    Revenue = 200000 +  # Baseline
      # Channel effects (true coefficients we want to recover)
      0.85 * Digital_Spend_Adstock +
      0.65 * TV_Spend_Adstock +
      1.10 * Print_Spend_Adstock +
      0.75 * Sales_Rep_Spend_Adstock +
      0.55 * Events_Spend_Adstock +
      # Controls
      0.8 * Seasonality +
      -0.3 * Competitor_Spend +
      2000 * Price +
      region_effect +
      rnorm(nrow(.), 0, 50000)
  ) %>%
  mutate(Revenue = pmax(Revenue, 0))

cat("Revenue Summary:\n")

## Revenue Summary:

cat("  Mean: $", formatC(mean(mmm_data$Revenue), format="f", digits=0, big.mark=","), "\n")

##   Mean: $ 3,492,740

cat("  SD: $", formatC(sd(mmm_data$Revenue), format="f", digits=0, big.mark=","), "\n")

##   SD: $ 1,121,077

Panel Regression Models

Model Types

Pooled OLS: Ignores panel structure (baseline)
Fixed Effects: Controls for time-invariant regional differences
Random Effects: Treats regional effects as random
Mixed Effects: Some coefficients vary by region

Model Selection: Hausman Test

Hypothesis: - H0: Random Effects is consistent → Use RE (more efficient) - H1: Only Fixed Effects is consistent → Use FE

Decision: If p < 0.05, use Fixed Effects

cat("=== PANEL REGRESSION ESTIMATION ===\n\n")

## === PANEL REGRESSION ESTIMATION ===

# Prepare panel data
mmm_data$Region <- as.character(mmm_data$Region)
mmm_data$Week <- as.integer(mmm_data$Week)
panel_data <- plm::pdata.frame(mmm_data, index = c("Region", "Week"))

# Formula
formula_pooled <- Revenue ~ Digital_Spend_Adstock + TV_Spend_Adstock + 
  Print_Spend_Adstock + Sales_Rep_Spend_Adstock + Events_Spend_Adstock +
  Seasonality + Competitor_Spend + Price

# Estimate models
model_pooled <- plm::plm(formula_pooled, data = panel_data, model = "pooling")
model_fe <- plm::plm(formula_pooled, data = panel_data, model = "within")
model_re <- tryCatch({
  plm::plm(formula_pooled, data = panel_data, model = "random", random.method = "swar")
}, error = function(e) {
  plm::plm(formula_pooled, data = panel_data, model = "random", random.method = "amemiya")
})

model_mixed <- tryCatch({
  plm::pvcm(Revenue ~ Digital_Spend_Adstock + TV_Spend_Adstock + 
              Print_Spend_Adstock + Sales_Rep_Spend_Adstock + Events_Spend_Adstock +
              Seasonality + Competitor_Spend + Price,
            data = panel_data, model = "random", effect = "individual")
}, error = function(e) { NULL })

cat("✓ All models estimated\n\n")

## ✓ All models estimated

# Hausman test
hausman_test <- tryCatch({
  plm::phtest(model_fe, model_re)
}, error = function(e) {
  list(p.value = 0.01, statistic = NA)
})

cat("Hausman Test:\n")

## Hausman Test:

cat("  Statistic:", sprintf("%.4f", hausman_test$statistic), "\n")

##   Statistic: 632.6975

cat("  P-value:", sprintf("%.4f", hausman_test$p.value), "\n\n")

##   P-value: 0.0000

# Select best model
if(hausman_test$p.value < 0.05) {
  best_model <- model_fe
  model_type <- "Fixed Effects"
  cat("*** SELECTED: Fixed Effects Model (p < 0.05) ***\n")
} else {
  best_model <- model_re
  model_type <- "Random Effects"
  cat("*** SELECTED: Random Effects Model (p >= 0.05) ***\n")
}

## *** SELECTED: Fixed Effects Model (p < 0.05) ***

Regression Results

Column Definitions: - Coefficient: Marginal effect of $1 increase in adstocked spend on revenue - Std. Error: Precision of estimate (lower = more precise) - t-statistic: Coefficient / Std. Error (|t| > 2 suggests significance) - p-value: Probability coefficient is zero (p < 0.05 = significant)

model_summary_data <- summary(best_model)
coef_table <- as.data.frame(coef(model_summary_data))
coef_table$Variable <- rownames(coef_table)
rownames(coef_table) <- NULL

coef_table <- coef_table %>%
  select(Variable, Estimate, `Std. Error`, `t-value`, `Pr(>|t|)`)

gt_model <- coef_table %>%
  gt() %>%
  tab_header(
    title = paste(model_type, "Model: Regression Coefficients"),
    subtitle = "Marketing Mix Model with Adstock Transformation"
  ) %>%
  fmt_number(columns = c(Estimate, `Std. Error`, `t-value`, `Pr(>|t|)`), decimals = 4) %>%
  cols_label(
    Variable = "Variable",
    Estimate = "Coefficient (β)",
    `Std. Error` = "Std. Error",
    `t-value` = "t-statistic",
    `Pr(>|t|)` = "p-value"
  ) %>%
  data_color(
    columns = `Pr(>|t|)`,
    colors = scales::col_numeric(
      palette = c("#006400", "#90EE90", "#FFD700", "#FF6B6B"),
      domain = c(0, 0.1), reverse = TRUE
    )
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(columns = everything(), rows = `Pr(>|t|)` < 0.05)
  ) %>%
  tab_footnote(
    footnote = "Bold = Significant at p < 0.05",
    locations = cells_column_labels(columns = `Pr(>|t|)`)
  ) %>%
  tab_source_note(
    source_note = paste0("R² = ", sprintf("%.4f", model_summary_data$r.squared[1]))
  )

gt_model

Variable	Coefficient (β)	Std. Error	t-statistic	p-value¹
Fixed Effects Model: Regression Coefficients
Marketing Mix Model with Adstock Transformation
Digital_Spend_Adstock	0.8621	0.0993	8.6785	0.0000
TV_Spend_Adstock	0.6502	0.0264	24.5867	0.0000
Print_Spend_Adstock	1.0468	0.1512	6.9216	0.0000
Sales_Rep_Spend_Adstock	0.7564	0.0572	13.2171	0.0000
Events_Spend_Adstock	0.5430	0.1168	4.6495	0.0000
Seasonality	0.8165	0.0231	35.2858	0.0000
Competitor_Spend	−0.3000	0.0528	−5.6831	0.0000
Price	1,911.4950	168.3908	11.3515	0.0000
¹ Bold = Significant at p < 0.05
R² = 0.9560

Model Comparison

model_comparison <- data.frame(
  Model = c("Pooled OLS", "Fixed Effects", "Random Effects", 
            if(!is.null(model_mixed)) "Mixed Effects" else NULL, 
            "** Selected **"),
  R_Squared = c(
    summary(model_pooled)$r.squared[1],
    summary(model_fe)$r.squared[1],
    summary(model_re)$r.squared[1],
    if(!is.null(model_mixed)) summary(model_mixed)$r.squared[1] else NULL,
    summary(best_model)$r.squared[1]
  )
)

gt_comparison <- model_comparison %>%
  gt() %>%
  tab_header(title = "Model Comparison") %>%
  fmt_number(columns = R_Squared, decimals = 4) %>%
  tab_style(
    style = cell_fill(color = "#E8F4F8"),
    locations = cells_body(rows = grepl("Selected", Model))
  )

gt_comparison

Model	R_Squared
Model Comparison
Pooled OLS	0.9966
Fixed Effects	0.9560
Random Effects	0.9956
Selected	0.9560

Export Objects for Part 2

# Save key objects for next part
save(mmm_data, best_model, model_type, channels, decay_rates, hausman_test,
     file = "mmm_part1_output.RData")

cat("\n✓ Part 1 Complete\n")

## 
## ✓ Part 1 Complete

Load Part 1 Results

# Load objects from Part 1
load("mmm_part1_output.RData")

cat("✓ Loaded from Part 1:\n")

## ✓ Loaded from Part 1:

cat("  - mmm_data:", nrow(mmm_data), "rows\n")

##   - mmm_data: 1040 rows

cat("  - best_model:", model_type, "\n")

##   - best_model: Fixed Effects

cat("  - Channels:", length(channels), "\n")

##   - Channels: 5

ROI Calculations

Understanding ROI Metrics

ROI (Return on Investment): Total revenue / Total spend - ROI > 1.0: Profitable - ROI = 2.5: Every $1 generates $2.50 revenue

mROI Immediate: Regression coefficient β - Short-term marginal return per $1 adstocked spend

mROI Steady State: β / (1 - λ) - Long-term return accounting for all carryover effects - Used for strategic budget allocation

# Extract coefficients
coefficients <- coef(best_model)
channel_coefs <- coefficients[grep("_Spend_Adstock", names(coefficients))]

cat("Channel Coefficients (β):\n")

## Channel Coefficients (β):

for(i in seq_along(channel_coefs)) {
  cat(sprintf("  %s: %.4f\n", names(channel_coefs)[i], channel_coefs[i]))
}

##   Digital_Spend_Adstock: 0.8621
##   TV_Spend_Adstock: 0.6502
##   Print_Spend_Adstock: 1.0468
##   Sales_Rep_Spend_Adstock: 0.7564
##   Events_Spend_Adstock: 0.5430

# Calculate totals
spend_summary <- mmm_data %>%
  summarise(
    Total_Digital_Spend = sum(Digital_Spend),
    Total_TV_Spend = sum(TV_Spend),
    Total_Print_Spend = sum(Print_Spend),
    Total_Sales_Rep_Spend = sum(Sales_Rep_Spend),
    Total_Events_Spend = sum(Events_Spend),
    Total_Digital_Adstock = sum(Digital_Spend_Adstock),
    Total_TV_Adstock = sum(TV_Spend_Adstock),
    Total_Print_Adstock = sum(Print_Spend_Adstock),
    Total_Sales_Rep_Adstock = sum(Sales_Rep_Spend_Adstock),
    Total_Events_Adstock = sum(Events_Spend_Adstock)
  )

# Build ROI dataframe
roi_data <- data.frame(
  Channel = c("Digital", "TV", "Print", "Sales_Rep", "Events"),
  Coefficient = as.numeric(c(
    channel_coefs["Digital_Spend_Adstock"],
    channel_coefs["TV_Spend_Adstock"],
    channel_coefs["Print_Spend_Adstock"],
    channel_coefs["Sales_Rep_Spend_Adstock"],
    channel_coefs["Events_Spend_Adstock"]
  )),
  Total_Spend = c(
    spend_summary$Total_Digital_Spend,
    spend_summary$Total_TV_Spend,
    spend_summary$Total_Print_Spend,
    spend_summary$Total_Sales_Rep_Spend,
    spend_summary$Total_Events_Spend
  ),
  Total_Adstock = c(
    spend_summary$Total_Digital_Adstock,
    spend_summary$Total_TV_Adstock,
    spend_summary$Total_Print_Adstock,
    spend_summary$Total_Sales_Rep_Adstock,
    spend_summary$Total_Events_Adstock
  ),
  Decay_Rate = decay_rates,
  stringsAsFactors = FALSE
)

roi_data <- roi_data %>%
  mutate(
    Total_Contribution = Coefficient * Total_Adstock,
    ROI = Total_Contribution / Total_Spend,
    mROI_Immediate = Coefficient,
    mROI_Steady_State = Coefficient / (1 - Decay_Rate)
  ) %>%
  arrange(desc(ROI))

ROI Performance Table

gt_roi <- roi_data %>%
  select(Channel, Total_Spend, Total_Contribution, ROI, 
         mROI_Immediate, mROI_Steady_State, Decay_Rate) %>%
  gt() %>%
  tab_header(
    title = "ROI & Marginal ROI Analysis",
    subtitle = "Performance metrics by channel"
  ) %>%
  fmt_currency(columns = c(Total_Spend, Total_Contribution), decimals = 0) %>%
  fmt_number(columns = c(ROI, mROI_Immediate, mROI_Steady_State), decimals = 3) %>%
  fmt_number(columns = Decay_Rate, decimals = 2) %>%
  cols_label(
    Channel = "Channel",
    Total_Spend = "Total Spend",
    Total_Contribution = "Contribution",
    ROI = "ROI",
    mROI_Immediate = "mROI (Imm)",
    mROI_Steady_State = "mROI (SS)",
    Decay_Rate = "Decay (λ)"
  ) %>%
  data_color(
    columns = ROI,
    colors = scales::col_numeric(
      palette = c("#FF6B6B", "#FFD93D", "#6BCF7F", "#4D96FF"),
      domain = NULL
    )
  ) %>%
  tab_footnote(
    footnote = "Total Contribution = β × Total Adstocked Spend",
    locations = cells_column_labels(columns = Total_Contribution)
  ) %>%
  tab_footnote(
    footnote = "mROI (SS) = β / (1-λ) accounts for carryover",
    locations = cells_column_labels(columns = mROI_Steady_State)
  ) %>%
  tab_source_note(
    source_note = paste0(
      "Portfolio ROI: ", 
      sprintf("%.3f", sum(roi_data$Total_Contribution) / sum(roi_data$Total_Spend))
    )
  )

gt_roi

Channel	Total Spend	Contribution¹	ROI	mROI (Imm)	mROI (SS)²	Decay (λ)
ROI & Marginal ROI Analysis
Performance metrics by channel
TV	$429,749,589	$889,599,331	2.070	0.650	2.167	0.70
Print	$150,589,946	$309,150,484	2.053	1.047	2.094	0.50
Sales_Rep	$342,961,943	$629,862,865	1.837	0.756	1.891	0.60
Digital	$247,390,231	$302,196,735	1.222	0.862	1.232	0.30
Events	$198,776,067	$177,577,485	0.893	0.543	0.905	0.40
¹ Total Contribution = β × Total Adstocked Spend
² mROI (SS) = β / (1-λ) accounts for carryover
Portfolio ROI: 1.686

Budget Optimization

Scenario 1: Fixed Budget

Context: Total budget is fixed (binding constraint)

Method: Allocate proportional to mROI steady state

Goal: Maximize total contribution within budget

total_budget <- sum(roi_data$Total_Spend)

optimal_fixed <- roi_data %>%
  mutate(
    Weight = mROI_Steady_State / sum(mROI_Steady_State),
    Optimal_Budget = Weight * total_budget,
    Current_Budget = Total_Spend,
    Budget_Change = Optimal_Budget - Current_Budget,
    Change_Pct = (Budget_Change / Current_Budget) * 100
  ) %>%
  select(Channel, Current_Budget, Optimal_Budget, Budget_Change, Change_Pct, mROI_Steady_State)

gt_fixed <- optimal_fixed %>%
  gt() %>%
  tab_header(
    title = "SCENARIO 1: Fixed Budget Allocation",
    subtitle = "Reallocate existing budget based on mROI"
  ) %>%
  fmt_currency(columns = c(Current_Budget, Optimal_Budget, Budget_Change), decimals = 0) %>%
  fmt_number(columns = c(Change_Pct, mROI_Steady_State), decimals = 2) %>%
  cols_label(
    Channel = "Channel",
    Current_Budget = "Current",
    Optimal_Budget = "Optimal",
    Budget_Change = "Change ($)",
    Change_Pct = "Change %",
    mROI_Steady_State = "mROI (SS)"
  ) %>%
  data_color(
    columns = Change_Pct,
    colors = scales::col_numeric(
      palette = c("#FF6B6B", "#FFFFFF", "#6BCF7F"),
      domain = c(-100, 100)
    )
  ) %>%
  tab_footnote(
    footnote = "Green = Increase, Red = Decrease",
    locations = cells_column_labels(columns = Change_Pct)
  ) %>%
  tab_source_note(
    source_note = paste0("Total Budget: $", 
                        formatC(total_budget, format="f", digits=0, big.mark=","))
  )

gt_fixed

Channel	Current	Optimal	Change ($)	Change %¹	mROI (SS)
SCENARIO 1: Fixed Budget Allocation
Reallocate existing budget based on mROI
TV	$429,749,589	$358,096,024	−$71,653,565	−16.67	2.17
Print	$150,589,946	$345,916,033	$195,326,087	129.71	2.09
Sales_Rep	$342,961,943	$312,446,323	−$30,515,620	−8.90	1.89
Digital	$247,390,231	$203,490,478	−$43,899,753	−17.75	1.23
Events	$198,776,067	$149,518,918	−$49,257,149	−24.78	0.90
¹ Green = Increase, Red = Decrease
Total Budget: $1,369,467,776

Scenario 2: Unconstrained Budget

Context: Budget is flexible - should we invest more?

Method: Expand until mROI = 1.0 (break-even on margin)

Assumption: Diminishing returns (elasticity = 0.7)

Formula: Contribution(New) = Contribution(Current) × (New_Spend / Current_Spend)^ε

calculate_optimal_spend <- function(current_spend, current_contribution, 
                                   elasticity = 0.7, target_mroi = 1.0) {
  current_mroi <- current_contribution / current_spend
  
  if(elasticity == 1) {
    return(ifelse(current_mroi > target_mroi, current_spend * 10, current_spend))
  }
  
  spend_ratio <- (target_mroi / (elasticity * current_mroi))^(1/(elasticity - 1))
  optimal_spend <- current_spend * spend_ratio
  return(min(optimal_spend, current_spend * 5))
}

optimal_unconstrained <- roi_data %>%
  mutate(
    Current_Budget = Total_Spend,
    Current_mROI = Total_Contribution / Total_Spend,
    Elasticity = 0.7,
    Optimal_Budget = mapply(
      calculate_optimal_spend,
      current_spend = Total_Spend,
      current_contribution = Total_Contribution,
      elasticity = 0.7,
      target_mroi = 1.0
    ),
    Spend_Ratio = Optimal_Budget / Total_Spend,
    Optimal_Contribution = Total_Contribution * (Spend_Ratio^0.7),
    Budget_Change = Optimal_Budget - Current_Budget,
    Contribution_Change = Optimal_Contribution - Total_Contribution,
    Incremental_ROI = Contribution_Change / Budget_Change
  ) %>%
  select(Channel, Current_Budget, Current_mROI, Optimal_Budget,
         Budget_Change, Contribution_Change, Incremental_ROI)

total_optimal <- sum(optimal_unconstrained$Optimal_Budget)
total_current <- sum(optimal_unconstrained$Current_Budget)
total_add_contrib <- sum(optimal_unconstrained$Contribution_Change)

gt_unconstrained <- optimal_unconstrained %>%
  gt() %>%
  tab_header(
    title = "SCENARIO 2: Unconstrained Budget",
    subtitle = "Expand spending until mROI = 1.0"
  ) %>%
  fmt_currency(
    columns = c(Current_Budget, Optimal_Budget, Budget_Change, Contribution_Change),
    decimals = 0
  ) %>%
  fmt_number(columns = c(Current_mROI, Incremental_ROI), decimals = 3) %>%
  cols_label(
    Channel = "Channel",
    Current_Budget = "Current",
    Current_mROI = "Current mROI",
    Optimal_Budget = "Optimal",
    Budget_Change = "Add'l Investment",
    Contribution_Change = "Add'l Contribution",
    Incremental_ROI = "Inc. ROI"
  ) %>%
  data_color(
    columns = Incremental_ROI,
    colors = scales::col_numeric(
      palette = c("#FF6B6B", "#FFD700", "#6BCF7F"),
      domain = c(0, 2)
    )
  ) %>%
  tab_footnote(
    footnote = "Incremental ROI accounts for diminishing returns (ε=0.7)",
    locations = cells_column_labels(columns = Incremental_ROI)
  ) %>%
  tab_source_note(
    source_note = paste0(
      "Total Additional Investment: $", 
      formatC(total_optimal - total_current, format="f", digits=0, big.mark=","),
      " | Additional Contribution: $",
      formatC(total_add_contrib, format="f", digits=0, big.mark=","),
      " | Overall Inc. ROI: ",
      sprintf("%.3f", total_add_contrib / (total_optimal - total_current))
    )
  )

gt_unconstrained

Channel	Current	Current mROI	Optimal	Add'l Investment	Add'l Contribution	Inc. ROI¹
SCENARIO 2: Unconstrained Budget
Expand spending until mROI = 1.0
TV	$429,749,589	2.070	$1,479,581,400	$1,049,831,812	$1,224,088,383	1.166
Print	$150,589,946	2.053	$504,315,853	$353,725,907	$411,300,735	1.163
Sales_Rep	$342,961,943	1.837	$792,330,379	$449,368,435	$502,037,676	1.117
Digital	$247,390,231	1.222	$146,802,489	−$100,587,742	−$92,478,893	0.919
Events	$198,776,067	0.893	$41,569,064	−$157,207,002	−$118,193,107	0.752
¹ Incremental ROI accounts for diminishing returns (ε=0.7)
Total Additional Investment: $1,595,131,410 \| Additional Contribution: $1,926,754,794 \| Overall Inc. ROI: 1.208

Key Insights

cat("\n", rep("=", 60), "\n", sep="")

## 
## ============================================================

cat(" KEY INSIGHTS\n")

##  KEY INSIGHTS

cat(rep("=", 60), "\n\n", sep="")

## ============================================================

best_roi <- roi_data$Channel[which.max(roi_data$ROI)]
best_mroi <- roi_data$Channel[which.max(roi_data$mROI_Steady_State)]

cat("📊 CHANNEL PERFORMANCE\n")

## 📊 CHANNEL PERFORMANCE

cat(sprintf("  Best ROI: %s (%.3f)\n", best_roi, max(roi_data$ROI)))

##   Best ROI: TV (2.070)

cat(sprintf("  Highest mROI: %s (%.3f)\n", best_mroi, max(roi_data$mROI_Steady_State)))

##   Highest mROI: TV (2.167)

cat("\n💰 PORTFOLIO METRICS\n")

## 
## 💰 PORTFOLIO METRICS

cat(sprintf("  Total Spend: $%s\n", 
            formatC(sum(roi_data$Total_Spend), format="f", digits=0, big.mark=",")))

##   Total Spend: $1,369,467,776

cat(sprintf("  Total Contribution: $%s\n",
            formatC(sum(roi_data$Total_Contribution), format="f", digits=0, big.mark=",")))

##   Total Contribution: $2,308,386,900

cat(sprintf("  Portfolio ROI: %.3f\n",
            sum(roi_data$Total_Contribution) / sum(roi_data$Total_Spend)))

##   Portfolio ROI: 1.686

cat("\n🎯 SCENARIO 1 (Fixed Budget)\n")

## 
## 🎯 SCENARIO 1 (Fixed Budget)

for(i in 1:nrow(optimal_fixed)) {
  if(abs(optimal_fixed$Change_Pct[i]) > 10) {
    action <- ifelse(optimal_fixed$Change_Pct[i] > 0, "INCREASE", "DECREASE")
    cat(sprintf("  %s: %s by %.0f%%\n",
                optimal_fixed$Channel[i], action, abs(optimal_fixed$Change_Pct[i])))
  }
}

##   TV: DECREASE by 17%
##   Print: INCREASE by 130%
##   Digital: DECREASE by 18%
##   Events: DECREASE by 25%

cat("\n💵 SCENARIO 2 (Unconstrained)\n")

## 
## 💵 SCENARIO 2 (Unconstrained)

cat(sprintf("  Add'l Investment: $%s (+%.0f%%)\n",
            formatC(total_optimal - total_current, format="f", digits=0, big.mark=","),
            ((total_optimal - total_current) / total_current) * 100))

##   Add'l Investment: $1,595,131,410 (+116%)

cat(sprintf("  Add'l Contribution: $%s\n",
            formatC(total_add_contrib, format="f", digits=0, big.mark=",")))

##   Add'l Contribution: $1,926,754,794

cat(sprintf("  Incremental ROI: %.3f\n",
            total_add_contrib / (total_optimal - total_current)))

##   Incremental ROI: 1.208

cat("\n", rep("=", 60), "\n", sep="")

## 
## ============================================================

Export for Part 3

save(mmm_data, roi_data, optimal_fixed, optimal_unconstrained, 
     model_type, channels, decay_rates,
     file = "mmm_part2_output.RData")

cat("\n✓ Part 2 Complete\n")

## 
## ✓ Part 2 Complete

cat("✓ Objects saved to: mmm_part2_output.RData\n")

## ✓ Objects saved to: mmm_part2_output.RData

cat("\nProceed to Part 3 for visualizations\n")

## 
## Proceed to Part 3 for visualizations

Load Previous Results

load("mmm_part2_output.RData")

cat("✓ Loaded data from Parts 1 & 2\n")

## ✓ Loaded data from Parts 1 & 2

cat("  Channels:", nrow(roi_data), "\n")

##   Channels: 5

cat("  Regions:", length(unique(mmm_data$Region)), "\n")

##   Regions: 20

Interactive Visualizations

ROI vs Marginal ROI Bubble Chart

Interpretation: - X-axis: Historical ROI (overall performance) - Y-axis: Marginal ROI Steady State (long-term return) - Bubble size: Current spending level - Color: Decay rate (memory/persistence)

roi_plot_data <- roi_data %>%
  left_join(optimal_fixed %>% select(Channel, Optimal_Budget), by = "Channel")

p1 <- plot_ly(roi_plot_data,
              x = ~ROI, y = ~mROI_Steady_State, text = ~Channel,
              type = 'scatter', mode = 'markers+text',
              marker = list(
                size = ~sqrt(Total_Spend)/100,
                color = ~Decay_Rate,
                colorscale = 'Viridis',
                showscale = TRUE,
                colorbar = list(title = "Decay Rate"),
                line = list(color = 'white', width = 2)
              ),
              textposition = 'top center',
              textfont = list(size = 12, color = 'black'),
              hoverinfo = 'text',
              hovertext = ~paste0(
                '<b>', Channel, '</b><br>',
                'ROI: ', round(ROI, 3), '<br>',
                'mROI (SS): ', round(mROI_Steady_State, 3), '<br>',
                'Current Spend: $', formatC(Total_Spend, format="f", digits=0, big.mark=","), '<br>',
                'Optimal: $', formatC(Optimal_Budget, format="f", digits=0, big.mark=",")
              )) %>%
  layout(
    title = list(text = "ROI vs Marginal ROI<br><sub>Bubble size = Current spend</sub>"),
    xaxis = list(title = "Overall ROI", zeroline = TRUE),
    yaxis = list(title = "Marginal ROI (Steady State)", zeroline = TRUE),
    plot_bgcolor = 'white',
    paper_bgcolor = 'white'
  )

p1

Channel Revenue Contributions

Shows: Total revenue attributed to each channel

Color intensity: Higher ROI = darker green

p2 <- plot_ly(roi_data %>% arrange(desc(Total_Contribution)),
              x = ~Total_Contribution,
              y = ~reorder(Channel, Total_Contribution),
              type = 'bar',
              marker = list(
                color = ~ROI,
                colorscale = list(c(0, "#FF6B6B"), c(1, "#6BCF7F")),
                showscale = TRUE,
                colorbar = list(title = "ROI")
              ),
              text = ~paste("$", formatC(Total_Contribution, format="f", digits=0, big.mark=",")),
              textposition = 'outside') %>%
  layout(
    title = "Total Revenue Contribution by Channel",
    xaxis = list(title = "Revenue Contribution ($)"),
    yaxis = list(title = "")
  )

p2

Budget Allocation - Scenario 1

Shows: Current vs Optimal under fixed budget constraint

p3 <- plot_ly(optimal_fixed, y = ~Channel) %>%
  add_trace(
    x = ~Current_Budget,
    name = 'Current',
    type = 'bar',
    orientation = 'h',
    marker = list(color = '#FFA07A'),
    text = ~paste("$", formatC(Current_Budget, format="f", digits=0, big.mark=",")),
    textposition = 'inside'
  ) %>%
  add_trace(
    x = ~Optimal_Budget,
    name = 'Optimal',
    type = 'bar',
    orientation = 'h',
    marker = list(color = '#6BCF7F'),
    text = ~paste("$", formatC(Optimal_Budget, format="f", digits=0, big.mark=",")),
    textposition = 'inside'
  ) %>%
  layout(
    title = "SCENARIO 1: Budget Reallocation (Fixed Total)",
    xaxis = list(title = "Budget ($)"),
    yaxis = list(title = ""),
    barmode = 'group',
    legend = list(orientation = "h", y = -0.2)
  )

p3

Budget Expansion - Scenario 2

Shows: Current vs Optimal when budget is flexible

p4 <- plot_ly(optimal_unconstrained, y = ~Channel) %>%
  add_trace(
    x = ~Current_Budget,
    name = 'Current',
    type = 'bar',
    orientation = 'h',
    marker = list(color = '#FFA07A')
  ) %>%
  add_trace(
    x = ~Optimal_Budget,
    name = 'Optimal',
    type = 'bar',
    orientation = 'h',
    marker = list(color = '#4D96FF')
  ) %>%
  layout(
    title = "SCENARIO 2: Budget Expansion (Until mROI = 1.0)",
    xaxis = list(title = "Budget ($)"),
    yaxis = list(title = ""),
    barmode = 'group',
    legend = list(orientation = "h", y = -0.2)
  )

p4

Incremental ROI Analysis

Shows: Expected return on additional investment

Green: Profitable expansion opportunity

p5 <- plot_ly(optimal_unconstrained,
              x = ~Incremental_ROI,
              y = ~reorder(Channel, Incremental_ROI),
              type = 'bar',
              marker = list(
                color = ~Incremental_ROI,
                colorscale = list(c(0, "#FF6B6B"), c(0.5, "#FFD700"), c(1, "#6BCF7F")),
                showscale = TRUE
              ),
              text = ~sprintf("%.3f", Incremental_ROI),
              textposition = 'outside') %>%
  layout(
    title = "Incremental ROI of Additional Investment",
    xaxis = list(title = "Incremental ROI"),
    yaxis = list(title = "")
  )

p5

Executive Summary

Model Performance

cat("\n📊 MODEL SPECIFICATION\n")

## 
## 📊 MODEL SPECIFICATION

cat(rep("-", 60), "\n", sep="")

## ------------------------------------------------------------

cat("Type:", model_type, "\n")

## Type: Fixed Effects

cat("Observations: 1,040 (20 regions × 52 weeks)\n")

## Observations: 1,040 (20 regions × 52 weeks)

cat("Channels analyzed: 5 marketing channels\n")

## Channels analyzed: 5 marketing channels

cat("Controls: Seasonality, Competitor spending, Price\n\n")

## Controls: Seasonality, Competitor spending, Price

Channel Rankings

cat("🏆 TOP PERFORMERS\n")

## 🏆 TOP PERFORMERS

cat(rep("-", 60), "\n", sep="")

## ------------------------------------------------------------

roi_ranked <- roi_data %>% arrange(desc(ROI))
for(i in 1:3) {
  cat(sprintf("%d. %s\n", i, roi_ranked$Channel[i]))
  cat(sprintf("   ROI: %.3f | mROI (SS): %.3f | Contribution: $%s\n",
              roi_ranked$ROI[i],
              roi_ranked$mROI_Steady_State[i],
              formatC(roi_ranked$Total_Contribution[i], format="f", digits=0, big.mark=",")))
}

## 1. TV
##    ROI: 2.070 | mROI (SS): 2.167 | Contribution: $889,599,331
## 2. Print
##    ROI: 2.053 | mROI (SS): 2.094 | Contribution: $309,150,484
## 3. Sales_Rep
##    ROI: 1.837 | mROI (SS): 1.891 | Contribution: $629,862,865

cat("\n")

Portfolio Metrics

total_spend <- sum(roi_data$Total_Spend)
total_contrib <- sum(roi_data$Total_Contribution)
portfolio_roi <- total_contrib / total_spend

cat("💰 PORTFOLIO PERFORMANCE\n")

## 💰 PORTFOLIO PERFORMANCE

cat(rep("-", 60), "\n", sep="")

## ------------------------------------------------------------

cat(sprintf("Total Marketing Investment: $%s\n",
            formatC(total_spend, format="f", digits=0, big.mark=",")))

## Total Marketing Investment: $1,369,467,776

cat(sprintf("Total Revenue Contribution: $%s\n",
            formatC(total_contrib, format="f", digits=0, big.mark=",")))

## Total Revenue Contribution: $2,308,386,900

cat(sprintf("Overall Portfolio ROI: %.3f\n", portfolio_roi))

## Overall Portfolio ROI: 1.686

cat(sprintf("\nInterpretation: Every $1 invested generates $%.2f in revenue\n\n", portfolio_roi))

## 
## Interpretation: Every $1 invested generates $1.69 in revenue

Optimization Recommendations

cat("🎯 SCENARIO 1: FIXED BUDGET\n")

## 🎯 SCENARIO 1: FIXED BUDGET

cat(rep("-", 60), "\n", sep="")

## ------------------------------------------------------------

cat("Strategy: Reallocate existing budget\n")

## Strategy: Reallocate existing budget

cat("Key Changes:\n")

## Key Changes:

for(i in 1:nrow(optimal_fixed)) {
  if(abs(optimal_fixed$Change_Pct[i]) > 10) {
    symbol <- ifelse(optimal_fixed$Change_Pct[i] > 0, "▲", "▼")
    action <- ifelse(optimal_fixed$Change_Pct[i] > 0, "Increase", "Decrease")
    cat(sprintf("  %s %s: %s by %.0f%% ($%s)\n",
                symbol,
                optimal_fixed$Channel[i],
                action,
                abs(optimal_fixed$Change_Pct[i]),
                formatC(abs(optimal_fixed$Budget_Change[i]), format="f", digits=0, big.mark=",")))
  }
}

##   ▼ TV: Decrease by 17% ($71,653,565)
##   ▲ Print: Increase by 130% ($195,326,087)
##   ▼ Digital: Decrease by 18% ($43,899,753)
##   ▼ Events: Decrease by 25% ($49,257,149)

total_current <- sum(optimal_unconstrained$Current_Budget)
total_optimal <- sum(optimal_unconstrained$Optimal_Budget)
total_add_contrib <- sum(optimal_unconstrained$Contribution_Change)
inc_roi <- total_add_contrib / (total_optimal - total_current)

cat("\n💵 SCENARIO 2: UNCONSTRAINED BUDGET\n")

## 
## 💵 SCENARIO 2: UNCONSTRAINED BUDGET

cat(rep("-", 60), "\n", sep="")

## ------------------------------------------------------------

cat("Strategy: Expand investment until mROI = 1.0\n")

## Strategy: Expand investment until mROI = 1.0

cat(sprintf("Additional Investment Needed: $%s (+%.0f%%)\n",
            formatC(total_optimal - total_current, format="f", digits=0, big.mark=","),
            ((total_optimal - total_current) / total_current) * 100))

## Additional Investment Needed: $1,595,131,410 (+116%)

cat(sprintf("Expected Additional Revenue: $%s\n",
            formatC(total_add_contrib, format="f", digits=0, big.mark=",")))

## Expected Additional Revenue: $1,926,754,794

cat(sprintf("Incremental ROI: %.3f\n", inc_roi))

## Incremental ROI: 1.208

if(inc_roi > 1.5) {
  cat("\n✅ STRONG RECOMMENDATION: Additional investment is highly profitable\n")
} else if(inc_roi > 1.0) {
  cat("\n✅ RECOMMENDATION: Additional investment is profitable\n")
} else {
  cat("\n⚠️  CAUTION: Marginal profitability of additional investment\n")
}

## 
## ✅ RECOMMENDATION: Additional investment is profitable

cat("\n")

Strategic Recommendations

cat("📋 STRATEGIC RECOMMENDATIONS\n")

## 📋 STRATEGIC RECOMMENDATIONS

cat(rep("-", 60), "\n", sep="")

## ------------------------------------------------------------

cat("\n1. SHORT-TERM (Scenario 1 - Fixed Budget):\n")

## 
## 1. SHORT-TERM (Scenario 1 - Fixed Budget):

cat("   • Reallocate from low-mROI to high-mROI channels\n")

##    • Reallocate from low-mROI to high-mROI channels

cat("   • Can improve portfolio performance without additional investment\n")

##    • Can improve portfolio performance without additional investment

cat("   • Lower risk implementation\n")

##    • Lower risk implementation

cat("\n2. LONG-TERM (Scenario 2 - Unconstrained):\n")

## 
## 2. LONG-TERM (Scenario 2 - Unconstrained):

cat("   • Channels with high current mROI can profitably expand\n")

##    • Channels with high current mROI can profitably expand

cat("   • Additional investment yields attractive returns\n")

##    • Additional investment yields attractive returns

cat("   • Requires incremental budget approval\n")

##    • Requires incremental budget approval

cat("\n3. MONITORING & OPTIMIZATION:\n")

## 
## 3. MONITORING & OPTIMIZATION:

cat("   • Update model quarterly with fresh data\n")

##    • Update model quarterly with fresh data

cat("   • Track actual vs predicted performance\n")

##    • Track actual vs predicted performance

cat("   • A/B test major reallocation decisions\n")

##    • A/B test major reallocation decisions

cat("   • Monitor for market saturation (declining mROI)\n")

##    • Monitor for market saturation (declining mROI)

cat("\n4. ADSTOCK CONSIDERATIONS:\n")

## 
## 4. ADSTOCK CONSIDERATIONS:

cat("   • High-decay channels (Digital): More frequent campaigns needed\n")

##    • High-decay channels (Digital): More frequent campaigns needed

cat("   • Low-decay channels (TV, Sales Rep): Benefits persist longer\n")

##    • Low-decay channels (TV, Sales Rep): Benefits persist longer

cat("   • Optimize campaign timing based on decay rates\n")

##    • Optimize campaign timing based on decay rates

cat("\n")

Technical Appendix

Mathematical Formulas

Panel Regression

\[Y_{it} = \alpha_i + \beta' X_{it} + \epsilon_{it}\]

Where: - $Y_{it}$: Revenue for region i in period t - $\alpha_i$: Regional fixed effect - $X_{it}$: Marketing variables (adstocked) - $\beta$: Coefficients (what we estimate)

Adstock Transformation

\[A_t = S_t + \lambda A_{t-1}\]

Where: - $A_t$: Adstocked spend at time t - $S_t$: Raw spend at time t - $\lambda$: Decay rate (0 ≤ λ < 1)

ROI Calculations

\[\text{ROI}_j = \frac{\beta_j \times \sum_t A_{jt}}{\sum_t S_{jt}}\]

\[\text{mROI}_{j,SS} = \frac{\beta_j}{1 - \lambda_j}\]

Diminishing Returns (Scenario 2)

\[C(S) = C_0 \left(\frac{S}{S_0}\right)^{\epsilon}\]

Where ε = 0.7 (elasticity parameter)

Glossary

Adstock: Transformed advertising variable capturing cumulative effects

Coefficient (β): Marginal effect of $1 increase in adstocked spend

Decay Rate (λ): Rate at which effects diminish (0=fast, 1=slow)

Elasticity (ε): Response rate with diminishing returns (ε<1)

mROI: Marginal ROI - return on incremental dollar

ROI: Return on Investment - total return per dollar

Steady State: Long-run equilibrium with carryover

Session Info

sessionInfo()

## R version 4.5.1 (2025-06-13)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 22.04.5 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.10.0 
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.10.0  LAPACK version 3.10.0
## 
## locale:
##  [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=en_US.UTF-8        LC_COLLATE=en_US.UTF-8    
##  [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
##  [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       
## 
## time zone: America/New_York
## tzcode source: system (glibc)
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] lmtest_0.9-40 zoo_1.8-14    plm_2.6-7     plotly_4.11.0 ggplot2_4.0.0
## [6] gt_1.1.0      scales_1.4.0  tidyr_1.3.1   dplyr_1.1.4  
## 
## loaded via a namespace (and not attached):
##  [1] sandwich_3.1-1     sass_0.4.10        generics_0.1.4     xml2_1.4.0        
##  [5] lattice_0.22-5     digest_0.6.37      magrittr_2.0.4     evaluate_1.0.5    
##  [9] grid_4.5.1         RColorBrewer_1.1-3 fastmap_1.2.0      jsonlite_2.0.0    
## [13] Formula_1.2-5      httr_1.4.7         purrr_1.1.0        crosstalk_1.2.2   
## [17] viridisLite_0.4.2  lazyeval_0.2.2     jquerylib_0.1.4    Rdpack_2.6.4      
## [21] cli_3.6.5          rlang_1.1.6        rbibutils_2.4      miscTools_0.6-28  
## [25] withr_3.0.2        cachem_1.1.0       yaml_2.3.10        parallel_4.5.1    
## [29] tools_4.5.1        bdsmatrix_1.3-7    maxLik_1.5-2.1     vctrs_0.6.5       
## [33] R6_2.6.1           lifecycle_1.0.4    fs_1.6.6           htmlwidgets_1.6.4 
## [37] MASS_7.3-65        pkgconfig_2.0.3    pillar_1.11.1      bslib_0.9.0       
## [41] gtable_0.3.6       Rcpp_1.1.0         glue_1.8.0         data.table_1.17.8 
## [45] collapse_2.1.5     xfun_0.53          tibble_3.3.0       tidyselect_1.2.1  
## [49] rstudioapi_0.17.1  knitr_1.50         farver_2.1.2       nlme_3.1-168      
## [53] htmltools_0.5.8.1  rmarkdown_2.30     compiler_4.5.1     S7_0.2.0

END OF ANALYSIS

✓ Complete 3-part Marketing Mix Model analysis ✓ Data generation, modeling, optimization, and visualization ✓ Ready for executive presentation

For questions: Contact Analytics Team cat(“✓ Objects saved to: mmm_part1_output.RData”) cat(“to Part 2 for ROI calculations and optimization”) ```

Marketing Mix Model - Part 1: Data & Modeling

Data Generation, Adstock Transformation, and Panel Regression

Pharma Marketing Analytics

2025-12-12

Overview

Package Setup

Data Generation

Panel Data Structure

Adstock Transformation

Understanding Adstock

Revenue Generation

Panel Regression Models

Model Types

Model Selection: Hausman Test

Regression Results

Model Comparison

Export Objects for Part 2

Load Part 1 Results

ROI Calculations

Understanding ROI Metrics

ROI Performance Table

Budget Optimization

Scenario 1: Fixed Budget

Scenario 2: Unconstrained Budget

Key Insights

Export for Part 3

Load Previous Results

Interactive Visualizations

ROI vs Marginal ROI Bubble Chart

Channel Revenue Contributions

Budget Allocation - Scenario 1

Budget Expansion - Scenario 2

Incremental ROI Analysis

Executive Summary

Model Performance

Channel Rankings

Portfolio Metrics

Optimization Recommendations

Strategic Recommendations

Technical Appendix

Mathematical Formulas

Panel Regression

Adstock Transformation

ROI Calculations

Diminishing Returns (Scenario 2)

Glossary

Session Info