Rのbs関数の解読
以下コピペ
function (x, df = NULL, knots = NULL, degree = 3, intercept = FALSE, Boundary.knots = range(x)) { x <- x if (smart.mode.is("read")) { return(eval(smart.expression)) } nx <- names(x) x <- as.vector(x) nax <- is.na(x) if (nas <- any(nax)) x <- x[!nax] if (!missing(Boundary.knots)) { Boundary.knots <- sort(Boundary.knots) outside <- (ol <- x < Boundary.knots[1]) | (or <- x > Boundary.knots[2L]) } else outside <- FALSE ord <- 1 + (degree <- as.integer(degree)) if (ord <= 1) stop("'degree' must be integer >= 1") if (!missing(df) && missing(knots)) { nIknots <- df - ord + (1 - intercept) if (nIknots < 0) { nIknots <- 0 warning("'df' was too small; have used ", ord - (1 - intercept)) } knots <- if (nIknots > 0) { knots <- seq(from = 0, to = 1, length = nIknots + 2)[-c(1, nIknots + 2)] stats::quantile(x[!outside], knots) } } Aknots <- sort(c(rep(Boundary.knots, ord), knots)) if (any(outside)) { warning("some 'x' values beyond boundary knots may ", "cause ill-conditioned bases") derivs <- 0:degree scalef <- gamma(1L:ord) basis <- array(0, c(length(x), length(Aknots) - degree - 1L)) if (any(ol)) { k.pivot <- Boundary.knots[1L] xl <- cbind(1, outer(x[ol] - k.pivot, 1L:degree, "^")) tt <- spline.des(Aknots, rep(k.pivot, ord), ord, derivs)$design basis[ol, ] <- xl %*% (tt/scalef) } if (any(or)) { k.pivot <- Boundary.knots[2L] xr <- cbind(1, outer(x[or] - k.pivot, 1L:degree, "^")) tt <- spline.des(Aknots, rep(k.pivot, ord), ord, derivs)$design basis[or, ] <- xr %*% (tt/scalef) } if (any(inside <- !outside)) basis[inside, ] <- spline.des(Aknots, x[inside], ord)$design } else basis <- spline.des(Aknots, x, ord)$design if (!intercept) basis <- basis[, -1L, drop = FALSE] n.col <- ncol(basis) if (nas) { nmat <- matrix(NA, length(nax), n.col) nmat[!nax, ] <- basis basis <- nmat } dimnames(basis) <- list(nx, 1L:n.col) a <- list(degree = degree, knots = if (is.null(knots)) numeric(0L) else knots, Boundary.knots = Boundary.knots, intercept = intercept, Aknots = Aknots) attributes(basis) <- c(attributes(basis), a) class(basis) <- c("bs", "basis", "matrix") if (smart.mode.is("write")) put.smart(list(df = df, knots = knots, degree = degree, intercept = intercept, Boundary.knots = Boundary.knots, match.call = match.call())) basis }