This is the document for New Donor LTV Predict model using Pledge and CS Center data.


Prepare the data with data preprocessing

Library Used

library(readxl)
library(dplyr)
library(lubridate)
library(ggplot2)
library(tidymodels)
library(data.table)
library(ranger)

Data Preprocessing for CS Center Data

You can also get this file from Report Function in Charitable, (Report Number : OP32)

call <- read_excel("call.xlsx") #Import data

call_sel <- call %>% select(`Serial Number`, `Task Group` ,`Task Closed Date`) # Selected columns 

call_sel <- 
  call_sel %>%
  group_by(`Serial Number`) %>% 
  mutate(count = n()) %>% 
  arrange(desc(`Task Closed Date`)) %>% 
  distinct(`Serial Number`, .keep_all = TRUE) 
#Removed duplicated record by serial No.

call_tran <- 
  call_sel %>% 
  select(`Serial Number`, `Task Closed Date`, count) %>% 
  mutate_if(is.character, as.factor)
#Selected columns again and generated new column
  
call_tran$`Task Closed Date` <- as.numeric(call_tran$`Task Closed Date`)
#Changed column format as numeric

call_tran <- as.data.frame(call_tran)

Call data will be used to extract the number of calls and check the correlation with Pledge data.

Prepare the data by using the latest records and creating a “count” column containing the total number of call records.

## Rows: 2,019
## Columns: 3
## $ `Serial Number`    <chr> "DR002378", "FF001712", "DR001102", "FF002298", "FF…
## $ `Task Closed Date` <dbl> 1704722898, 1704718174, 1704189267, 1704188748, 170…
## $ count              <int> 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, …

Data Preprocessing for Pledge Data

You can also get this file from Report Function in Charitable, (Report Number : OP24)

new <- read_excel("new.xlsx") #Import data

new_date <- 
  new %>% 
    filter(`Pledge Created` >= as.Date("2023-07-01") & `Pledge Created` <= as.Date("2024-01-31")) %>% 
  filter(Frequency == 1) 
#selected specific period and recurring pledge 

new_sel <- 
  new_date %>% 
  select(SerialNo, DOB, Gender, SourceCode, Bank, TotalContribution, ChannelType, D0, `Pledge Created`, successful_transactions_count, Campaign)
#Selected columns

new_tran <- 
  new_sel %>% 
  mutate(total =TotalContribution) %>% 
  dplyr::select(- TotalContribution) %>% 
  mutate_if(is.character,as.factor)
#Changed Y column name and changed column format

new_tran$DOB <- as.numeric(new_tran$DOB)
new_tran$D0 <- as.numeric(new_tran$D0)
new_tran$`Pledge Created` <- as.numeric(new_tran$`Pledge Created`)
#Changed column format as numeric


As you know, the pledge data contains lots of data including personal information which has to remove

Data preprocessing was performed by selecting the necessary columns and changing the characteristics of the columns.

For modeling purposes, a factor column containing many values must be converted to characters.

new_tran <- 
  new_tran %>% 
  mutate(cam = ifelse(is.na(Campaign),0,1)) %>% 
  dplyr::select(-Campaign)

new_tran$cam <- as.factor(new_tran$cam)  
new_tran$SerialNo <- as.character(new_tran$SerialNo)



Changed column for merge data

setnames(call_tran, old = "Serial Number", new = "SerialNo")
setnames(call_tran, old = "Task Closed Date", new = "task date")

pled <- 
  new_tran %>% 
  left_join(call_tran, by = "SerialNo")
#Merge data.


Check the merged data


## Rows: 1,908
## Columns: 13
## $ SerialNo                      <chr> "IF001128", "TM000243", "FF005984", "FF0…
## $ DOB                           <dbl> 113875200, 674956800, 790128000, 1046563…
## $ Gender                        <fct> Male, Female, Male, Female, Female, Male…
## $ SourceCode                    <fct> ODP, LLF, FIN, FIN, LLF, FIN, FIN, FIN, …
## $ Bank                          <fct> KFTC, KFTC, NICEPAY, KFTC, KFTC, NICEPAY…
## $ ChannelType                   <fct> Web, TM, EVENT, EVENT, TM, EVENT, EVENT,…
## $ D0                            <dbl> 1688688000, 1688688000, 1688428800, NA, …
## $ `Pledge Created`              <dbl> 1688342400, 1688342400, 1688428800, 1688…
## $ successful_transactions_count <fct> 7, 7, 7, 0, 6, 6, 7, 0, 6, 7, 1, 7, 7, 7…
## $ total                         <dbl> 140000, 70000, 140000, 0, 40000, 60000, …
## $ cam                           <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ `task date`                   <dbl> NA, NA, NA, 1690461012, 1693935143, NA, …
## $ count                         <int> NA, NA, NA, 1, 1, NA, NA, 1, NA, NA, 1, …

Replaced “NA” value, if the column format is numeric then “Na” Value to “0”.
if the column format is character or factor then “Na” value is to “emt” .

pled <- 
  pled %>% 
  mutate(task = ifelse(is.na(`task date`),0,`task date`)) %>% 
  mutate(count = ifelse(is.na(count),0,count)) %>% 
  select(-`task date`)

pled <- 
  pled %>% 
  mutate(DOB = ifelse(is.na(DOB),0,DOB)) %>% 
  mutate(D0 = ifelse(is.na(D0),0,D0)) %>% 
  mutate(Gender = if_else(is.na(Gender),"emt",Gender)) %>% 
  mutate(ChannelType = if_else(is.na(ChannelType),"emt",ChannelType)) %>% 
  mutate_if(is.character,as.factor)

pled$SerialNo <-as.character(pled$SerialNo) 
#Serial No. is not used in the model.
Data summary
Name pled
Number of rows 1908
Number of columns 13
_______________________
Column type frequency:
character 1
factor 6
numeric 6
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
SerialNo 0 1 8 8 0 1908 0

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
Gender 0 1 FALSE 3 Fem: 1152, Mal: 716, emt: 40
SourceCode 0 1 FALSE 6 FIN: 759, LLF: 625, ODP: 470, REA: 36
Bank 0 1 FALSE 5 KFT: 1468, NIC: 422, MAN: 16, KFT: 1
ChannelType 0 1 FALSE 10 DRT: 586, Web: 470, EVE: 381, STR: 377
successful_transactions_count 0 1 FALSE 9 0: 423, 1: 303, 2: 287, 3: 259
cam 0 1 FALSE 2 1: 1892, 0: 16

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
DOB 0 1 2.775817e+08 625342970.32 -1210377600 -266112000 252720000 885427200 1667260800 ▂▇▅▇▂
D0 0 1 1.321272e+09 705377101.91 0 1689616800 1695168000 1700784000 1705449600 ▂▁▁▁▇
Pledge Created 0 1 1.697445e+09 5153009.31 1688342400 1693180800 1697760000 1701993600 1705536000 ▆▆▆▇▇
total 0 1 3.952966e+04 47810.39 0 10000 30000 60000 800000 ▇▁▁▁▁
count 0 1 2.500000e-01 0.57 0 0 0 0 6 ▇▁▁▁▁
task 0 1 3.480599e+08 685762490.13 0 0 0 0 1704722898 ▇▁▁▁▂

Building a predictive model


Split data into “train” and “test”

set.seed(123) #Random number settings

split <- initial_split(pled, prop = 0.7) #7:3
train<- training(split)
test <- testing(split)


Prepare the data for modeling

Preprocessing for modeling, use “receipe” function in “tidymodels”

rf_recipe_1 <- 
  recipe(total ~ ., data = train) %>%
  step_center(all_numeric_predictors()) %>%      #Centered from the mean
  step_scale(all_numeric_predictors()) %>%       #Scaling by sd
  step_rm(SerialNo) %>%                          #Excluding serial number
  step_zv(all_numeric_predictors()) %>%          #Exclude variables with zero variance (variance is 0 and not predicted)
  step_normalize(all_numeric_predictors())   #normalization


Generating Model with Random Forest


mty <- rf_recipe_1 %>% 
  prep() %>% 
  bake(new_data = NULL)

#mty value have to follow total independent value contains factor column as well

. 

rf_model <- 
  rand_forest(mtry = 3) %>%
  set_engine("ranger") %>%
  set_mode("regression")

Fit the preprocessing model to “train” and “test” data


pre_train <- rf_recipe_1 %>% prep() %>% bake(new_data = train)
pre_test <- rf_recipe_1 %>% prep() %>% bake(new_data = test)

Fitting and Training the Model with prepared data


rf_fit <-   rf_model %>%   fit(total ~ ., data = pre_train)

rf_pred <-   rf_fit %>%   predict(new_data = pre_test)

Evaluate models with real data.


com_data <- data.frame(truth = pre_test$total, estimate = rf_pred$.pred)

com_data_tbl <- as_tibble(com_data)

r_squared <- 1 - sum((com_data_tbl$truth - com_data_tbl$estimate)^2) / sum((com_data_tbl$truth - mean(com_data_tbl$truth))^2)

r_squared 
## [1] 0.5703958