Slowed down all graphs, added collider graph

Author: NickCH-K

Animation of Collider.R

@@ -0,0 +1,48 @@
+library(tidyverse)
+library(gganimate)
+library(ggthemes)
+
+#Probably try a few times until the raw correlation looks nice and low
+df <- data.frame(X = rnorm(200)+1,Y=rnorm(200)+1,time="1") %>%
+  mutate(C = as.integer(X+Y+rnorm(200)/2>2)) %>%
+  group_by(C) %>%
+  mutate(mean_X=mean(X),mean_Y=mean(Y)) %>%
+  ungroup()
+
+cor(df$X,df$Y)
+
+#Calculate correlations
+before_cor <- paste("1. Start with raw data, ignoring C. Correlation between X and Y: ",round(cor(df$X,df$Y),3),sep='')
+after_cor <- paste("7. Analyze what's left! Correlation between X and Y controlling for C: ",round(cor(df$X-df$mean_X,df$Y-df$mean_Y),3),sep='')
+
+
+
+
+#Add step 2 in which X is demeaned, and 3 in which both X and Y are, and 4 which just changes label
+dffull <- rbind(
+  #Step 1: Raw data only
+  df %>% mutate(mean_X=NA,mean_Y=NA,C=0,time=before_cor),
+  #Step 2: Raw data only
+  df %>% mutate(mean_X=NA,mean_Y=NA,time='2. Separate data by the values of C.'),
+  #Step 3: Add x-lines
+  df %>% mutate(mean_Y=NA,time='3. Figure out what differences in X are explained by C'),
+  #Step 4: X de-meaned 
+  df %>% mutate(X = X - mean_X,mean_X=0,mean_Y=NA,time="4. Remove differences in X explained by C"),
+  #Step 5: Remove X lines, add Y
+  df %>% mutate(X = X - mean_X,mean_X=NA,time="5. Figure out what differences in Y are explained by C"),
+  #Step 6: Y de-meaned
+  df %>% mutate(X = X - mean_X,Y = Y - mean_Y,mean_X=NA,mean_Y=0,time="6. Remove differences in Y explained by C"),
+  #Step 7: Raw demeaned data only
+  df %>% mutate(X = X - mean_X,Y = Y - mean_Y,mean_X=NA,mean_Y=NA,time=after_cor))
+
+p <- ggplot(dffull,aes(y=Y,x=X,color=as.factor(C)))+geom_point()+
+  geom_vline(aes(xintercept=mean_X,color=as.factor(C)))+
+  geom_hline(aes(yintercept=mean_Y,color=as.factor(C)))+
+  guides(color=guide_legend(title="C"))+
+  scale_color_colorblind()+
+  labs(title = 'Inventing a Correlation Between X and Y by Controlling for Collider C \n{next_state}')+
+  transition_states(time,transition_length=c(1,12,32,12,32,12,12),state_length=c(160,125,100,75,100,75,160),wrap=FALSE)+
+  ease_aes('sine-in-out')+
+  exit_fade()+enter_fade()
+
+animate(p,nframes=200)

Animation of Controlling for Z.R

@@ -31,12 +31,14 @@ dffull <- rbind(
   #Step 6: Raw demeaned data only
   df %>% mutate(X = X - mean_X,Y = Y - mean_Y,mean_X=NA,mean_Y=NA,time=after_cor))
 
-ggplot(dffull,aes(y=Y,x=X,color=as.factor(W)))+geom_point()+
+p <- ggplot(dffull,aes(y=Y,x=X,color=as.factor(W)))+geom_point()+
   geom_vline(aes(xintercept=mean_X,color=as.factor(W)))+
   geom_hline(aes(yintercept=mean_Y,color=as.factor(W)))+
   guides(color=guide_legend(title="W"))+
   scale_color_colorblind()+
   labs(title = 'The Relationship between Y and X, Controlling for a Binary Variable W \n{next_state}')+
-  transition_states(time,transition_length=c(6,16,6,16,6,6),state_length=c(50,22,12,22,12,50),wrap=FALSE)+
+  transition_states(time,transition_length=c(12,32,12,32,12,12),state_length=c(160,100,75,100,75,160),wrap=FALSE)+
   ease_aes('sine-in-out')+
   exit_fade()+enter_fade()
+
+animate(p,nframes=200)

Animation of DID.R

@@ -40,7 +40,7 @@ dffull <- rbind(
 
 
 
-ggplot(dffull,aes(y=Y,x=xaxisTime,color=as.factor(Control)))+geom_point()+
+p <- ggplot(dffull,aes(y=Y,x=xaxisTime,color=as.factor(Control)))+geom_point()+
   guides(color=guide_legend(title="Group"))+
   geom_vline(aes(xintercept=1.5),linetype='dashed')+
   scale_color_colorblind()+
@@ -82,4 +82,4 @@ ggplot(dffull,aes(y=Y,x=xaxisTime,color=as.factor(Control)))+geom_point()+
   ease_aes('sine-in-out')+
   exit_fade()+enter_fade()
 
-
+animate(p,nframes=150)

Animation of Fixed Effects.R

@@ -28,12 +28,14 @@ dffull <- rbind(
   #Step 6: Raw demeaned data only
   df %>% mutate(X = X - mean_X,Y = Y - mean_Y,mean_X=NA,mean_Y=NA,time=after_cor))
 
-ggplot(dffull,aes(y=Y,x=X,color=as.factor(Person)))+geom_point()+
+p <- ggplot(dffull,aes(y=Y,x=X,color=as.factor(Person)))+geom_point()+
   geom_vline(aes(xintercept=mean_X,color=as.factor(Person)))+
   geom_hline(aes(yintercept=mean_Y,color=as.factor(Person)))+
   guides(color=guide_legend(title="Individual"))+
   scale_color_colorblind()+
   labs(title = 'The Relationship between Y and X, with Individual Fixed Effects \n{next_state}')+
-  transition_states(time,transition_length=c(6,16,6,16,6,6),state_length=c(50,22,12,22,12,50),wrap=FALSE)+
+  transition_states(time,transition_length=c(12,32,12,32,12,12),state_length=c(160,100,75,100,75,160),wrap=FALSE)+
   ease_aes('sine-in-out')+
   exit_fade()+enter_fade()
+
+animate(p,nframes=200)

Animation of IV.R

@@ -33,7 +33,7 @@ endpts <- df %>%
   group_by(Z) %>%
   summarize(mean_X=mean(mean_X),mean_Y=mean(mean_Y))
 
-ggplot(dffull,aes(y=Y,x=X,color=as.factor(Z)))+geom_point()+
+p <- ggplot(dffull,aes(y=Y,x=X,color=as.factor(Z)))+geom_point()+
   geom_vline(aes(xintercept=mean_X,color=as.factor(Z)))+
   geom_hline(aes(yintercept=mean_Y,color=as.factor(Z)))+
   guides(color=guide_legend(title="Z"))+
@@ -46,3 +46,4 @@ ggplot(dffull,aes(y=Y,x=X,color=as.factor(Z)))+geom_point()+
   ease_aes('sine-in-out')+
   exit_fade()+enter_fade()
 
+animate(p,nframes=175)

Animation of Matching.R

@@ -42,7 +42,7 @@ dffull <- rbind(
   df %>% mutate(Y = NA,bins=NA,state="6. The treatment effect is the remaining difference."))
 
 
-ggplot(dffull,aes(y=Y,x=xaxisTime,color=Treated,size=Treated))+geom_point()+
+p <- ggplot(dffull,aes(y=Y,x=xaxisTime,color=Treated,size=Treated))+geom_point()+
   geom_vline(aes(xintercept=bins))+
   geom_hline(aes(yintercept=mean_Y,color=Treated))+
   geom_segment(aes(x=.5,xend=.5,
@@ -57,4 +57,4 @@ ggplot(dffull,aes(y=Y,x=xaxisTime,color=Treated,size=Treated))+geom_point()+
   ease_aes('sine-in-out')+
   exit_fade()+enter_fade()
 
-  
+animate(p,nframes=200)

Animation of RDD.R

@@ -27,7 +27,7 @@ dffull <- rbind(
   df %>% mutate(mean_Y = ifelse(xaxisTime > 9 & xaxisTime < 11,mean_Y,NA),Y=ifelse(xaxisTime > 9 & xaxisTime < 11,mean_Y,NA),groupLine=NA,state="5. The jump at the cutoff is the effect of treatment."))
 
 
-ggplot(dffull,aes(y=Y,x=xaxisTime))+geom_point()+
+p <- ggplot(dffull,aes(y=Y,x=xaxisTime))+geom_point()+
   geom_vline(aes(xintercept=10),linetype='dashed')+
   geom_point(aes(y=mean_Y,x=groupX),color="red",size=2)+
   geom_vline(aes(xintercept=groupLine))+
@@ -46,4 +46,4 @@ ggplot(dffull,aes(y=Y,x=xaxisTime))+geom_point()+
   ease_aes('sine-in-out')+
   exit_fade()+enter_fade()
 
-  
+animate(p,nframes=175)