Economic Disparity/R simulation

# ============================================================================
# Симуляция данных из модели Economic Disparity
library(ggplot2)
library(dplyr)

set.seed(123)
n <- 1000  # количество участков

# Создание пространственных координат
coords <- expand.grid(x = 1:sqrt(n), y = 1:sqrt(n))

# Симуляция агентов и их влияния на землю
rich_locations <- sample(1:n, size = n0.2)  # 20% богатых
poor_locations <- sample(setdiff(1:n, rich_locations), size = n0.3)  # 30% бедных

# Базовые значения
base_quality <- 50
base_price <- 50

# Создание данных
land_data <- data.frame(
  id = 1:n,
  x = coords$x,
  y = coords$y,
  agent_type = ifelse(1:n %in% rich_locations, "rich",
                      ifelse(1:n %in% poor_locations, "poor", "empty")),
  stringsAsFactors = FALSE
)

# Влияние агентов на качество и цену с пространственным затуханием
land_data$quality <- base_quality
land_data$price <- base_price

for(i in 1:n) {
  for(j in 1:n) {
    if(i != j) {
      distance <- sqrt((land_data$x[i] - land_data$x[j])^2 + 
                      (land_data$y[i] - land_data$y[j])^2)
      effect <- exp(-distance/5)  # экспоненциальное затухание
      
      if(land_data$agent_type[j] == "rich") {
        land_data$quality[i] <- land_data$quality[i] + 10  effect
        land_data$price[i] <- land_data$price[i] + 10  effect
      } else if(land_data$agent_type[j] == "poor") {
        land_data$quality[i] <- land_data$quality[i] - 5  effect
        land_data$price[i] <- land_data$price[i] - 5  effect
      }
    }
  }
}

# Добавление случайного шума (ошибки)
land_data$error <- rnorm(n, 0, 5)
land_data$price_observed <- land_data$price + land_data$error

# Регрессионная модель
model <- lm(price_observed ~ quality, data = land_data)
summary(model)

# Расчет дисперсии ошибок
residuals <- residuals(model)
error_variance <- var(residuals)
cat("Оценка дисперсии случайной ошибки:", error_variance, "\n")

# Анализ гетероскедастичности по типам районов
variance_by_type <- land_data %>%
  mutate(residuals = residuals(model)) %>%
  group_by(agent_type) %>%
  summarise(
    variance = var(residuals),
    mean_quality = mean(quality),
    count = n()
  )

print("Дисперсия остатков по типам районов:")
print(variance_by_type)

# Тест Бреуша-Пагана на гетероскедастичность
library(lmtest)
bp_test <- bptest(model)
cat("Тест Бройша-Пагана на гетероскедастичность: p-value =", bp_test$p.value, "\n")

# Визуализация остатков
ggplot(land_data, aes(x = quality, y = residuals(model))) +
  geom_point(aes(color = agent_type), alpha = 0.6) +
  geom_hline(yintercept = 0, linetype = "dashed") +
  geom_smooth(method = "loess", se = FALSE) +
  labs(
    title = "Анализ остатков модели Economic Disparity",
    x = "Качество земли",
    y = "Остатки",
    color = "Тип района"
  ) +
  theme_minimal()


# ====================================================================