Модель Шеллінга: трохи експериментів

Про модель Шеллінга поговорили, малюнки подивились (див. https://rpubs.com/ruslana/709723). У випадку з шаховим розміщенням спостерігали ситуацію: за значення порогу 0.3 візуально відмінностей між початковим та кінцевим розташуванням агентів не було помічено. А ось за значення порогу 0.4 сегрегація вже спостерігається (причому візуально початкове і кінцеве розміщення відрізняються досить суттєво). Як таке могло статись? Адже між числами 0.3 і 0.4 не така вже й велика різниця... Справа у тому, що в агентних моделях навіть незначні відмінності у значеннях параметрів можуть призводити до дуже різних результатів. Наприклад, за значення порогу 0.25 (мова йде про випадкове розміщення агентів) візуально відмінності між початковим та кінцевим розміщенням не особливо помітні. Зате за значення порогу 0.26 ця різниця стає більш помітною. Можете подивитися і оцінити.

Schelling_model(0.25, vz = "static")

Schelling_model(0.26, vz = "static")

Однак є одне "але". Результат залежить від того, в якому порядку початково розташовані агенти. Нагадаємо, що це випадкове розміщення, а, отже, з кожним новим виконанням коду за одних і тих самих значень параметрів результати і, відповідно, візуалізація будуть різними. Переглянемо результати симуляцій за значень порогів 0.24, 0.25, 0.26. Причому для кожного зі значень порогів проведемо не одну, а 50 симуляцій (щоб спробувати усунути вплив порядку розташування агентів на результати).

# Результати  50 симуляцій
res0.24 <- lapply(1:50, function(x) Schelling_model(0.24, vz = "none", res = T))
res0.25 <- lapply(1:50, function(x) Schelling_model(0.25, vz = "none", res = T))
res0.26 <- lapply(1:50, function(x) Schelling_model(0.26, vz = "none", res = T))

Функція Schelling_model дозволяє розрахувати середню частку сусідів своєї групи на кожному кроці. Нас цікавить лише перший (початкове розташування) та останній (кінцеве розташування) крок.

# Середня частка своїх (початкове і кінцеве розміщення)
## Значення порогу 0.24
seg0.24 <- sapply(1:50, function(x) res0.24[[x]][dim(res0.24[[x]])[1],1])
init0.24 <- sapply(1:50, function(x) res0.24[[x]][1,1])

## Значення порогу 0.25
seg0.25 <- sapply(1:50, function(x) res0.25[[x]][dim(res0.25[[x]])[1],1])
init0.25 <- sapply(1:50, function(x) res0.25[[x]][1,1])

## Значення порогу 0.26
seg0.26 <- sapply(1:50, function(x) res0.26[[x]][dim(res0.26[[x]])[1],1])
init0.26 <- sapply(1:50, function(x) res0.26[[x]][1,1])

Для середньої частки сусідів своєї групи розрахуємо середні та 95%-ві довірчі інтервали для них. Нагадаю, що цей показник характеризує ступінь вираженості сегрегації.

# Формуємо табличку: середні з довірчими інтервалами
## Початкове розміщення
init <- rbind(format(round(mean(init0.24), 3), nsmall = 3),
              paste(format(round(t.test(init0.24)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(init0.24)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(init0.25), 3), nsmall = 3),
              paste(format(round(t.test(init0.25)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(init0.25)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(init0.26), 3), nsmall = 3),
              paste(format(round(t.test(init0.26)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(init0.26)$conf.int[2], 4), nsmall = 4), sep = "; "))
## Кінцеве розміщення
seg <- rbind(format(round(mean(seg0.24), 3), nsmall = 3),
              paste(format(round(t.test(seg0.24)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(seg0.24)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(seg0.25), 3), nsmall = 3),
              paste(format(round(t.test(seg0.25)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(seg0.25)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(seg0.26), 3), nsmall = 3),
              paste(format(round(t.test(seg0.26)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(seg0.26)$conf.int[2], 4), nsmall = 4), sep = "; "))

# Ура, табличка!
table1 <- t(cbind(init, seg))
rownames(table1) <- c("Початкове розміщення", "Кінцеве розміщення")
colnames(table1) <- rep(c("Середнє", "95%-ві довірчі інтервали"), 3)
table1 %>%
kbl(align = "c") %>%
  column_spec(1, bold = T) %>%
  kable_styling(bootstrap_options = c("hover", "condensed", "bordered"), font_size = 13) %>%
  add_header_above(c(" ", "Поріг 0.24" = 2, "Поріг 0.25" = 2, "Поріг 0.26" = 2), bold = T, font_size = 14)

	Поріг 0.24		Поріг 0.25		Поріг 0.26
	Середнє	95%-ві довірчі інтервали	Середнє	95%-ві довірчі інтервали	Середнє	95%-ві довірчі інтервали
Початкове розміщення	0.498	0.4953; 0.4999	0.499	0.4969; 0.5018	0.497	0.4942; 0.4989
Кінцеве розміщення	0.589	0.5834; 0.5942	0.593	0.5884; 0.5968	0.693	0.6871; 0.6990

Для порогів 0.24 та 0.25 середня частка сусідів своєї групи (кінцеве розміщення) не відрізняється: 95%-ві довірчі інтервали перетинаються. Однак за значення порогу 0.26 вона куди вища, ніж для порогу 0.25. Сегрегація на першому кроці (початкове розташування) менш виражена, порівняно з кінцевим розташуванням, і це справедливо для всіх вказаних у таблиці значень порогів.

Розглянемо випадок, коли агенти початково розташовані у шаховому порядку. За значення порогу 0.33 відмінності між початковим та кінцевим розміщенням не надто очевидні. Однак вони стають більш помітними за значення порогу 0.34.

Schelling_model(0.33, chs = T, vz = "static")

Schelling_model(0.34, chs = T, vz = "static")

Переглянемо результати 50 симуляцій для значень порогів 0.32, 0.33, 0.34. За шахового розміщення вільні клітинки розташовані на решітці випадковим чином, через що кожне нове виконання коду (для одних і тих самих значень параметрів) може давати різні результати.

# Результати 50 симуляцій
resc0.32 <- lapply(1:50, function(x) Schelling_model(0.32, chs = T, vz = "none", res = T))
resc0.33 <- lapply(1:50, function(x) Schelling_model(0.33, chs = T, vz = "none", res = T))
resc0.34 <- lapply(1:50, function(x) Schelling_model(0.34, chs = T, vz = "none", res = T))

# Середня частка своїх (початкове і кінцеве розміщення)
## Значення порогу 0.32
segc0.32 <- sapply(1:50, function(x) resc0.32[[x]][dim(resc0.32[[x]])[1],1])
initc0.32 <- sapply(1:50, function(x) resc0.32[[x]][1,1])

## Значення порогу 0.33
segc0.33 <- sapply(1:50, function(x) resc0.33[[x]][dim(resc0.33[[x]])[1],1])
initc0.33 <- sapply(1:50, function(x) resc0.33[[x]][1,1])

## Значення порогу 0.34
segc0.34 <- sapply(1:50, function(x) resc0.34[[x]][dim(resc0.34[[x]])[1],1])
initc0.34 <- sapply(1:50, function(x) resc0.34[[x]][1,1])

Для середньої частки сусідів своєї групи розрахуємо середні та 95%-ві довірчі інтервали для них.

# Знову формуємо табличку: середні з довірчими інтервалами
## Початкове розміщення
initc <- rbind(format(round(mean(initc0.32), 3), nsmall = 3),
              paste(format(round(t.test(initc0.32)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(initc0.32)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(initc0.33), 3), nsmall = 3),
              paste(format(round(t.test(initc0.33)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(initc0.33)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(initc0.34), 3), nsmall = 3),
              paste(format(round(t.test(initc0.34)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(initc0.34)$conf.int[2], 4), nsmall = 4), sep = "; "))
## Кінцеве розміщення
segc <- rbind(format(round(mean(segc0.32), 3), nsmall = 3),
              paste(format(round(t.test(segc0.32)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(segc0.32)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(segc0.33), 3), nsmall = 3),
              paste(format(round(t.test(segc0.33)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(segc0.33)$conf.int[2], 4), nsmall = 4), sep = "; "),
              format(round(mean(segc0.34), 3), nsmall = 3),
              paste(format(round(t.test(segc0.34)$conf.int[1], 4), nsmall = 4), 
              format(round(t.test(segc0.34)$conf.int[2], 4), nsmall = 4), sep = "; "))

# Ура, ще одна табличка!
table2 <- t(cbind(initc, segc))
rownames(table2) <- c("Початкове розміщення", "Кінцеве розміщення")
colnames(table2) <- rep(c("Середнє", "95%-ві довірчі інтервали"), 3)
table2 %>%
kbl(align = "c") %>%
  column_spec(1, bold = T) %>%
  kable_styling(bootstrap_options = c("hover", "condensed", "bordered"), font_size = 13) %>%
  add_header_above(c(" ", "Поріг 0.32" = 2, "Поріг 0.33" = 2, "Поріг 0.34" = 2), bold = T, font_size = 14)

	Поріг 0.32		Поріг 0.33		Поріг 0.34
	Середнє	95%-ві довірчі інтервали	Середнє	95%-ві довірчі інтервали	Середнє	95%-ві довірчі інтервали
Початкове розміщення	0.488	0.4874; 0.4883	0.488	0.4874; 0.4882	0.487	0.4870; 0.4880
Кінцеве розміщення	0.508	0.5064; 0.5103	0.509	0.5059; 0.5111	0.635	0.6223; 0.6474

І ось що вийшло. Середня частка сусідів своєї групи (кінцеве розміщення) не відрізняється для порогів 0.32 і 0.33. Однак за значення порогу 0.34 вона помітно вона вища, ніж для порогу 0.33. Сегрегація на першому кроці (початкове розміщення агентів) менш виражена, порівняно з кінцевим розміщенням. Це справедливо для всіх, вказаних у таблиці значень порогів.

Вийшло якось сумбурно...та нехай:) Головне, розуміти дві речі. По-перше, візуалізацію краще доповнювати числовими показниками (я зараз кажу суто про агентні моделі). По-друге, навіть якщо різниця між значеннями порогів становить 0.01, це може суттєво вплинути на результат.