Оценить (т.е. предсказать) сглаживающий сплайн вне R

Question

Я установил сглаживающий сплайн для данных в R с

library(splines)
Model <- smooth.spline(x, y, df =6) 

Я хотел бы взять подогнанный сплайн и оценить его для произвольных новых данных во внешнем коде (не в R). Другими словами, делать то, что predict.smooth.spline функция делает. Я посмотрел на Model объект:

> str(Total_work_model)
List of 15
 $ x       : num [1:14] 0.0127 0.0186 0.0275 0.0343 0.0455 ...
 $ y       : num [1:14] 3174 3049 2887 2862 2975 ...
 $ w       : num [1:14] 1 1 1 1 1 1 1 1 1 1 ...
 $ yin     : num [1:14] 3173 3075 2857 2844 2984 ...
 $ data    :List of 3
  ..$ x: num [1:14] 0.0343 0.0455 0.0576 0.0697 0.0798 ...
  ..$ y: num [1:14] 2844 2984 3048 2805 2490 ...
  ..$ w: num [1:14] 1 1 1 1 1 1 1 1 1 1 ...
 $ lev     : num [1:14] 0.819 0.515 0.542 0.568 0.683 ...
 $ cv.crit : num 6494075
 $ pen.crit: num 3260
 $ crit    : num 3
 $ df      : num 8
 $ spar    : num 0.353
 $ lambda  : num 8.26e-05
 $ iparms  : Named int [1:3] 3 0 10
  ..- attr(*, "names")= chr [1:3] "icrit" "ispar" "iter"
 $ fit     :List of 5
  ..$ knot : num [1:20] 0 0 0 0 0.056 ...
  ..$ nk   : int 16
  ..$ min  : num 0.0127
  ..$ range: num 0.104
  ..$ coef : num [1:16] 3174 3132 3027 2871 2842 ...
  ..- attr(*, "class")= chr "smooth.spline.fit"
 $ call    : language smooth.spline(x = Phi00, y = Total, df = 8)
 - attr(*, "class")= chr "smooth.spline"

я думаю Model$fit$knot а также Model$fit$coef векторы содержат полное описание подгонки. Обратите внимание, что узлы 20, а x а также y у меня есть 14 элементов каждый: я всегда думал, что у сглаживающего сплайна будет столько же узлов, сколько и точек привязки. Однако, поскольку первые три и последние три узла идентичны, 20-6 = 14, что имеет смысл. Проблема в том, что я не знаю, как использовать Model$fit$knot а также Model$fit$coef делать прогнозы за пределами R. Я пытался взглянуть на predict.smooth.splineно удивительно вот что я получаю

> library(splines)
> predict.smooth.spline
Error: object 'predict.smooth.spline' not found

РЕДАКТИРОВАТЬ: так как, очевидно, некоторые пользователи неправильно поняли вопрос, я знаю, как использовать predictв R, чтобы получить новые значения моего сглаживающего сплайна. Проблема в том, что я хочу сделать эти прогнозы во внешнем коде. Таким образом, я хотел взглянуть на код функции predict.smooth.spline, чтобы я мог попытаться воспроизвести алгоритм вне R. Обычно в R вы можете прочитать код функции, просто введя ее имя (без аргументов и без скобок) в приглашении R. Но когда я пытаюсь сделать это с predict.smooth.splineЯ получаю вышеуказанную ошибку.

EDIT2: благодаря большой помощи @r2evans, я нашел источник для predict метод smooth.spline, Я (кажется, я) понимаю большую часть этого:

> stats:::predict.smooth.spline.fit
function (object, x, deriv = 0, ...) 
{
    if (missing(x)) 
        x <- seq.int(from = object$min, to = object$min + object$range, 
            length.out = length(object$coef) - 4L)
    xs <- (x - object$min)/object$range
    extrap.left <- xs < 0
    extrap.right <- xs > 1
    interp <- !(extrap <- extrap.left | extrap.right)
    n <- sum(interp)
    y <- xs
    if (any(interp)) 
        y[interp] <- .Fortran(C_bvalus, n = as.integer(n), knot = as.double(object$knot), 
            coef = as.double(object$coef), nk = as.integer(object$nk), 
            x = as.double(xs[interp]), s = double(n), order = as.integer(deriv))$s
    if (any(extrap)) {
        xrange <- c(object$min, object$min + object$range)
        if (deriv == 0) {
            end.object <- Recall(object, xrange)$y
            end.slopes <- Recall(object, xrange, 1)$y * object$range
            if (any(extrap.left)) 
                y[extrap.left] <- end.object[1L] + end.slopes[1L] * 
                  (xs[extrap.left] - 0)
            if (any(extrap.right)) 
                y[extrap.right] <- end.object[2L] + end.slopes[2L] * 
                  (xs[extrap.right] - 1)
        }
        else if (deriv == 1) {
            end.slopes <- Recall(object, xrange, 1)$y * object$range
            y[extrap.left] <- end.slopes[1L]
            y[extrap.right] <- end.slopes[2L]
        }
        else y[extrap] <- 0
    }
    if (deriv > 0) 
        y <- y/(object$range^deriv)
    list(x = x, y = y)
}

Однако у меня есть две трудности:

1. .Fortran() функция вызывает подпрограмму Fortran bvalus чей источник довольно прост. Тем не мение, bvalus по очереди звонки bvalue что гораздо сложнее, и звонки interv чей источник я не могу найти. Плохие новости: bvalue это слишком сложно для меня, чтобы понять (я определенно не эксперт Фортран). Хорошие новости: внешний код, который должен воспроизводить predict.smooth.spline.fit это также код Fortran. Если хуже становится хуже, я мог бы просто попросить моего коллегу указать источник из bvalus а также bvalue в своем коде. Однако, даже в этом, по общему признанию, не очень хорошем сценарии, я все еще пропустил бы исходный код для interv (Я надеюсь, что это не вызывает что-то еще!!!).

2. Я не понимаю, что здесь делается (заметьте, меня интересует только deriv == 0 дело):

К

  if (any(extrap)) {
        xrange <- c(object$min, object$min + object$range)
        if (deriv == 0) {
            end.object <- Recall(object, xrange)$y
            end.slopes <- Recall(object, xrange, 1)$y * object$range
            if (any(extrap.left)) 
                y[extrap.left] <- end.object[1L] + end.slopes[1L] * 
                  (xs[extrap.left] - 0)
            if (any(extrap.right)) 
                y[extrap.right] <- end.object[2L] + end.slopes[2L] * 
                  (xs[extrap.right] - 1)
        }

Какой-то рекурсивный код? Любая помощь здесь?

Answer 1

smooth.spline не в splines пакет, это в stats, Кроме того, он не экспортируется, поэтому вы должны использовать метод тройного двоеточия, чтобы увидеть его: stats:::predict.smooth.spline, Затем он указывает на predict.smooth.spline.fit, который можно найти аналогичным образом. (Так как он по выбору использует .Fortran()вам, возможно, придется сделать вывод, что происходит... если вы не погрузитесь в источник.)

Answer 2

Экспорт сглаживающего сплайна в виде кусочно-полиномов является одним из способов восстановления сплайна за пределами R. Мой пакет SplinesUtils: https://github.com/ZheyuanLi/SplinesUtils может сделать это. Вы можете получить это по

devtools::install_github("ZheyuanLi/SplinesUtils")

Функция для использования здесь SmoothSplinesAsPiecePoly, Я просто копирую примеры для этой функции в своей документации.

library(SplinesUtils)

## a toy dataset
set.seed(0)
x <- 1:100 + runif(100, -0.1, 0.1)
y <- poly(x, 9) %*% rnorm(9)
y <- y + rnorm(length(y), 0, 0.2 * sd(y))

## fit a smoothing spline
sm <- smooth.spline(x, y)

## coerce "smooth.spline" object to "PiecePoly" object
oo <- SmoothSplineAsPiecePoly(sm)

## print the "PiecePoly"
oo
#61 piecewise polynomials of degree 3 are constructed!
#Use 'summary' to export all of them.
#The first 6 are printed below.
#-0.626 - 0.17 * (x - 1.08) - 0 * (x - 1.08) ^ 2 - 0.0094 * (x - 1.08) ^ 3
#-0.768 - 0.148 * (x - 1.95) - 0.0246 * (x - 1.95) ^ 2 - 0.00569 * (x - 1.95) ^ 3
#-0.919 + 0.0259 * (x - 4.01) + 0.0598 * (x - 4.01) ^ 2 + 0.0086 * (x - 4.01) ^ 3
#-0.834 + 0.124 * (x - 5.08) + 0.0323 * (x - 5.08) ^ 2 + 0.00466 * (x - 5.08) ^ 3
#-0.494 + 0.197 * (x - 7.08) + 0.00433 * (x - 7.08) ^ 2 + 0.0027 * (x - 7.08) ^ 3
#-0.113 + 0.183 * (x - 9.03) + 0.0115 * (x - 9.03) ^ 2 + 0.00377 * (x - 9.03) ^ 3

Узлы сплайна

oo$knots
# [1]   1.079339   1.953102   4.014571   5.081642   7.079678   9.032160
# [7]  10.025823  11.941195  12.935311  14.976821  16.999540  18.043524
#[13]  19.976007  22.086941  22.942429  24.925111  25.953444  27.902678
#[19]  30.073938  30.968070  33.019913  34.937244  36.065475  38.058848
#[25]  38.921589  40.982255  43.029412  44.056587  46.005944  47.904666
#[31]  48.995446  51.038546  51.995524  53.987619  55.914136  56.919893
#[37]  59.003727  60.981366  62.082575  63.991813  64.966479  66.951603
#[43]  69.053262  69.916849  71.967815  73.969337  74.966755  77.078440
#[49]  78.072868  80.055464  81.986932  83.042503  84.965070  86.940538
#[55]  88.042224  89.949098  90.928661  92.911787  95.075254  96.055783
#[61]  97.991055 100.062174

Кусочно-полиномиальные коэффициенты

CoefMat <- oo$PiecePoly$coef
## for the first 5 pieces
CoefMat[, 1:5]
#             [,1]         [,2]         [,3]        [,4]         [,5]
#[1,] -0.626225456 -0.768321912 -0.919380838 -0.83408278 -0.494257767
#[2,] -0.169805245 -0.148267472  0.025888868  0.12418698  0.197353171
#[3,]  0.000000000  0.024649465  0.059832206  0.03228737  0.004331680
#[4,]  0.009403574  0.005688943 -0.008604501 -0.00466386 -0.002702257

Пакет также имеет другие функциональные возможности. См. Например, определение всех локальных экстремумов сглаженного сплайна с помощью функции R "smooth.spline".