Advertisement
Guest User

Untitled

a guest
Aug 19th, 2019
80
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.88 KB | None | 0 0
  1. library(mgcv)
  2. library(raster)
  3. library(magrittr)
  4. library(sp)
  5.  
  6. # Generate a dummy probability surface using Swaziland as an example
  7. swz_elev <- raster::getData('alt', country="SWZ")
  8. swz_prob <- swz_elev / cellStats(swz_elev, max)
  9.  
  10. # Generate some random points to act as sampling sites
  11. candidate_sites <- coordinates(swz_elev)[which(!is.na(swz_elev[])),]
  12. sample_pixels <- sample(1:nrow(candidate_sites), 100)
  13. sampling_sites <- candidate_sites[sample_pixels,] %>% as.data.frame()
  14.  
  15. # Take a binomial sample of 100 at each site
  16. sampling_sites$prob <- raster::extract(swz_prob, sampling_sites[,c("x", "y")])
  17. sampling_sites$n_pos <- rbinom(100, 100, sampling_sites$prob )
  18. sampling_sites$n_neg <- 100 - sampling_sites$n_pos
  19.  
  20. # Fit a GAM with bivaruate smooth on lat/lng
  21. gam_mod <- gam(cbind(n_pos, n_neg) ~ s(x, y, bs="gp"),
  22. data = sampling_sites,
  23. family = "binomial")
  24.  
  25. # Look at predicted mean
  26. prediction_data <- as.data.frame(candidate_sites)
  27. predicted_prob <- predict(gam_mod, prediction_data, type="response")
  28. predicted_prob_raster <- swz_elev
  29. predicted_prob_raster[which(!is.na(swz_elev[]))] <- predicted_prob
  30. plot(predicted_prob_raster)
  31.  
  32. # Simulate from the posterior
  33. Cg <- predict(gam_mod, prediction_data, type = "lpmatrix")
  34. sims <- rmvn(1000, mu = coef(gam_mod), V = vcov(gam_mod, unconditional = TRUE))
  35. fits <- Cg %*% t(sims)
  36. fits_prob <- exp(fits) / (1 + exp(fits))
  37.  
  38. #### Aggregate simulated values over districts
  39. # Get district boundary polygons
  40. swz_districts <- raster::getData("GADM", level=2, country="SWZ")
  41.  
  42. # Identify which district each pixel is in
  43. which_district <- sp::over(SpatialPoints(prediction_data, proj4string = crs(swz_districts)), swz_districts)
  44.  
  45. # Calculate the district mean per draw from the posterior
  46. district_posterior <- apply(fits_prob, 2, function(x){tapply(x, which_district$GID_2, mean)})
  47.  
  48. # Look at the posterior for the first district
  49. hist(district_posterior[1,])
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement