Наивное пороговое прогнозирование случайных блужданий

Что такое пороговое прогнозирование или ПП можно прочитать здесь.

Протестируем НМП на ВРСБ.

При этом положим d=0, а p=1. Тогда задачу ПП можно сформулировать так: превысит ли будущее значение текущее значение?

Эксперимент будет состоять из следующих шагов:

  1. Сгенерируем ВРСБ с количеством значений n=250.
  2. Продифференцируем и за тем нормируем полученный ВРСБ.
  3. Протестируем НМП на выборке m=100.
  4. Рассчитаем показатели PL и PM, при условиях: если будущее фактическое значение и прогнозное больше si+d, либо будущее фактическое значение и прогнозное меньше, либо равно si+d, то в этом случае будем считать прогноз успешным. Иначе неуспешным.
  5. Повторим эксперимент 1000 раз с шага 1 и рассчитаем средние значения PL, PM.

Следует отметить, что НМП в интерпретации ПП прогнозирует всегда один и тот же вариант будущего значения – будущее значение равно предыдущему.

Так как мы имеем дело с ВРСБ – то оценки PL и PM должны быть примерно равными.

Вот график всех полученных значений PL:

Pl.jpeg

По графику видно, что показатель PL колеблется около значения 50%. Мы прогнозируем «абсолютно» случайную величину — случайное блуждание с использованием «случайной» или наивной модели, следовательно показатель PL — также величина случайная.

Среднее значение или оценка показателей такова: PL=49.754, PM=50.246.

Как видим, примерно 50/50, как при подбрасывании монеты. Что и требовалось показать и взять в качестве ориентира.

Если какая-либо более сложная МП будет давать оценку значения PL большую, чем НМП на ВРСБ, то скорее всего такая модель будет более точной и стабильной в своей точности на любых других данных, в том числе и на валютных курсах.

В следующем эксперименте проверим НМП на реальных данных. А в заключение приведу скрипт, что использовал в этом эксперименте.

#Нормировка выборки
nrmV2<-function(V,a)
{
  lenV<-length(V)
  if(lenV<=0) {return(V)}
  return ( a*V/max(abs(V)) )
}

#Конвертация методом разностей
conV<-function(V)
{
  lenV<-length(V)
  if (lenV<2) {return (V)}
  return((V[-1]-V[-lenV]))
}

#Генерация ВРСБ
genRW<-function(n)
{
nV<-rnorm(n)
S<-nV[1]
for (i in 2:n)
{ S<-c(S,(S[i-1]+nV[i])) }
return(S)
}

#НМП
getFVM1<-function(V)
{
  if(is.null(V)) {return(V)} #проверка, что выборка содержит хоть одно значение
  return(V[length(V)])
}

#Функция тестирования
tstPM<-function(V,ti)
{
    res<-NULL
  lenV<-length(V)
  #Проверка на ошибку. Объём остаточной выборки должен в 1,5 раза превышать тестовый интервал
  if (lenV<(1.5*ti)) {cat("Недостаточный объём выборки для тестирования!"); return(res)}
  pl<-0
  d<-0
  for(i in ti:1)
  {
    pr<-getFVM1(V[1:(lenV-i)])
    rv<-V[(lenV-i+1)]
    if (((rv>d) && (pr>d)) ||
        ((rv<=d) && (pr<=d)))
    {pl<-pl+1}
    res<-rbind.data.frame(res,cbind(rv,pr,pl))
  }
  return(res)
}

#Основной код
plV<-NULL
for(i in 1:1000)
{
S<-nrmV2(conV(genRW(250)),0.9)
res<-tstPM(S,100)
plV<-c(plV,res[nrow(res),3])
}
print(mean(plV))
print(100-mean(plV))
plot(plV,type='l', col="blue")

Похожие статьи:

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *