TEXT   33
Partial Regression on Predecessors
Guest on 15th March 2023 02:27:50 AM

1. ## The partial regression-on-predecessors scatterplot matrix defined in section 4.3.4
2.
3. "partial.r"<-function(x=matrix(rnorm(120),20,6),...){
4.   # For testing purposes only (set to F if you don't need "2 vs. 1" labels):
5.   showlabels <- F
6.
7.   # Make sure x is in matrix form
8.   x <- as.matrix(x)
9.   n <- ncol(x)
10.
11.   # Make sure we clean up our mess (revert back to original "par" parameters)
12.   # when we're done
13.   oldpar <- par("pty", "oma", "mar", "cex", "tck",
14.     "mgp", "mex", "mfrow")
15.   on.exit({par(oldpar)})
16.
17.   # Set layout, size and margin parameters
18.   # make plots square
19.   par(pty="s")
20.   # determine new optimal plotting character size
21.   CEX <- par("cex") * max(7.7/(2*(n-1)+3), 0.6)*0.5
22.   # specify grid of (n-1) by (n-1) plots
23.   par(mfcol = c(n-1,n-1))
24.   # magically cause plots to pack together nicely
25.   par(oma = rep(3,4))
26.   par(mar = rep(0.3,4))
27.   dif <- diff(par("fin"))/2
28.   if(dif > 0)
29.     par(omi = c(dif*(n-1), 0, dif*(n-1), 0) + par("omi"))
30.   else
31.     par(omi = c(0, (-dif)*(n-1), 0, (-dif)*(n-1)) + par("omi"))
32.   # re-specify plotting character size (since par(mfrow) screwed it up)
33.   par(cex = CEX)
34.   # specify the points type
35.   par(pch=16)
36.
37.
38.   dat <- x
39.   m <- n-1
40.   mat.x <- NULL
41.   mat.y <- NULL
42.
43.   for (k in (1:m)){
44.    fres <- sapply(1:(m+1-k), function(i) if(k==1 && i==1) dat[,i] else residuals(lm(dat[,i] ~ dat[,c(1:(i+k-1))][,-c(i)])))
45.    bres <- sapply(1:(m+1-k), function(i) if(k==1 && i==1) dat[,i+k] else residuals(lm(dat[,i+k] ~ dat[,c(1:(i+k-1))][,-c(i)])))
46.    mat.x <- cbind(mat.x,fres)
47.    mat.y <- cbind(mat.y,bres)
48.   }
49.
50.   locmat <- matrix(rep(0,m^2),nrow=m)
51.   count <- 0
52.   for (i in (1:m)){
53.     for (j in (1:(m+1-i))){
54.       count <- count+1
55.       locmat[i,j] <- count
56.     }
57.   }
58.
59.   # Make plots (i from top to bottom, j from left to right)
60.   for (i in (2:n)){
61.     for(j in (1:(n-1))){
62.       if (j < i-1){
63.         # prepare an empty plot with correct limits and no axes
64.         plot(range(x[!is.na(x[,j]),j]), range(x[!is.na(x[,i]),i]),
65.            type = "n", axes = F, ...)
66.         # create empty plot and put border around it
67.         box()
68.         # show points for j'th vs. i'th columns of x
69.         points(as.vector(x[,j]),as.vector(x[,i]), ...)
70.         # show which variables are being plotted
71.         if (showlabels)
72.           text(mean(range(x[!is.na(x[,j]),j])),
73.         mean(range(x[!is.na(x[,i]),i])),
74.         paste(j,"vs.",i),cex=1.5*CEX)
75.       }
76.       else{
77.         # Get the information of which variables to be plotted against each other on this grid
78.         loc <- locmat[j-i+2,i-1]
79.         # prepare an empty plot with correct limits and no axes
80.         plot(range(mat.x[!is.na(mat.x[,loc]),loc]), range(mat.y[!is.na(mat.y[,loc]),loc]),
81.            type = "n", axes = F, ...)
82.         # create empty plot and put border around it
83.         box()
84.         # show points for j'th vs. i'th columns of x
85.         points(as.vector(mat.x[,loc]),as.vector(mat.y[,loc]), ...)
86.       }
87.     }
88.   }
89. }

Raw Paste

or to edit or fork this paste. It's free.