Функции сплайна для небольших наборов данных в R

Question

Я экспериментировал с множеством различных функций сплайнов, доступных в R, чтобы охарактеризовать очень маленький набор данных. Я полагаю, что с гораздо большим набором данных любое количество кривых будет вести себя так, как я ожидал бы, но данные в этом случае ограничены. Приведенный ниже код показывает пример типов данных, с которыми я работаю:

library(ggplot2); library(stats) 

dat <- data.frame(x = c(0.333, 0.5, 1, 2, 3, 4, 5), 
        y = c(5.875e-03, 1.225e-02, 3.902e-02, 8.942e-03, 
         4.277e-03, 1.938e-03, 1.131e-03)) 


mod <- splinefun(dat$x, dat$y, method = "monoH.FC") 
mod <- data.frame(x = seq(0.333, 5, by = 0.1), y = mod(seq(0.333, 5, by = 0.1))) 

ggplot() + geom_point(data = dat, aes(x = x, y = y)) + 
geom_line(data = mod, aes(x = x, y = y)) 

До сих пор, монотонный Эрмит сплайн, что подходит лучше всего, но он все еще имеет некоторые проблемы.

Интуитивно я могу рассказать вам, как должна выглядеть кривая. Он должен иметь максимум x = 1 и не должен иметь этот провал на x = 2.5. Кривая не кажется, что ее трудно воссоздать; он асимметричен с левым перекосом и предсказуемым хвостом.

Есть ли лучший способ создать сплайн-функцию, которая более правильно подходит (что я предполагаю) общий набор данных, или, альтернативно, есть лучший инструмент, чем сплайны для подгонки кривых к небольшим наборам данных?

Answer 1

Это похоже на то, что вы после того, как это сделать подходит ближе к линейным в-между, я думаю, вы можете принудить интерполяцию средней точки, как настоящий момент:

dat2 = data.frame(x = union(dat$x,dat$x - c(0,diff(dat$x)/2)), 
        y = interp1(dat$x,dat$y,xi = union(dat$x,dat$x - c(0,diff(dat$x)/2)))) 

(interp1 может быть ненужно здесь, union(dat$y,dat$y - c(0,diff(dat$y)/2)) должны делать то же самое, но код выше работ)

EDIT:. Примечание, для того, чтобы diff работать, вам нужны ваши данные, чтобы быть правильно заказал первый

это создает новые данные. кадр h указывает между предыдущими, если вы теперь сплайсируете его, вы взвешиваете более линейную подгонку

EDIT2: Вы также можете использовать сглаживающие сплайны с весами таким образом и задавать весовые точки между ними ниже, чем веса первичных точек:

mod <- splinefun(dat$x, dat$y,method = 'monoH.FC') 
mod2 <- data.frame(x = seq(0.333, 5, by = 0.1), y = mod(seq(0.333, 5, by = 0.1))) 


# A set of weights, where each point in-between is weighted half as much 
dat2$w <- rep(c(0.5,1),ceiling(length(dat2$x)/2))[-1] 

# Smoothing Spline 
modelspline <- smooth.spline(dat2$x, dat2$y,dat2$w) 

# Plot points 
xplot <- seq(min(dat2$x),max(dat2$x),by = 0.1) 

# And Plot comparison 
ggplot() + 
    geom_point(data = dat, aes(x = x, y = y)) + 
    geom_line(data = mod2, aes(x = x, y = y)) + 
    geom_line(data = data.frame(predict(modelspline,xplot)), 
     aes(x = x, y = y),color = 'red')