partitioned regression

[lecy]

Example of displaying bivariate relationships while controlling for independent factors with partitioned regression.

Basic setup for visualizing relationship between X and Y while conditioning on Z:

y ~ a0 + a1*z + e1
x ~ b0 + b1*z + e2
y.c = a0 + a1*ave.z + e1
x.c = b0 + b1*ave.z + e2

plot( x.c, y.c )  # conditional plot

Unconditioned plots:

Conditioned plots:

d <- sample( c(0,1), 100, replace=T )
x <- 1:100 
z <- 100 + 20*rnorm(100)
y <- 250 + 2*x - z + 20*d + 10*rnorm(100)
df <- data.frame(x,y,z,d)

# UNCONDITIONED PLOTS
par( mfrow=c(2,2) )
boxplot( y ~ d )
jplot( x, z, "x", "z" )
jplot( x, y, "x", "y" )
jplot( z, y, "z", "y" )

# CONDITIONED PLOTS
par( mfrow=c(2,2) )
boxplot( y ~ d, main="Bivariate Only" )
partition_reg( y="z", x="x", 
               controls=c("d"), df )
partition_reg( y="y", x="x", 
               controls=c("z","d"), df )
partition_reg( y="y", x="z", 
               controls=c("x","d"), df )

# y = dv vector object
# x = iv vector object 
# controls = list of control variables names as string
# df = data frame where all variables located
partition_reg <- function( y, x, controls, df )
{
  fm1 <- as.formula( paste( paste0( y, " ~"), paste( controls, collapse= " + " ) ) )
  fm2 <- as.formula( paste( paste0( x, " ~"), paste( controls, collapse= " + " ) ) )
  reg1 <- lm( fm1, data=df )
  reg2 <- lm( fm2, data=df )

  center <- 1
  for( i in 1:length(controls) )
  {
    ave.i <- mean( unlist( df[ controls[i] ] ), na.rm=T )
    center <- c( center, ave.i )
  }

  y.c <- sum( reg1$coefficients * center ) + reg1$residuals 
  x.c <- sum( reg2$coefficients * center ) + reg2$residuals 

  summary( lm( y.c ~ x.c ) )
  plot( x.c, y.c, bty="n", col=gray(0.5,0.5), pch=19, cex=1,
        xlab=x, ylab=y )
  lines( stats::lowess( x.c, y.c ), col="red", lwd=2 )
  title( main=paste0( "Controls: ", paste( controls, collapse= " + " ) ) )
}

jplot <- function(x,y,xlab,ylab)
{
  plot( x, y, 
        bty="n", 
        col=gray(0.5,0.5), 
        pch=19, cex=1,
        xlab=xlab,
        ylab=ylab )
  lines( stats::lowess( x, y ), col="red", lwd=2 )
}