Предсказать значения от синусоидального шума - PullRequest
4 голосов
/ 28 декабря 2010

Фон

Использование R для прогнозирования следующих значений в серии.

Проблема

Следующий код генерирует и строит модель для кривой с некоторым равномерным шумом:

slope = 0.55
offset = -0.5
amplitude = 0.22
frequency = 3
noise = 0.75
x <- seq( 0, 200 )
y <- offset + (slope * x / 100) + (amplitude * sin( frequency * x / 100 ))
yn <- y + (noise * runif( length( x ) ))

gam.object <- gam( yn ~ s( x ) + 0 )
plot( gam.object, col = rgb( 1.0, 0.392, 0.0 ) )
points( x, yn, col = rgb( 0.121, 0.247, 0.506 ) )

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

p <- predict( gam.object, data.frame( x=201:210 ) )

Прогнозы не выглядят правильными при построении графика:

df <- data.frame( fit=c( fitted( gam.object ), p ) )
plot( seq( 1:211 ), df[,], col="blue" )
points( yn, col="orange" )

Предсказанные значения (начиная с 201 года) кажутся слишком низкими.

Вопросы

  1. Являются ли предсказанные значения, как показано, на самом деле самыми точными предсказаниями?
  2. Если нет, то как можно улучшить точность?
  3. Как лучше объединить два набора данных (fitted.values( gam.object ) и p)?

1 Ответ

3 голосов
/ 28 декабря 2010
  1. Моделируемые данные странные, потому что все ошибки, которые вы добавляете к «true» y, больше 0. (runif создает числа на [0,1], а не [-1,1].)
  2. Проблема исчезает, если в модели разрешен член-перехват.

Например:

gam.object2 <- gam( yn ~ s( x ))
p2 <- predict( gam.object2, data.frame( x=201:210 ))
points( 1:211, c( fitted( gam.object2 ), p2), col="green")

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

Ваш третий вопрос нуждается в разъяснении, потому что gam -объект не является data.frame.Два типа данных не смешиваются.

Более полный пример:

slope = 0.55
amplitude = 0.22
frequency = 3
noise = 0.75
x <- 1:200
y <- (slope * x / 100) + (amplitude * sin( frequency * x / 100 ))
ynoise <- y + (noise * runif( length( x ) ))

gam.object <- gam( ynoise ~ s( x ) )
p <- predict( gam.object, data.frame( x = 1:210 ) )

plot( p, col = rgb( 0, 0.75, 0.2 ) )
points( x, ynoise, col = rgb( 0.121, 0.247, 0.506 ) )
points( fitted( gam.object ), col = rgb( 1.0, 0.392, 0.0 ) )
...