Test access index comparable across cities. Perhaps BFCA ?

[rafapereirabr]

Test BFCA sensitivity to:

• 1. city size

• 1.1 calcular BFCA medio de varias cidades considerando (1) numero absoluto, e (2) numero relativo de empregos. Checar se o ranking de cidades muda entre opcoes (1) e (2)

• 2. time threshold

• 2.1 para uma cidade, calcular BFCA com varios thresholds e ver como a distribuicao de acessibilidade entre hexagonos varia

[rafapereirabr]

@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]

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

[mvpsaraiva]

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.

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]

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.

[rafapereirabr]

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

[mvpsaraiva]

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

Vamos! Agora temos material suficiente pra conversar.

[rafapereirabr]

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]

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]

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]

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.

[rafapereirabr]

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]

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]

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.

• Allen, J., & Farber, S. (2020). A measure of competitive access to destinations for comparing across multiple study regions. Geographical analysis, 52(1), 69-86.
  • R code availabe here