inst/doc/areal-interpolation-comparison.R

In populR: Population Downscaling Using Areal Interpolation

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)


## ----sarea, fig.height = 5, fig.width = 5, fig.align = "center"---------------

# attach library
library(populR)

# load data
data('src')
data('trg')

source <- src
target <- trg

# plot data
plot(source['geometry'], col = "#634B56", border = NA)
plot(target['geometry'], col = "#FD8D3C", add = T)


## ----setup, message=FALSE, warning=FALSE--------------------------------------

# attach libraries 
library(populR)
library(areal)
library(sf)

# load data
data('src')
data('trg')

source <- src
target <- trg

# populR - awi
awi <- pp_estimate(target = target, source = source, spop = pop, sid = sid, 
                   method = awi)
# populR - vwi
vwi <- pp_estimate(target = target, source = source, spop = pop, sid = sid, 
                   volume = floors, method = vwi)

# areal - sum weights
aws <- aw_interpolate(target, tid = tid, source = source, sid = 'sid', 
                      weight = 'sum', output = 'sf', extensive = 'pop')
# areal - total weights
awt <- aw_interpolate(target, tid = tid, source = source, sid = 'sid', 
                      weight = 'total', output = 'sf', extensive = 'pop')

# sf - total weights
sf <- st_interpolate_aw(source['pop'], target, extensive = TRUE)


## -----------------------------------------------------------------------------

# sum initial values
sum(source$pop)

# populR - awi
sum(awi$pp_est)

# populR - vwi
sum(vwi$pp_est)

# areal - awt
sum(awt$pop)

# areal - aws
sum(aws$pop)

# sf
sum(sf$pop)



## -----------------------------------------------------------------------------

# order values using tid
awi <- awi[order(awi$tid),]
vwi <- vwi[order(vwi$tid),]

# get values and create a df
awi_values <- awi$pp_est
vwi_values <- vwi$pp_est

awt_values <- awt$pop
aws_values <- aws$pop

sf_values <- sf$pop

df <- data.frame(vwi = vwi_values, awi = awi_values, aws = aws_values,
                 awt = awt_values, sf = sf_values)

df[1:20,]


## -----------------------------------------------------------------------------

target


## -----------------------------------------------------------------------------
rf <- awi$rf

df <- cbind(rf, df)

df[1:20,]


## ----scatter, fig.height = 7, fig.width = 7.2, fig.align = "center", message=FALSE, warning=FALSE----

awi_error <- pp_compare(df, estimated = awi, actual = rf, title = "awi vs actual")
awi_error

vwi_error <- pp_compare(df, estimated = vwi, actual = rf, title = "vwi vs actual")
vwi_error

sf_error <- pp_compare(df, estimated = sf, actual = rf, title = "sf vs actual")
sf_error

awt_error <- pp_compare(df, estimated = awt, actual = rf, title = "awt vs actual")
awt_error

aws_error <- pp_compare(df, estimated = aws, actual = rf, title = "aws vs actual")
aws_error



## -----------------------------------------------------------------------------

library(microbenchmark)

# performance comparison
microbenchmark(
  suppressWarnings(pp_estimate(target = target, source = source, spop = pop, sid = sid, 
                   method = awi)),
  suppressWarnings(pp_estimate(target = target, source = source, spop = pop, sid = sid, 
                   volume = floors, method = vwi)),
  aw_interpolate(target, tid = tid, source = source, sid = 'sid', 
                      weight = 'sum', output = 'sf', extensive = 'pop'),
  aw_interpolate(target, tid = tid, source = source, sid = 'sid', 
                      weight = 'total', output = 'sf', extensive = 'pop'),
  suppressWarnings(st_interpolate_aw(source['pop'], target, extensive = TRUE))
)