Анализ временных рядов/R

Анализ временных рядов и регрессионные методы

Практические примеры в R: Анализ временных рядов и регрессионные методы

Симуляция данных

# Симулируем данные, похожие на реальные результаты Segregation Model
# Параметр: %-SIMILAR-WANTED = 30%

set.seed(123)

# Генерируем нестационарный ряд (с трендом и шумом)
time_steps <- 1:100
true_trend <- 50 + 0.3 * time_steps  # тренд: медленный рост
# добавляем шум и эффект насыщения
noise <- rnorm(100, mean = 0, sd = 2)
saturation <- 100 * (1 - exp(-0.05 * time_steps))  # асимптотический рост
happy_agents_pct <- pmin(true_trend + noise + saturation - 50, 95)

# Визуализируем
plot(time_steps, happy_agents_pct, type='l', 
     main='Segregation Model: % счастливых агентов',
     xlab='Шаг времени', ylab='% счастливых',
     lwd=2, col='darkblue')
grid()

1. 1. 1. Шаг 1: Проверка на стационарность

```r

1. Используем ADF тест (Augmented Dickey-Fuller)

library(tseries)

1. Тест на исходном ряде

adf_original <- adf.test(happy_agents_pct) cat("ADF тест на исходном ряде:\n") print(adf_original)

1. Если p-value > 0.05, ряд нестационарен
2. Обычно p-value < 0.05 для стационарного ряда (отвергаем H0 о нестационарности)

```

Шаг 2: Линейная регрессия и детерендизация

# Строим линейную регрессию для извлечения тренда
regression_model <- lm(happy_agents_pct ~ time_steps)
summary(regression_model)

# Вывод покажет:
# Coefficients:
#             Estimate Std. Error t value Pr(>|t|)    
# (Intercept) 50.1234    0.5678  88.27   <2e-16 ***
# time_steps   0.2987    0.0098  30.49   <2e-16 ***

# Извлекаем остатки (детерендированный ряд)
residuals_detrended <- residuals(regression_model)

# Визуализируем остатки
par(mfrow=c(2,2))

plot(time_steps, residuals_detrended, type='l',
     main='Остатки после удаления тренда',
     xlab='Шаг времени', ylab='Остатки')
abline(h=0, lty=2, col='red')

# Гистограмма остатков
hist(residuals_detrended, breaks=20, 
     main='Распределение остатков',
     xlab='Значение', freq=FALSE)
curve(dnorm(x, mean=mean(residuals_detrended), 
            sd=sd(residuals_detrended)), 
      add=TRUE, col='red', lwd=2)

# Q-Q plot
qqnorm(residuals_detrended, main='Q-Q диаграмма')
qqline(residuals_detrended, col='red')

par(mfrow=c(1,1))

Шаг 3: Критерий Дарбина-Уотсона

library(lmtest)

# Основной тест
dw_result <- dwtest(regression_model)
cat("\n=== Тест Дарбина-Уотсона ===\n")
print(dw_result)

# Ручной расчёт для проверки
n <- length(residuals_detrended)
dw_manual <- sum(diff(residuals_detrended)^2) / sum(residuals_detrended^2)
cat("DW статистика (ручной расчёт):", dw_manual, "\n")

# Интерпретация:
# Если DW ~ 2: нет автокорреляции ✓
# Если DW ~ 0: положительная автокорреляция (остатки похожи)
# Если DW ~ 4: отрицательная автокорреляция (остатки чередуются)

if (dw_result$p.value > 0.05) {
  cat("Вывод: Нет значимой автокорреляции (p > 0.05) ✓\n")
} else {
  cat("Вывод: Есть значимая автокорреляция (p < 0.05) ⚠\n")
}

Шаг 4: Автокорреляционная функция (ACF)

# Визуализация ACF для остатков
par(mfrow=c(2,1))

acf(residuals_detrended, main='ACF остатков (исходные)')
pacf(residuals_detrended, main='Частная ACF остатков')

par(mfrow=c(1,1))

# Интерпретация:
# - Если столбцы внутри пунктирных границ → нет значимой автокорреляции
# - Если выходят за границы → есть автокорреляция на данном лаге
```

### Шаг 5: Альтернативный метод - Дифференцирование

<syntaxhighlight lang="R" line>
# Первые разности (простое дифференцирование)
diff_happy <- diff(happy_agents_pct)

# Визуализируем
par(mfrow=c(2,1))

plot(happy_agents_pct, type='l', main='Исходный ряд')
plot(diff_happy, type='l', main='Первые разности')

par(mfrow=c(1,1))

# Проверяем стационарность разностей
adf_diff <- adf.test(diff_happy)
cat("ADF тест на дифференцированном ряде:\n")
print(adf_diff)

# Если p-value < 0.05, ряд стационарен ✓
```

---

## Полный рабочий пример 2: Minority Game

; Специфика: высокая волатильность

<syntaxhighlight lang="R" line>
# Minority Game: процент успешных выборов агента во времени
# Данные более шумные, чем в Segregation

set.seed(456)
time_steps_mg <- 1:150

# Создаём более волатильный ряд
base_success <- 50 + 2 * sin(time_steps_mg / 20)  # слабый циклический тренд
noise_mg <- rnorm(150, mean=0, sd=4)
success_rate <- pmax(pmin(base_success + noise_mg, 90), 10)  # bounds: 10-90%

plot(time_steps_mg, success_rate, type='l',
     main='Minority Game: % успешных выборов',
     xlab='Раунд игры', ylab='Успешность (%)',
     lwd=2, col='darkgreen')
grid()

1. 1. 1. Анализ: Проверка стационарности

# ADF тест
adf_mg <- adf.test(success_rate)
cat("ADF тест:\n")
print(adf_mg)

# KPSS тест (альтернативный)
library(tseries)
kpss_test <- kpss.test(success_rate)
cat("\nKPSS тест:\n")
print(kpss_test)

# Примечание: если ADF не отвергает H0 (p > 0.05) 
# и KPSS отвергает H0 (p < 0.05), то ряд точно нестационарен

Анализ

Более сложная регрессия

# В Minority Game может быть эффект памяти
# Проверим: зависит ли успех в t от успеха в t-1

# Создаём лаговые переменные
lag1_success <- c(NA, success_rate[-150])
lag2_success <- c(NA, NA, success_rate[-149:150])

# Удаляем NA
valid_idx <- 3:150
y <- success_rate[valid_idx]
x_lag1 <- lag1_success[valid_idx]
x_lag2 <- lag2_success[valid_idx]
time_x <- time_steps_mg[valid_idx]

# Регрессия с лагами
ar_model <- lm(y ~ time_x + x_lag1 + x_lag2)
summary(ar_model)

# Проверяем остатки
residuals_ar <- residuals(ar_model)
dw_ar <- dwtest(ar_model)
print(dw_ar)

# Если лаги значимы, это указывает на автокорреляцию в исходных данных

---

Пример 3: Сравнение методов детерендизации

# Используем данные Segregation Model из примера 1

# Метод 1: Линейная регрессия
residuals_linear <- residuals(lm(happy_agents_pct ~ time_steps))

# Метод 2: Дифференцирование
residuals_diff <- diff(happy_agents_pct)

# Метод 3: Полиномиальная регрессия (более гибкая)
poly_model <- lm(happy_agents_pct ~ poly(time_steps, 2))
residuals_poly <- residuals(poly_model)

# Визуализация результатов
par(mfrow=c(2,2))

plot(time_steps, residuals_linear, type='l', 
     main='Метод 1: Линейная регрессия',
     ylab='Остатки')
abline(h=0, col='red', lty=2)

plot(time_steps[-1], residuals_diff, type='l',
     main='Метод 2: Дифференцирование',
     ylab='Первые разности')
abline(h=0, col='red', lty=2)

plot(time_steps, residuals_poly, type='l',
     main='Метод 3: Полиномиальная регрессия',
     ylab='Остатки')
abline(h=0, col='red', lty=2)

# Сравнение качества
cat("=== Сравнение качества моделей ===\n")
cat("Линейная регрессия:\n")
print(summary(lm(happy_agents_pct ~ time_steps))$adj.r.squared)

cat("Полиномиальная регрессия:\n")
print(summary(poly_model)$adj.r.squared)

par(mfrow=c(1,1))

---

Пример 4: Экспорт данных из NetLogo в R

1. 1. 1. Файл NetLogo (.csv экспорт)

# Допустим, вы экспортировали данные из NetLogo как 'segregation_data.csv'
# Структура файла:
# [step] [happy-percent] [num-unhappy]
# 0      50.2            245
# 1      52.1            231
# ...

# Загружаем данные
data_nl <- read.csv('segregation_data.csv')

# Проверяем структуру
head(data_nl)
str(data_nl)

# Вынимаем колонку счастья
happy_ts <- data_nl$happy_percent

# Теперь применяем все методы анализа из примеров выше
model <- lm(happy_ts ~ data_nl$step)
summary(model)

dw <- dwtest(model)
print(dw)