Background

In order to gain political power, you must ensure that people that agree with you are empowered and compelled to vote. The losers in politics these days are the people with the dissuaded followers. So the question becomes: How do you get your followers out to vote? We can use predictive analysis to reach people that can be persuaded to vote by a flyer, the people whom it will not effect, and the sleeping dogs. To do this the best course of action is to develop an uplift model.

Read data and consider the variables

voter.df <- read.csv("/Users/marsh/Downloads/Voter-Persuasion.csv")
dim(voter.df) # We note 1000 observations and 79 variables
## [1] 10000    79
names(voter.df)
##  [1] "VOTER_ID"      "SET_NO"        "OPP_SEX"       "AGE"          
##  [5] "HH_ND"         "HH_NR"         "HH_NI"         "MED_AGE"      
##  [9] "NH_WHITE"      "NH_AA"         "NH_ASIAN"      "NH_MULT"      
## [13] "HISP"          "COMM_LT10"     "COMM_609P"     "MED_HH_INC"   
## [17] "COMM_CAR"      "COMM_CP"       "COMM_PT"       "COMM_WALK"    
## [21] "KIDS"          "M_MAR"         "F_MAR"         "ED_4COL"      
## [25] "GENDER_F"      "GENDER_M"      "H_AFDLN3P"     "H_F1"         
## [29] "H_M1"          "H_MFDLN3P"     "PARTY_D"       "PARTY_I"      
## [33] "PARTY_R"       "VPP_08"        "VPP_12"        "VPR_08"       
## [37] "VPR_10"        "VPR_12"        "VG_04"         "VG_06"        
## [41] "VG_08"         "VG_10"         "VG_12"         "PP_PELIG"     
## [45] "PR_PELIG"      "AP_PELIG"      "G_PELIG"       "E_PELIG"      
## [49] "NL5G"          "NL3PR"         "NL5AP"         "NL2PP"        
## [53] "REG_DAYS"      "UPSCALEBUY"    "UPSCALEMAL"    "UPSCALEFEM"   
## [57] "BOOKBUYERI"    "FAMILYMAGA"    "FEMALEORIE"    "RELIGIOUSM"   
## [61] "GARDENINGM"    "CULINARYIN"    "HEALTHFITN"    "DOITYOURSE"   
## [65] "FINANCIALM"    "RELIGIOUSC"    "POLITICALC"    "MEDIANEDUC"   
## [69] "CAND1S"        "CAND2S"        "MESSAGE_A"     "MESSAGE_A_REV"
## [73] "I3"            "CAND1_UND"     "CAND2_UND"     "MOVED_AD"     
## [77] "MOVED_A"       "opposite"      "Partition"
head(voter.df[,1:5])
##   VOTER_ID SET_NO OPP_SEX AGE HH_ND
## 1   193801      2       0  28     1
## 2   627701      1       0  53     2
## 3   306924      2       0  68     2
## 4   547609      1       0  66     0
## 5   141105      3       0  23     0
## 6   334787      1       0  49     2
# Applying the mean function to find the proportion of voters who voted a particular way
# Observing which voters moved in a Democratic direction in each of the two groups
aggregate(MOVED_A~MESSAGE_A, voter.df, mean)
##   MESSAGE_A MOVED_A
## 1         0  0.3444
## 2         1  0.4024
aggregate(MOVED_A~MESSAGE_A+Partition, voter.df, mean)
##   MESSAGE_A Partition   MOVED_A
## 1         0         T 0.3441955
## 2         1         T 0.4127249
## 3         0         V 0.3446933
## 4         1         V 0.3868869
table(voter.df$MOVED_AD)
## 
##    N    Y 
## 6266 3734

Partition

train.df = subset(voter.df, Partition == "T")
valid.df = subset(voter.df, Partition == "V")

Check for best model based on significance

glm <- glm(formula = MOVED_A ~ ., family = binomial, data = voter.df )
## Warning: glm.fit: algorithm did not converge
glm1 <- glm(formula = MOVED_A ~ OPP_SEX + AGE + HH_ND + HH_NR + MED_AGE + COMM_PT + ED_4COL + GENDER_F + H_F1 + H_M1 + PARTY_D + PARTY_R + VG_04 + VG_06 + VG_08 + E_PELIG + UPSCALEFEM + FAMILYMAGA + CAND1S + CAND2S + MESSAGE_A, family = binomial, data = voter.df )
glm2 <- glm(formula =MOVED_A ~ OPP_SEX + AGE + HH_ND + HH_NR + MED_AGE + COMM_PT + ED_4COL + GENDER_F + H_F1 + H_M1 + PARTY_D + PARTY_R + VG_04 + VG_06 + VG_08 + E_PELIG + UPSCALEFEM + BOOKBUYERI + FAMILYMAGA + CAND1S + CAND2S + MESSAGE_A, family = binomial, data = voter.df )
glm3 <- glm(formula = MOVED_A ~ OPP_SEX + AGE + HH_ND + HH_NR + MED_AGE + COMM_PT + ED_4COL + GENDER_F + H_F1 + H_M1 + PARTY_D + PARTY_R + VG_04 + VG_06 + VG_08 + G_PELIG+ E_PELIG + UPSCALEFEM + FAMILYMAGA + CAND1S + CAND2S + MESSAGE_A, family = binomial, data = voter.df )
glm4 <- glm(formula = MOVED_A ~ OPP_SEX + AGE + HH_ND + HH_NR + MED_AGE + COMM_609P + COMM_PT + ED_4COL + GENDER_F + H_F1 + H_M1 + PARTY_D + PARTY_R + VG_04 + VG_06 + VG_08 + G_PELIG+ E_PELIG + UPSCALEFEM + FAMILYMAGA + CAND1S + CAND2S + MESSAGE_A, family = binomial, data = voter.df )
glm5 <- glm(formula = MOVED_A ~ OPP_SEX + AGE + HH_ND + HH_NR + MED_AGE +NH_WHITE+ COMM_609P + COMM_PT + ED_4COL + GENDER_F + H_F1 + H_M1 + PARTY_D + PARTY_R + VG_04 + VG_06 + VG_08 + G_PELIG+ E_PELIG + UPSCALEFEM + FAMILYMAGA + CAND1S + CAND2S + MESSAGE_A, family = binomial, data = voter.df )

BIC(glm1,glm2,glm3,glm4,glm5)
##      df      BIC
## glm1 24 7711.995
## glm2 25 7719.749
## glm3 25 7693.486
## glm4 26 7681.158
## glm5 27 7676.316
AIC(glm1,glm2,glm3,glm4,glm5)
##      df      AIC
## glm1 24 7538.947
## glm2 25 7539.490
## glm3 25 7513.227
## glm4 26 7493.689
## glm5 27 7481.637

Classification tree to find effective models

ct <- rpart(MOVED_A ~ OPP_SEX + AGE + HH_ND + HH_NR + MED_AGE +NH_WHITE+ COMM_609P + COMM_PT + ED_4COL + GENDER_F + H_F1 + H_M1 + PARTY_D + PARTY_R + VG_04 + VG_06 + VG_08 + G_PELIG+ E_PELIG + UPSCALEFEM + FAMILYMAGA + CAND1S + CAND2S + MESSAGE_A, data = voter.df,control = rpart.control(maxdepth = 3))

fancyRpartPlot(ct, main = "Scorers Classifcation Tree", sub ="Marshall John Larson", palettes = c("Blues"), type = 1)

New models based on classification tree

glm6<-glm(formula = MOVED_A ~ GENDER_F +PARTY_D + CAND1S + 
CAND2S, family = binomial, data = voter.df)
glm7<-glm(formula = MOVED_A ~ PARTY_D + CAND1S + 
CAND2S, family = binomial, data = voter.df)


BIC(glm6,glm7)
##      df     BIC
## glm6  7 8002.79
## glm7  6 8324.63
AIC(glm6,glm7)
##      df      AIC
## glm6  7 7952.317
## glm7  6 8281.368

My computer was not able to load the rest of the required packages, so I was unable to analyze further.