Как сгенерировать B-сплайн нулевой степени, используя R - PullRequest
0 голосов
/ 25 января 2019

В настоящее время я работаю с B-сплайнами, используя функцию R bs из пакета splines, и в качестве графического примера я хотел бы привести рисунок, показывающий различия между наборами сплайнов с разными степенями.

Проблема в том, что bs поддерживает только градусы больше 0. Сплайн нулевой степени - не более чем индикаторная функция для заданной области, определенной узлами, но я не знаю, как ее сгенерировать. Это то, что я сделал до сих пор

x<-seq(0,1,length.out =1000)
    par(mfrow=c(3,1))
    B1<-bs(x,knots = seq(0,1,length.out = 11)[-c(1,11)],Boundary.knots = c(0,1),intercept = T,degree = 1)
    matplot(x,B1,type="l",lty=1,ylim = c(-0.1,1.2),xlab = "",ylab = "")
    abline(v=seq(0,1,length.out = 11),lty=2)
    legend("top", legend ="B-splines of order 2")

    B2<-bs(x,knots = seq(0,1,length.out = 11)[-c(1,11)],Boundary.knots = c(0,1),intercept = T,degree = 2)
    matplot(x,B2,type="l",lty=1,ylim = c(-0.1,1.2),xlab = "",ylab = "")
    abline(v=seq(0,1,length.out = 11),lty=2)
    legend("top", legend ="B-splines of order 3")

    B3<-bs(x,knots = seq(0,1,length.out = 11)[-c(1,11)],Boundary.knots = c(0,1),intercept = T,degree = 3)
    matplot(x,B3,type="l",lty=1,ylim = c(-0.1,1.2),xlab = "",ylab = "")
    abline(v=seq(0,1,length.out = 11),lty=2)
    legend("top", legend ="B-splines of order 4")

Это изображение, взятое из Hastie et.al (2017) - это то, чего мне не хватает. enter image description here

Заранее спасибо

1 Ответ

0 голосов
/ 25 января 2019

Как я понимаю из комментариев, вам нужна функция, которая задает входной вектор x из n точек, возвращающих серию из n-1 "сплайнов"; где i th сплайн определяется как имеющий значение 1 в диапазоне x[i] < x < x[i+1] или 0 в другом месте.

Мы можем сделать это так:

x <- seq(0,1,length.out =10)

zero_spline = function(x, xout, n=1000) {
  if (missing(xout)) xout = seq(min(x), max(x), length.out = n)
  zs = data.frame()
  y = numeric(length(xout))
  for (i in 1:(length(x)-1L)) {
    yi = y
    yi[(xout > x[i]) & (xout < x[i+1])] = 1
    zs = rbind(zs, data.frame(xout, yi, interval=i))
  }
  zs
}

zs = zero_spline(x, n=100) 

library(ggplot2)
ggplot(zs, aes(xout, yi, color=factor(interval))) +
  geom_line()

enter image description here

...