search

ipeaGIT / acesso_oport

IPEA - Projeto Acesso a Oportunidades
https://www.ipea.gov.br/acessooportunidades/
51 stars 20 forks source link

Test access index comparable across cities. Perhaps BFCA ? #54

Open rafapereirabr opened 4 years ago

rafapereirabr commented 4 years ago

Test BFCA sensitivity to:

rafapereirabr commented 3 years ago

@mvpsaraiva , voce pode dar uma ajuda e fazer uns testes com o indicador do BFCA? O código para calcular o BFCA está nesse script entre linhas 117 a 187.

Minha sugestão seria calcular a média de acesso a empregos a pé para cada uma das 20 cidades do projeto (usando os dados anteriores de 2019 mesmo). A gente conversar depois sobre os detalhes como fazer o teste.

mvpsaraiva commented 3 years ago

Ok, vou fazer uns testes. Consegue me dar um 'assign'? A opção não aparece pra mim...

mvpsaraiva commented 3 years ago

Aparentemente o BFCA não resolve o problema da comparação entre cidades de tamanhos diferentes. O gráfico mostra várias mudanças de ranking entre as cidades quando se compara acessibilidade ao número absoluto de empregos ou ao percentual de empregos. Isso independente do time threshold e do uso da função binária ou gaussiana.

bfca_rank_avg

As correlações (Spearman rank correlation) também são bem baixas:

function 15 min 30 min 45 min 60 min
binary 0.293 0.211 0.114 0.0842
gaussian 0.304 0.0947 0.0812 0.0812
mvpsaraiva commented 3 years ago

Continuando os testes, agora incluindo a medida 2SFCA original, além das medidas cumulativa e gravitacional para comparação. O padrão segue mais ou menos o mesmo: correlação positiva entre acessibilidade e número de empregos, correlação negativa entre acessibilidade e % de empregos, e correlação próxima de zero entre as duas acessibilidades. Nesse ponto, a BFCA mostrou uma correlação um pouco maior entre # e % de empregos, porém ainda assim baixa.

access_cor_t30_mean

access_cor_t30_median

rafapereirabr commented 3 years ago

Boa. Acho que vale a pena provocarmos o Paez para um bate papo.

mvpsaraiva commented 3 years ago

Boa. Acho que vale a pena provocarmos o Paez para um bate papo.

Vamos! Agora temos material suficiente pra conversar.

rafapereirabr commented 3 years ago

Marcus, nos calculos que voce fez com BFCA considerando proporção de empregos, você usou população em termos absolutos? Ou tambem consideração proporção de população?

mvpsaraiva commented 3 years ago

Marcus, nos calculos que voce fez com BFCA considerando proporção de empregos, você usou população em termos absolutos? Ou tambem consideração proporção de população?

Usei sempre números absolutos na população, nem me dei conta de testar com valores relativos. Posso adaptar os scripts e testar, deve ser bem fácil. Acha que vale a pena?

rafapereirabr commented 3 years ago

Se for coisa rápida de rodar, acho que vale a pena sim. Eu estava pensando nisso ontem, e me parece que talvez faça sentido que no BFCA ou ambas variaives (pop e oportunidades) devem ser medidas da mesma maneira (ou em valores absolutos Ou em valores relativos).

mvpsaraiva commented 3 years ago

Nos gráficos abaixo, todas medidas tipo FCA calculadas com % de empregos também usam o % da população. Os resultados são interessantes: agora as correlações das medidas BFCA e PFCA % também são positivas, mesmo que mais baixas em relação às medidas com números absolutos de população e emprego. A medida 2SFCA ainda ainda tem correlação negativa ou nula.

access_cor_t30_median_v2

rafapereirabr commented 2 years ago

Resolvi pegar uma única cidade e fazer uns experimentos. Ainda não tem conclusao, e bem fiz todos cenários. Mas vou colando os cenários nos comentarios abaixo.

Cenario 1: duas cidades idênticas, mas uma delas tem 5x mais pessoas e escolas:

easypackages::libraries('r5r', 'data.table', 'ggplot2', 'forcats', 'magrittr')

# build transport network
data_path <- system.file("extdata/poa", package = "r5r")
r5r_core <- setup_r5(data_path = data_path, temp_dir = TRUE)

# load origin/destination points
points_small_city <- read.csv(file.path(data_path, "poa_hexgrid.csv"))

# create identical city with 5 times the number of people and schools
points_large_city <- as.data.table(points_small_city)
points_large_city[, population := population * 5] 
points_large_city[, schools := schools * 5]

# calculate accessibility from each origin
access_small <- accessibility(r5r_core,
                        origins = points_small_city,
                        destinations = points_small_city,
                        opportunities_colname = "schools",
                        mode = "TRANSIT",
                        decay_function = "step",
                        cutoffs = 60)

access_large <- accessibility(r5r_core,
                              origins = points_large_city,
                              destinations = points_large_city,
                              opportunities_colname = "schools",
                              mode = "TRANSIT",
                              decay_function = "step",
                              cutoffs = 60)

# count totals
total_pop_small <- sum(points_small_city$population) 
total_pop_large <- sum(points_large_city$population)

total_schools_small <- sum(points_small_city$schools) 
total_schools_large <- sum(points_large_city$schools) 

# same number of schools per person
total_schools_small / total_pop_small
total_schools_large / total_pop_large

# relative accessibility (proportion of schools accessible)
access_small[, access_rel := accessibility / total_schools_small ]
access_large[, access_rel := accessibility / total_schools_large ]

# bring pop info back
access_small[points_small_city, on=c('from_id'='id'), population := i.population]
access_large[points_large_city, on=c('from_id'='id'), population := i.population]

# average access of each city
df1 <- access_small[, .(size='small',
                        access_absl = weighted.mean(x=accessibility, w=population),
                        access_prop = weighted.mean(x=access_rel,    w=population),
                        access_norm = weighted.mean(x=accessibility, w=population) / total_pop_small
                        )]

df2 <- access_large[, .(size='large',
                        access_absl = weighted.mean(x=accessibility, w=population),
                        access_prop = weighted.mean(x=access_rel,    w=population),
                        access_norm = weighted.mean(x=accessibility, w=population) / total_pop_large
                        )]
# result
rbind(df1, df2)
#>     size access_absl access_prop   access_norm
#> 1: small    41.72254   0.2150646 0.00005132334
#> 2: large   208.61269   0.2150646 0.00005132334
rafapereirabr commented 2 years ago

Cenário 2: duas cidades onde uma é um recorte (um subset) territorial da outra (portanto menos populacao e menos escolas tambem)

easypackages::libraries('r5r', 'data.table', 'ggplot2', 'sfheaders')

# build transport network
data_path <- system.file("extdata/poa", package = "r5r")
r5r_core <- setup_r5(data_path = data_path, temp_dir = TRUE)

# load origin/destination points
points_large_city <- read.csv(file.path(data_path, "poa_hexgrid.csv"))
points_large_city_sf <- sfheaders::sf_point(points_large_city, x = 'lon', y='lat', keep = T)

# create small city by selecting points within a buffer around the city center
city_center <- subset(points_large_city_sf, id=='89a9012889bffff')
buff_small_city <- st_buffer(city_center, dist = 0.05)
points_small_city_sf <- st_intersection(points_large_city_sf, buff_small_city)
points_small_city <- subset(points_large_city, id %in% points_small_city_sf$id)

ggplot() +
   geom_sf(data=points_large_city_sf, color='gray') +
   geom_sf(data=points_small_city_sf, color='red')

# calculate accessibility from each origin
access_small <- accessibility(r5r_core,
                        origins = points_small_city,
                        destinations = points_small_city,
                        opportunities_colname = "schools",
                        mode = "TRANSIT",
                        decay_function = "step",
                        cutoffs = 60)

access_large <- accessibility(r5r_core,
                              origins = points_large_city,
                              destinations = points_large_city,
                              opportunities_colname = "schools",
                              mode = "TRANSIT",
                              decay_function = "step",
                              cutoffs = 60)

# count totals
total_pop_small <- sum(points_small_city$population) 
total_pop_large <- sum(points_large_city$population)

total_schools_small <- sum(points_small_city$schools) 
total_schools_large <- sum(points_large_city$schools) 

# same number of schools per person
total_schools_small / total_pop_small
total_schools_large / total_pop_large

# relative accessibility (proportion of schools accessible)
access_small[, access_rel := accessibility / total_schools_small ]
access_large[, access_rel := accessibility / total_schools_large ]

# bring pop info back
access_small[points_small_city, on=c('from_id'='id'), population := i.population]
access_large[points_large_city, on=c('from_id'='id'), population := i.population]

# average access of each city
df1 <- access_small[, .(size='small',
                        access_absl = weighted.mean(x=accessibility, w=population),
                        access_prop = weighted.mean(x=access_rel,    w=population),
                        access_norm = weighted.mean(x=accessibility, w=population) / total_pop_small
                        )]

df2 <- access_large[, .(size='large',
                        access_absl = weighted.mean(x=accessibility, w=population),
                        access_prop = weighted.mean(x=access_rel,    w=population),
                        access_norm = weighted.mean(x=accessibility, w=population) / total_pop_large
                        )]
rbind(df1, df2)
#>     size access_absl access_prop   access_norm
#> 1: small    44.24103   0.5027390 0.00012902623
#> 2: large    41.72254   0.2150646 0.00005132334
rafapereirabr commented 2 years ago

O Allen e Farber propuseram um indicador que, em tese, resolve o problema de viés de tamanho de cidade, mas acho q a gente precisa testar pra ver se resolve mesmo.