inst/doc/vulnerability_in_dar.R

In BSBT: The Bayesian Spatial Bradley--Terry Model

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

## ----setup, include = FALSE---------------------------------------------------
library(BSBT)

## ---- fig.width= 7, fig.height=7----------------------------------------------
data("dar.shapefiles")
library(sf)
plot(dar.shapefiles$geometry, lwd = 0.5)

## ----message=FALSE, warning=FALSE, paged.print=FALSE--------------------------
data("dar.adj.matrix")

## -----------------------------------------------------------------------------
data("dar.comparisons")

## -----------------------------------------------------------------------------
head(dar.comparisons)

## -----------------------------------------------------------------------------
win.matrix <- BSBT::comparisons_to_matrix(452, dar.comparisons)

## -----------------------------------------------------------------------------
k <- constrained_adjacency_covariance_function(dar.adj.matrix, type = "matrix", hyperparameters = c(1, 1), linear.combination = rep(1, 452), linear.constraint = 0)

## -----------------------------------------------------------------------------
data("mean.deprivation")

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

#Create Colour Scale
library(RColorBrewer)
red.green.colours <- brewer.pal(10, "RdYlGn")
bin.size <- (2.5-(-1.5))/10
bins <- bin.size*(1:10) - 1.5

#Bin Subwards by colour
dar.colours <- numeric(452)
for(j in 1:452){
  dar.colours[j] <- min(which(bins >= mean.deprivation[j]))
}

## ---- fig.width= 7, fig.height=7----------------------------------------------
oldpar <- par() #save current graphical parameter
par(fig=c(0,1,0.1,1))
plot(dar.shapefiles$geometry, col = red.green.colours[dar.colours], lwd = 0.25)
par(fig=c(0.1,0.9,0.2,0.25), mar = rep(0.2, 4), new = TRUE)
image(1:10, 1, as.matrix(1:10), col = brewer.pal(10, "RdYlGn"),
      xlab = "", ylab = "", xaxt = "n", yaxt = "n",
      bty = "n")
axis(1, at = seq(0.5, 10.5, 1), labels = round(c(-1.5, bins), 2.5), lty = 0)
par(fig = oldpar$fig) #reset graphical parameters

## -----------------------------------------------------------------------------
male.comparisons <- dar.comparisons[dar.comparisons$gender == "male", ]
female.comparisons <- dar.comparisons[dar.comparisons$gender == "female", ]

male.win.matrix <- matrix(0, 452, 452)
for(j in 1:dim(male.comparisons)[1])
  male.win.matrix[male.comparisons[j, 1], male.comparisons[j, 2]] <- male.win.matrix[male.comparisons[j, 1], male.comparisons[j, 2]] + 1

female.win.matrix <- matrix(0, 452, 452)
for(j in 1:dim(female.comparisons)[1])
  female.win.matrix[female.comparisons[j, 1], female.comparisons[j, 2]] <- female.win.matrix[female.comparisons[j, 1], female.comparisons[j, 2]] + 1

## -----------------------------------------------------------------------------
k <- constrained_adjacency_covariance_function(dar.adj.matrix, type = "matrix", hyperparameters = c(1, 1), linear.combination = rep(1, 452), linear.constraint = 0)

## -----------------------------------------------------------------------------
data("male.mean.deprivation")
data("female.mean.deprivation")

g <- female.mean.deprivation - male.mean.deprivation

bin.size <- (max(2.01*g) - min(2*g))/10
bins <- bin.size*(1:10) + min(2*g)
diff.colours <- numeric(452)
for(j in 1:452)
  diff.colours[j] <- min(which(bins >= 2*g[j]))

oldpar <- par() #save current graphical parameter
par(fig=c(0,1,0.1,1))
plot(dar.shapefiles$geometry, col = red.green.colours[diff.colours], lwd = 0.25)
par(fig=c(0.1,0.9,0.2,0.25), mar = rep(0.2, 4), new = TRUE)
image(1:10, 1, as.matrix(1:10), col = brewer.pal(10, "RdYlGn"),
      xlab = "", ylab = "", xaxt = "n", yaxt = "n",
      bty = "n")
axis(1, at = seq(0.5, 10.5, 1), labels = round(c(min(2*g), bins), 1), lty = 0)
par(fig = oldpar$fig) #reset graphical parameters