R: Translate a model having orthogonal polynomials to a function using qr decomposition

Question

I'm using R to create a linear regression model having orthogonal polynomial. My model is:

fit=lm(log(UFB2_BITRATE_REF3) ~ poly(QPB2_REF3,2)  + B2DBSA_REF3,data=UFB) 

UFB2_FPS_REF1= 29.98 27.65 26.30 25.69 24.68 23.07 22.96 22.16 21.51 20.75 20.75 26.15 24.59 22.91 21.02 19.59 18.80 18.21 17.07 16.74 15.98 15.80
QPB2_REF1 = 36 34 32 30 28 26 24 22 20 18 16 36 34 32 30 28 26 24 22 20 18 16
B2DBSA_REF1 = DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DOFFSOFF DONSON   DONSON  DONSON   DONSON   DONSON   DONSON   DONSON   DONSON   DONSON   DONSON   DONSON
Levels: DOFFSOFF DONSON

The corresponding summary is:

Call:
lm(formula = log(UFB2_BITRATE_REF3) ~ poly(QPB2_REF3, 2) + B2DBSA_REF3, data = UFB)

Residuals:
       Min         1Q     Median         3Q        Max 
-0.0150795 -0.0058792  0.0006155  0.0049245  0.0120587 

Coefficients:
                               Estimate Std. Error t value Pr(>|t|)    
(Intercept)                   9.630e+00  3.302e-02  291.62  < 2e-16 ***
poly(QPB2_REF3, 2, raw = T)1 -4.385e-02  2.640e-03  -16.61 2.31e-12 ***
poly(QPB2_REF3, 2, raw = T)2 -1.827e-03  5.047e-05  -36.20  < 2e-16 ***
B2DBSA_REF3DONSON            -3.746e-02  3.566e-03  -10.51 4.16e-09 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

Residual standard error: 0.008363 on 18 degrees of freedom
Multiple R-squared: 0.9999, Adjusted R-squared: 0.9999 
F-statistic: 8.134e+04 on 3 and 18 DF,  p-value: < 2.2e-16 

Next, I want to create a function f(x)=a + bx + cx^2 + .... for this model. I want to use qr decomposition using Gram Schmidt algorithm in R.

Do you have anything in mind? Thank you in advance!

Answer 1

I'm ignoring "I want to use qr decomposition using Gram Schmidt algorithm in R" except to note that poly() uses qr() to calculate its orthogonal polynomials.

I read the question as wanting to take the model with coefficients in terms of orthogonal polynomials poly(QPB2_REF3, 2, raw = FALSE) and express it algebraically in powers of QPB2_REF3. That means expressing the orthogonal polynomials poly(QPB2_REF3, 2, raw = FALSE)1, poly(QPB2_REF3, 2, raw = FALSE)2 conventionally as coefficients of powers of QPB2_REF3 rather than as the "centering and normalization constants" in the attr(, "coefs") of the poly() object.

Over the years in the various R forums others have made similar requests to be told that one can: (a) calculate the polynomials using poly.predict(), so the conventional form coefficients aren't needed; (b) see the algorithm in the code and/or Kennedy & Gentle (1980, pp. 343–4).

(a) didn't meet my didactic needs. On (b) I could see how to calculate the polynomial values for given x but I just got lost in the algebra trying to deduce the conventional form coefficients :-{

Kennedy & Gentle refer to "solving for x in p(x)" which to my simple mind suggested lm and led to the truly horrible approach implemented in orth2raw() below. I fully accept that there must be a better, more direct, way to deduce the conventional form coefficients from the centering and normalisation constants but I can't work it out, and this approach seems to work.

orth2raw <- function(x){
# x <- poly(.., raw=FALSE) has a "coefs" attribute "which contains 
# the centering and normalization constants used in constructing 
# the orthogonal polynomials". orth2raw returns the coefficents of
# those polynomials in the conventional form
#    b0.x^0 + b1.x^1 + b2.x^2 + ...
# It handles the coefs list returned by my modifications of 
# poly and polym to handle multivariate predictions  
    o2r <- function(coefs){
       Xmean <- coefs$alpha[1]
       Xsd <- sqrt(coefs$norm2[3]/coefs$norm2[2])
       X <- seq(Xmean-3*Xsd, Xmean+3*Xsd, length.out=degree+1)
       Y <- poly(X, degree = degree, coefs=coefs)
       Rcoefs <- matrix(0,degree, degree+1)
       for (i in 1:degree) Rcoefs[i,1:(i+1)] <- coef(lm(Y[,i] ~ poly(X, i, raw=TRUE) ))
       dimnames(Rcoefs) <- list(paste0("poly(x)", 1:degree), paste0("x^",0:degree))
       Rcoefs
      }
   degree <- max(attr(x, "degree"))
   coefs <- attr(x, "coefs")
   if(is.list(coefs[[1]])) lapply(coefs, o2r) else o2r(coefs)
   }