`poly()`如何生成正交多项式?如何理解"coefs"归来?

pyg*_*pyg 9 regression r matrix linear-regression lm

我对正交多项式的理解是它们采用的形式

y(x)= a1 + a2(x - c1)+ a3(x - c2)(x - c3)+ a4(x - c4)(x - c5)(x - c6)......最多为期望的条款

其中a1,a2 是每个正交项的系数(在拟合之间变化),并且c1,c2 是正交项内的系数,确定使得这些项保持正交性(使用相同x值的拟合之间一致)

我理解poly()用于拟合正交多项式.一个例子

x = c(1.160, 1.143, 1.126, 1.109, 1.079, 1.053, 1.040, 1.027, 1.015, 1.004, 0.994, 0.985, 0.977) # abscissae not equally spaced

y = c(1.217395, 1.604360, 2.834947, 4.585687, 8.770932, 9.996260, 9.264800, 9.155079, 7.949278, 7.317690, 6.377519, 6.409620, 6.643426)

# construct the orthogonal polynomial
orth_poly <- poly(x, degree = 5)

# fit y to orthogonal polynomial
model <- lm(y ~ orth_poly) 
Run Code Online (Sandbox Code Playgroud)

我想提取系数a1,a2 ,以及正交系数c1,c2 .我不知道该怎么做.我的猜测是

model$coefficients
Run Code Online (Sandbox Code Playgroud)

返回第一组系数,但我正在努力如何提取其他系数.也许在内

attributes(orth_poly)$coefs
Run Code Online (Sandbox Code Playgroud)

非常感谢.

李哲源*_*李哲源 19

我刚刚意识到有一个密切相关的问题从R的poly()函数中提取正交多项式系数?2年前.答案只是解释了什么predict.poly,但我的答案给出了完整的图片.


第1节:如何poly表示正交多项式

我对正交多项式的理解是它们采用的形式

y(x)= a1 + a2(x - c1)+ a3(x - c2)(x - c3)+ a4(x - c4)(x - c5)(x - c6)......最多为期望的条款

不,不,没有这样的清洁形式.poly()生成单元正交多项式,可以用下面的递归算法表示.这是如何predict.poly生成线性预测矩阵的.令人惊讶的是,poly它本身不使用这种递归而是使用残酷的力:正交跨度的普通多项式的模型矩阵的QR分解.但是,这相当于递归.

在此输入图像描述


第2节:输出的解释 poly()

让我们考虑一个例子.拿x你的帖子,

X <- poly(x, degree = 5)

#                 1           2           3            4           5
# [1,]  0.484259711  0.48436462  0.48074040  0.351250507  0.25411350
# [2,]  0.406027697  0.20038942 -0.06236564 -0.303377083 -0.46801416
# [3,]  0.327795682 -0.02660187 -0.34049024 -0.338222850 -0.11788140
# ...           ...          ...        ...          ...         ...
#[12,] -0.321069852  0.28705108 -0.15397819 -0.006975615  0.16978124
#[13,] -0.357884918  0.42236400 -0.40180712  0.398738364 -0.34115435
#attr(,"coefs")
#attr(,"coefs")$alpha
#[1] 1.054769 1.078794 1.063917 1.075700 1.063079
# 
#attr(,"coefs")$norm2
#[1] 1.000000e+00 1.300000e+01 4.722031e-02 1.028848e-04 2.550358e-07
#[6] 5.567156e-10 1.156628e-12
Run Code Online (Sandbox Code Playgroud)

以下是这些属性:

  • alpha[1]给出x_bar = mean(x),即中心;
  • alpha - alpha[1]give alpha0,, alpha1...,alpha4(alpha5计算但在poly返回之前丢弃X,因为它不会被使用predict.poly);
  • 的第一个值norm2始终为1的第二个到最后的l0,l1,..., l5,给人的平方列规范X; l0是丢弃的列平方范数P0(x - x_bar),它总是n(即length(x)); 而第一个1只是填充,以便递归进入内部predict.poly.
  • beta0,beta1,beta2,...,beta_5不返回,但可以通过计算norm2[-1] / norm2[-length(norm2)].

第3节:poly使用QR分解和递归算法实现

如前所述,poly不使用递归,而是使用递归predict.poly.就个人而言,我不明白这种不一致设计背后的逻辑/原因.在这里,我将提供一个my_poly自己编写的函数,使用递归生成矩阵,如果QR = FALSE.何时QR = TRUE,它是一个类似但不完全相同的实现poly.代码评论很好,有助于您理解这两种方法.

## return a model matrix for data `x`
my_poly <- function (x, degree = 1, QR = TRUE) {
  ## check feasibility
  if (length(unique(x)) < degree)
    stop("insufficient unique data points for specified degree!")
  ## centring covariates (so that `x` is orthogonal to intercept)
  centre <- mean(x)
  x <- x - centre
  if (QR) {
    ## QR factorization of design matrix of ordinary polynomial
    QR <- qr(outer(x, 0:degree, "^"))
    ## X <- qr.Q(QR) * rep(diag(QR$qr), each = length(x))
    ## i.e., column rescaling of Q factor by `diag(R)`
    ## also drop the intercept
    X <- qr.qy(QR, diag(diag(QR$qr), length(x), degree + 1))[, -1, drop = FALSE]
    ## now columns of `X` are orthorgonal to each other
    ## i.e., `crossprod(X)` is diagonal
    X2 <- X * X
    norm2 <- colSums(X * X)    ## squared L2 norm
    alpha <- drop(crossprod(X2, x)) / norm2
    beta <- norm2 / (c(length(x), norm2[-degree]))
    colnames(X) <- 1:degree
    } 
  else {
    beta <- alpha <- norm2 <- numeric(degree)
    ## repeat first polynomial `x` on all columns to initialize design matrix X
    X <- matrix(x, nrow = length(x), ncol = degree, dimnames = list(NULL, 1:degree))
    ## compute alpha[1] and beta[1]
    norm2[1] <- new_norm <- drop(crossprod(x))
    alpha[1] <- sum(x ^ 3) / new_norm
    beta[1] <- new_norm / length(x)
    if (degree > 1L) {
      old_norm <- new_norm
      ## second polynomial
      X[, 2] <- Xi <- (x - alpha[1]) * X[, 1] - beta[1]
      norm2[2] <- new_norm <- drop(crossprod(Xi))
      alpha[2] <- drop(crossprod(Xi * Xi, x)) / new_norm
      beta[2] <- new_norm / old_norm
      old_norm <- new_norm
      ## further polynomials obtained from recursion
      i <- 3
      while (i <= degree) {
        X[, i] <- Xi <- (x - alpha[i - 1]) * X[, i - 1] - beta[i - 1] * X[, i - 2]
        norm2[i] <- new_norm <- drop(crossprod(Xi))
        alpha[i] <- drop(crossprod(Xi * Xi, x)) / new_norm
        beta[i] <- new_norm / old_norm
        old_norm <- new_norm
        i <- i + 1
        }
      }
    }
  ## column rescaling so that `crossprod(X)` is an identity matrix
  scale <- sqrt(norm2)
  X <- X * rep(1 / scale, each = length(x))
  ## add attributes and return
  attr(X, "coefs") <- list(centre = centre, scale = scale, alpha = alpha[-degree], beta = beta[-degree])
  X
  }
Run Code Online (Sandbox Code Playgroud)

第4节:输出的解释 my_poly

X <- my_poly(x, 5, FALSE)
Run Code Online (Sandbox Code Playgroud)

得到的矩阵与poly由此遗漏产生的矩阵相同.属性不一样.

#attr(,"coefs")
#attr(,"coefs")$centre
#[1] 1.054769

#attr(,"coefs")$scale
#[1] 2.173023e-01 1.014321e-02 5.050106e-04 2.359482e-05 1.075466e-06

#attr(,"coefs")$alpha
#[1] 0.024025005 0.009147498 0.020930616 0.008309835

#attr(,"coefs")$beta
#[1] 0.003632331 0.002178825 0.002478848 0.002182892
Run Code Online (Sandbox Code Playgroud)

my_poly 更明显地返回施工信息:

  • centrex_bar = mean(x);
  • scale给出列规范(norm2返回的平方根poly);
  • alphaalpha1,alpha2,alpha3,alpha4,
  • betabeta1,beta2,beta3,beta4.

第5节:预测例程 my_poly

由于my_poly返回不同的属性,stats:::predict.poly不兼容my_poly.这是适当的例程my_predict_poly:

## return a linear predictor matrix, given a model matrix `X` and new data `x`
my_predict_poly <- function (X, x) {
  ## extract construction info
  coefs <- attr(X, "coefs")
  centre <- coefs$centre
  alpha <- coefs$alpha
  beta <- coefs$beta
  degree <- ncol(X)
  ## centring `x`
  x <- x - coefs$centre
  ## repeat first polynomial `x` on all columns to initialize design matrix X
  X <- matrix(x, length(x), degree, dimnames = list(NULL, 1:degree))
  if (degree > 1L) {
    ## second polynomial
    X[, 2] <- (x - alpha[1]) * X[, 1] - beta[1]
    ## further polynomials obtained from recursion
    i <- 3
    while (i <= degree) {
      X[, i] <- (x - alpha[i - 1]) * X[, i - 1] - beta[i - 1] * X[, i - 2]
      i <- i + 1
      }
    }
  ## column rescaling so that `crossprod(X)` is an identity matrix
  X * rep(1 / coefs$scale, each = length(x))
  }
Run Code Online (Sandbox Code Playgroud)

考虑一个例子:

set.seed(0); x1 <- runif(5, min(x), max(x))
Run Code Online (Sandbox Code Playgroud)

stats:::predict.poly(poly(x, 5), x1)
my_predict_poly(my_poly(x, 5, FALSE), x1)
Run Code Online (Sandbox Code Playgroud)

给出完全相同的结果预测矩阵:

#               1          2           3          4          5
#[1,]  0.39726381  0.1721267 -0.10562568 -0.3312680 -0.4587345
#[2,] -0.13428822 -0.2050351  0.28374304 -0.0858400 -0.2202396
#[3,] -0.04450277 -0.3259792  0.16493099  0.2393501 -0.2634766
#[4,]  0.12454047 -0.3499992 -0.24270235  0.3411163  0.3891214
#[5,]  0.40695739  0.2034296 -0.05758283 -0.2999763 -0.4682834
Run Code Online (Sandbox Code Playgroud)

请注意,预测程序只是简单地采用现有的构造信息而不是重建多项式.


第6节:只是对待polypredict.poly作为黑匣子

很少需要了解内部的一切.对于统计建模,知道poly构造模型拟合的多项式基础就足够了,其系数可以在中找到lmObject$coefficients.在进行预测时,predict.poly永远不需要被用户调用,因为predict.lm它会为您完成.通过这种方式,只需处理polypredict.poly作为黑匣子是绝对可以的.