In this study, we measure delta (discount rate) and then assign people to be paid either a SS payment or a LL default by default, but they can switch to the other option if they want.

we want to show that the effect of default condition (cond) is only significant for the middle range of the deltac variable.

the most intuitive way to do this is to separate the sample into 3 groups: patient (low delta), impatient (high delta), and middle (in between the other two groups).

doing this shows that the default effect only appears for the middle group.

all<-read.csv("study 1 plus replication data.csv", header=T, sep=",")
summary(all$deltac)
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -4.542e-03 -1.732e-03 -1.049e-03  2.955e-05  1.551e-03  7.140e-03
patient<-subset(all, deltac <= -1.732e-03)
impatient<-subset(all, deltac  >= 1.551e-03)
middle<-subset(all, all$deltac > -1.732e-03 & all$deltac < 1.551e-03)
prop.test(table(patient$SS, patient$cond))
## 
##  2-sample test for equality of proportions with continuity
##  correction
## 
## data:  table(patient$SS, patient$cond)
## X-squared = 0.1653, df = 1, p-value = 0.6843
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.1449320  0.2566619
## sample estimates:
##    prop 1    prop 2 
## 0.4970414 0.4411765
prop.test(table(impatient$SS, impatient$cond))
## 
##  2-sample test for equality of proportions with continuity
##  correction
## 
## data:  table(impatient$SS, impatient$cond)
## X-squared = 1.123, df = 1, p-value = 0.2893
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  -0.07352199  0.27928216
## sample estimates:
##    prop 1    prop 2 
## 0.5869565 0.4840764
prop.test(table(middle$SS, middle$cond))
## 
##  2-sample test for equality of proportions with continuity
##  correction
## 
## data:  table(middle$SS, middle$cond)
## X-squared = 19.7526, df = 1, p-value = 8.814e-06
## alternative hypothesis: two.sided
## 95 percent confidence interval:
##  0.1263148 0.3259626
## sample estimates:
##    prop 1    prop 2 
## 0.5821596 0.3560209

now here is the continuous analysis is using delta (centered) and default condition to predict choice of the SS option. it shows no significant interaction between the two IVs, where the discrete analysis above seems to suggest that there IS an interaction - the effect of condition depends on the level of delta. the plot of the regression also seems to show that the two lines only differ in the middle of the delta distribution.

fit3<-glm(SS ~ deltac*cond, data=all, family=binomial)
summary(fit3)
## 
## Call:
## glm(formula = SS ~ deltac * cond, family = binomial, data = all)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.2669  -0.8932  -0.6661   0.9939   2.1482  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -0.4636     0.1147  -4.044 5.26e-05 ***
## deltac        395.9964    49.7544   7.959 1.73e-15 ***
## condSS          0.7413     0.1620   4.576 4.73e-06 ***
## deltac:condSS  92.7838    80.2682   1.156    0.248    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1120.28  on 809  degrees of freedom
## Residual deviance:  939.65  on 806  degrees of freedom
## AIC: 947.65
## 
## Number of Fisher Scoring iterations: 4
library(visreg)
visreg(fit3, "deltac", by="cond", overlay=TRUE, partial=FALSE,  xlab="present bias (beta)", scale="response", ylab="P (choosing SS)")

I think one part of the issue here is that we are looking for a non-linear effect (i.e. condition only having an effect in the middle values of delta) but the logistic regression is a linear model. Do you think using splines could help us here? Or any other ideas?

Basically I just want to make the sure the continuous analysis, the plot, and the discrete analysis are all agreeing with each other, which right now they seem not to be.

this approach makes sense too - just plotting the same continuous cond*delta interaction but for each of the three ‘patience’ groups - is there a way to show each of these 3 plots on the same plot??

f1<-glm(SS ~ deltac*cond, data=patient, family=binomial)
summary(f1)
## 
## Call:
## glm(formula = SS ~ deltac * cond, family = binomial, data = patient)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.7465  -0.6468  -0.5803  -0.5340   2.0334  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)  
## (Intercept)    -1.5472     0.9368  -1.651   0.0986 .
## deltac         74.9478   383.9332   0.195   0.8452  
## condSS          1.8793     1.8409   1.021   0.3073  
## deltac:condSS 768.0231   835.5764   0.919   0.3580  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 183.46  on 202  degrees of freedom
## Residual deviance: 180.99  on 199  degrees of freedom
## AIC: 188.99
## 
## Number of Fisher Scoring iterations: 5
visreg(f1, "deltac", by="cond", overlay=TRUE, partial=FALSE,  xlab="delta", scale="response", ylab="P (choosing SS)")

f2<-glm(SS ~ deltac*cond, data=middle, family=binomial)
summary(f2)
## 
## Call:
## glm(formula = SS ~ deltac * cond, family = binomial, data = middle)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.7570  -1.1447  -0.8322   1.1473   1.6111  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)    -0.3884     0.1809  -2.147   0.0318 *  
## deltac        347.0384   165.5134   2.097   0.0360 *  
## condSS          1.0058     0.2562   3.926 8.63e-05 ***
## deltac:condSS 121.2500   233.3093   0.520   0.6033    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 558.86  on 403  degrees of freedom
## Residual deviance: 524.73  on 400  degrees of freedom
## AIC: 532.73
## 
## Number of Fisher Scoring iterations: 4
visreg(f2, "deltac", by="cond", overlay=TRUE, partial=FALSE,  xlab="delta", scale="response", ylab="P (choosing SS)")

f3<-glm(SS ~ deltac*cond, data=impatient, family=binomial)
summary(f3)
## 
## Call:
## glm(formula = SS ~ deltac * cond, family = binomial, data = impatient)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.0094   0.4308   0.6796   0.7797   0.9145  
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)
## (Intercept)     0.37170    0.65447   0.568    0.570
## deltac        174.89136  165.52161   1.057    0.291
## condSS          0.03848    0.93569   0.041    0.967
## deltac:condSS 149.06064  262.64912   0.568    0.570
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 217.27  on 202  degrees of freedom
## Residual deviance: 211.83  on 199  degrees of freedom
## AIC: 219.83
## 
## Number of Fisher Scoring iterations: 4
visreg(f3, "deltac", by="cond", overlay=TRUE, partial=FALSE,  xlab="delta", scale="response", ylab="P (choosing SS)")