library(kableExtra)
<- c("WHITE", "BLACK", "ASIAN", "HISPANIC", "AM", "OTHER") list_race
Scharakteryzowanie zróżnicowania rasowego oraz segregacji rasowej w wybranym hrabstwie w roku X.
Obliczenie miar segregacji rasowej (\(H\), \(D\)) oraz zróżnicowania rasowego (\(E\), \(E_{std}\)) na podstawie danych z bloków spisowych (blocks)
Obliczenie miar segregacji rasowej (\(H\), \(D\)) oraz zróżnicowania rasowego (\(E\), \(E_{std}\)) na podstawie danych z obszarów spisowych (census tract)
Proszę przedstawić raport opisujący strukturę rasowo-etniczną wybranego hrabstwa w analizowanym roku. Raport ma zawierać następujące informacje:
Proszę obliczyć wskaźnik \(D\) dla grup: WB – biali/czarni, WA – biali/Azjaci, WL – biali/Latynosi, BL - Czarni/Latynosi, AL - Azjaci/Latynosi, AB - Azjaci/Czarni.
Zadanie wymaga zestawienia wyników otrzymanych w danej grupie analizującej wybrane hrabstwo.
Uwaga! W przypadku grup 3 osobowych należy wykonać analizę dla lat 1990-2010.
Wykorzystując miary zróżnicowania oraz segregacji rasowej, proszę przeanalizować jak zmieniła się struktura rasowa w hrabstwie w latach 1990-2020. Wyniki powinny zostać zestawione w 2 tabelach. Komentarz powinien zawierać porównanie miar segregacji oraz zróżnicowania rasowego otrzymanych na podstawie bloków oraz obszarów spisowych.
ROK | POP | BIALI | CZARNI | AZJACI | RDZENNI_AMERYKANIE | POZOSTALI | LATYNOSI |
---|---|---|---|---|---|---|---|
1990 | |||||||
2000 | |||||||
2010 | |||||||
2020 |
W poniższej tabeli przyrostek “_b” oznacza miary wyliczone z danych zagregowanych do bloków spisowych, a przyrostek “_ct” z obszarów spisowych.
ROK | E_b | Estd_b | Dwb_b | Dwa_b | Dwl_b | H_b | E_ct | Estd_ct | Dwb_ct | Dwa_ct | Dwl_ct | H_ct |
---|---|---|---|---|---|---|---|---|---|---|---|---|
1990 | ||||||||||||
2000 | ||||||||||||
2010 | ||||||||||||
2020 |
Obliczenie miar segregacji rasowej wymaga podziału obszaru na mniejsze jednostki spisowe.
W poniższym przykładzie wyliczono miary segregacji oraz zróżnicowania rasowego na podstawie danych z bloków spisowych. Obliczenia dla danego hrabstwa należy wykonać wykorzystując dane przygotowane w poprzednim ćwiczeniu i zapisane w pliku dane_attr/[nazwa_hrabstwa]_[rok]_blocks_attr.csv
Przed przystąpieniem do obliczeń należy wywołać wszystkie poniżesz funkcje.
#proportions - wektor zawierający odsetek poszczególnych ras w ogólnej liczbie ludności (wartości od 0 do 1)
#base - podstawa logarytmu, domyslnie exp(1) oznacza obliczenie logarytmu naturalnego
= function(proportions, base = exp(1)) {
entropy_fnc = -sum(ifelse(proportions > 0, proportions * log(proportions, base = base), 0))
entr return(entr)
}
= function(proportions, base = exp(1)) {
entropy_std_fnc = -sum(ifelse(proportions > 0, proportions * log(proportions, base = base), 0)) #obliczenie entropii
entr = entr/log(length(proportions), base = base) #standaryzacja
entr_std return(entr_std)
}
<- function(races) {
hindex #races_all to liczba osob w calym obszarze w podziale na grupy rasowo-etniczne
= apply(races, 2, sum, na.rm=TRUE)
races_all
#liczba osob w calym obszarze
= sum(races_all, na.rm=TRUE)
pop
#liczba osob w kazdej jednostce spisowej
= apply(races, 1, sum, na.rm=TRUE)
pop_i
#odsetek osob w danej grupy rasowo-etnicznej w kazdej jednostce spisowej
= races/pop_i
proportions
#odsetek osob w danej grupy rasowo-etnicznej w calym obszarze
= races_all/sum(races_all, na.rm = TRUE)
proportions_all
#entropia dla kazdej jednostki spisowej
= apply(proportions, 1, entropy_fnc)
ent_i
#entropia dla calego obszaru
= entropy_fnc(proportions_all)
ent
#obliczenie H
= sum(pop_i*(ent-ent_i)/(ent*pop), na.rm=TRUE)
hind return(hind)
}
# a - liczba osob grupy 1 w jednostce spisowej, b - liczba osob gruy 2 w jednostce spisowej
= function(a, b) {
d_ind = 0.5*sum(abs(a/sum(a, na.rm=TRUE) - b/sum(b, na.rm=TRUE)))
d return(d)
}
Tabela przedstawia dane dotyczące struktury rasowo-etnicznej dla 16 bloków spisowych dla 6 kategorii rasowo-etnicznych (WHITE, BLACK, ASIAN, HISPANIC, NATIVE AMERICAN, OTHER RACE). Dane te można zagregować do dwóch obszarów spisowych (pole TRACTA -> 12301 oraz 12302).
<- read.csv("data/cw2/ex.csv") dat
GISJOIN | GISJOIN_T | COUNTY_CODE | STATEA | COUNTYA | TRACTA | BLOCKA | WHITE | BLACK | ASIAN | AM | OTHER | HISPANIC | POP |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
G06007500123011000 | G0600750012301 | 6075 | 6 | 75 | 12301 | 1000 | 28 | 11 | 25 | 2 | 2 | 5 | 73 |
G06007500123011001 | G0600750012301 | 6075 | 6 | 75 | 12301 | 1001 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
G06007500123011002 | G0600750012301 | 6075 | 6 | 75 | 12301 | 1002 | 22 | 8 | 90 | 1 | 5 | 2 | 128 |
G06007500123011003 | G0600750012301 | 6075 | 6 | 75 | 12301 | 1003 | 5 | 2 | 4 | 0 | 0 | 4 | 15 |
G06007500123011004 | G0600750012301 | 6075 | 6 | 75 | 12301 | 1004 | 1 | 2 | 0 | 0 | 0 | 1 | 4 |
G06007500123011005 | G0600750012301 | 6075 | 6 | 75 | 12301 | 1005 | 395 | 211 | 234 | 7 | 37 | 258 | 1142 |
G06007500123011006 | G0600750012301 | 6075 | 6 | 75 | 12301 | 1006 | 43 | 10 | 93 | 0 | 4 | 9 | 159 |
G06007500123012000 | G0600750012301 | 6075 | 6 | 75 | 12301 | 2000 | 372 | 72 | 401 | 6 | 41 | 321 | 1213 |
G06007500123021000 | G0600750012302 | 6075 | 6 | 75 | 12302 | 1000 | 453 | 55 | 259 | 11 | 46 | 118 | 942 |
G06007500123021001 | G0600750012302 | 6075 | 6 | 75 | 12302 | 1001 | 368 | 72 | 220 | 3 | 42 | 116 | 821 |
G06007500123022000 | G0600750012302 | 6075 | 6 | 75 | 12302 | 2000 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
G06007500123022001 | G0600750012302 | 6075 | 6 | 75 | 12302 | 2001 | 60 | 18 | 31 | 0 | 4 | 26 | 139 |
G06007500123022002 | G0600750012302 | 6075 | 6 | 75 | 12302 | 2002 | 123 | 13 | 269 | 1 | 8 | 34 | 448 |
G06007500123022003 | G0600750012302 | 6075 | 6 | 75 | 12302 | 2003 | 111 | 9 | 36 | 1 | 7 | 27 | 191 |
G06007500123022004 | G0600750012302 | 6075 | 6 | 75 | 12302 | 2004 | 134 | 71 | 136 | 5 | 10 | 35 | 391 |
G06007500123022005 | G0600750012302 | 6075 | 6 | 75 | 12302 | 2005 | 58 | 4 | 60 | 1 | 2 | 16 | 141 |
<- c("WHITE", "BLACK", "ASIAN", "HISPANIC", "AM", "OTHER") list_race
<- apply(dat[,list_race], 2, sum, na.rm = TRUE) races_all
races_all
## WHITE BLACK ASIAN HISPANIC AM OTHER
## 2173 558 1858 972 38 208
= sum(races_all) pop
<- races_all/sum(races_all)
perc_all round(perc_all*100, 2)
## WHITE BLACK ASIAN HISPANIC AM OTHER
## 37.42 9.61 32.00 16.74 0.65 3.58
Entropia jest miarą zróżnicowania całego obszaru (np. hrabstwa). Musimy zatem najpierw zsumować dane dotyczące struktury rasowo-etnicznej całego obszaru, a następnie obliczyć odsetek poszczególnych ras w ogólnej liczbie ludności.
<- apply(dat[,list_race], 2, sum, na.rm = TRUE) #races_all zawiera liczbę osob wg ras dla całego obszaru
races_all <- races_all/sum(races_all) #Odseted osob poszczegolnych ras dla calego obszaru
perc <- perc[list_race] #wybierz tylko wartosci dla ras
perc perc
## WHITE BLACK ASIAN HISPANIC AM OTHER
## 0.374203547 0.096090925 0.319958671 0.167384191 0.006543826 0.035818839
Wektor perc zawiera dane, które należy podstawić do obliczenia entropii.
<- entropy_fnc(perc)
ent ent
## [1] 1.408882
<- entropy_std_fnc(perc)
ent_std ent_std
## [1] 0.7863122
= dat[, list_race]
races = hindex(races)
h h
## [1] 0.04788728
<- d_ind(dat$WHITE, dat$BLACK) d_wb
<- d_ind(dat$WHITE, dat$ASIAN) d_wa
<- d_ind(dat$WHITE, dat$HISPANIC) d_wl
<- round(c(entropia = ent, entropia_std = ent_std, H = h, Dwb = d_wb, Dwa = d_wa, Dwl = d_wl), 3)
out_ct out_ct
## entropia entropia_std H Dwb Dwa Dwl
## 1.409 0.786 0.048 0.282 0.219 0.245
Wyniki zostaną zapisane w pliku tekstowym, w folderze results. Proszę nazwać plik [nazwa_habstwa]_[rok]seg_div_metric_block.txt lub [nazwa_habstwa][rok]_seg_div_metric_ct.txt dla obszarów spisowych.
sink('results/seg_div_metric_block.txt')
perc_all
## WHITE BLACK ASIAN HISPANIC AM OTHER
## 0.374203547 0.096090925 0.319958671 0.167384191 0.006543826 0.035818839
races_all
## WHITE BLACK ASIAN HISPANIC AM OTHER
## 2173 558 1858 972 38 208
out_ct
## entropia entropia_std H Dwb Dwa Dwl
## 1.409 0.786 0.048 0.282 0.219 0.245
sink()
Proszę samodzielnie powtórzyć powyższe obliczenia używając danych zaagregowanych do obszarów spisowych (dane w ćwiczeniu 2 zapisane w pliku dane_attr/[nazwa_hrabstwa]_[rok]_tracts_attr.csv)