├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── r.yml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS.md ├── R ├── QA.R ├── build_files.R ├── calRaster.R ├── getIsoscapes.R ├── isoStack.R ├── oddsRatio.R ├── pdRaster.R ├── plot.QA.R ├── qtlRaster.R ├── refTrans.R ├── subOrigData.R ├── summarize.R ├── sysdata.rda └── wDist.R ├── README.md ├── Rmarkdown ├── body.Rmd ├── bound │ └── assignR.Rmd ├── cran_header.Rmd ├── dev_header.Rmd └── renderVignette.R ├── assignR.Rproj ├── cran-comments.md ├── data-raw ├── ham.xlsx ├── hstds.xlsx ├── knownOrig0_2.xlsx ├── ko_past_versions │ └── knownOrig0_1.xlsx ├── oam.xlsx ├── ostds.xlsx └── prep_data.R ├── data └── stds.rda ├── docs ├── IsoEcol21vignette.html └── index.html ├── inst ├── CITATION └── extdata │ ├── d2h_lrNA.tif │ ├── knownOrig_samples.csv │ ├── knownOrig_sites.cpg │ ├── knownOrig_sites.dbf │ ├── knownOrig_sites.prj │ ├── knownOrig_sites.shp │ ├── knownOrig_sites.shx │ ├── knownOrig_sources.csv │ ├── naMap.cpg │ ├── naMap.dbf │ ├── naMap.prj │ ├── naMap.shp │ ├── naMap.shx │ ├── sr_MI.tif │ ├── states.cpg │ ├── states.dbf │ ├── states.prj │ ├── states.shp │ ├── states.shx │ ├── wrld_simpl.cpg │ ├── wrld_simpl.dbf │ ├── wrld_simpl.prj │ ├── wrld_simpl.shp │ └── wrld_simpl.shx ├── man ├── QA.rd ├── assignR.Rd ├── c.wDist.Rd ├── calRaster.Rd ├── d2h_lrNA.Rd ├── getIsoscapes.Rd ├── isoStack.Rd ├── jointP.Rd ├── knownOrig.Rd ├── naMap.Rd ├── oddsRatio.Rd ├── pdRaster.Rd ├── plot.QA.Rd ├── plot.isoStack.Rd ├── plot.wDist.Rd ├── qtlRaster.Rd ├── refTrans.Rd ├── sr_MI.Rd ├── states.Rd ├── stds.Rd ├── subOrigData.Rd ├── unionP.Rd ├── wDist.Rd └── wrld_simpl.Rd ├── manuscripts ├── Ma_2020_MEE │ ├── MEE_script.R │ └── states_shapefile │ │ ├── states.dbf │ │ ├── states.prj │ │ ├── states.sbn │ │ ├── states.sbx │ │ ├── states.shp │ │ ├── states.shp.xml │ │ └── states.shx └── Magozzi_2021_MEE │ └── data_analysis.R ├── tests ├── testthat.R └── testthat │ ├── .gitignore │ ├── test_getIsoscapes.R │ ├── test_pdRaster.R │ ├── test_plot.QA.R │ ├── test_plot.isoStack.R │ ├── test_processing.R │ └── test_refTrans.R └── vignettes └── assignR.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^Rmarkdown$ 2 | ^docs$ 3 | ^data-raw$ 4 | ^n3qafliajlfewe$ 5 | ^cran-comments\.md$ 6 | ^CRAN-RELEASE$ 7 | ^manuscripts$ 8 | <<<<<<< HEAD 9 | ^.*\.Rproj$ 10 | ^\.Rproj\.user$ 11 | ======= 12 | ^codecov\.yml$ 13 | >>>>>>> 79146b21e9e5f977d8ddab23bba1f84504844c48 14 | ^doc$ 15 | ^Meta$ 16 | ^\.github$ 17 | ^CRAN-SUBMISSION$ 18 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/r.yml: -------------------------------------------------------------------------------- 1 | name: R 2 | 3 | on: 4 | 5 | push: 6 | branches: [ master ] 7 | 8 | pull_request: 9 | branches: [ master ] 10 | 11 | jobs: 12 | build: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | strategy: 16 | fail-fast: false 17 | matrix: 18 | config: 19 | - {os: macOS-latest, r: 'release'} 20 | - {os: ubuntu-latest, r: 'release'} 21 | - {os: windows-latest, arch: x64, r: 'devel'} 22 | # - {os: windows-latest, r: '4.0.0'} 23 | 24 | steps: 25 | - name: Run checkout 26 | uses: actions/checkout@v4 27 | 28 | - name: Set up pandoc 29 | uses: r-lib/actions/setup-pandoc@v2 30 | 31 | - name: Set up R ${{ matrix.config.r }} 32 | uses: r-lib/actions/setup-r@v2 33 | with: 34 | r-version: ${{ matrix.config.r }} 35 | use-public-rspm: true 36 | 37 | - name: Mac setup 38 | if: runner.os == 'macOS' 39 | run: brew install gdal 40 | 41 | - name: Linux setup 42 | if: runner.os == 'Linux' 43 | run: | 44 | sudo apt-get install libcurl4-openssl-dev 45 | sudo apt-get install gdal-bin proj-bin libgdal-dev libproj-dev 46 | 47 | - name: Install dependencies 48 | uses: r-lib/actions/setup-r-dependencies@v2 49 | with: 50 | extra-packages: any::rcmdcheck 51 | 52 | - name: Check package 53 | uses: r-lib/actions/check-r-package@v2 54 | with: 55 | error-on: '"error"' 56 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | on: 2 | push: 3 | branches: 4 | - master 5 | pull_request: 6 | branches: 7 | - master 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: macOS-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v3 18 | 19 | - uses: r-lib/actions/setup-r@v2 20 | 21 | - name: Install gdal 22 | run: | 23 | find /usr/local/bin -type l -ilname '*/Library/Frameworks/Python.framework/*' -delete 24 | brew install gdal 25 | 26 | - uses: r-lib/actions/setup-r-dependencies@v2 27 | 28 | - name: Test coverage 29 | run: covr::codecov() 30 | shell: Rscript {0} 31 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # used in tests 25 | n3qafliajlfewe/* 26 | 27 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 28 | .httr-oauth 29 | 30 | # knitr and R markdown default cache directories 31 | /*_cache/ 32 | /cache/ 33 | 34 | # Temporary files created by R markdown 35 | *.utf8.md 36 | *.knit.md 37 | 38 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 39 | rsconnect/ 40 | doc 41 | Meta 42 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: assignR 2 | Type: Package 3 | Title: Infer Geographic Origin from Isotopic Data 4 | Version: 2.4.3.9000 5 | Authors@R: c(person(given = "Chao", 6 | family = "Ma", 7 | role = "aut"), 8 | person(given = "Gabe", 9 | family = "Bowen", 10 | role = c("aut", "cre"), 11 | email = "gabe.bowen@utah.edu")) 12 | Description: Routines for re-scaling isotope maps using known-origin tissue isotope data, assigning origin of unknown samples, and summarizing and assessing assignment results. Methods are adapted from Wunder (2010, in ISBN:9789048133536) and Vander Zanden, H. B. et al. (2014) as described in Ma, C. et al. (2020) . 13 | Imports: mvnfast, rlang, geosphere, terra (>= 1.7-23) 14 | Depends: R (>= 4.0) 15 | Suggests: knitr, rmarkdown, testthat, covr 16 | VignetteBuilder: knitr 17 | License: GPL-3 18 | Language: en-US 19 | Encoding: UTF-8 20 | LazyData: true 21 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | export(calRaster) 2 | export(getIsoscapes) 3 | export(jointP) 4 | export(oddsRatio) 5 | export(pdRaster) 6 | S3method(pdRaster,default) 7 | S3method(pdRaster,isoStack) 8 | export(isoStack) 9 | export(QA) 10 | export(qtlRaster) 11 | export(refTrans) 12 | export(subOrigData) 13 | export(unionP) 14 | export(wDist) 15 | S3method(plot,QA) 16 | S3method(plot,isoStack) 17 | S3method(plot,wDist) 18 | S3method(c,wDist) 19 | importFrom(terra, rast, extract, values, setValues, nlyr, crop, mask, global, 20 | vect, writeRaster, compareGeom, project, lapp, ext, intersect, 21 | crs, "crs<-", cells, resample, as.points, distance, geom, plot, 22 | geomtype, same.crs, "values<-", ncell, merge, points, res, crds) 23 | importFrom(grDevices, dev.off, pdf, png, col2rgb, rgb) 24 | importFrom(graphics, abline, boxplot, legend, lines, par, text, title, 25 | polygon) 26 | importFrom(stats, coef, cov, cor, dnorm, lm, median, na.omit, rnorm, sd, var, 27 | density, weighted.mean, quantile) 28 | importFrom(utils, data, download.file, setTxtProgressBar, txtProgressBar, 29 | tail, unzip, read.csv) 30 | importFrom(mvnfast, dmvn) 31 | importFrom(rlang, cnd_muffle) 32 | importFrom(geosphere, bearing) -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # assignR news 2 | 3 | ## assignR 2.4.3.9000 4 | 5 | ## assignR 2.4.3 6 | * Bug fixes and enhanced error checking 7 | * Requires R >= 4.0 8 | 9 | ## assignR 2.4.1 10 | * Single site can be provided in wDist and will be recycled with a message 11 | * wDist allows specification of bandwidth for kernel density estimation 12 | * Bug fixes 13 | 14 | ## assignR 2.4.0 15 | * Updates and fixes in the knownOrig database (v 0.2) 16 | * Added download of global bioavailable Sr and USA groundwater H and O isotopes in getIsoscapes 17 | * Bug fixes 18 | 19 | ## assignR 2.3.0 20 | * Transitioned spatial dependencies to terra package; all functions still accept raster and sp objects for backward compatibility, but users are encouraged to move their workflows to terra 21 | * Instituted versioning of the knownOrig database (v 0.1) 22 | * Performance improvements for large QA jobs 23 | * Bug fixes 24 | 25 | ## assignR 2.2.3 26 | * Bug fixes 27 | 28 | ## assignR 2.2.2 29 | * Updated error handling in getIsoscapes 30 | 31 | ## assignR 2.2.1 32 | * Remove data from projects 14 and 15 from knownOrig dataset 33 | 34 | ## assignR 2.2.0 35 | * Add wDist function and c and plot methods for summarizing weighted distance and bearing distributions using sample collection locations and posterior probability maps 36 | * QA option to run without iterative recalibration of isoscape 37 | * Bug fixes 38 | * Documentation edits 39 | 40 | ## assignR 2.1.1 41 | * Bug fixes 42 | 43 | ## assignR 2.1.0 44 | * Add isoStack function to stack multiple isoscapes in a single data object; added plot s3 method for this class 45 | * Add getIsoscape function supporting download of gridded isotope maps; removed global precipitation maps previously distributed with package 46 | * Update pdRaster and QA to support multivariate analysis 47 | * Add option to include spatial prior in QA 48 | * Bug fixes 49 | 50 | ## assignR 2.0.0 51 | 52 | * knownOrig database has been expanded and reformatted 53 | * New data objects document different calibration standards used to generate known-origin H and O isotope data 54 | * subOrigData supports transformation of data among different calibration standard scales using the 'standard-chain' method of Magozzi et al. (in press); format of return object from this function has changed 55 | * calRaster changes including new format for input object "known" and use of weighted least squares regression; tissue isoscape variance calculation updated to a + b - c, where a is isoscape grid cell variance, b is the residual variance of tissue predictions made from isoscape-tissue rescaling functions fit using values sampled from the isoscape with noise, and c is the variance of the sampled isoscape values 56 | * QA changes including new format for input object "known" and option to resample known data by site rather than by sample; for bySite option returned results are the average of site-level average statistics; argument order changed for consistency with calRaster 57 | * sp objects updated to support WKT2_2019 strings 58 | 59 | ## assignR 1.2.1 60 | 61 | * Updates to ensure compatibility with new CRS specifications in rgdal 62 | * QA now accepts optional argument "by", allowing reduced run-time 63 | 64 | ## assignR 1.2.0 65 | 66 | * NAMESPACE imports required functions only 67 | * Implemented testthat testing 68 | * Minor corrections to knownOrig data 69 | * Minor enhancements and bug fixes 70 | 71 | ## assignR 1.1.3.1 72 | 73 | * Data update: remove plover maps, add US states 74 | 75 | ## assignR 1.1.3 76 | 77 | * Shorter run-time for vignette examples 78 | 79 | ## assignR 1.1.2 80 | 81 | * Functional examples for QA 82 | * Improved handling of graphical parameters in plotting functions 83 | * Bug fixes 84 | 85 | ## assignR 1.1.1 86 | 87 | * Consistent syntax for saving output to disk, which requires explicit specification of directory 88 | * Improved messaging from functions 89 | * Bug fixes 90 | 91 | ## assignR 1.1 92 | 93 | * Propagation of error covariance in isoscape and rescaling models removes source of bias in posterior probabilities 94 | * plot.QA converted to S3 method 95 | * Bug and code fixes to pass CRAN check 96 | 97 | ## assignR 1.0 98 | 99 | Initial GitHUB release 100 | -------------------------------------------------------------------------------- /R/QA.R: -------------------------------------------------------------------------------- 1 | QA = function(known, isoscape, bySite = TRUE, valiStation = 1, 2 | valiTime = 50, recal = TRUE, by = 2, prior = NULL, 3 | mask = NULL, setSeed = TRUE, name = NULL){ 4 | 5 | #space to handle messages and warnings 6 | mstack = wstack = character(0) 7 | addm = function(cnd){ 8 | mstack <<- append(mstack, cnd$message) 9 | cnd_muffle(cnd) 10 | } 11 | addw = function(cnd){ 12 | wstack <<- append(wstack, cnd$message) 13 | cnd_muffle(cnd) 14 | } 15 | 16 | #check bySite 17 | if(!is.logical(bySite)){ 18 | stop("bySite must be logical") 19 | } 20 | 21 | #check isoscape and set ni number of isotopes 22 | if(inherits(isoscape, "isoStack")){ 23 | ni = length(isoscape) 24 | 25 | for(i in 1:ni){ 26 | if(inherits(isoscape[[i]], c("RasterStack", "RasterBrick"))){ 27 | warning("raster objects are depreciated, transition to package terra") 28 | if(inherits(i, "RasterStack")){ 29 | crs(isoscape[[i]][[1]]) = crs(isoscape[[i]][[2]]) = 30 | crs(isoscape[[i]]) 31 | } 32 | isoscape[[i]] = rast(isoscape[[i]]) 33 | } 34 | if(nlyr(isoscape[[i]]) != 2) { 35 | stop("Input isoscapes should be SpatRaster with two layers 36 | (mean and standard deviation)") 37 | } 38 | } 39 | } else{ 40 | ni = 1 41 | 42 | if(inherits(isoscape, "rescale")){ 43 | isoscape = isoscape$isoscape.rescale 44 | } 45 | 46 | if(inherits(isoscape, c("RasterStack", "RasterBrick"))) { 47 | warning("raster objects are depreciated, transition to package terra") 48 | isoscape = rast(isoscape) 49 | } 50 | 51 | if(inherits(isoscape, "SpatRaster")){ 52 | if(crs(isoscape) == "") { 53 | stop("isoscape must have valid coordinate reference system") 54 | } 55 | if(nlyr(isoscape) != 2){ 56 | stop("Input isoscape should be SpatRaster with two layers 57 | (mean and standard deviation)") 58 | } 59 | } else { 60 | stop("isoscape should be a SpatRaster") 61 | } 62 | } 63 | 64 | #check known for multi-isotope 65 | if(ni > 1){ 66 | #two options for ni>1, list of SODs, check and unpack each to SpatVector 67 | if(inherits(known, "list")){ 68 | if(length(known) != ni){ 69 | stop("length of known must equal length of isoStack") 70 | } 71 | #convert each SOD into SpatVector 72 | for(i in 1:ni){ 73 | known[[i]] = withCallingHandlers( 74 | message = addm, 75 | warning = addw, 76 | check_SOD(known[[i]], isoscape[[i]], bySite) 77 | ) 78 | } 79 | #merge by sample - ?support partial data? 80 | k.spdf = known[[1]] 81 | kmlen = length(known[[1]]) 82 | for(i in 2:ni){ 83 | k.spdf = merge(k.spdf, known[[i]], by = "Sample_ID", 84 | all.x = FALSE) 85 | if(bySite){ 86 | if(!all(k.spdf$Site_ID.x == k.spdf$Site_ID.y)){ 87 | stop("different Site_ID values for same samples") 88 | } 89 | k.spdf = k.spdf[, names(k.spdf) != "Site_ID.x"] 90 | names(k.spdf)[names(k.spdf) == "Site_ID.y"] = "Site_ID" 91 | } 92 | #move Sample_IDs to last column 93 | k.spdf = cbind(k.spdf[,-1], k.spdf[1]) 94 | kmlen = max(kmlen, length(known[[i]])) 95 | } 96 | if(length(k.spdf) != kmlen){ 97 | warning(paste("non-matching samples in known,", length(k.spdf), 98 | "of", kmlen, "samples being used")) 99 | } 100 | known = k.spdf 101 | } 102 | #if ni == 1 103 | } else{ 104 | if(inherits(known, "subOrigData")){ 105 | known = withCallingHandlers( 106 | message = addm, 107 | warning = addw, 108 | check_SOD(known, isoscape, bySite) 109 | ) 110 | } 111 | } 112 | 113 | #SOD or SOD list will now be converted to this 114 | if(inherits(known, "SpatVector")){ 115 | known = withCallingHandlers( 116 | message = addm, 117 | warning = addw, 118 | if(ni > 1){ 119 | check_SV(known, isoscape[[1]], bySite, ni) 120 | } else{ 121 | check_SV(known, isoscape, bySite, ni) 122 | } 123 | ) 124 | } else{ 125 | stop("invalid object provided for known") 126 | } 127 | 128 | #check recal 129 | if(!inherits(recal, "logical")){ 130 | stop("recal must be logical") 131 | } 132 | if(!recal){ 133 | valiTime = nrow(known) 134 | valiStation = 1 135 | bySite = FALSE 136 | } 137 | 138 | #check valiTime 139 | if(valiTime < 2){ 140 | stop("valiTime must be an integer greater than 1") 141 | } 142 | 143 | #check by 144 | if(!(as.integer(by) == by) || by < 1 || by > 25){ 145 | stop("by must be an integer between 1 and 25") 146 | } 147 | 148 | #check name 149 | if(!is.null(name)){ 150 | if(!inherits(name, "character")){ 151 | stop("name must be a character string") 152 | } 153 | } 154 | 155 | #check setSeed 156 | if(!is.logical(setSeed)){ 157 | stop("setSeed must be logical") 158 | } 159 | if(setSeed){ 160 | set.seed(100) 161 | } 162 | 163 | #check and apply mask 164 | if(!is.null(mask)){ 165 | if(ni > 1){ 166 | mask = check_mask(mask, isoscape[[1]]) 167 | for(i in seq_len(ni)){ 168 | isoscape[[i]] = mask(isoscape[[i]], mask) 169 | isoscape[[i]] = crop(isoscape[[i]], mask) 170 | } 171 | } else{ 172 | mask = check_mask(mask, isoscape) 173 | isoscape = mask(isoscape, mask) 174 | isoscape = crop(isoscape, mask) 175 | } 176 | } 177 | 178 | #remove samples that fall off isoscape 179 | if(ni > 1){ 180 | kbad = is.na(apply(extract(isoscape[[i]], known, ID = FALSE), 181 | 1, sum)) 182 | } else{ 183 | kbad = is.na(apply(extract(isoscape, known, ID = FALSE), 1, sum)) 184 | } 185 | if(any(kbad)){ 186 | wtxt = paste("No isoscape values found at the following", sum(kbad), "locations:\n") 187 | for(i in seq_along(kbad)){ 188 | if(kbad[i]){ 189 | wtxt = paste0(wtxt, geom(known)[i, 3], ", ", geom(known)[i, 4], "\n") 190 | } 191 | } 192 | warning(wtxt) 193 | known = known[!kbad] 194 | } 195 | 196 | #check valiStation 197 | if(bySite){ 198 | if(valiStation > (length(unique(known$Site_ID)) - 3)){ 199 | stop("for bySite = TRUE valiStation must be 3 or more smaller 200 | than the number of unique sites in known") 201 | } 202 | } else{ 203 | if(valiStation > (nrow(known) - 3)){ 204 | stop("for bySite = FALSE valiStation must be 3 or more smaller 205 | than the number of samples in known") 206 | } 207 | } 208 | 209 | if(bySite){ 210 | rowLength = length(unique(known$Site_ID)) 211 | ids = known$Site_ID 212 | } else{ 213 | rowLength = nrow(known) 214 | ids = seq_len(rowLength) 215 | } 216 | if(recal){ 217 | val_stations = sort(sample(ids, valiStation, replace = FALSE)) 218 | for (i in seq_len(valiTime)[-1]){ 219 | val_stations = rbind(val_stations, 220 | sort(sample(ids, valiStation, 221 | replace = FALSE))) 222 | } 223 | } else{ 224 | val_stations = matrix(ids, nrow = rowLength) 225 | } 226 | 227 | xx = seq(1, 101, by) 228 | if(tail(xx, 1) != 101){ 229 | xx = c(xx, 101) 230 | } 231 | prption_byProb = matrix(0, valiTime, length(xx)) 232 | prption_byArea = matrix(0, valiTime, length(xx)) 233 | pd_v = matrix(0, valiTime, valiStation) 234 | precision = list() 235 | 236 | # create progress bar 237 | pb = txtProgressBar(min = 0, max = valiTime, style = 3) 238 | 239 | # total area 240 | if(ni > 1){ 241 | Tarea = min(global(isoscape[[1]], "notNA")) 242 | } else{ 243 | Tarea = min(global(isoscape, "notNA")) 244 | } 245 | 246 | for (i in seq_len(valiTime)){ 247 | if(bySite){ 248 | v = known[known$Site_ID %in% val_stations[i,],] 249 | m = known[-(known$Site_ID %in% val_stations[i,]),] 250 | } else{ 251 | v = known[val_stations[i,],] 252 | m = known[-val_stations[i,],] 253 | } 254 | 255 | if(recal){ 256 | if(ni > 1){ 257 | rescales = list() 258 | for(j in 1:ni){ 259 | m_sub = m[,(j * 2 - 1):(j * 2)] 260 | class(m_sub) = "QAData" 261 | rescales[[j]] = withCallingHandlers( 262 | message = addm, 263 | warning = addw, 264 | calRaster(m_sub, isoscape[[j]], genplot = FALSE, 265 | verboseLM = FALSE)[[1]] 266 | ) 267 | } 268 | rescale = isoStack(rescales) 269 | } else{ 270 | class(m) = "QAData" 271 | rescale = withCallingHandlers( 272 | message = addm, 273 | warning = addw, 274 | calRaster(m, isoscape, genplot = FALSE, 275 | verboseLM = FALSE) 276 | ) 277 | } 278 | } else{ 279 | rescale = isoscape 280 | } 281 | 282 | pd = withCallingHandlers( 283 | message = addm, 284 | warning = addw, 285 | pdRaster(rescale, unknown = 286 | cbind("ID" = seq_along(v), 287 | values(v[,seq(1, ni*2-1, by=2)])), 288 | prior = prior, genplot = FALSE) 289 | ) 290 | 291 | # pd value for each validation sample or site 292 | pd_temp = diag(extract(pd, v, ID = FALSE, raw = TRUE)) 293 | 294 | if(bySite){ 295 | for(j in seq(valiStation)){ 296 | pd_v[i, j] = mean(pd_temp[v$Site_ID == val_stations[i, j]]) 297 | } 298 | } else{ 299 | pd_v[i,] = pd_temp 300 | } 301 | 302 | # spatial precision and accuracy by checking top percentage by cumulative prob. 303 | precision[[i]] = matrix(0, length(xx), valiStation) 304 | 305 | for(j in seq_along(xx)){ 306 | qtl = qtlRaster(pd, threshold = (xx[j]-1)/100, thresholdType = "prob", 307 | genplot = FALSE) 308 | rv_temp = diag(extract(qtl, v, ID = FALSE, raw = TRUE)) 309 | pre_temp = global(qtl, "sum", na.rm = TRUE) / Tarea 310 | if(bySite){ 311 | rv_sm = double(valiStation) 312 | for(k in seq(valiStation)){ 313 | rv_sm[k] = mean(rv_temp[v$Site_ID == val_stations[i, k]]) 314 | precision[[i]][j, k] = mean(pre_temp[v$Site_ID == 315 | val_stations[i, k], 1]) 316 | } 317 | prption_byProb[i, j] = mean(rv_sm) 318 | } else{ 319 | prption_byProb[i, j] = mean(rv_temp) 320 | precision[[i]][j,] = pre_temp[,] 321 | } 322 | } 323 | 324 | # sensitivity by checking top percentage by cumulative area 325 | for(j in seq_along(xx)){ 326 | qtl = qtlRaster(pd, threshold = (xx[j]-1)/100, thresholdType = "area", 327 | genplot = FALSE) 328 | rv_temp = diag(extract(qtl, v, ID = FALSE, raw = TRUE)) 329 | if(bySite){ 330 | rv_sm = double(valiStation) 331 | for(k in seq(valiStation)){ 332 | rv_sm[k] = mean(rv_temp[v$Site_ID == val_stations[i, k]]) 333 | } 334 | prption_byArea[i, j] = mean(rv_sm) 335 | } else{ 336 | prption_byArea[i, j] = mean(rv_temp) 337 | } 338 | } 339 | 340 | #update progress bar 341 | Sys.sleep(0.1) 342 | setTxtProgressBar(pb, i) 343 | } 344 | 345 | #clean up warnings and messages 346 | wstack = unique(wstack) 347 | mstack = unique(mstack) 348 | trsh = lapply(wstack, warning, call. = FALSE) 349 | cat("\n") 350 | message(mstack) 351 | 352 | random_prob_density = 1 / Tarea 353 | 354 | result = list(name, val_stations, pd_v, prption_byArea, 355 | prption_byProb, precision, random_prob_density, by) 356 | names(result) = c("name", "val_stations", "pd_val", 357 | "prption_byArea", "prption_byProb", "precision", 358 | "random_prob_density", "by") 359 | class(result) = "QA" 360 | return(result) 361 | } 362 | 363 | check_SOD = function(known, isoscape, bySite){ 364 | 365 | col_site = NULL 366 | 367 | #check quality of SOD 368 | if(is.null(known$data) || is.null(known$marker)){ 369 | stop("missing information in subOrigData known") 370 | } 371 | #find data columns 372 | col_m = match(known$marker, names(known$data)) 373 | col_sd = match(paste0(known$marker, ".sd"), names(known$data)) 374 | if(is.na(col_m) | is.na(col_sd)){ 375 | stop("cannot match marker to data table in subOrigData known") 376 | } 377 | #find site column 378 | if(bySite){ 379 | col_site = match("Site_ID", names(known$data)) 380 | if(is.na(col_site)){ 381 | stop("no Site_ID field in known; provide Site_IDs or use bySite = FALSE") 382 | } 383 | } 384 | #find samples column 385 | col_sample = match("Sample_ID", names(known$data)) 386 | #pull out SpatVector 387 | known = known$data 388 | #simplify data 389 | known = known[, c(col_m, col_sd, col_site, col_sample)] 390 | #check projection 391 | if(crs(known) == "") { 392 | stop("known must have valid coordinate reference system") 393 | } 394 | if(!same.crs(known, isoscape)){ 395 | known = project(known, crs(isoscape)) 396 | message("known was reprojected") 397 | } 398 | 399 | return(known) 400 | } 401 | 402 | check_SV = function(known, isoscape, bySite, ni){ 403 | 404 | col_site = NULL 405 | 406 | #check for enough columns 407 | if(ncol(known) < ni * 2){ 408 | if(ncol(known) == 1 & ni == 1){ 409 | warning("use of known with 1 data column is depreciated; known 410 | should include the measured 411 | isotope values and 1 sd uncertainty for each 412 | isotope system; assuming equal uncertainty for all samples") 413 | known[,2] = rep(0.0001, nrow(known)) 414 | } else{ 415 | stop("known must include the measured 416 | isotope values and 1 sd uncertainty for each sample") 417 | } 418 | } 419 | 420 | #check all data columns are numeric w/ no missing values 421 | for(i in 1:(ni*2)){ 422 | if(!is.numeric(values(known)[,i])){ 423 | stop("non-numeric data in sample value fields of known") 424 | } 425 | if(any(is.na(values(known)[, i])) || 426 | any(is.nan(values(known)[, i])) || 427 | any(is.null(values(known)[, i]))){ 428 | stop("Missing values detected in known sample value fields") 429 | } 430 | } 431 | 432 | #check that all SD values are greater than zero 433 | for(i in seq(2, ni*2, by = 2)){ 434 | if(any(!(values(known)[, i] > 0))){ 435 | stop("negative or zero values found in known uncertainties") 436 | } 437 | } 438 | 439 | #check for Site_ID column 440 | if(bySite){ 441 | col_site = match("Site_ID", names(known)) 442 | if(is.na(col_site)){ 443 | stop("no Site_ID field in known; provide Site_IDs or use bySite = FALSE") 444 | } 445 | } 446 | 447 | if(!is.null(col_site)){ 448 | if(any(is.na(values(known)[, col_site])) || 449 | any(is.nan(values(known)[, col_site])) || 450 | any(is.null(values(known)[, col_site]))){ 451 | stop("Missing values detected in sites field") 452 | } 453 | } 454 | if(crs(known) == "") { 455 | stop("known must have valid coordinate reference system") 456 | } 457 | if(!same.crs(known, isoscape)){ 458 | known = project(known, crs(isoscape)) 459 | message("known was reprojected") 460 | } 461 | if(nrow(known) < 10){ 462 | warning("there are fewer than 10 known samples") 463 | } 464 | if(nrow(known) < 3){ 465 | stop("QA requires at least 3 known samples") 466 | } 467 | 468 | return(known) 469 | } 470 | -------------------------------------------------------------------------------- /R/build_files.R: -------------------------------------------------------------------------------- 1 | internal_files = function(){ 2 | #add data to package environment 3 | assign("wrld_simpl", terra::vect(system.file("extdata/wrld_simpl.shp", package = "assignR")), 4 | pos = "package:assignR") 5 | assign("states", terra::vect(system.file("extdata/states.shp", package = "assignR")), 6 | pos = "package:assignR") 7 | assign("naMap", terra::vect(system.file("extdata/naMap.shp", package = "assignR")), 8 | pos = "package:assignR") 9 | assign("d2h_lrNA", terra::rast(system.file("extdata/d2h_lrNA.tif", package = "assignR")), 10 | pos = "package:assignR") 11 | assign("sr_MI", terra::rast(system.file("extdata/sr_MI.tif", package = "assignR")), 12 | pos = "package:assignR") 13 | 14 | assign("knownOrig", list(sites = terra::vect(system.file("extdata/knownOrig_sites.shp", package = "assignR")), 15 | samples = read.csv(system.file("extdata/knownOrig_samples.csv", package = "assignR")), 16 | sources = read.csv(system.file("extdata/knownOrig_sources.csv", package = "assignR"))), 17 | pos = "package:assignR") 18 | 19 | packageStartupMessage(paste0("knownOrig database version ", kov$version, ", ", 20 | kov$nSamples, " samples from ", kov$nSites, " sites.")) 21 | } 22 | 23 | .onAttach = function(libname, pkgname){ 24 | #run attach 25 | internal_files() 26 | 27 | #cleanup removes terra pointers from package environment at end of session 28 | # clean = function(e){ 29 | # detach("package:assignR", unload = TRUE, character.only = TRUE) 30 | # } 31 | # e = as.environment("package:assignR") 32 | # g = function(){ 33 | # reg.finalizer(e, clean, onexit = TRUE) 34 | # } 35 | # g() 36 | } 37 | 38 | -------------------------------------------------------------------------------- /R/calRaster.R: -------------------------------------------------------------------------------- 1 | calRaster = function (known, isoscape, mask = NULL, interpMethod = 2, 2 | NA.value = NA, ignore.NA = TRUE, genplot = TRUE, 3 | outDir = NULL, verboseLM = TRUE){ 4 | 5 | 6 | #check that isoscape is valid and has defined CRS 7 | ##legacy raster 8 | if(inherits(isoscape, c("RasterStack", "RasterBrick"))) { 9 | warning("raster objects are depreciated, transition to package terra") 10 | isoscape = rast(isoscape) 11 | ##legacy raster 12 | } 13 | 14 | if(inherits(isoscape, "SpatRaster")){ 15 | if(crs(isoscape) == ""){ 16 | stop("isoscape must have valid coordinate reference system") 17 | } 18 | if(nlyr(isoscape) != 2) { 19 | stop("isoscape should be a SpatRaster with two layers 20 | (mean and standard deviation)") 21 | } 22 | } else { 23 | stop("isoscape should be a SpatRaster") 24 | } 25 | 26 | #check that known is valid and has defined, correct CRS 27 | if(!(inherits(known, c("subOrigData", "QAData", 28 | "SpatialPointsDataFrame", 29 | "SpatVector")))) { 30 | stop("known must be a subOrigData or SpatVector object") 31 | } 32 | if(inherits(known, "SpatialPointsDataFrame")){ 33 | known = vect(known) 34 | } 35 | if(inherits(known, "subOrigData")){ 36 | if(is.null(known$data) || is.null(known$marker)){ 37 | stop("missing information in subOrigData known") 38 | } 39 | col_m = match(known$marker, names(known$data)) 40 | col_sd = match(paste0(known$marker, ".sd"), names(known$data)) 41 | if(is.na(col_m) | is.na(col_sd)){ 42 | stop("cannot match marker to data table in subOrigData known") 43 | } 44 | known = known$data 45 | }else{ 46 | if(inherits(known, "QAData")){ 47 | class(known) = "SpatVector" 48 | } else{ 49 | message("user-provided known; assuming measured isotope value and 1 sd 50 | uncertainty are contained in columns 1 and 2, respectively") 51 | } 52 | if(ncol(known) < 2){ 53 | if(ncol(known) == 1){ 54 | warning("use of known with 1 data column is depreciated; known 55 | should include a data frame containing the measured 56 | isotope values (col 1) and 1 sd uncertainty (col 2); 57 | assuming equal uncertainty for all samples") 58 | known[,2] = rep(0.0001, nrow(known)) 59 | } else{ 60 | stop("known must include a data frame containing the measured 61 | isotope values (col 1) and 1 sd uncertainty (col 2)") 62 | } 63 | } 64 | if(any(!is.numeric(values(known)[,1]), !is.numeric(values(known)[,2]))){ 65 | stop("known must include data containing the measured 66 | isotope values (col 1) and 1 sd uncertainty (col 2)") 67 | } 68 | col_m = 1 69 | col_sd = 2 70 | } 71 | if(any(is.na(values(known)[, col_m])) || 72 | any(is.nan(values(known)[, col_m])) || 73 | any(is.null(values(known)[, col_m]))){ 74 | stop("Missing values detected in known values") 75 | } 76 | if(any(is.na(values(known)[, col_sd])) || 77 | any(is.nan(values(known)[, col_sd])) || 78 | any(is.null(values(known)[, col_sd]))){ 79 | stop("Missing values detected in known uncertainties") 80 | } 81 | if(any(values(known)[, col_sd] == 0)){ 82 | stop("zero values found in known uncertainties") 83 | } 84 | if(crs(known) == "") { 85 | stop("known must have valid coordinate reference system") 86 | } 87 | if(nrow(unique(crds(known))) < 3){ 88 | stop("isoscape rescaling requires data from at least 3 locations") 89 | } 90 | if(!same.crs(known, isoscape)){ 91 | known = project(known, crs(isoscape)) 92 | message("known was reprojected") 93 | } 94 | 95 | #check that mask is valid and has defined, correct CRS 96 | mask = check_mask(mask, isoscape) 97 | 98 | #check that other inputs are valid 99 | if(!interpMethod %in% c(1,2)){ 100 | stop("interpMethod should be 1 or 2") 101 | } 102 | if(!inherits(genplot, "logical")) { 103 | message("genplot should be logical (T or F), using default = T") 104 | genplot = TRUE 105 | } 106 | if(!is.null(outDir)){ 107 | if(!inherits(outDir, "character")){ 108 | stop("outDir should be a character string") 109 | } 110 | if(!dir.exists(outDir)){ 111 | message("outDir does not exist, creating") 112 | dir.create(outDir) 113 | } 114 | } 115 | 116 | #extract with mask 117 | if(!is.null(mask)){ 118 | known = known[mask,] 119 | isoscape = crop(isoscape, mask) 120 | } 121 | 122 | #check and set isoscape NA value if necessary 123 | if(!is.na(NA.value)) { 124 | tempVals = values(isoscape) 125 | tempVals[tempVals == NA.value] = NA 126 | isoscape = setValues(isoscape, tempVals) 127 | } 128 | 129 | #get dimensions 130 | nSample = nrow(known) 131 | 132 | #create space for regression variables 133 | null.iso = NULL 134 | 135 | #populate the dependent variable values 136 | tissue.iso = values(known)[, col_m] 137 | tissue.iso.sd = values(known)[, col_sd] 138 | tissue.iso.wt = 1 / tissue.iso.sd^2 139 | 140 | #populate the independent variable values 141 | if (interpMethod == 1) { 142 | isoscape.iso = extract(isoscape, known, method = "simple")[,2:3] 143 | } else { 144 | isoscape.iso = extract(isoscape, known, method = "bilinear")[,2:3] 145 | } 146 | #protect against negative values from interpolation 147 | isoscape.iso[,2] = pmax(isoscape.iso[,2], 148 | global(isoscape, min, na.rm = TRUE)[2, 1]) 149 | 150 | #warn if some known sites have NA isoscape values 151 | if (any(is.na(isoscape.iso[, 1]))) { 152 | na = which(is.na(isoscape.iso[, 1])) 153 | wtxt = "No isoscape values found at the following locations:\n" 154 | for(i in na){ 155 | wtxt = paste0(wtxt, geom(known)[i, 3], ", ", geom(known)[i, 4], "\n") 156 | } 157 | if (ignore.NA) warning(wtxt) 158 | if (!ignore.NA) { 159 | cat(wtxt) 160 | stop("Delete these data in known origin data or use a different 161 | isoscape that has values at these locations") 162 | } 163 | 164 | #remove na values before continuing 165 | tissue.iso = tissue.iso[!is.na(isoscape.iso[,1])] 166 | tissue.iso.wt = tissue.iso.wt[!is.na(isoscape.iso[,1])] 167 | isoscape.iso = isoscape.iso[!is.na(isoscape.iso[,1]), ] 168 | nSample = length(tissue.iso) 169 | } 170 | 171 | #fit the regression model 172 | lmResult = lm(tissue.iso ~ isoscape.iso[, 1], weights = tissue.iso.wt) 173 | 174 | #output 175 | if (verboseLM){ 176 | cat("\n\n--------------------------------------- 177 | ------------------------------------------\n") 178 | cat("rescale function uses linear regression model, 179 | the summary of this model is:\n") 180 | cat("------------------------------------------- 181 | --------------------------------------\n") 182 | print(summary(lmResult)) 183 | } 184 | 185 | #create data object for return 186 | x = isoscape.iso[, 1] 187 | y = tissue.iso 188 | w = tissue.iso.wt 189 | xyw = data.frame(x, y, w) 190 | 191 | if (genplot == TRUE || !is.null(outDir) ) { 192 | #formatted lm equation for plotting 193 | equation = function(mod) { 194 | lm_coef = list(a = as.numeric(round(coef(mod)[1], digits = 2)), 195 | b = as.numeric(round(coef(mod)[2], digits = 2)), 196 | r2 = round(summary(mod)$r.squared, digits = 2)) 197 | lm_eq = substitute(italic(y) == a + b %.% italic(x) * 198 | "," ~ ~italic(R)^2 ~ "=" ~ r2, lm_coef) 199 | as.expression(lm_eq) 200 | } 201 | #coordinates for placing equation legend in plot 202 | xl = max(x) 203 | yl = min(y) + 0.05 * diff(range(y)) 204 | } 205 | 206 | if(genplot == TRUE){ 207 | #plot 208 | plot(x, y, pch = 21, bg="grey", xlab="Isoscape value", 209 | ylab="Tissue value", main="Rescale regression model") 210 | abline(lmResult) 211 | text(xl, yl, equation(lmResult), pos=2) 212 | } 213 | 214 | #pull slope and intercept 215 | intercept = as.numeric(coef(lmResult)[1]) 216 | slope = as.numeric(coef(lmResult)[2]) 217 | 218 | #create rescaled prediction isoscape 219 | isoscape.rescale = isoscape[[1]] * slope + intercept 220 | 221 | #simulate rescaling function variance 222 | isoscape.sim = matrix(0, nrow = nSample, ncol = 100) 223 | for(i in seq_along(isoscape.iso[,1])){ 224 | isoscape.sim[i,] = rnorm(100, isoscape.iso[i, 1], isoscape.iso[i, 2]) 225 | } 226 | isoscape.dev = tissue.dev = double() 227 | for(i in 1:100){ 228 | lm.sim = lm(tissue.iso ~ isoscape.sim[,i], weights = tissue.iso.wt) 229 | isoscape.dev = c(isoscape.dev, isoscape.sim[,i] - isoscape.iso[,1]) 230 | tissue.dev = c(tissue.dev, lm.sim$residuals) 231 | } 232 | 233 | ti.corr = cor(isoscape.dev, tissue.dev)^2 234 | 235 | #combine uncertainties of isoscape and rescaling function 236 | #rescaling variance is frac of model variance uncorrelated w/ isoscape error 237 | rescale.sd = sqrt(isoscape[[2]]^2 + var(lmResult$residuals) * (1-ti.corr)) 238 | 239 | #stack the output rasters and apply names 240 | isoscape.rescale = c(isoscape.rescale, rescale.sd) 241 | names(isoscape.rescale) = c("mean", "sd") 242 | 243 | #crop output if required 244 | if (!is.null(mask)) { 245 | isoscape.rescale = crop(isoscape.rescale, mask) 246 | } 247 | 248 | #plot the output rasters 249 | if (genplot == TRUE) { 250 | print(plot(isoscape.rescale, mar = c(2, 2, 2, 4), 251 | main = c("Rescaled mean", "Rescaled sd"))) 252 | } 253 | 254 | #pdf output 255 | if (!is.null(outDir)) { 256 | pdf(paste0(outDir, "/rescale_result.pdf"), width = 6, height = 4) 257 | 258 | #plot 259 | plot(x, y, pch = 21, bg="grey", xlab="Isoscape value", 260 | ylab="Tissue value", main="Rescale regression model") 261 | abline(lmResult) 262 | text(xl, yl, equation(lmResult), pos=2) 263 | 264 | print(plot(isoscape.rescale, mar = c(2, 2, 2, 4), 265 | main = c("Rescaled mean", "Rescaled sd"))) 266 | dev.off() 267 | } 268 | 269 | #set names for return data object 270 | names(xyw) = c("isoscape.iso", "tissue.iso", "tissue.iso.wt") 271 | 272 | #package results 273 | result = list(isoscape.rescale = isoscape.rescale, lm.data = xyw, 274 | lm.model = lmResult) 275 | class(result) = c("rescale") 276 | 277 | #done 278 | return(result) 279 | } 280 | -------------------------------------------------------------------------------- /R/getIsoscapes.R: -------------------------------------------------------------------------------- 1 | getIsoscapes = function(isoType = "GlobalPrecipGS", timeout = 1200){ 2 | 3 | dpath.pre = "https://wateriso.utah.edu/waterisotopes/media/ArcGrids/" 4 | 5 | if(!is.numeric(timeout)){ 6 | stop("timeout must be a number") 7 | } 8 | 9 | if(!(isoType %in% names(GIconfig))){ 10 | stop("isoType invalid") 11 | } 12 | 13 | giconfig = GIconfig[[match(isoType, names(GIconfig))]] 14 | 15 | wd = getwd() 16 | setwd(tempdir()) 17 | ot = getOption("timeout") 18 | options(timeout = timeout) 19 | on.exit({ 20 | options(timeout = ot) 21 | setwd(wd) 22 | }) 23 | 24 | dlf = function(fp, fn){ 25 | dfs = tryCatch({ 26 | download.file(fp, fn) 27 | }, 28 | warning = function(cond){ 29 | return(cond) 30 | }, 31 | error = function(cond){ 32 | return(cond) 33 | }) 34 | return(dfs) 35 | } 36 | 37 | pdlf = function(dfs, wd, ot){ 38 | setwd(wd) 39 | options(timeout = ot) 40 | message(paste("Download failed with status/message: \n", dfs)) 41 | } 42 | 43 | if(!file.exists(giconfig$dpath.post)){ 44 | dfs = dlf(paste0(dpath.pre, giconfig$dpath.post), giconfig$dpath.post) 45 | if(!is.numeric(dfs)){ 46 | pdlf(dfs, wd, ot) 47 | return(NULL) 48 | }else if(dfs != 0){ 49 | pdlf(dfs, wd, ot) 50 | return(NULL) 51 | } 52 | } 53 | 54 | procRest = function(fn, lnames, onames){ 55 | if(file.exists("zRec.txt")){ 56 | zRec = readLines("zRec.txt") 57 | } else{ 58 | zRec = "none" 59 | } 60 | if((!all(lnames %in% list.files())) | (zRec != fn)){ 61 | uz = unzip(fn) 62 | writeLines(fn, "zRec.txt") 63 | } 64 | rs = list() 65 | for(i in 1:length(lnames)){ 66 | rs[[i]] = rast(lnames[i]) 67 | } 68 | names(rs) = onames 69 | return(rs) 70 | } 71 | 72 | rs = tryCatch({ 73 | procRest(giconfig$dpath.post, giconfig$lnames, giconfig$onames) 74 | }, 75 | error = function(cond){ 76 | stop(cond) 77 | }, 78 | finally = { 79 | options(timeout = ot) 80 | setwd(wd) 81 | }) 82 | 83 | switch(giconfig$eType, 84 | { #1 85 | if(length(rs) > 1){ 86 | out = rast(rs) 87 | } else{ 88 | out = rs 89 | } 90 | }, 91 | { #2 92 | out = rast(rs) 93 | }) 94 | 95 | message(paste0("Refer to ", tempdir(), "\\metadata.txt for 96 | documentation and citation information")) 97 | 98 | return(out) 99 | } 100 | -------------------------------------------------------------------------------- /R/isoStack.R: -------------------------------------------------------------------------------- 1 | isoStack = function(..., clean = TRUE){ 2 | 3 | r = list(...) 4 | 5 | if(inherits(r[[1]], "list")){ 6 | r = unlist(r, recursive = FALSE) 7 | } 8 | 9 | if((!inherits(r, "list")) | length(r) < 2){ 10 | stop("... must be a list containing multiple isoscapes") 11 | } 12 | n = length(r) 13 | 14 | for(i in 1:n){ 15 | if(inherits(r[[i]], "rescale")){ 16 | r[[i]] = r[[i]]$isoscape.rescale 17 | } 18 | if(!inherits(r[[i]], c("RasterBrick", "RasterStack", "SpatRaster"))){ 19 | stop("each object in ... must be a SpatRaster") 20 | } 21 | if(inherits(r[[i]], c("RasterBrick", "RasterStack"))){ 22 | r[[i]] = rast(r[[i]]) 23 | warning("raster objects are depreciated, transition to package terra") 24 | } 25 | if(nlyr(r[[i]]) != 2){ 26 | stop("each isoscape must include two layers: mean and 1 sd") 27 | } 28 | if(crs(r[[i]]) == "") { 29 | stop("each isoscape must have valid coordinate reference system") 30 | } 31 | } 32 | 33 | #projections 34 | for(i in 2:n){ 35 | if(!same.crs(r[[i]], r[[1]])){ 36 | if(clean){ 37 | r[[i]] = project(r[[i]], crs(r[[1]])) 38 | } else{ 39 | stop("isoscape projections differ, clean set to FALSE") 40 | } 41 | } 42 | } 43 | 44 | #check other properties 45 | res.flag = FALSE 46 | ext.flag = FALSE 47 | res.max = res(r[[1]]) 48 | ext.min = ext(r[[1]]) 49 | for(i in 2:n){ 50 | if(!identical(res(r[[i]]), res(r[[1]]))) res.flag = TRUE 51 | if(!identical(ext(r[[i]]), ext(r[[1]]))) ext.flag = TRUE 52 | 53 | res.max = pmin(res.max, res(r[[i]])) 54 | ext.min = intersect(ext.min, ext(r[[i]])) 55 | } 56 | 57 | #fix other properties 58 | if(res.flag | ext.flag){ 59 | if(clean){ 60 | #Make raster target 61 | r.targ = rast(ext = ext.min, resolution = res.max, 62 | crs = crs(r[[1]])) 63 | 64 | for(i in 1:n){ 65 | if(!compareGeom(r[[i]], r.targ, rowcol = FALSE, crs = FALSE, 66 | res = TRUE, stopOnError = FALSE)){ 67 | r[[i]] = resample(r[[i]], r.targ) 68 | } 69 | } 70 | } else{ 71 | stop("isoscape properties differ, clean set to FALSE") 72 | } 73 | } 74 | 75 | #common mask 76 | r = maskIso(r, n) 77 | 78 | #assign class 79 | class(r) = "isoStack" 80 | 81 | return(r) 82 | } 83 | 84 | plot.isoStack = function(x, ...){ 85 | 86 | if(!inherits(x, "isoStack")){ 87 | stop("plot.isoStack needs isoStack object") 88 | } 89 | 90 | if(length(x) < 2){ 91 | stop("isoStack must include at least 2 isoscapes") 92 | } 93 | 94 | for(i in x){ 95 | if(!inherits(i, c("RasterBrick", "RasterStack", "SpatRaster"))){ 96 | stop("each object in r must be a SpatRaster") 97 | } 98 | if(nlyr(i) != 2){ 99 | stop("each isoscape must include two layers: mean and 1 sd") 100 | } 101 | } 102 | 103 | for(i in x){ 104 | plot(i) 105 | } 106 | } 107 | 108 | maskIso = function(r, n){ 109 | #Create mask 110 | m = r[[1]] 111 | for(i in 2:n){ 112 | m = m * r[[i]] 113 | } 114 | m = m[[1]] * m[[2]] 115 | 116 | #Apply mask 117 | for(i in 1:n){ 118 | r[[i]] = mask(r[[i]], m) 119 | } 120 | 121 | return(r) 122 | } 123 | -------------------------------------------------------------------------------- /R/oddsRatio.R: -------------------------------------------------------------------------------- 1 | oddsRatio = function(pdR, inputP){ 2 | 3 | if(!inherits(pdR, c("RasterLayer", "RasterStack", "RasterBrick", "SpatRaster"))){ 4 | stop("pdR should be a SpatRaster") 5 | } 6 | if(!inherits(pdR, "SpatRaster")){ 7 | warning("raster objects are depreciated, transition to package terra") 8 | pdR = rast(pdR) 9 | } 10 | 11 | if(!inherits(inputP, c("SpatialPoints", "SpatialPolygons", "SpatVector"))){ 12 | stop("inputP should be point or polygon SpatVector") 13 | } 14 | 15 | if(!inherits(inputP, "SpatVector")){ 16 | inputP = vect(inputP) 17 | } 18 | 19 | if(geomtype(inputP) == "points"){ 20 | if(crs(inputP) == ""){ 21 | stop("inputP must have coord. ref.") 22 | } 23 | if(!same.crs(inputP, pdR)){ 24 | inputP = project(inputP, crs(pdR)) 25 | message("inputP was reprojected") 26 | } 27 | 28 | n = length(inputP) 29 | extrVals = extract(pdR, inputP)[,-1] 30 | if(any(is.na(extrVals))){ 31 | stop("one or more points have probability NA") 32 | } 33 | gmax = matrix(rep(global(pdR, "max", na.rm = TRUE)[,1], n), 34 | nrow = n, byrow = TRUE) 35 | gmin = matrix(rep(global(pdR, "min", na.rm = TRUE)[,1], n), 36 | nrow = n, byrow = TRUE) 37 | result2 = data.frame(ratioToMax = extrVals/gmax, 38 | ratioToMin = extrVals/gmin) 39 | if(n == 1){ 40 | result = result2 41 | } 42 | else if(n == 2){ 43 | if(nlyr(pdR) > 1){ 44 | result1 = (extrVals[1,]/(1-extrVals[1,])) / 45 | (extrVals[2,]/(1-extrVals[2,])) 46 | } else { 47 | result1 = (extrVals[1]/(1-extrVals[1])) / (extrVals[2]/(1-extrVals[2])) 48 | } 49 | result = list(oddsRatio = result1, ratioToMaxMin = result2) 50 | names(result) = c("P1/P2 odds ratio", "Odds relative to the max/min pixel") 51 | row.names(result[[2]]) = c("P1", "P2") 52 | } 53 | else{ 54 | stop("input points (inputP) should be one or two points") 55 | } 56 | } else if(geomtype(inputP) == "polygons"){ 57 | if(length(inputP) != 2){ 58 | stop("input polygons (inputP) should be two polygons") 59 | } 60 | if(crs(inputP) == ""){ 61 | stop("inputP must have coord. ref.") 62 | } 63 | if(!same.crs(inputP, pdR)){ 64 | inputP = project(inputP, crs(pdR)) 65 | message("inputP was reprojected") 66 | } 67 | 68 | extrVals = extract(pdR, inputP, "sum", na.rm = TRUE) 69 | if(any(extrVals[, -1] == 0)){ 70 | stop("No values in P1 and/or P2") 71 | } 72 | 73 | result1 = (extrVals[1, -1]/(1-extrVals[1, -1])) / 74 | (extrVals[2, -1]/(1-extrVals[2, -1])) 75 | result2 = length(cells(crop(pdR, inputP[1,]))) / 76 | length(cells(crop(pdR, inputP[2,]))) 77 | result = list(oddsRatio = result1, polygonCellRatio = result2) 78 | names(result) = c("P1/P2 odds ratio", "Ratio of numbers of cells in two polygons") 79 | } else{ 80 | stop("inputP must be point or polygon SpatVector") 81 | } 82 | 83 | return(result) 84 | } 85 | -------------------------------------------------------------------------------- /R/pdRaster.R: -------------------------------------------------------------------------------- 1 | pdRaster = function(r, unknown, prior = NULL, mask = NULL, 2 | genplot = TRUE, outDir = NULL){ 3 | UseMethod("pdRaster", r) 4 | } 5 | 6 | pdRaster.default = function(r, unknown, prior = NULL, mask = NULL, 7 | genplot = TRUE, outDir = NULL) { 8 | 9 | if(inherits(r, "rescale")){ 10 | r = r$isoscape.rescale 11 | } 12 | 13 | ##legacy raster 14 | if(inherits(r, c("RasterStack", "RasterBrick"))) { 15 | warning("raster objects are depreciated, transition to package terra") 16 | r = rast(r) 17 | ##legacy raster 18 | } 19 | 20 | if(inherits(r, "SpatRaster")){ 21 | if(crs(r) == ""){ 22 | stop("r must have valid coordinate reference system") 23 | } 24 | if(nlyr(r) != 2) { 25 | stop("r should be a SpatRaster with two layers 26 | (mean and standard deviation)") 27 | } 28 | } else{ 29 | stop("r should be a SpatRaster with two layers 30 | (mean and standard deviation)") 31 | } 32 | 33 | data = check_unknown(unknown, 1) 34 | n = nrow(data) 35 | 36 | prior = check_prior(prior, r) 37 | 38 | mask = check_mask(mask, r) 39 | 40 | check_options(genplot, outDir) 41 | 42 | if(is.null(mask)){ 43 | rescaled.mean = r[[1]] 44 | rescaled.sd = r[[2]] 45 | } else{ 46 | rescaled.mean = crop(r[[1]], mask) 47 | rescaled.mean = mask(rescaled.mean, mask) 48 | rescaled.sd = crop(r[[2]], mask) 49 | rescaled.sd = mask(rescaled.sd, mask) 50 | } 51 | 52 | errorV = values(rescaled.sd, mat = FALSE) 53 | meanV = values(rescaled.mean, mat = FALSE) 54 | result = NULL 55 | temp = list() 56 | 57 | for (i in seq_len(n)) { 58 | indv.data = data[i, ] 59 | indv.id = indv.data[1,1] 60 | assign = dnorm(indv.data[1,2], mean = meanV, sd = errorV) 61 | if(!is.null(prior)){ 62 | assign = assign * values(prior, mat = FALSE) 63 | } 64 | assign.norm = assign / sum(assign, na.rm = TRUE) 65 | assign.norm = setValues(rescaled.mean, assign.norm) 66 | if (i == 1){ 67 | result = assign.norm 68 | } else { 69 | result = c(result, assign.norm) 70 | } 71 | if(!is.null(outDir)){ 72 | filename = paste0(outDir, "/", indv.id, "_like", ".tif", sep = "") 73 | writeRaster(assign.norm, filename = filename, filetype = "GTiff", overwrite = TRUE) 74 | } 75 | } 76 | names(result) = data[,1] 77 | 78 | write_out(outDir, genplot, n, result, data) 79 | 80 | return(result) 81 | } 82 | 83 | pdRaster.isoStack = function(r, unknown, prior = NULL, mask = NULL, 84 | genplot = TRUE, outDir = NULL) { 85 | 86 | ni = length(r) 87 | 88 | for(i in seq(ni)){ 89 | ##legacy raster 90 | if(inherits(r[[i]], c("RasterStack", "RasterBrick"))) { 91 | warning("raster objects are depreciated, transition to package terra") 92 | r[[i]] = rast(r[[i]]) 93 | ##legacy raster 94 | } 95 | 96 | if(inherits(r[[i]], "SpatRaster")){ 97 | if(crs(r[[i]]) == ""){ 98 | stop("isoscape must have valid coordinate reference system") 99 | } 100 | if(nlyr(r[[i]]) != 2) { 101 | stop("isoscape should be a SpatRaster with two layers 102 | (mean and standard deviation)") 103 | } 104 | } else { 105 | stop("isoscape layers should be a SpatRaster") 106 | } 107 | } 108 | 109 | data = check_unknown(unknown, ni) 110 | n = nrow(data) 111 | 112 | prior = check_prior(prior, r[[1]]) 113 | 114 | mask = check_mask(mask, r[[1]]) 115 | 116 | check_options(genplot, outDir) 117 | 118 | if(is.null(mask)){ 119 | rescaled.mean = r[[1]][[1]] 120 | rescaled.sd = r[[1]][[2]] 121 | } else{ 122 | rescaled.mean = crop(r[[1]][[1]], mask) 123 | rescaled.mean = mask(rescaled.mean, mask) 124 | rescaled.sd = crop(r[[1]][[2]], mask) 125 | rescaled.sd = mask(rescaled.sd, mask) 126 | } 127 | 128 | meanV = values(rescaled.mean, mat = FALSE) 129 | errorV = values(rescaled.sd, mat = FALSE) 130 | 131 | for(i in 2:ni){ 132 | if(is.null(mask)){ 133 | rescaled.mean = r[[i]][[1]] 134 | rescaled.sd = r[[i]][[2]] 135 | } else{ 136 | rescaled.mean = crop(r[[i]][[1]], mask) 137 | rescaled.mean = mask(rescaled.mean, mask) 138 | rescaled.sd = crop(r[[i]][[2]], mask) 139 | rescaled.sd = mask(rescaled.sd, mask) 140 | } 141 | meanV = cbind(meanV, values(rescaled.mean, mat = FALSE)) 142 | errorV = cbind(errorV, values(rescaled.sd, mat = FALSE)) 143 | } 144 | 145 | result = NULL 146 | temp = list() 147 | assign = as.numeric(rep(NA, nrow(meanV))) 148 | cells = seq_along(meanV[,1]) 149 | cellmask = apply(cbind(meanV, errorV), 1, anyNA) 150 | cells = cells[!cellmask] 151 | 152 | #sanity check 153 | cd = cdt = cor(meanV, use = "pairwise.complete.obs")^2 154 | diag(cdt) = NA 155 | if(any(cdt > 0.7, na.rm = TRUE)){ 156 | warning("two or more isoscapes have shared variance > 0.7, added information 157 | will be limited, and specificity of assignments may be inflated") 158 | } 159 | 160 | dev = d.cell = cov(meanV, use = "pairwise.complete.obs") 161 | v = sqrt(diag(dev)) 162 | d.l = list() 163 | for(i in cells){ 164 | v.cell = errorV[i,] / v 165 | for(j in 1:ni){ 166 | for(k in 1:ni){ 167 | d.cell[j, k] = dev[j, k] * v.cell[j] * v.cell[k] 168 | } 169 | } 170 | d.l[[i]] = d.cell 171 | } 172 | 173 | for (i in seq_len(n)) { 174 | indv.data = data[i, ] 175 | indv.id = indv.data[1, 1] 176 | indv.iso = indv.data[1, -1] 177 | 178 | for(j in cells){ 179 | assign[j] = dmvn(as.numeric(indv.iso), meanV[j,], d.l[[j]]) 180 | } 181 | 182 | if(!is.null(prior)){ 183 | assign = assign * values(prior, mat = FALSE) 184 | } 185 | assign.norm = assign / sum(assign[!is.na(assign)]) 186 | assign.norm = setValues(rescaled.mean, assign.norm) 187 | if (i == 1){ 188 | result = assign.norm 189 | } else { 190 | result = c(result, assign.norm) 191 | } 192 | if(!is.null(outDir)){ 193 | filename = paste0(outDir, "/", indv.id, "_like", ".tif", sep = "") 194 | writeRaster(assign.norm, filename = filename, filetype = "GTiff", overwrite = TRUE) 195 | } 196 | } 197 | names(result) = data[,1] 198 | 199 | write_out(outDir, genplot, n, result, data) 200 | 201 | return(result) 202 | } 203 | 204 | check_unknown = function(unknown, n){ 205 | 206 | if(inherits(unknown, "refTrans")){ 207 | unknown = process_refTrans(unknown) 208 | } 209 | 210 | if(inherits(unknown, "list")){ 211 | if(length(unknown) < n){ 212 | stop("number of refTrans objects provided is less than number of isoscapes") 213 | } 214 | if(length(unknown) > n){ 215 | warning(paste("more refTrans objects than isoscapes, only using first", 216 | n, "objects")) 217 | } 218 | 219 | un = process_refTrans(unknown[[1]]) 220 | nobs = nrow(un) 221 | 222 | for(i in 2:n){ 223 | u = process_refTrans(unknown[[i]]) 224 | if(nrow(u) != nobs){ 225 | stop("different numbers of samples in refTrans objects") 226 | } 227 | un = merge(un, u, by.x = 1, by.y = 1) 228 | if(nrow(un) != nobs){ 229 | stop("sample IDs in refTrans objects don't match") 230 | } 231 | } 232 | 233 | unknown = un 234 | } 235 | 236 | for(i in seq(ncol(unknown))){ 237 | if(any(is.na(unknown[,i])) || any(is.nan(unknown[,i])) || 238 | any(is.null(unknown[,i]))){ 239 | stop("Missing values detected in unknown") 240 | } 241 | } 242 | 243 | if (!inherits(unknown, "data.frame")) { 244 | stop("unknown should be a data.frame, see help page of pdRaster function") 245 | } 246 | 247 | if(ncol(unknown) < (n + 1)){ 248 | stop("unknown must contain sample ID in col 1 and marker values in col 2+") 249 | } 250 | if(ncol(unknown) > (n + 1)){ 251 | warning("more than n marker + 1 cols in unknown, assuming IDs in col 1 and marker values in cols 2 to (n+1)") 252 | } 253 | for(i in 2:(n+1)){ 254 | if(!is.numeric(unknown[,i])){ 255 | stop("unknown data column(s) must contain numeric values") 256 | } 257 | } 258 | 259 | return(unknown[,1:(n+1)]) 260 | } 261 | 262 | check_prior = function(prior, r){ 263 | 264 | if(!is.null(prior)){ 265 | #legacy raster 266 | if(inherits(prior, "RasterLayer")){ 267 | warning("raster objects are depreciated, transition to package terra") 268 | prior = rast(prior) 269 | #legacy raster 270 | } 271 | 272 | if(inherits(prior, "SpatRaster")){ 273 | if(crs(prior) == ""){ 274 | stop("isoscape must have valid coordinate reference system") 275 | } 276 | if(!same.crs(prior, r[[1]])) { 277 | prior = project(prior, crs(r[[1]])) 278 | message("prior was reprojected") 279 | } 280 | compareGeom(prior, r) 281 | } else{ 282 | stop("prior should be a SpatRaster") 283 | } 284 | } 285 | 286 | return(prior) 287 | } 288 | 289 | check_options = function(genplot, outDir){ 290 | 291 | if(!inherits(genplot, "logical")){ 292 | stop("genplot should be logical (TRUE or FALSE)") 293 | } 294 | 295 | if(!is.null(outDir)){ 296 | if(class(outDir)[1] != "character"){ 297 | stop("outDir should be a character string") 298 | } 299 | if(!dir.exists(outDir)){ 300 | message("outDir does not exist, creating") 301 | dir.create(outDir) 302 | } 303 | } 304 | 305 | return() 306 | } 307 | 308 | check_mask = function(mask, r){ 309 | 310 | if (!is.null(mask)) { 311 | if(inherits(mask, "SpatialPolygons")){ 312 | mask = vect(mask) 313 | } 314 | if(inherits(mask, "SpatVector")){ 315 | if(crs(mask) == ""){ 316 | stop("mask must have valid coordinate reference system") 317 | } 318 | if(geomtype(mask) != "polygons"){ 319 | stop("mask geometry must be polygons") 320 | } 321 | if(!same.crs(mask, r)){ 322 | mask = project(mask, crs(r)) 323 | message("mask was reprojected") 324 | } 325 | } else { 326 | stop("mask should be SpatVector") 327 | } 328 | } 329 | 330 | return(mask) 331 | } 332 | 333 | write_out = function(outDir, genplot, n, result, data){ 334 | 335 | if(!is.null(outDir)){ 336 | if (n > 5){ 337 | pdf(paste0(outDir, "/output_pdRaster.pdf"), width = 10, height = 10) 338 | par(mfrow = c(ceiling(n/5), 5)) 339 | } else { 340 | pdf(paste0(outDir, "/output_pdRaster.pdf"), width = 10, height = 10) 341 | } 342 | } 343 | 344 | if (genplot == TRUE){ 345 | if (n == 1){ 346 | pp = plot(result, mar = c(2, 2, 1, 5)) 347 | print(pp) 348 | } else { 349 | pp = plot(result, mar = c(2, 2, 2, 5), main = data[, 1]) 350 | print(pp) 351 | } 352 | } 353 | 354 | if(!is.null(outDir)){ 355 | dev.off() 356 | } 357 | 358 | return() 359 | } 360 | 361 | process_refTrans = function(unknown){ 362 | if(inherits(unknown, "refTrans")){ 363 | if(ncol(unknown$data) == 3){ 364 | un = data.frame("ID" = seq(1:nrow(unknown$data)), unknown$data[,1]) 365 | names(un)[2] = names(unknown$data)[1] 366 | message("no sample IDs in refTrans object, assigning numeric sequence") 367 | } else if(ncol(unknown$data) == 4){ 368 | un = unknown$data[,1:2] 369 | } else{ 370 | stop("incorrectly formatted refTrans object in unknown") 371 | } 372 | } else{ 373 | stop("only refTrans objects can be provided in listed unknown") 374 | } 375 | return(un) 376 | } 377 | -------------------------------------------------------------------------------- /R/plot.QA.R: -------------------------------------------------------------------------------- 1 | plot.QA = function(x, ..., outDir = NULL){ 2 | 3 | a = list(x, ...) 4 | 5 | if(!inherits(a[[1]], "QA")){ 6 | stop("x must be one or more QA objects") 7 | } 8 | 9 | if(!is.null(outDir)){ 10 | if(!inherits(outDir, "character")){ 11 | stop("outDir should be a character string") 12 | } 13 | if(!dir.exists(outDir)){ 14 | message("outDir does not exist, creating") 15 | dir.create(outDir) 16 | } 17 | } 18 | 19 | n = 0 20 | bys = integer() 21 | for(i in seq_len(length(a))){ 22 | if(inherits(a[[i]], "QA")){ 23 | n = n + 1 24 | if(is.null(a[[i]]$by)){ 25 | stop("plot now requires QA objects with the by element (use assignR v.1.2.1 or greater)") 26 | } 27 | bys = c(bys, a[[i]]$by) 28 | } 29 | } 30 | 31 | if(n > 1){ 32 | if(!all(diff(bys) == 0)){ 33 | stop("plotting multiple QA objects requires that all have the same by increment") 34 | } 35 | } 36 | 37 | #vector of thresholds 38 | xx = seq(0.00, 1, a[[1]]$by/100) 39 | if(tail(xx, 1) != 1){ 40 | xx = c(xx, 1) 41 | } 42 | 43 | if(n == 1){ 44 | 45 | vali = ncol(x$val_stations) 46 | niter = nrow(x$val_stations) 47 | 48 | means.p = data.frame(xx, apply(x$prption_byProb, 2, mean)) 49 | means.a = data.frame(xx, apply(x$prption_byArea, 2, mean)) 50 | 51 | precision = matrix(rep(0, niter*length(xx)), 52 | ncol=niter, nrow=length(xx)) 53 | for (i in 1:niter){ 54 | precision[,i] = apply(x$precision[[i]], 1, median) 55 | } 56 | 57 | mean.pre = NULL 58 | for(i in 1:length(xx)){ 59 | mean.pre = append(mean.pre, mean(precision[i,])) 60 | } 61 | 62 | pre = data.frame(xx, 1 - mean.pre) 63 | 64 | pd = data.frame(as.numeric(x$pd_val) / x$random_prob_density) 65 | 66 | plot(c(0,1), c(1,0), type="l", col="dark grey", lwd=2, lty=3, 67 | xlab="Probability quantile", 68 | ylab="Proportion of area excluded", xlim=c(0,1), ylim=c(0,1)) 69 | lines(pre[,1], pre[,2], lwd=2) 70 | 71 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 72 | xlab="Probability quantile", 73 | ylab="Proportion of validation stations included", xlim=c(0,1), 74 | ylim=c(0,1)) 75 | lines(means.p[,1], means.p[,2], lwd=2) 76 | 77 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 78 | xlab="Area quantile", 79 | ylab="Proportion of validation stations included", xlim=c(0,1), 80 | ylim=c(0,1)) 81 | lines(means.a[,1], means.a[,2], lwd=2) 82 | 83 | boxplot(pd, ylab = "Odds ratio (known origin:random)", 84 | outline = FALSE) 85 | abline(1,0, col="dark grey", lwd=2, lty=3) 86 | 87 | if(!is.null(outDir)){ 88 | 89 | png(paste0(outDir, "/QA1.png"), units = "in", width = 8, 90 | height = 3, res = 600) 91 | p = par(no.readonly = TRUE) 92 | on.exit(par(p)) 93 | par(mfrow = c(1, 3)) 94 | 95 | plot(c(0,1), c(1,0), type="l", col="dark grey", lwd=2, lty=3, 96 | xlab="Probability quantile", 97 | ylab="Proportion of area excluded", xlim=c(0,1), 98 | ylim=c(0,1)) 99 | lines(pre[,1], pre[,2], lwd=2) 100 | 101 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 102 | xlab="Probability quantile", 103 | ylab="Proportion of validation stations included", 104 | xlim=c(0,1), ylim=c(0,1)) 105 | lines(means.p[,1], means.p[,2], lwd=2) 106 | 107 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 108 | xlab="Area quantile", 109 | ylab="Proportion of validation stations included", 110 | xlim=c(0,1), ylim=c(0,1)) 111 | lines(means.a[,1], means.a[,2], lwd=2) 112 | 113 | dev.off() 114 | 115 | png(paste0(outDir, "/QA2.png"), units = "in", width = 6, 116 | height = 4, res = 600) 117 | 118 | boxplot(pd, ylab = "Odds ratio (known origin:random)", 119 | outline = FALSE) 120 | abline(1,0, col="dark grey", lwd=2, lty=3) 121 | 122 | dev.off() 123 | } 124 | 125 | } else{ 126 | 127 | nm = rep("", n) 128 | vali = niter = rep(0, n) 129 | 130 | for(i in seq_len(n)){ 131 | if(is.null(a[[i]]$name)){ 132 | nm[i] = as.character(i) 133 | } else if(a[[i]]$name == "") { 134 | nm[i] = as.character(i) 135 | } else { 136 | nm[i] = a[[i]]$name 137 | } 138 | vali[i] = ncol(a[[i]]$val_stations) 139 | niter[i] = nrow(a[[i]]$val_stations) 140 | } 141 | 142 | means.p = data.frame(xx, apply(a[[1]]$prption_byProb, 2, 143 | mean)) 144 | means.a = data.frame(xx, apply(a[[1]]$prption_byArea, 2, 145 | mean)) 146 | 147 | precision = matrix(ncol=niter[1], nrow=length(xx)) 148 | for (i in 1:niter[1]){ 149 | precision[,i] = apply(a[[1]]$precision[[i]],1, median) 150 | } 151 | 152 | mean.pre = NULL 153 | for(i in seq_along(xx)){ 154 | mean.pre = append(mean.pre, mean(precision[i,])) 155 | } 156 | 157 | pre = data.frame(xx, 1 - mean.pre) 158 | 159 | pd = matrix(ncol=n, nrow = max(niter) * max(vali)) 160 | pd[1:(niter[1] * vali[1]), 1] = as.numeric(a[[1]]$pd_val) / 161 | a[[1]]$random_prob_density 162 | 163 | for(i in seq_len(n)[-1]){ 164 | 165 | means.p = cbind(means.p, apply(a[[i]]$prption_byProb, 2, 166 | mean)) 167 | means.a = cbind(means.a, apply(a[[i]]$prption_byArea, 2, 168 | mean)) 169 | 170 | precision = matrix(ncol=niter[i], nrow=length(xx)) 171 | for (j in seq(niter[i])){ 172 | precision[,j] = apply(a[[i]]$precision[[j]], 1, median) 173 | } 174 | 175 | mean.pre = NULL 176 | for(j in seq_along(xx)){ 177 | mean.pre = append(mean.pre, mean(precision[j,])) 178 | } 179 | 180 | pre = cbind(pre, 1 - mean.pre) 181 | 182 | pd[1:(niter[i] * vali[i]), i] = as.numeric(a[[i]]$pd_val) / 183 | a[[i]]$random_prob_density 184 | 185 | } 186 | 187 | plot(c(0,1), c(1,0), type="l", col="dark grey", lwd=2, lty=3, 188 | xlab="Probability quantile", 189 | ylab="Proportion of area excluded", xlim=c(0,1), ylim=c(0,1)) 190 | for(i in seq_len(n)){ 191 | lines(pre[,1], pre[,i+1], lwd=2, col=i+1) 192 | } 193 | legend(0.01, 0.55, nm, lwd=2, col=seq(2,n+1), bty="n") 194 | 195 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 196 | xlab="Probability quantile", 197 | ylab="Proportion of validation stations included", 198 | xlim=c(0,1), ylim=c(0,1)) 199 | for(i in seq_len(n)){ 200 | lines(means.p[,1], means.p[,i+1], lwd=2, col=i+1) 201 | } 202 | legend(0.01, 1, nm, lwd=2, col=seq(2,n+1), bty="n") 203 | 204 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 205 | xlab="Area quantile", 206 | ylab="Proportion of validation stations included", 207 | xlim=c(0,1), ylim=c(0,1)) 208 | for(i in seq_len(n)){ 209 | lines(means.a[,1], means.a[,i+1], lwd=2, col=i+1) 210 | } 211 | legend(0.6, 0.55, nm, lwd=2, col=seq(2,n+1), bty="n") 212 | 213 | boxplot(pd, col=seq(2,n+1), names = nm, 214 | ylab = "Odds ratio (known origin:random)", outline = FALSE) 215 | abline(1, 0, col="dark grey", lwd=2, lty=3) 216 | 217 | if(!is.null(outDir)){ 218 | png(paste0(outDir, "/QA1.png"), units = "in", width = 8, 219 | height = 3, res = 600) 220 | p = par(no.readonly = TRUE) 221 | on.exit(par(p)) 222 | par(mfrow = c(1, 3)) 223 | 224 | plot(c(0,1), c(1,0), type="l", col="dark grey", lwd=2, lty=3, 225 | xlab="Probability quantile", 226 | ylab="Proportion of area excluded", xlim=c(0,1), 227 | ylim=c(0,1)) 228 | for(i in seq_len(n)){ 229 | lines(pre[,1], pre[,i+1], lwd=2, col=i+1) 230 | } 231 | t = par("usr")[4] * 0.6 232 | b = par("usr")[3] 233 | yp1 = mean(c(t,b)) 234 | yp = yp1 + (n-1) / 6 * yp1 235 | legend(0, yp, nm, lwd=2, col=seq(2,n+1), bty="n") 236 | text(0.95, 0.95, "(a)") 237 | 238 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 239 | xlab="Probability quantile", 240 | ylab="Proportion of validation stations included", 241 | xlim=c(0,1), ylim=c(0,1)) 242 | for(i in seq_len(n)){ 243 | lines(means.p[,1], means.p[,i+1], lwd=2, col=i+1) 244 | } 245 | text(0.05, 0.95, "(b)") 246 | 247 | plot(c(0,1), c(0,1), type="l", col="dark grey", lwd=2, lty=3, 248 | xlab="Area quantile", 249 | ylab="Proportion of validation stations included", 250 | xlim=c(0,1), ylim=c(0,1)) 251 | for(i in seq_len(n)){ 252 | lines(means.a[,1], means.a[,i+1], lwd=2, col=i+1) 253 | } 254 | text(0.05, 0.95, "(c)") 255 | 256 | dev.off() 257 | 258 | png(paste0(outDir, "/QA2.png"), units = "in", width = 6, 259 | height = 4, res = 600) 260 | 261 | boxplot(pd, col=seq(2,n+1), names = nm, 262 | ylab = "Odds ratio (known origin:random)", 263 | outline = FALSE) 264 | abline(1, 0, col="dark grey", lwd=2, lty=3) 265 | 266 | dev.off() 267 | } 268 | 269 | return() 270 | } 271 | } 272 | 273 | 274 | -------------------------------------------------------------------------------- /R/qtlRaster.R: -------------------------------------------------------------------------------- 1 | qtlRaster = function(pdR, threshold, thresholdType = "area", 2 | genplot = TRUE, outDir = NULL){ 3 | 4 | if(!inherits(pdR, c("RasterLayer", "RasterStack", "RasterBrick", "SpatRaster"))){ 5 | stop("input probability density map (pdR) should be a SpatRaster") 6 | } 7 | if(!inherits(pdR, "SpatRaster")){ 8 | warning("raster objects are depreciated, transition to package terra") 9 | pdR = rast(pdR) 10 | } 11 | if(!inherits(threshold, "numeric")){ 12 | stop("threshold must be a number between 0 and 1 ") 13 | } 14 | if(length(threshold)[1] != 1){ 15 | stop("threshold must be a number between 0 and 1 ") 16 | } 17 | if(threshold < 0 | threshold > 1){ 18 | stop("threshold must be a number between 0 and 1") 19 | } 20 | if(thresholdType != "area" & thresholdType != "prob"){ 21 | stop("thresholdType must be 'area' or 'prob'. See help page for 22 | further information") 23 | } 24 | if(!inherits(genplot, "logical")) { 25 | message("genplot should be logical (T or F), using default = T") 26 | genplot = TRUE 27 | } 28 | if(!is.null(outDir)){ 29 | if(!inherits(outDir, "character")){ 30 | stop("outDir should be a character string") 31 | } 32 | if(!dir.exists(outDir)){ 33 | message("outDir does not exist, creating") 34 | dir.create(outDir) 35 | } 36 | } 37 | 38 | result = pdR 39 | n = nlyr(result) 40 | 41 | if(thresholdType == "prob"){ 42 | if(threshold == 0){ 43 | cut = rep(1, n) 44 | } else if(threshold == 1){ 45 | cut = rep(0, n) 46 | } else{ 47 | cut = double(n) 48 | pdR.values = values(pdR, na.rm = TRUE) 49 | for(i in seq_len(n)){ 50 | pdR.value = sort(pdR.values[,i]) 51 | k = length(pdR.value) 52 | left = 1 53 | right = k 54 | while((right-left) > 2){ 55 | start = round(mean(c(left, right))) 56 | total = sum(pdR.value[start:k]) 57 | if(total > threshold){ 58 | left = start 59 | } 60 | if(total < threshold){ 61 | right = start 62 | } 63 | } 64 | cut[i] = pdR.value[start] 65 | } 66 | } 67 | result = pdR > cut 68 | title1 = "probability" 69 | } 70 | 71 | if(thresholdType == "area"){ 72 | if(threshold == 0){ 73 | cut = rep(1, n) 74 | } else if(threshold == 1){ 75 | cut = rep(0, n) 76 | } else{ 77 | pdR.values = values(pdR, na.rm = TRUE) 78 | cut = apply(pdR.values, 2, quantile, probs = 1 - threshold) 79 | } 80 | result = pdR > cut 81 | title1 = "area" 82 | } 83 | 84 | names(result) = names(pdR) 85 | tls = character(n) 86 | if(n > 1){ 87 | for(i in seq_len(n)){ 88 | tls[i] = paste0("Top ", threshold*100, "% by ", title1, " for ", names(result)[i]) 89 | } 90 | } else{ 91 | tls = paste0("Top ", threshold*100, "% by ", title1) 92 | } 93 | 94 | if(genplot){ 95 | for(i in seq_len(n)){ 96 | plot(result[[i]], legend=FALSE) 97 | title(tls[i]) 98 | } 99 | } 100 | if(!is.null(outDir)){ 101 | pdf(paste0(outDir, "/qtlRaster_result.pdf")) 102 | for(i in seq_len(n)){ 103 | plot(result[[i]], legend=FALSE) 104 | title(tls[i]) 105 | } 106 | dev.off() 107 | } 108 | return(result) 109 | } 110 | -------------------------------------------------------------------------------- /R/refTrans.R: -------------------------------------------------------------------------------- 1 | refTrans = function(samples, marker = "d2H", ref_scale = "VSMOW_H", 2 | niter = 5000){ 3 | 4 | #load data in funtion environ 5 | data("stds", envir = environment()) 6 | stds = stds 7 | ham = stds$ham 8 | oam = stds$oam 9 | hstds = stds$hstds 10 | ostds = stds$ostds 11 | 12 | #For data sent from subOrigData 13 | if(inherits(samples, "SOD")){ 14 | class(samples) = "data.frame" 15 | #Identify values based on marker 16 | if(marker == "d2H"){ 17 | #Intial reference scales 18 | start_scales = unique(samples$H_cal) 19 | #Pull original reference scales to a vector for later use 20 | samples_scales = samples$H_cal 21 | #Remove scales from samples object 22 | samples = samples[,-ncol(samples)] 23 | #Which adjacency matrix and standard table? 24 | am = ham 25 | cal_table = hstds 26 | #Name of the relevant SD column 27 | sd_col = "d2H.sd" 28 | } else if(marker == "d18O"){ 29 | start_scales = unique(samples$O_cal) 30 | samples_scales = samples$O_cal 31 | samples = samples[,-ncol(samples)] 32 | am = oam 33 | cal_table = ostds 34 | sd_col = "d18O.sd" 35 | } 36 | 37 | #Check that cal isn't missing 38 | if(NA %in% start_scales){ 39 | warning("No calibration scale reported, some samples dropped from scale transformation") 40 | start_scales = start_scales[!is.na(start_scales)] 41 | samples = samples[!is.na(samples_scales),] 42 | samples_scales = samples_scales[!is.na(samples_scales)] 43 | } 44 | #Check that cal isn't missing for all samples 45 | if(length(samples_scales) == 0){ 46 | stop("No calibration scale reported for any samples, transformation not possible") 47 | } 48 | 49 | #Check that target exists in adj. matrix 50 | if(is.na(match(ref_scale, rownames(am)))){ 51 | warning("ref_scale not valid. Returning untransformed values.") 52 | return(list("data" = samples, "chains" = NULL)) 53 | } else{ 54 | #check whether ref_scale is a not floating calibration 55 | ref_scale.anchor = cal_table[cal_table$Calibration == ref_scale, 56 | "Ref_scale"] 57 | if(ref_scale != ref_scale.anchor){ 58 | #if so update ref_scale to floating target 59 | ref_scale = ref_scale.anchor 60 | wt = paste("ref_scale is calibrated to another scale. Returning values on", 61 | ref_scale, "scale.") 62 | message(wt) 63 | } 64 | trans_out = trans(start_scales, samples_scales, samples, ref_scale, 65 | am, cal_table, marker, sd_col, niter) 66 | return(trans_out) 67 | } 68 | #User-provided data 69 | } else if(inherits(samples, "data.frame")){ 70 | if(!(marker %in% c("d2H", "d18O"))){ 71 | stop("marker must be d2H or d18O") 72 | } 73 | if(!(marker %in% names(samples))){ 74 | stop("samples must include a data field for the selected marker") 75 | } 76 | if(!(paste0(marker, ".sd") %in% names(samples))){ 77 | stop("samples must include a sd field for the selected marker") 78 | } 79 | if(!(paste0(marker, "_cal") %in% names(samples))){ 80 | stop("samples must include a calibration scale field for the selected marker") 81 | } 82 | if(marker == "d2H"){ 83 | #Vector of all starting calibration scales 84 | start_scales = unique(samples$d2H_cal) 85 | #Which adjacency matrix and calibration table? 86 | am = ham 87 | cal_table = hstds 88 | #Pull starting standard scales for use 89 | samples_scales = samples$d2H_cal 90 | #SD column 91 | sd_col = "d2H.sd" 92 | } else { 93 | start_scales = unique(samples$d18O_cal) 94 | am = oam 95 | cal_table = ostds 96 | samples_scales = samples$d18O_cal 97 | sd_col = "d18O.sd" 98 | } 99 | if(!is.numeric(samples[,marker])){ 100 | stop("samples data field must be numeric") 101 | } 102 | if(!is.numeric(samples[,sd_col])){ 103 | stop("samples sd field must be numeric") 104 | } 105 | 106 | #Check that target exists in adj. matrix 107 | if(is.na(match(ref_scale, rownames(am)))){ 108 | stop("ref_scale not valid. No transformation possible.") 109 | } else{ 110 | #check whether ref_scale is a not floating calibration 111 | ref_scale.anchor = cal_table[cal_table$Calibration == ref_scale, 112 | "Ref_scale"] 113 | if(ref_scale != ref_scale.anchor){ 114 | #if so update ref_scale to floating target 115 | ref_scale = ref_scale.anchor 116 | wt = paste("ref_scale is calibrated to another scale. Returning values on", 117 | ref_scale, "scale.") 118 | message(wt) 119 | } 120 | trans_out = trans(start_scales, samples_scales, samples, ref_scale, 121 | am, cal_table, marker, sd_col, niter) 122 | if(nrow(trans_out$data > 0)){ 123 | if(marker == "d2H"){ 124 | trans_out$data$d2H_cal = rep(ref_scale) 125 | } else{ 126 | trans_out$data$d18O_cal = rep(ref_scale) 127 | } 128 | } else{ 129 | stop("No samples could be transformed") 130 | } 131 | class(trans_out) = "refTrans" 132 | return(trans_out) 133 | } 134 | 135 | } else{ 136 | stop("samples must be a data.frame") 137 | } 138 | 139 | } 140 | 141 | trans = function(start_scales, samples_scales, samples, ref_scale, am, 142 | cal_table, marker, sd_col, niter){ 143 | for(i in seq_along(start_scales)){ 144 | samples_sub = samples[samples_scales == start_scales[i],] 145 | chain = cal_chain(start_scales[i], ref_scale, am) 146 | if(!is.null(chain)){ 147 | if(length(chain) > 1){ 148 | #Sample from originally calibrated values 149 | vals = matrix(nrow = nrow(samples_sub), ncol = niter) 150 | for(j in seq_along(samples_sub[,1])){ 151 | vals[j,] = rnorm(niter, samples_sub[j, marker], 152 | samples_sub[j, sd_col]) 153 | } 154 | #Add uncertainty for first calibration, if present 155 | ssv1 = std_vals(chain[1], cal_table) 156 | if(!is.na(ssv1$lse)){ 157 | ssv2 = ssv1 158 | ssv2$lse = ssv2$hse = 0 159 | ssv1$ref_scale = "start" 160 | vals = cal_shift(vals, ssv1, ssv2, niter) 161 | } 162 | #Cycle through chain 163 | for(j in 1:(length(chain)-1)){ 164 | ssv1 = std_vals(chain[j], cal_table) 165 | ssv2 = std_vals(chain[j+1], cal_table) 166 | vals = cal_shift(vals, ssv1, ssv2, niter) 167 | if(is.null(vals)){ 168 | chain = NULL 169 | break 170 | } 171 | } 172 | if(!is.null(chain)){ 173 | samples_sub[, marker] = apply(vals, 1, mean) 174 | samples_sub[, sd_col] = apply(vals, 1, sd) 175 | } 176 | } 177 | } 178 | if(is.null(chain)){ 179 | if(i == 1){ 180 | samples_out = samples[0,] 181 | chain_out = list() 182 | } 183 | } else{ 184 | if(i == 1){ 185 | samples_out = samples_sub 186 | chain_out = list(chain) 187 | } else{ 188 | samples_out = rbind(samples_out, samples_sub) 189 | chain_out = append(chain_out, list(chain)) 190 | } 191 | } 192 | } 193 | return(list("data" = samples_out, "chains" = chain_out)) 194 | } 195 | 196 | 197 | #Breadth first algorithm to identify shortest standard chain 198 | cal_chain = function(ss1, ss2, scs){ 199 | #Get adj. matrix row/col index for starting calibration 200 | node.start = match(ss1, rownames(scs)) 201 | #This matrix will accumulate all possible paths 202 | chains = matrix(node.start, nrow = 1) 203 | #Current path length 204 | l = 1 205 | 206 | #Go until the target reference scale is found 207 | while(!(ss2 %in% rownames(scs)[chains[,l]])){ 208 | #Store the current number of paths 209 | srows = nrow(chains) 210 | #Add a step to the path 211 | l = l + 1 212 | #A new column in the matix records that step 213 | chains = cbind(chains, rep(NA)) 214 | #Each row is a unique path founds so far, cycle through them 215 | for(i in 1:nrow(chains)){ 216 | #If that path has already reached a dead end, skip it 217 | if(!is.na(chains[i, l-1])){ 218 | #Otherwise find all calibrations that can be reached from 219 | #the end of the current path 220 | nodes.n = unname(which(scs[chains[i, l-1],] == 1)) 221 | #For each of those possible new nodes 222 | for(j in nodes.n){ 223 | #check to make sure new node is not already in chain 224 | if(!(j %in% chains[i,])){ 225 | #if not, add a new row to matrix representing the 226 | #newly extended path...contining old path + new node 227 | chains = rbind(chains, c(chains[i,1:(l-1)], j)) 228 | } 229 | } 230 | } 231 | } 232 | #If no new rows have been added then exploration of the Adj. Mat. 233 | #has finished without reaching the target. Exit with error. 234 | if(nrow(chains) == srows){ 235 | warning(paste("Values can not be converted from", ss1, "to", 236 | ss2, "standard scale. Some samples dropped from scale transformation")) 237 | return(NULL) 238 | } 239 | } 240 | #Return the chain connecting ss1 and ss2 241 | chain = chains[match(ss2, rownames(scs)[chains[,l]]),] 242 | chain = rownames(scs)[chain] 243 | return(chain) 244 | } 245 | 246 | std_vals = function(scale, sds){ 247 | lm = sds$Low[sds$Calibration == scale] 248 | hm = sds$High[sds$Calibration == scale] 249 | lse = sds$Low_se[sds$Calibration == scale] 250 | hse = sds$High_se[sds$Calibration == scale] 251 | ref_scale = sds$Ref_scale[sds$Calibration == scale] 252 | ssv = list("lm" = lm, "hm" = hm, "lse" = lse, "hse" = hse, 253 | "ref_scale" = ref_scale) 254 | class(ssv) = "ssv" 255 | return(ssv) 256 | } 257 | 258 | cal_shift = function(vals, ssv1, ssv2, niter){ 259 | if(!inherits(ssv1, "ssv") | !inherits(ssv2, "ssv")){ 260 | stop("RM values must be provided as class ssv") 261 | } 262 | 263 | if(ssv1$ref_scale != ssv2$ref_scale){ 264 | if(!is.na(ssv1$lse)){ 265 | if(!is.na(ssv2$lse)){ 266 | ssv1.lv = rnorm(niter, ssv1$lm, ssv1$lse) 267 | ssv1.hv = rnorm(niter, ssv1$hm, ssv1$hse) 268 | ssv2.lv = rnorm(niter, ssv2$lm, ssv2$lse) 269 | ssv2.hv = rnorm(niter, ssv2$hm, ssv2$hse) 270 | } else{ 271 | ssv1.lv = rnorm(niter, ssv1$lm, ssv1$lse) 272 | ssv1.hv = rnorm(niter, ssv1$hm, ssv1$hse) 273 | ssv2.lv = ssv2$lm 274 | ssv2.hv = ssv2$hm 275 | } 276 | } else if(!is.na(ssv2$lse)){ 277 | ssv1.lv = ssv1$lm 278 | ssv1.hv = ssv1$hm 279 | ssv2.lv = rnorm(niter, ssv2$lm, ssv2$lse) 280 | ssv2.hv = rnorm(niter, ssv2$hm, ssv2$hse) 281 | } else{ 282 | ssv1.lv = ssv1$lm 283 | ssv1.hv = ssv1$hm 284 | ssv2.lv = ssv2$lm 285 | ssv2.hv = ssv2$hm 286 | } 287 | 288 | m = (ssv2.hv - ssv2.lv) / (ssv1.hv - ssv1.lv) 289 | b = ssv2.hv - ssv1.hv * m 290 | 291 | vals.new = vals * m + b 292 | 293 | return(vals.new) 294 | } else{ 295 | return(vals) 296 | } 297 | 298 | } 299 | -------------------------------------------------------------------------------- /R/subOrigData.R: -------------------------------------------------------------------------------- 1 | subOrigData = function(marker = "d2H", taxon = NULL, group = NULL, dataset = NULL, 2 | age_code = NULL, mask = NULL, ref_scale = "VSMOW_H", 3 | niter = 5000, genplot = TRUE) { 4 | 5 | #load data in function environment 6 | knownOrig = knownOrig 7 | knownOrig_samples = knownOrig$samples 8 | knownOrig_sites = knownOrig$sites 9 | knownOrig_sources = knownOrig$sources 10 | 11 | result = knownOrig_samples 12 | 13 | if(length(marker) > 1){ 14 | stop("only one marker currently allowed") 15 | } 16 | if(!marker %in% colnames(knownOrig_samples)){ 17 | stop("marker must be column name for isotope data field") 18 | } 19 | 20 | if(!is.null(taxon)){ 21 | if(!all(taxon %in% unique(knownOrig_samples$Taxon))){ 22 | warning("One or more taxa not present in database") 23 | } 24 | result = result[result$Taxon %in% taxon,] 25 | } 26 | 27 | if(!is.null(group)){ 28 | if(!all(group %in% unique(knownOrig_samples$Group))){ 29 | warning("One or more groups not present in database") 30 | } 31 | result = result[result$Group %in% group,] 32 | } 33 | 34 | if(!is.null(dataset)){ 35 | if(!is.numeric(dataset)){ 36 | warning("dataset format should now be a numeric dataset ID, see knownOrig_sources.rda") 37 | } else if(!all(dataset %in% unique(knownOrig_sources$Dataset_ID))){ 38 | warning("One or more datasets not present in database") 39 | } 40 | result = result[result$Dataset_ID %in% dataset,] 41 | } 42 | 43 | if(!is.null(age_code)){ 44 | if(!all(age_code %in% unique(knownOrig_samples$Age_class))){ 45 | warning("One or more age codes not present in database") 46 | } 47 | result = result[result$Age_class %in% age_code,] 48 | } 49 | 50 | result = result[!is.na(result[,marker]),] 51 | if(nrow(result) == 0){ 52 | stop("No samples match query") 53 | } 54 | 55 | mask = check_mask(mask, knownOrig_sites) 56 | if(!is.null(mask)){ 57 | result_sites = knownOrig_sites[mask,] 58 | 59 | if(length(result_sites) > 0){ 60 | result = result[result$Site_ID %in% result_sites$Site_ID,] 61 | if(nrow(result) > 0) { 62 | result_sites = result_sites[result_sites$Site_ID %in% 63 | result$Site_ID,] 64 | } else{ 65 | stop("No samples found in mask\n") 66 | } 67 | } else{ 68 | stop("No sites found in mask\n") 69 | } 70 | 71 | } else{ 72 | result_sites = knownOrig_sites[knownOrig_sites$Site_ID %in% 73 | result$Site_ID,] 74 | } 75 | 76 | message(paste(length(result[,1]),"samples are found from", 77 | length(result_sites), "sites")) 78 | 79 | result_sources = knownOrig_sources[knownOrig_sources$Dataset_ID %in% 80 | result$Dataset_ID,] 81 | 82 | if(!is.null(ref_scale)){ 83 | if(marker == "d2H"){ 84 | result = merge(result, result_sources[,c("Dataset_ID", "H_cal")], 85 | by = "Dataset_ID", all.x = TRUE) 86 | } else{ 87 | result = merge(result, result_sources[,c("Dataset_ID", "O_cal")], 88 | by = "Dataset_ID", all.x = TRUE) 89 | } 90 | class(result) = "SOD" 91 | trans_out = refTrans(result, marker, ref_scale, niter) 92 | result_data = merge(result_sites, trans_out$data, by = "Site_ID", 93 | all.x = FALSE, duplicateGeoms = TRUE) 94 | 95 | return_obj = list("data" = result_data, "sources" = 96 | result_sources, "chains" = trans_out$chains, 97 | "marker" = marker) 98 | class(return_obj) = "subOrigData" 99 | message(paste(length(result_data$Sample_ID), "samples from", 100 | length(unique(result_data$Site_ID)), 101 | "sites in the transformed dataset")) 102 | } else{ 103 | result_data = merge(result_sites, result, by = "Site_ID", 104 | all.x = FALSE, duplicateGeoms = TRUE) 105 | 106 | return_obj = list("data" = result_data, "sources" = result_sources, 107 | "chains" = NULL, "marker" = marker) 108 | class(return_obj) = "subOrigData" 109 | } 110 | 111 | if(!inherits(genplot, "logical")) { 112 | message("genplot should be logical (T or F), using default = T") 113 | genplot = TRUE 114 | } 115 | 116 | if(genplot){ 117 | if(is.null(mask)){ 118 | wrld_simpl = wrld_simpl 119 | plot(wrld_simpl, axes = TRUE) 120 | points(result_data, col = "red", cex = 0.5) 121 | } else{ 122 | plot(mask, axes = TRUE) 123 | points(result_data, col = "red") 124 | } 125 | } 126 | 127 | return(return_obj) 128 | } 129 | -------------------------------------------------------------------------------- /R/summarize.R: -------------------------------------------------------------------------------- 1 | jointP = function(pdR){ 2 | 3 | if(!inherits(pdR, c("RasterStack", "RasterBrick", "SpatRaster"))){ 4 | stop("input probability density map (pdR) should be a SpatRaster") 5 | } 6 | if(!inherits(pdR, "SpatRaster")){ 7 | warning("raster objects are depreciated, transition to package terra") 8 | pdR = rast(pdR) 9 | } 10 | 11 | n = nlyr(pdR) 12 | result = pdR[[1]] * pdR[[2]] 13 | if(n > 2){ 14 | for(i in seq_len(n)[-1:-2]){ 15 | result = result * pdR[[i]] 16 | } 17 | } 18 | 19 | result = result / global(result, sum, na.rm = TRUE)[1, 1] 20 | names(result) = "Joint_Probability" 21 | p = options("scipen") 22 | on.exit(options(p)) 23 | options(scipen = -2) 24 | plot(result) 25 | title("Joint Probability") 26 | return(result) 27 | } 28 | 29 | unionP = function(pdR){ 30 | 31 | if(!inherits(pdR, c("RasterStack", "RasterBrick", "SpatRaster"))){ 32 | stop("input probability density map (pdR) should be a SpatRaster") 33 | } 34 | if(!inherits(pdR, "SpatRaster")){ 35 | warning("raster objects are depreciated, transition to package terra") 36 | pdR = rast(pdR) 37 | } 38 | 39 | result = (1 - pdR[[1]]) 40 | n = nlyr(pdR) 41 | for(i in seq_len(n)[-1]){ 42 | result = lapp(c(result, pdR[[i]]), fun = function(x, y){return(x*(1-y))}) 43 | } 44 | 45 | plot(1-result) 46 | title("Union Probability") 47 | return(1-result) 48 | } -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/R/sysdata.rda -------------------------------------------------------------------------------- /R/wDist.R: -------------------------------------------------------------------------------- 1 | wDist = function(pdR, sites, maxpts = 1e5, bw = "sj"){ 2 | 3 | if(!inherits(pdR, c("RasterLayer", "RasterStack", "RasterBrick", "SpatRaster"))){ 4 | stop("input probability density map (pdR) should be a SpatRaster") 5 | } 6 | if(!inherits(pdR, "SpatRaster")){ 7 | warning("raster objects are depreciated, transition to package terra") 8 | pdR = rast(pdR) 9 | } 10 | if(crs(pdR) == ""){ 11 | stop("pdR must have coord. ref.") 12 | } 13 | 14 | if(!inherits(sites, c("SpatialPoints", "SpatVector"))){ 15 | stop("sites should be a SpatVector") 16 | } 17 | if(inherits(sites, "SpatialPoints")){ 18 | sites = vect(sites) 19 | } 20 | 21 | if(length(sites) == 1 & nlyr(pdR) > 1){ 22 | s = sites 23 | for(i in 2:nlyr(pdR)){ 24 | s = rbind(s, sites) 25 | } 26 | sites = s 27 | message("Single location in sites will be recycled") 28 | } 29 | if(length(sites) != nlyr(pdR)){ 30 | stop("sites and pdR have different lenghts; wDist requires one site per pdR layer") 31 | } 32 | if(crs(sites) == ""){ 33 | stop("sites must have coord. ref.") 34 | } 35 | if(!same.crs(sites, pdR)){ 36 | sites = project(sites, crs(pdR)) 37 | } 38 | 39 | if(!is.numeric(maxpts)){ 40 | stop("maxpts must be numeric") 41 | } 42 | if(!(round(maxpts) == maxpts) | maxpts < 1){ 43 | stop("maxpts must be a positive integer") 44 | } 45 | 46 | #make space 47 | wd = list() 48 | 49 | p = function(y, w){ 50 | Position(function(x) x >= y, w) 51 | } 52 | 53 | #for safety; using projected data works on most platforms 54 | pdR = project(pdR, "WGS84") 55 | sites = project(sites, "WGS84") 56 | 57 | for(i in seq_along(sites)){ 58 | pdSP = as.points(pdR[[i]]) 59 | if(length(pdSP) > maxpts){ 60 | index = sample(seq(length(pdSP)), maxpts) 61 | pdSP = pdSP[index,] 62 | pdSP = setValues(pdSP, values(pdSP) / sum(values(pdSP))) 63 | } 64 | 65 | d = distance(pdSP, sites[i,])[,1] 66 | b = bearing(geom(pdSP)[,c("x", "y")], 67 | geom(sites[i])[,c("x", "y")]) 68 | 69 | w = values(pdSP)[,1] 70 | d.dens = density(d, weights = w, bw = bw, warnWbw = FALSE) 71 | b.dens = density(b, weights = w, bw = bw, warnWbw = FALSE) 72 | 73 | #record weighted mean of distance distribution 74 | s = weighted.mean(d, w) 75 | 76 | #find and record quantiles within weighted distance distribution 77 | dw = cbind(d, w) 78 | dw = dw[order(d),] 79 | for(j in 2:nrow(dw)){ 80 | dw[j, 2] = dw[j, 2] + dw[j-1, 2] 81 | } 82 | 83 | qts = sapply(c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95), p, w = dw[, 2]) 84 | s = c(s, dw[qts, 1]) 85 | 86 | bxw = cbind(b, w) 87 | 88 | #find minimum weight value in bearing data to establish 'break' 89 | bbins = seq(-180, 170, by = 10) 90 | mp = 1 91 | for(j in bbins){ 92 | pbin = sum(bxw[bxw[,1] >= j & bxw[,1] < j + 10, 2]) 93 | if(pbin < mp){ 94 | mp = pbin 95 | mpb = j 96 | } 97 | } 98 | 99 | #re-reference bearing data to break 100 | bxw[, 1] = bxw[, 1] - mpb 101 | for(j in seq_along(bxw[,1])){ 102 | if(bxw[j, 1] < 0){ 103 | bxw[j, 1] = bxw[j, 1] + 360 104 | } 105 | } 106 | 107 | #weighted mean, re-referenced 108 | s = c(s, weighted.mean(bxw[, 1], bxw[, 2])) 109 | 110 | #find and record quantiles within weighted bearing distribution 111 | bxw = bxw[order(bxw[, 1]),] 112 | for(j in 2:nrow(bxw)){ 113 | bxw[j, 2] = bxw[j, 2] + bxw[j-1, 2] 114 | } 115 | qts = sapply(c(0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95), p, w = bxw[, 2]) 116 | s = c(s, bxw[qts, 1]) 117 | 118 | #rectify bearings 119 | s[9:16] = s[9:16] + mpb 120 | for(j in 9:16){ 121 | if(s[j] >= 180){ 122 | s[j] = s[j] - 360 123 | } 124 | } 125 | names(s) = c("wMeanDist", "w05Dist", "w10Dist", "w25Dist", 126 | "w50Dist", "w75Dist", "w90Dist", "w95Dist", "wMeanBear", 127 | "w05Bear", "w10Bear", "w25Bear", "w50Bear", "w75Bear", 128 | "w90Bear", "w95Bear") 129 | 130 | wd[[i]] = list(stats = s, d.dens = d.dens, b.dens = b.dens) 131 | } 132 | 133 | class(wd) = "wDist" 134 | names(wd) = names(pdR) 135 | return(wd) 136 | } 137 | 138 | c.wDist = function(...){ 139 | 140 | a = list(...) 141 | 142 | if(!inherits(a[[1]], "wDist")){ 143 | stop("... must be one or more wDist objects") 144 | } 145 | 146 | n = 0 147 | for(i in seq_len(length(a))){ 148 | if(inherits(a[[i]], "wDist")){ 149 | n = n + 1 150 | } else{ 151 | stop("this method only accepts wDist objects as arguments") 152 | } 153 | } 154 | 155 | s = matrix(ncol = 16) 156 | k = 1 157 | for(i in seq_len(n)){ 158 | nn = length(a[[i]]) 159 | for(j in seq_len(length(a[[i]]))){ 160 | if(k == 1){ 161 | s = matrix(a[[i]][[j]]$stats, nrow = 1) 162 | nms = names(a[[i]][j]) 163 | } else{ 164 | s = rbind(s, a[[i]][[j]]$stats) 165 | nms = append(nms, names(a[[i]][j])) 166 | } 167 | k = k + 1 168 | } 169 | } 170 | 171 | s = as.data.frame(s) 172 | names(s) = names(a[[1]][[1]]$stats) 173 | s = cbind("Sample_ID" = nms, s) 174 | 175 | return(s) 176 | } 177 | 178 | plot.wDist = function(x, ..., bin = 20, pty = "both", index = c(1:5)){ 179 | 180 | if(!inherits(x, "wDist")){ 181 | stop("x must be a wDist object") 182 | } 183 | 184 | n = length(x) 185 | if(n == 0){ 186 | stop("x is empty") 187 | } 188 | 189 | if(any(round(index) != index)){ 190 | stop("index values must be integers") 191 | } 192 | if(length(index) > 5){ 193 | message("more than 5 values in index, only the first 5 will be plotted") 194 | index = index[1:5] 195 | } 196 | if(length(index) == 5){ 197 | if(all(index == c(1:5)) & n < 5){ 198 | index = c(1:n) 199 | } 200 | } 201 | if(any(index > n)){ 202 | message("index values exceeding length of x will not be plotted") 203 | index = index[index <= n] 204 | } 205 | np = length(index) 206 | 207 | if(!is.numeric(bin)){ 208 | stop("bin must be numeric") 209 | } 210 | if(length(bin) > 1){ 211 | stop("bin must be length 1") 212 | } 213 | if(bin <=0 | bin > 90){ 214 | stop("bin must be a value between 0 and 90") 215 | } 216 | if(360 %% bin != 0){ 217 | stop("bin should be a factor of 360") 218 | } 219 | 220 | if(!(pty %in% c("both", "dist", "bear"))){ 221 | stop("pty not valid for plot.xist") 222 | } 223 | 224 | opar = par(no.readonly = TRUE) 225 | on.exit(par(opar)) 226 | 227 | if(pty %in% c("both", "dist")){ 228 | #Distance 229 | d.xmax = d.ymax = 0 230 | d.dens = list() 231 | for(i in index){ 232 | d.dens[[i]] = x[[i]]$d.dens 233 | d.xmax = max(d.xmax, max(d.dens[[i]]$x)) 234 | d.ymax = max(d.ymax, max(d.dens[[i]]$y)) 235 | } 236 | 237 | plot(d.dens[[index[1]]], xlim = c(0, d.xmax), ylim = c(0, d.ymax), 238 | main = "", ylab = "Probability density", xlab = "Distance (m)", 239 | col = index[1]) 240 | for(i in index[-1]){ 241 | lines(d.dens[[i]], col = i) 242 | } 243 | legend("topright", legend = unique(names(x)[index]), lty = 1, 244 | col = unique(index), inset = 0.01) 245 | } 246 | 247 | if(pty %in% c("both", "bear")){ 248 | #Bearing 249 | b.dens = list() 250 | for(i in index){ 251 | b.dens[[i]] = x[[i]]$b.dens 252 | } 253 | 254 | arc = function(a1, a2, b){ 255 | a = seq(a1, a2, by = 0.5) 256 | r = 2 * pi * a / 360 257 | x = sin(r) * b 258 | y = cos(r) * b 259 | return(cbind(x, y)) 260 | } 261 | 262 | wedge = function(a1, a2, b){ 263 | xy = arc(a1, a2, b) 264 | xy = rbind(c(0,0), xy, c(0,0)) 265 | return(xy) 266 | } 267 | 268 | bins = seq(-180, 179.9, by = bin) 269 | vals = numeric(length(bins)) 270 | 271 | if(np > 3){ 272 | mfr = 2 273 | if(np == 5){ 274 | mfc = 3 275 | }else{ 276 | mfc = 2 277 | } 278 | } else{ 279 | mfr = 1 280 | mfc = np 281 | } 282 | par(mfrow = c(mfr, mfc), mar = c(1,1,2,1)) 283 | 284 | for(i in index){ 285 | b = b.dens[[i]]$x 286 | for(j in seq_along(b)){ 287 | if(b[j] < -180){ 288 | b[j] = b[j] + 360 289 | } else if(b[j] >= 180){ 290 | b[j] = b[j] - 360 291 | } 292 | } 293 | y = b.dens[[i]]$y 294 | for(j in seq_along(bins)){ 295 | vals[j] = sum(y[b >= bins[j] & b < bins[j] + bin]) 296 | } 297 | 298 | b.max = max(vals) 299 | xy = arc(-180, 180, b.max) 300 | plot(xy, type = "l", col = "dark grey", axes = FALSE, 301 | ylim = c(-b.max, 1.05 * b.max), 302 | xlab = "", ylab = "", asp = 1, main = names(x)[i]) 303 | text(0, b.max * 1.05, paste0("max=", signif(b.max, 2)), 304 | col = "dark grey", pos = 4, offset = 1) 305 | lines(arc(-180, 180, b.max/2), col = "dark grey") 306 | for(j in c(-180, -90, 0, 90)){ 307 | lines(wedge(j, j, b.max * 1.05), col = "dark grey") 308 | } 309 | for(j in seq_along(bins)){ 310 | xy = wedge(bins[j], bins[j] + bin, vals[j]) 311 | c = col2rgb(i) 312 | polygon(xy, col = rgb(c[1], c[2], c[3], 313 | alpha = 200, maxColorValue = 255)) 314 | } 315 | } 316 | } 317 | 318 | par(opar) 319 | return() 320 | } 321 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # assignR 2 | 3 | ## Basic 4 | 5 | Data and tools supporting geographic assignment of materials based on their isotopic chemistry. Isoscapes (environmental isotope maps) can be generated externally or downloaded using the *getIsoscapes* function. Data from samples of known origin are used to calibrate the relationship between isoscape and sample values, and can be provided by the user or extracted from the package database (*knownOrig.rda*). Database data or user-provided known-origin or unknown origin sample data can be transformed among different H and O isotope reference scales to improve comparability (*refTrans*). Functions (*calRaster*, *pdRaster*) support calibrating one or more isoscapes (multiple layers combined using *isoStack*) and inverting the assignment model to estimate the probability of origin for unknown samples across a geographic study domain. Functions (*QA*, *plot.QA*) allow quality assessment of assignment results and comparison of methods using split-sample tests and known origin data. Functions (*oddsRatio*, *qtlRaster*, *jointP*, *unionP*) support post-hoc classification of results, summarization of results from multiple samples, and comparison of support for different locations. 6 | 7 | For current production release, see the vignette [here](https://CRAN.R-project.org/package=assignR) and install from CRAN. 8 | 9 | For examples demonstrating functions in the latest development release, see [https://spatial-lab.github.io/assignR/](https://spatial-lab.github.io/assignR/). 10 | 11 | ## Install and load latest CRAN release 12 | install.packages("assignR") 13 | library(assignR) 14 | 15 | ## Package contents 16 | 17 | **Datasets** 18 | 19 | *d2h_lrNA* - Low-resolution, North American crop of growing season d2H isoscape, used in examples. 20 | 21 | *sr_MI* - Low-resolution crop of locally-weathered Sr isoscape, used in examples. 22 | 23 | *knownOrig* - Hydrogen and oxygen isotope values of known-origin samples including human hair, insect chitin and bird feathers, with location information. 24 | 25 | *stds* - Information on reference scales used to report data from different labs, useful for converting between scales 26 | 27 | *naMap* - North America outline 28 | 29 | *states* - 48 contiguous United States 30 | 31 | **Functions** 32 | 33 | *subOrigData* - Subset the known-origin stable isotope dataset included in this package 34 | 35 | *refTrans* - Transform data among reference scales 36 | 37 | *getIsoscapes* - Download and unpack isoscapes from waterisotopes.org 38 | 39 | *isoStack* - Combine multiple isoscapes 40 | 41 | *plot.isoStack* - Plot isoStack object 42 | 43 | *calRaster* - Transform one or more isoscapes to reflect target sample type 44 | 45 | *pdRaster* - Assign sample to calibrated isoscape(S) based on isotopic composition(s) 46 | 47 | *qtlRaster* - Select most likely region of origin from posterior probability surface (by cumulative percent area probability) 48 | 49 | *jointP* - Calculate joint probability for individuals of common origin (product of probabilities) 50 | 51 | *unionP* - Calculate probability that at least one individual came from each map location (union of probabilities) 52 | 53 | *oddsRatio* - Calculate ratio of odds for two locations or areas (points or polygons) 54 | 55 | *wDist* - Summarize distance and direction of movement 56 | 57 | *c.wDist* - Combine wDist statistics for multiple samples 58 | 59 | *plot.wDist* - Plot results from wDist 60 | 61 | *QA* - Quality analysis of geographic assignment 62 | 63 | *plot.QA* - Plot results of one or more quality analyses from QA function 64 | 65 | 66 | [![Build status](https://github.com/SPATIAL-Lab/assignR/actions/workflows/r.yml/badge.svg)](https://github.com/SPATIAL-Lab/assignR/actions) 67 | [![codecov](https://codecov.io/gh/SPATIAL-Lab/assignR/branch/master/graph/badge.svg)](https://app.codecov.io/gh/SPATIAL-Lab/assignR) 68 | 69 | 70 | -------------------------------------------------------------------------------- /Rmarkdown/body.Rmd: -------------------------------------------------------------------------------- 1 | 2 | We will introduce the basic functionality of **assignR** using data bundled with the package. We'll review how to access data for known-origin biological samples and environmental models, use these to fit and apply functions estimating the probability of sample origin across a study region, and summarize these results to answer research and conservation questions. We'll also demonstrate a quality analysis tool useful in study design, method comparison, and uncertainty analysis. 3 | 4 | ***** 5 | Let's load **assignR** and another package we'll need. 6 | 7 | ```{r load, message=FALSE, warning=FALSE, results="hide"} 8 | library(assignR) 9 | library(terra) 10 | ``` 11 | 12 | ***** 13 | Now use data from the package to plot a simplified North America boundary mask. 14 | 15 | ```{r boundary} 16 | plot(naMap) 17 | ``` 18 | 19 | ***** 20 | Let's do the same for a growing season precipitation H isoscape for North America. Notice this is a spatial raster (SpatRaster) with two layers, the mean prediction and a standard error of the prediction. The layers are from [waterisotopes.org](https://wateriso.utah.edu/waterisotopes/), and their resolution has been reduced to speed up processing in these examples. Full-resolution isoscapes of several different types can be downloaded using the `getIsoscapes` function (refer to the help page for details). 21 | 22 | ```{r isoscape, fig.width=7, fig.asp=0.45} 23 | plot(d2h_lrNA) 24 | ``` 25 | 26 | ***** 27 | The package includes a database of H and O isotope data for known origin samples (`knownOrig.rda`), which consists of three features (`sites`, `samples`, and `sources`). Let's load it and have a look. First we'll get the names of the data fields available in the tables. 28 | 29 | ```{r knownOrig_names} 30 | names(knownOrig$sites) 31 | names(knownOrig$samples) 32 | names(knownOrig$sources) 33 | ``` 34 | 35 | The `sites` feature is a spatial object that records the geographic location of all sites from which samples are available. 36 | 37 | ```{r knownOrig_sites, fig.width=6, fig.asp=0.6} 38 | plot(wrld_simpl) 39 | points(knownOrig$sites, col = "red") 40 | ``` 41 | 42 | Now lets look at a list of species names available. 43 | 44 | ```{r knownOrig_taxa} 45 | unique(knownOrig$samples$Taxon) 46 | ``` 47 | 48 | ***** 49 | Load H isotope data for North American Loggerhead Shrike from the package database. 50 | 51 | ```{r birdData, fig.width=5, fig.asp=0.8} 52 | Ll_d = subOrigData(taxon = "Lanius ludovicianus", mask = naMap) 53 | ``` 54 | 55 | By default, the `subOrigData` function transforms all data to a common reference scale (defined by the standard materials and assigned, calibrated values for those; by default VSMOW-SLAP) using data from co-analysis of different laboratory standards (see [Magozzi et al., 2021](https://doi.org/10.1111/2041-210X.13556)). The calibrations used are documented in the function's return object. 56 | 57 | ```{r birdChains} 58 | Ll_d$chains 59 | ``` 60 | 61 | Information on these calibrations is contained in the `stds.rda` data file. 62 | 63 | Transformation is important when blending data from different labs or papers because different reference scales have been used to calibrate published data and these calibrations are not always comparable. In this case all the data come from one paper: 64 | 65 | ```{r birdSources} 66 | Ll_d$sources[,1:3] 67 | ``` 68 | 69 | If we didn't want to transform the data, and instead wished to use the reference scale from the original publication, we can specify that in our call to `subOrigData`. Keep in mind that any subsequent analyses using these data will be based on this calibration scale: for example, if you wish to assign samples of unknown origin, the values for those samples should be reported on the same scale. 70 | 71 | ```{r birdNoTrans, fig.width=5, fig.asp=0.8} 72 | Ll_d = subOrigData(taxon = "Lanius ludovicianus", mask = naMap, ref_scale = NULL) 73 | Ll_d$sources$H_cal 74 | ``` 75 | 76 | For a real application you would want to explore the database to find measurements that are appropriate to your study system (same or similar taxon, geographic region, measurement approach, etc.) or collect and import known-origin data that are specific to your system. 77 | 78 | ***** 79 | # Single-isoscape Analysis 80 | 81 | We need to start by assessing how the environmental (precipitation) isoscape values correlate with the sample values. `calRaster` fits a linear model relating the precipitation isoscape values to sample values, and applies it to produce a calibrated, sample-type specific isoscape. 82 | 83 | ```{r calRaster, fig.width=6, fig.asp=0.8, out.width='90%'} 84 | d2h_Ll = calRaster(known = Ll_d, isoscape = d2h_lrNA, mask = naMap) 85 | ``` 86 | 87 | ***** 88 | Let's create some hypothetical samples to use in demonstrating how we can evaluate the probability that the samples originated from different parts of the isoscape. The isotope values are drawn from a random distribution with a standard deviation of 8 per mil, which is a pretty reasonable variance for conspecific residents at a single location. We'll also add made-up values for the analytical uncertainty for each sample and a column recording the calibration scale used for our measurements. If you had real measured data for your study samples you would load them here, instead. 89 | 90 | ```{r samples} 91 | id = letters[1:5] 92 | set.seed(123) 93 | d2H = rnorm(5, -110, 8) 94 | d2H.sd = runif(5, 1.5, 2.5) 95 | d2H_cal = rep("UT_H_1", 5) 96 | Ll_un = data.frame(id, d2H, d2H.sd, d2H_cal) 97 | print(Ll_un) 98 | ``` 99 | 100 | As discussed above, one issue that must be considered with any organic H or O isotope data is the reference scale used by the laboratory producing the data. The reference scale for your unknown samples should be the same as that for the known origin data used in calRaster. Remember that the scale for our known origin data `d` is *OldEC.1_H_1*. Let's assume that our fake data were normalized to the *UT_H_1* scale. The `refTrans` function allows us to convert between the two. 101 | 102 | ```{r refTrans} 103 | Ll_un = refTrans(Ll_un, ref_scale = "OldEC.1_H_1") 104 | print(Ll_un) 105 | ``` 106 | 107 | Notice that both the d2H values and the uncertainties have been updated to reflect the scale transformation. 108 | 109 | ***** 110 | Now we will produce posterior probability density maps for the unknown samples. For reference on the Bayesian inversion method see [Wunder, 2010](https://doi.org/10.1007/978-90-481-3354-3_12) 111 | 112 | ```{r pdRaster, fig.width=6, fig.asp=0.6, out.width='95%'} 113 | Ll_prob = pdRaster(d2h_Ll, Ll_un) 114 | ``` 115 | 116 | Cell values in these maps are small because each cell's value represents the probability that this one cell, out of all of them on the map, is the actual origin of the sample. Together, all cell values on the map sum to '1', reflecting the assumption that the sample originated *somewhere* in the study area. Let's check this for sample 'a'. 117 | 118 | ```{r sums} 119 | global(Ll_prob[[1]], 'sum', na.rm = TRUE) 120 | ``` 121 | 122 | Check out the help page for `pdRaster` for additional options, including the use of informative prior probabilities. 123 | 124 | ***** 125 | # Multi-isoscape Analysis 126 | 127 | We can also use multiple isoscapes to (potentially) add power to our analyses. We will start by calibrating a H isoscape for the monarch butterfly, *Danaus plexippus*. 128 | 129 | ```{r Dp, fig.width=5, fig.asp=0.8, out.width='45%'} 130 | Dp_d = subOrigData(taxon = "Danaus plexippus") 131 | d2h_Dp = calRaster(Dp_d, d2h_lrNA) 132 | ``` 133 | 134 | ***** 135 | Our second isoscape represents ^87^Sr/^86^Sr values across our study region, the state of Michigan. It was published by [Bataille and Bowen, 2012](https://doi.org/10.1016/j.chemgeo.2012.01.028), obtained from [waterisotopes.org](https://wateriso.utah.edu/waterisotopes/), cropped and aggregated to coarser resolution, and a rough estimate of uncertainty added. 136 | 137 | In this case, we do not have any known-origin tissue samples to work with. However, our isoscape was developed to approximate the bioavailable Sr pool, and Sr isotopes are not strongly fractionated in food webs. Thus, our analysis will assume that the isoscape provides a good representation of the expected Sr values for our study species without calibration. 138 | 139 | Let's look at the Sr isoscape and compare it with our butterfly H isoscape. 140 | 141 | ```{r srIso, fig.width=5, fig.asp=0.8, out.width='45%'} 142 | plot(sr_MI$weathered.mean) 143 | crs(sr_MI, describe = TRUE) 144 | crs(d2h_Dp$isoscape.rescale, describe = TRUE) 145 | ``` 146 | 147 | Notice that the we have two different spatial data objects, one for Sr and one for d2H, and that they have different extents and projections. In order to conduct a multi-isotope analysis, we'll first combine these into a single object using the `isoStack` function. In addition to combining the objects, this function resolves differences in their projection, resolution, and extent. It's always a good idea to check that the properties of the isoStack components are consistent with your expectations. 148 | 149 | ```{r isoStack} 150 | Dp_multi = isoStack(d2h_Dp, sr_MI) 151 | lapply(Dp_multi, crs, describe = TRUE) 152 | ``` 153 | 154 | ***** 155 | Now we'll generate a couple of hypothetical unknown samples to use in our analysis. It is important that our isotopic markers appear here in the same order as in the `isoStack` object we created above. 156 | 157 | ```{r Dp_unknown} 158 | Dp_unk = data.frame("ID" = c("A", "B"), "d2H" = c(-86, -96), "Sr" = c(0.7089, 0.7375)) 159 | ``` 160 | 161 | ***** 162 | We are ready to make our probability maps. First let's see how our posterior probabilities would look if we only used the hydrogen isotope data. 163 | 164 | ```{r Dp_Honly, fig.width=5, fig.asp=0.6, out.width='85%'} 165 | Dp_pd_Honly = pdRaster(Dp_multi[[1]], Dp_unk[,-3]) 166 | ``` 167 | 168 | We see pretty clear distinctions between the two samples, driven by a strong SW-NE gradient in the tissue isoscape H values across the state. 169 | 170 | ***** 171 | What if we add the Sr information to the analysis? The syntax for running `pdRaster` is the same, but now we provide our isoStack object in place of the single isoscape. The function will use the spatial covariance of the isoscape values to approximate the error covariance for the two (or more) markers and return posterior probabilities based on the multivariate normal probability density function evaluated at each grid cell. 172 | 173 | ```{r Dp_multi, fig.width=5, fig.asp=0.6, out.width='85%'} 174 | Dp_pd_multi = pdRaster(Dp_multi, Dp_unk) 175 | ``` 176 | 177 | Note that the addition of Sr data greatly strengthens the geographic constraints on our hypothetical unknown samples: the difference between the highest and lowest posterior probabilities is much larger than with H only, and the pattern of high probabilities reflects the regionalization characteristic of the Sr isoscape. This is especially true for sample B, which has a fairly distinctive, high ^87^Sr/^86^Sr value. 178 | 179 | ***** 180 | # Post-hoc Analysis 181 | ## Odds Ratio 182 | 183 | Many of the functions in **assignR** are designed to help you analyze and draw inference from the posterior probability surfaces we've created above. For the following examples we'll return to our single-isoscape, Loggerhead shrike analysis, but the tools work identically for multi-isoscape results. 184 | 185 | The `oddsRatio` tool compares the posterior probabilities for two different locations or regions. This might be useful in answering real-world questions...for example "is this sample more likely from France or Spain?", or "how likely is this hypothesized location relative to other possibilities?". 186 | 187 | Let's compare probabilities for two spatial areas - the states of Utah and New Mexico. First we'll extract the state boundaries from package data and plot them. 188 | 189 | ```{r polygons} 190 | s1 = states[states$STATE_ABBR == "UT",] 191 | s2 = states[states$STATE_ABBR == "NM",] 192 | plot(naMap) 193 | plot(s1, col = c("red"), add = TRUE) 194 | plot(s2, col = c("blue"), add = TRUE) 195 | ``` 196 | 197 | Now we can get the odds ratio for the two regions. The result reports the odds ratio for the regions (first relative to second) for each of the 5 unknown samples plus the ratio of the areas of the regions. If the isotope values (& prior) were completely uninformative the odds ratios would equal the ratio of areas. 198 | 199 | ```{r oddsRatio1} 200 | s12 = rbind(s1, s2) 201 | oddsRatio(Ll_prob, s12) 202 | ``` 203 | 204 | Here you can see that even though Utah is quite a bit smaller the isotopic evidence suggests it's much more likely to be the origin of each sample. This result is consistent with what you might infer from a first-order comparison of the state map with the posterior probability maps, above. 205 | 206 | ***** 207 | Comparisons can also be made using points. Let's create two points (one in each of the Plover regions) and compare their odds. This result also shows the odds ratio for each point relative to the most- and least-likely grid cells on the posterior probability map. 208 | 209 | ```{r oddsRatio2} 210 | pp1 = c(-112,40) 211 | pp2 = c(-105,33) 212 | pp12 = vect(rbind(pp1,pp2)) 213 | crs(pp12) = crs(naMap) 214 | oddsRatio(Ll_prob, pp12) 215 | ``` 216 | 217 | The odds of the first point being the location of origin are pretty high for each sample, and much higher than for the second point. 218 | 219 | ## Distance and Direction 220 | 221 | A common goal in movement research is to characterize the distance or direction of movement for individuals. The `wDist` tool and it's helper methods are designed to leverage the information in the posterior probability surfaces for this purpose. 222 | 223 | The analyses conducted in **assignR** cannot determine a single unique location of origin for a given sample, but the do give the probability that each location on the map is the location of origin. If we know the collection location for a sample, we can calculate the distance and direction between each possible location of origin and the collection site, and weighting these by their posterior probability generate a distribution (and statistics for that distribution) describing the distance and direction of travel. 224 | 225 | Let's do a weighted distance analysis for our first two unknown origin loggerhead shrike samples. Since these are pretend samples, we'll pretend that the two point locations we defined above for the `oddsRatio` analysis are the locations at which these samples were collected. Here are those locations plotted with the corresponding posterior probability maps. 226 | 227 | ```{r wDist1, fig.width=5, fig.asp=0.8, out.width='45%'} 228 | # View the data 229 | plot(Ll_prob[[1]], main = names(Ll_prob)[1]) 230 | points(pp12[1], cex = 2) 231 | plot(Ll_prob[[2]], main = names(Ll_prob)[2]) 232 | points(pp12[2], cex = 2) 233 | ``` 234 | 235 | Now let's run the analysis and use the functions `c` and `plot` to view the summary statistics and distributions returned by `wDist`. 236 | 237 | ```{r wDist2, fig.width=5, fig.asp=0.8, out.width='45%'} 238 | wd = wDist(Ll_prob[[1:2]], pp12) 239 | c(wd)[c(1,2,4,6,8,10,12,14,16)] #only showing select columns for formatting! 240 | plot(wd) 241 | ``` 242 | 243 | Comparing these statistics and plots with the data shows how the `wDist` metrics nicely summarize the direction and distance of movement. Both individuals almost certainly moved south from their location of origin to the collection location. Individual a's migration may have been a little bit shorter than b's, and in a more southwesterly direction, patterns that are dominated more by the difference in collection locations than the probability surfaces for location of origin. Also notice the multi-modal distance distribution for individual a...these can be common in `wDist` summaries so it's a good ideal to look at the distributions themselves before choosing and interpreting summary statistics. 244 | 245 | ## Assignment 246 | 247 | Researchers often want to classify their study area in to regions that are and are not likely to be the origin of the sample (effectively 'assigning' the sample to a part of the area). This requires choosing a subjective threshold to define how much of the study domain is represented in the assignment region. `qtlRaster` offers two choices. 248 | 249 | Let's extract 10% of the study area, giving maps that show the 10% of grid cells with the highest posterior probability for each sample. 250 | 251 | ```{r qtlRaster1, fig.width=5, fig.asp=0.8, out.width='45%'} 252 | qtlRaster(Ll_prob, threshold = 0.1) 253 | ``` 254 | 255 | ***** 256 | Now we'll instead extract 80% of the posterior probability density, giving maps that show the smallest region within which there is an 80% chance each sample originated. 257 | 258 | ```{r qtlRaster2, fig.width=5, fig.asp=0.8, out.width='45%'} 259 | qtlRaster(Ll_prob, threshold = 0.8, thresholdType = "prob") 260 | ``` 261 | 262 | Comparing the two results, the probability-based assignment regions are broader. This suggests that we'll need to assign to more than 10% of the study area if we want to correctly assign 80% or more of our samples. We'll revisit this below and see how we can chose thresholds that are as specific as possible while achieving a desired level of assignment 'quality'. 263 | 264 | ## Summarization 265 | 266 | Most studies involve multiple unknown samples, and often it is desirable to summarize the results from these individuals. `jointP` and `unionP` offer two options for summarizing posterior probabilities from multiple samples. 267 | 268 | `jointP` calculates the probability that **all** samples came from each grid cell in the analysis area. Note that this summarization will only be useful if all samples are truly derived from a single population of common geographic origin. 269 | 270 | ```{r jointP, fig.width=5, fig.asp=0.8} 271 | jointP(Ll_prob) 272 | ``` 273 | 274 | ***** 275 | `unionP` calculates the probability that **any** sample came from each grid cell in the analysis area. In this case we'll save the output to a variable for later use. 276 | 277 | ```{r unionP, fig.width=5, fig.asp=0.8} 278 | Ll_up = unionP(Ll_prob) 279 | ``` 280 | 281 | The results from `unionP` highlight a broader region, as you might expect. 282 | 283 | ***** 284 | Any of the other post-hoc analysis tools can be applied to the summarized results. Here we'll use `qtlRaster` to identify the 10% of the study area that is most likely to be the origin of one or more samples. 285 | 286 | ```{r qtlRaster3, fig.width=5, fig.asp=0.8} 287 | qtlRaster(Ll_up, threshold = 0.1) 288 | ``` 289 | 290 | ***** 291 | # Quality Analysis 292 | 293 | How good are the geographic assignments? What area or probability threshold should be used? Is it better to use isoscape *A* or *B* for my analysis? The `QA` function is designed to help answer these questions. 294 | 295 | `QA` uses known-origin data to test the quality of isotope-based assignments and returns a set of metrics from this test. The default method conducts a split-sample test, iteratively splitting the dataset and using part to calibrate the isoscape(s) and the rest to evaluate assignment quality. The option `recal = FALSE` allows `QA` to be run without the `calRaster` calibration step. This provides a less complete assessment of methodological error but allows evaluation of assignments to tissue isoscapes made outside of the `QA` function, for example those calibrated using a different known-origin dataset or made through spatial modeling of tissue data, directly. 296 | 297 | We will run quality assessment on the Loggerhead shrike known-origin dataset and precipitation isoscape. These analyses take some time to run, depending on the number of stations and iterations used. 298 | 299 | ```{r QA1, warning=FALSE, results='hide'} 300 | qa1 = QA(Ll_d, d2h_lrNA, valiStation = 8, valiTime = 4, by = 5, mask = naMap, name = "normal") 301 | ``` 302 | 303 | ***** 304 | We can plot the result using `plot`. 305 | 306 | ```{r plot.QA1, fig.width=4, fig.asp=1, out.width='45%'} 307 | plot(qa1) 308 | ``` 309 | 310 | The first three panels show three metrics, granularity (higher is better), bias (closer to 1:1 is better), and sensitivity (higher is better). The second plot shows the posterior probabilities at the known locations of origin relative to random (=1, higher is better). More information is provided in [Ma et al., 2020](https://doi.org/10.1111/2041-210X.13426). 311 | 312 | A researcher might refer to the sensitivity plot, for example, to assess what `qtlRaster` area threshold would be required to obtain 90% correct assignments in their study system. Here it's somewhere between 0.25 and 0.3. 313 | 314 | ***** 315 | How would using a different isoscape or different known origin dataset affect the analysis? Multiple QA objects can be compared to make these types of assessments. 316 | 317 | Let's modify our isoscape to add some random noise. 318 | 319 | ```{r modraster, fig.width=5, fig.asp=0.8} 320 | dv = values(d2h_lrNA[[1]]) 321 | dv = dv + rnorm(length(dv), 0, 15) 322 | d2h_fuzzy = setValues(d2h_lrNA[[1]], dv) 323 | plot(d2h_fuzzy) 324 | ``` 325 | 326 | ***** 327 | We'll combine the fuzzy isoscape with the uncertainty layer from the original isoscape, then rerun `QA` using the new version. Obviously this is not something you'd do in real work, but as an example it allows us to ask the question "how would the quality of my assignments change if my isoscape predictions were of reduced quality?". 328 | 329 | ```{r QA2, warning=FALSE, results='hide'} 330 | d2h_fuzzy = c(d2h_fuzzy, d2h_lrNA[[2]]) 331 | qa2 = QA(Ll_d, d2h_fuzzy, valiStation = 8, valiTime = 4, by = 5, mask = naMap, name = "fuzzy") 332 | ``` 333 | 334 | ***** 335 | Now we can `plot` to compare. 336 | 337 | ```{r plot.QA2, fig.width=4, fig.asp=1, out.width='45%'} 338 | plot(qa1, qa2) 339 | ``` 340 | 341 | Assignments made using the fuzzy isoscape are generally poorer than those made without fuzzing. Hopefully that's not a surprise, but you might encounter cases where decisions about how to design your project or conduct your data analysis do have previously unknown or unexpected consequences. These types of comparisons can help reveal them! 342 | 343 | ***** 344 | ***** 345 | Questions or comments? 346 | -------------------------------------------------------------------------------- /Rmarkdown/cran_header.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "assignR Examples" 3 | author: "Gabe Bowen, Chao Ma" 4 | date: "`r format(Sys.Date(), '%B %d, %Y')`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{assignR Examples} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | \usepackage[utf8]{inputenc} 10 | --- 11 | 12 | ```{r setup, include=FALSE} 13 | knitr::opts_chunk$set(echo = TRUE, warning = FALSE) 14 | ``` 15 | -------------------------------------------------------------------------------- /Rmarkdown/dev_header.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "assignR Examples - Dev Release" 3 | author: "Gabe Bowen, Chao Ma" 4 | date: "`r format(Sys.Date(), '%B %d, %Y')`" 5 | output: 6 | html_document: 7 | toc: true 8 | toc_float: true 9 | --- 10 | 11 | ```{r setup, include=FALSE} 12 | knitr::opts_chunk$set(echo = TRUE, warning = FALSE) 13 | ``` 14 | 15 | # Setup and Introduction 16 | 17 | This vignette demonstrates the latest features from the development version, which is installed via GitHub. 18 | 19 | ```{r install, eval=FALSE} 20 | library(devtools) 21 | install_github("SPATIAL-Lab/assignR@*release") 22 | ``` 23 | -------------------------------------------------------------------------------- /Rmarkdown/renderVignette.R: -------------------------------------------------------------------------------- 1 | 2 | dh = readLines("Rmarkdown/dev_header.Rmd") 3 | ch = readLines("Rmarkdown/cran_header.Rmd") 4 | b = readLines("Rmarkdown/body.Rmd") 5 | 6 | da = append(dh, b) 7 | ca = append(ch, b) 8 | 9 | writeLines(da, "Rmarkdown/bound/assignR.Rmd") 10 | writeLines(ca, "vignettes/assignR.Rmd") 11 | 12 | rmarkdown::render( 13 | "Rmarkdown/bound/assignR.Rmd", 14 | output_file = "../../docs/index.html" 15 | ) 16 | -------------------------------------------------------------------------------- /assignR.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | v2.4.3 fixes bug triggered in R dev. 2 | 3 | # Resubmission 4 | This is a resubmission in which I have added an Authors@R description field. 5 | 6 | # Test environments 7 | * local Windows 11 x64; R 4.4.2 8 | * Ubuntu 22.04.5 (on GitHub Actions); R 4.4.0 9 | * Mac OS 14.7.1 (on GitHub Actions); R 4.4.0 10 | * Windows Server 2022 (on GitHub Actions); r87417 11 | 12 | # R CMD check results 13 | No ERRORs, WARNINGs, or NOTEs 14 | 15 | # Downstream dependencies 16 | There are currently no downstream dependencies for this package. 17 | -------------------------------------------------------------------------------- /data-raw/ham.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/data-raw/ham.xlsx -------------------------------------------------------------------------------- /data-raw/hstds.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/data-raw/hstds.xlsx -------------------------------------------------------------------------------- /data-raw/knownOrig0_2.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/data-raw/knownOrig0_2.xlsx -------------------------------------------------------------------------------- /data-raw/ko_past_versions/knownOrig0_1.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/data-raw/ko_past_versions/knownOrig0_1.xlsx -------------------------------------------------------------------------------- /data-raw/oam.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/data-raw/oam.xlsx -------------------------------------------------------------------------------- /data-raw/ostds.xlsx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/data-raw/ostds.xlsx -------------------------------------------------------------------------------- /data-raw/prep_data.R: -------------------------------------------------------------------------------- 1 | library(openxlsx) 2 | library(devtools) 3 | library(terra) 4 | library(assignR) 5 | 6 | #---- 7 | 8 | #Download configuration data 9 | map_ln = c("d2h_MA.tif", "d2h_se_MA.tif", 10 | "d18o_MA.tif", "d18o_se_MA.tif") 11 | 12 | map_on = c("d2h_MA", "d2h_se_MA", "d18o_MA", "d18o_se_MA") 13 | 14 | mop_ln = c("d2h_01.tif", "d2h_se_01.tif", 15 | "d2h_02.tif", "d2h_se_02.tif", 16 | "d2h_03.tif", "d2h_se_03.tif", 17 | "d2h_04.tif", "d2h_se_04.tif", 18 | "d2h_05.tif", "d2h_se_05.tif", 19 | "d2h_06.tif", "d2h_se_06.tif", 20 | "d2h_07.tif", "d2h_se_07.tif", 21 | "d2h_08.tif", "d2h_se_08.tif", 22 | "d2h_09.tif", "d2h_se_09.tif", 23 | "d2h_10.tif", "d2h_se_10.tif", 24 | "d2h_11.tif", "d2h_se_11.tif", 25 | "d2h_12.tif", "d2h_se_12.tif", 26 | "d18o_01.tif", "d18o_se_01.tif", 27 | "d18o_02.tif", "d18o_se_02.tif", 28 | "d18o_03.tif", "d18o_se_03.tif", 29 | "d18o_04.tif", "d18o_se_04.tif", 30 | "d18o_05.tif", "d18o_se_05.tif", 31 | "d18o_06.tif", "d18o_se_06.tif", 32 | "d18o_07.tif", "d18o_se_07.tif", 33 | "d18o_08.tif", "d18o_se_08.tif", 34 | "d18o_09.tif", "d18o_se_09.tif", 35 | "d18o_10.tif", "d18o_se_10.tif", 36 | "d18o_11.tif", "d18o_se_11.tif", 37 | "d18o_12.tif", "d18o_se_12.tif") 38 | 39 | mop_on = c("d2h_01", "d2h_se_01", "d2h_02", "d2h_se_02", 40 | "d2h_03", "d2h_se_03", "d2h_04", "d2h_se_04", 41 | "d2h_05", "d2h_se_05", "d2h_06", "d2h_se_06", 42 | "d2h_07", "d2h_se_07", "d2h_08", "d2h_se_08", 43 | "d2h_09", "d2h_se_09", "d2h_10", "d2h_se_10", 44 | "d2h_11", "d2h_se_11", "d2h_12", "d2h_se_12", 45 | "d18o_01", "d18o_se_01", "d18o_02", "d18o_se_02", 46 | "d18o_03", "d18o_se_03", "d18o_04", "d18o_se_04", 47 | "d18o_05", "d18o_se_05", "d18o_06", "d18o_se_06", 48 | "d18o_07", "d18o_se_07", "d18o_08", "d18o_se_08", 49 | "d18o_09", "d18o_se_09", "d18o_10", "d18o_se_10", 50 | "d18o_11", "d18o_se_11", "d18o_12", "d18o_se_12") 51 | 52 | GIconfig = list( 53 | "GlobalPrecipGS" = list( 54 | dpath.post = "GlobalPrecipGS.zip", 55 | lnames = c("d2h_GS.tif", "d2h_se_GS.tif", 56 | "d18o_GS.tif", "d18o_se_GS.tif"), 57 | onames = c("d2h", "d2h.se", "d18o", "d18o.se"), 58 | eType = 2 59 | ), 60 | "USPrecipMA" = list( 61 | dpath.post = "USPrecip.zip", 62 | lnames = map_ln, 63 | onames = map_on, 64 | eType = 2 65 | ), 66 | "GlobalPrecipMA" = list( 67 | dpath.post = "GlobalPrecip.zip", 68 | lnames = map_ln, 69 | onames = map_on, 70 | eType = 2 71 | ), 72 | "USPrecipMO" = list( 73 | dpath.post = "USPrecip.zip", 74 | lnames = mop_ln, 75 | onames = mop_on, 76 | eType = 2 77 | ), 78 | "GlobalPrecipMO" = list( 79 | dpath.post = "GlobalPrecip.zip", 80 | lnames = mop_ln, 81 | onames = mop_on, 82 | eType = 2 83 | ), 84 | "USPrecipALL" = list( 85 | dpath.post = "USPrecip.zip", 86 | lnames = c(map_ln, mop_ln), 87 | onames = c(map_on, mop_on), 88 | eType = 2 89 | ), 90 | "GlobalPrecipALL" = list( 91 | dpath.post = "GlobalPrecip.zip", 92 | lnames = c(map_ln, mop_ln), 93 | onames = c(map_on, mop_on), 94 | eType = 2 95 | ), 96 | "USSurf" = list( 97 | dpath.post = "USSw.zip", 98 | lnames = c("d2h.tif", "d2h_se.tif", "d18o.tif", 99 | "d18o_se.tif"), 100 | onames = c("d2h", "d2h_sd", "d18o", "d18o_sd"), 101 | eType = 2 102 | ), 103 | "USTap" = list( 104 | dpath.post = "USTap.zip", 105 | lnames = c("d2h.tif", "d2h_se.tif", "d2h_sd.tif", "d18o.tif", 106 | "d18o_se.tif", "d18o_sd.tif"), 107 | onames = c("d2h", "d2h_se", "d2h_sd", "d18o", "d18o_se", 108 | "d18o_sd"), 109 | eType = 2 110 | ), 111 | "USGround" = list( 112 | dpath.post = "USGw.zip", 113 | lnames = c("d2h_1-10m.tif", "d2h_sd_1-10m.tif", 114 | "d2h_10-25m.tif", "d2h_sd_10-25m.tif", 115 | "d2h_25-50m.tif", "d2h_sd_25-50m.tif", 116 | "d2h_50-100m.tif", "d2h_sd_50-100m.tif", 117 | "d2h_100-200m.tif", "d2h_sd_100-200m.tif", 118 | "d2h_200-500m.tif", "d2h_sd_200-500m.tif", 119 | "d2h_500+m.tif", "d2h_sd_500+m.tif", 120 | "d18o_1-10m.tif", "d18o_sd_1-10m.tif", 121 | "d18o_10-25m.tif", "d18o_sd_10-25m.tif", 122 | "d18o_25-50m.tif", "d18o_sd_25-50m.tif", 123 | "d18o_50-100m.tif", "d18o_sd_50-100m.tif", 124 | "d18o_100-200m.tif", "d18o_sd_100-200m.tif", 125 | "d18o_200-500m.tif", "d18o_sd_200-500m.tif", 126 | "d18o_500+m.tif", "d18o_sd_500+m.tif"), 127 | onames = c("d2h_1-10m", "d2h_sd_1-10m", 128 | "d2h_10-25m", "d2h_sd_10-25m", 129 | "d2h_25-50m", "d2h_sd_25-50m", 130 | "d2h_50-100m", "d2h_sd_50-100m", 131 | "d2h_100-200m", "d2h_sd_100-200m", 132 | "d2h_200-500m", "d2h_sd_200-500m", 133 | "d2h_500+m", "d2h_sd_500+m", 134 | "d18o_1-10m", "d18o_sd_1-10m", 135 | "d18o_10-25m", "d18o_sd_10-25m", 136 | "d18o_25-50m", "d18o_sd_25-50m", 137 | "d18o_50-100m", "d18o_sd_50-100m", 138 | "d18o_100-200m", "d18o_sd_100-200m", 139 | "d18o_200-500m", "d18o_sd_200-500m", 140 | "d18o_500+m", "d18o_sd_500+m"), 141 | eType = 2 142 | ), 143 | "USSr" = list( 144 | dpath.post = "USSr.zip", 145 | lnames = c("USSr_Rock.tif", "USSr_Weath.tif", 146 | "USSr_Riv.tif"), 147 | onames = c("sr_rock", "sr_weath", "sr_riv"), 148 | eType = 1 149 | ), 150 | "CaribSr" = list( 151 | dpath.post = "CaribSr.zip", 152 | lnames = c("CaribSr_Rock.tif", "CaribSr_Weath.tif", 153 | "CaribSr_Riv.tif"), 154 | onames = c("sr_rock", "sr_weath", "sr_riv"), 155 | eType = 1 156 | ), 157 | "GlobalSr" = list( 158 | dpath.post = "GlobalSr.zip", 159 | lnames = c("GlobalSr.tif", "GlobalSr_se.tif"), 160 | onames = c("sr_bio", "sr_bio_se"), 161 | eType = 2 162 | ) 163 | ) 164 | 165 | #adjacency matrix for H 166 | ham = read.xlsx("data-raw/ham.xlsx", rowNames = TRUE) 167 | ham = as.matrix(ham) 168 | #Verify matrix symmetry 169 | isSymmetric(ham) 170 | 171 | #adjacency matrix for O 172 | oam = read.xlsx("data-raw/oam.xlsx", rowNames = TRUE) 173 | oam = as.matrix(oam) 174 | #Verify matrix symmetry 175 | isSymmetric(oam) 176 | 177 | #Standards definitions files 178 | hstds = read.xlsx("data-raw/hstds.xlsx") 179 | ostds = read.xlsx("data-raw/ostds.xlsx") 180 | 181 | #Verify rownumber matches adjacency matrix dimensions 182 | nrow(hstds) == nrow(ham) 183 | nrow(ostds) == nrow(oam) 184 | 185 | #Verify that all matrix entries have a match in definition file 186 | all(row.names(ham) %in% hstds$Calibration) 187 | all(row.names(oam) %in% ostds$Calibration) 188 | 189 | #Known origin data table 190 | knownOrig_sources = read.xlsx("data-raw/knownOrig0_2.xlsx", 191 | sheet = "knownOrig_sources") 192 | sites = read.xlsx("data-raw/knownOrig0_2.xlsx", 193 | sheet = "knownOrig_sites") 194 | knownOrig_samples = read.xlsx("data-raw/knownOrig0_2.xlsx", 195 | sheet = "knownOrig_samples") 196 | 197 | #check standard scale names 198 | ss = unique(knownOrig_sources$H_cal) 199 | ss = ss[!is.na(ss)] 200 | all(ss %in% hstds$Calibration) 201 | ss = unique(knownOrig_sources$O_cal) 202 | ss = ss[!is.na(ss)] 203 | all(ss %in% ostds$Calibration) 204 | 205 | #check linking fields 206 | all(knownOrig_samples$Site_ID %in% sites$Site_ID) 207 | all(knownOrig_samples$Dataset_ID %in% knownOrig_sources$Dataset_ID) 208 | 209 | #Convert to SpatVector 210 | knownOrig_sites = vect(sites, geom = c("Longitude", "Latitude"), crs = "WGS84") 211 | 212 | #Write knownOrig parts 213 | writeVector(knownOrig_sites, "inst/extdata/knownOrig_sites.shp", 214 | overwrite = TRUE) 215 | write.csv(knownOrig_samples, "inst/extdata/knownOrig_samples.csv", 216 | row.names = FALSE) 217 | write.csv(knownOrig_sources, "inst/extdata/knownOrig_sources.csv", 218 | row.names = FALSE) 219 | 220 | stds = list(hstds = hstds, ostds = ostds, ham = ham, oam = oam) 221 | 222 | #knownOrig info 223 | kov = list("version" = "0.2") 224 | kov$nSamples = nrow(knownOrig_samples) 225 | kov$nSites = length(knownOrig_sites) 226 | 227 | #Save internal 228 | use_data(GIconfig, kov, internal = TRUE, overwrite = TRUE) 229 | 230 | #Save external 231 | use_data(stds, overwrite = TRUE) 232 | 233 | #Prepare MI strontium isoscape 234 | sr = getIsoscapes("USSr") 235 | sr = sr$sr_weath 236 | srun = setValues(sr, values(sr) * 0.01) 237 | sr = c(sr, srun) 238 | states.proj = project(states, crs(sr)) 239 | mi = states.proj[states.proj$STATE_NAME == "Michigan",] 240 | sr_MI = mask(sr, mi) 241 | sr_MI = crop(sr_MI, mi) 242 | names(sr_MI) = c("weathered.mean", "weathered.sd") 243 | sr_MI = aggregate(sr_MI, 10) 244 | writeRaster(sr_MI, "inst/extdata/sr_MI.tif", overwrite = TRUE) 245 | 246 | #Prepare lrNA H isoscape 247 | pcp = getIsoscapes() 248 | pcp = c(pcp$d2h, pcp$d2h.se) 249 | pcp = mask(pcp, naMap) 250 | pcp = crop(pcp, naMap) 251 | d2h_lrNA = aggregate(pcp, 48, na.rm = TRUE) 252 | crs(d2h_lrNA) = crs("WGS84") 253 | writeRaster(d2h_lrNA, "inst/extdata/d2h_lrNA.tif", overwrite = TRUE) 254 | -------------------------------------------------------------------------------- /data/stds.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/data/stds.rda -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite assignR in publications use:") 2 | 3 | bibentry(bibtype = "Article", 4 | title = "assignR: An R package for isotope-based geographic assignment", 5 | author = c(person(c("Ma", "Chao")), 6 | person(c("Vander Zanden", "Hannah B.")), 7 | person(c("Wunder", "Michael B.")), 8 | person(c("Bowen", "Gabriel J."))), 9 | journal = "Methods in Ecology and Evolution", 10 | year = "2020", 11 | doi = "10.1111/2041-210X.13426", 12 | url = "https://doi.org/10.1111/2041-210X.13426", 13 | 14 | textVersion = paste("Chao Ma, Hannah B. Vander Zanden, Michael B. Wunder, and Gabriel J. Bowen (2020).", 15 | "assignR: An R package for isotope-based geographic assignment.", 16 | "Methods in Ecology and Evolution.", 17 | "https://doi.org/10.1111/2041-210X.13426") 18 | ) -------------------------------------------------------------------------------- /inst/extdata/d2h_lrNA.tif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/d2h_lrNA.tif -------------------------------------------------------------------------------- /inst/extdata/knownOrig_sites.cpg: -------------------------------------------------------------------------------- 1 | UTF-8 -------------------------------------------------------------------------------- /inst/extdata/knownOrig_sites.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/knownOrig_sites.dbf -------------------------------------------------------------------------------- /inst/extdata/knownOrig_sites.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] -------------------------------------------------------------------------------- /inst/extdata/knownOrig_sites.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/knownOrig_sites.shp -------------------------------------------------------------------------------- /inst/extdata/knownOrig_sites.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/knownOrig_sites.shx -------------------------------------------------------------------------------- /inst/extdata/knownOrig_sources.csv: -------------------------------------------------------------------------------- 1 | "Dataset_ID","Dataset_name","Citation","Sampling_method","Sample_powdered","Lipid_extraction","Lipid_extraction_method","Exchange","Exchange_method","Exchange_T","H_cal","O_cal","Std_powdered","Drying","Analysis_method","Analysis_type","Source_comments" 2 | 2,"Hobson et al. 2012 Plos","Hobson KA, Van Wilgenburg SL, Wassenaar LI, Larson K. 2012. Linking hydrogen (d2H) isotopes in feathers and precipitation: sources of variance and consequences for assignment to isoscapes. Plos One 7:e35137","Vane",NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldEC.1_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 3 | 3,"Hobson and Wassenaar 1997 Oecologia","Hobson KA, Wassenaar LI. 1997. Linking breeding and wintering grounds of neotropical migrant songbirds using stable hydrogen isotopic analysis of feathers. Oecologia 109:142-148",NA,NA,"Y","Chloroform Ether","N",NA,NA,NA,NA,NA,"N","pyrolysis; CF-IRMS","H",NA 4 | 4,"Clark et al. 2006 Can J Zool","Clark RG, Hobson KA, Wassenaar LI. 2006. Geographic variation in the isotopic (dD, d13C, d15N, d34S) composition of feathers and claws from lesser scaup and northern pintail: implications for studies of migratory connectivity. Canadian Journal of Zoology 84:1395-1401",NA,NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldEC.1_H_1",NA,NA,"N","pyrolysis; CF-IRMS","H",NA 5 | 5,"Hobson et al. 2004 Oecologia","Hobson KA, Bowen GJ, Wassenaar LI, Ferrand Y, Lormee H. 2004. Using stable hydrogen and oxygen isotope measurements of feathers to infer geographical origins of migrating European birds. Oecologia 141:477-488","Vane",NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldEC.1_H_1","IAEA_O_1","Y","N","pyrolysis; CF-IRMS","H_O",NA 6 | 6,"Lott and Smith 2006 Auk","Lott CA, Smith JP. 2006. A geographic-information-system approach to estimating the origin of migratory raptors in North America using stable hydrogen isotope ratios in feathers. The Auk 123:822-835",NA,"Y",NA,NA,"Y","Comparative eqib","Ambient","OldEC.1_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 7 | 7,"Hobson and Kohler 2015 Ecol Evol","Hobson KA, Kohler G. 2015. On the use of stable oxygen isotope (d18O) measurements for tracking avian movements in North America. Ecology and Evolution 5:799-806",NA,NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","EC_H_5","EC_O_10",NA,"N","pyrolysis; CF-IRMS","H_O",NA 8 | 8,"Thompson et al. 2010 Am J Phys Anthropol","Thompson AH, Chesson LA, Podlesak DW, Bowen GJ, Cerling TE, Ehleringer JR. 2010. Stable isotope analysis of modern human hair collected from Asia (China, India, Mongolia, and Pakistan). American Journal of Physical Anthropology 141:440-451",NA,"Y","Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldUT_H_1","OldUT_O_1","Y","Y","pyrolysis; CF-IRMS","H_O",NA 9 | 9,"Bowen et al. 2009 Am J Phys Anthropol","Bowen GJ, Ehleringer JR, Chesson LA, Thompson AH, Podlesak DW, Cerling TE. 2009. Dietary and physiological controls on the hydrogen and oxygen isotope ratios for hair from mid-20th century indigenous populations. American Journal of Physical Anthropology 139:494-504",NA,"Y","Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldUT_H_1","OldUT_O_1","Y","Y","pyrolysis; CF-IRMS","H_O",NA 10 | 10,"Ehleringer et al. 2008 PNAS","Ehleringer JR, Bowen GJ, Chesson LA, West AG, Podlesak DW, Cerling TE. 2008. Hydrogen and oxygen isotope ratios in human hair are related to geography. Procedings of the National Academy of Science 105:2788-2793",NA,"Y","N",NA,"Y","Comparative eqib","Ambient","OldUT_H_1","OldUT_O_1","Y","Y","pyrolysis; CF-IRMS","H_O",NA 11 | 11,"Wunder et al. 2005 Oecologia","Wunder MB, Kester CL, Knopf FL, Rye RO. 2005. A test of geographic assignment using isotope tracers in feathers of known origin. Oecologia 144:607-617",NA,NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","DEN_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 12 | 12,"van Dijk et al. 2014 J Avian Biol","van Dijk JGB, Meissner W, Klaassen M. 2014. Improving provenance studies in migratory birds when using feather hydrogen stable isotopes. Journal of Avian Biology 45:103-108",NA,NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldEC.1_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 13 | 13,"Neto et al. 2006 J Avian Biol","Neto JM, Newton J, Gosler AG, Perrins CM. 2006. Using stable isotope analysis to determine the winter molt extent in migratory birds: the complex moult of Savi's warblers Locustella luscinioides. Journal of Avian Biology 37:117-124","Whole","Y","N",NA,"Y","Comparative eqib","Ambient","OldEC.2_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 14 | 16,"Magozzi et al. 2021 Front Ecol Evol","Magozzi S, Vander Zanden HB, Wunder MB, Trueman CN, Pinney K, Peers D, Dennison PE, Horns JJ, Sekercioglu CH, Bowen GJ. Combining models of the environment, behavior, and physiology to predict tissue hydrogen and oxygen isotope variance among individual terrestrial animals. Frontiers in Ecology and Evolution 8:536109","Vane","Y","Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","UT_H_2","UT_O_2","Y","Y","pyrolysis; CF-IRMS","H_O",NA 15 | 17,"Prochazka et al. 2013 J Avian Biol","Prochazka P, Van Wilgenburg SL, Neto JM, Yosef R, Hobson KA. 2013. Using stable hydrogen isotopes (d2H) and ring recoveries to trace natal origins in a Eurasian passerine with a migratory wildlife. Journal of Avian Biology 44:541-550","Vane",NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldEC.1_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 16 | 18,"Langin et al. 2007 Oecologia","Langin KM, Reudink MW, Marra PP, Norris DR, Jyser TK, Ratcliffe LM. 2007. Hydrogen isotopic variation in migratory bird tissues of known origin: implications for geographic assignments. Oecologia 152:449-457",NA,NA,"Y","2:1 chloroform:methanol","N",NA,NA,NA,NA,NA,"N","pyrolysis; CF-IRMS","H",NA 17 | 19,"Bataille Canadian Human Hair","Bataille unpubl data",NA,"Y",NA,NA,"Y","Comparative eqib","High","CAN_H_1",NA,"Y","Y","pyrolysis; CF-IRMS","H",NA 18 | 20,"Hobson et al. 2019 FEE","Hobson KA, Kardynal KJ, Koehler G. 2019. Expanding the isotopic toolbox to track monarch butterfly (Danaus plexippus) origins and migration: on the utility of stable oxygen isotope (d18O) measurements. Frontiers in Ecology and Evolution 7:224",NA,"N","Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","EC_H_5","EC_O_10",NA,"N","pyrolysis; CF-IRMS","H_O",NA 19 | 21,"Chabot et al. 2012 Plos","Chabot AA, Hobson KA, Van Wilgenburg SL, McQuat GJ, Lougheed SC. 2012. Advances in linking wintering migrant birds to their breeding-ground origins using combined analyses of genetic and stable isotope markers. Plos One 7:e43627","Vane",NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","OldEC.1_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 20 | 22,"Contina et al. 2023 Ecol Lett, in revision","Contina A, Yanco SW, Pierce AK, Vander Zanden HB, Stricker CA, Bowen GJ, Wunder MB. 2023. Dynamic environments generate geographic fluctuations in population structure of an inland shorebird. Ecology Letters, in revision",NA,NA,"Y","2:1 chloroform:methanol","Y","Comparative eqib","Ambient","DEN_H_1",NA,"Y","N","pyrolysis; CF-IRMS","H",NA 21 | -------------------------------------------------------------------------------- /inst/extdata/naMap.cpg: -------------------------------------------------------------------------------- 1 | UTF-8 -------------------------------------------------------------------------------- /inst/extdata/naMap.dbf: -------------------------------------------------------------------------------- 1 | {AlayerN 1.000000000000000 -------------------------------------------------------------------------------- /inst/extdata/naMap.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] -------------------------------------------------------------------------------- /inst/extdata/naMap.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/naMap.shp -------------------------------------------------------------------------------- /inst/extdata/naMap.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/naMap.shx -------------------------------------------------------------------------------- /inst/extdata/sr_MI.tif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/sr_MI.tif -------------------------------------------------------------------------------- /inst/extdata/states.cpg: -------------------------------------------------------------------------------- 1 | UTF-8 -------------------------------------------------------------------------------- /inst/extdata/states.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/states.dbf -------------------------------------------------------------------------------- /inst/extdata/states.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] -------------------------------------------------------------------------------- /inst/extdata/states.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/states.shp -------------------------------------------------------------------------------- /inst/extdata/states.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/states.shx -------------------------------------------------------------------------------- /inst/extdata/wrld_simpl.cpg: -------------------------------------------------------------------------------- 1 | UTF-8 -------------------------------------------------------------------------------- /inst/extdata/wrld_simpl.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/wrld_simpl.dbf -------------------------------------------------------------------------------- /inst/extdata/wrld_simpl.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] -------------------------------------------------------------------------------- /inst/extdata/wrld_simpl.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/wrld_simpl.shp -------------------------------------------------------------------------------- /inst/extdata/wrld_simpl.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/inst/extdata/wrld_simpl.shx -------------------------------------------------------------------------------- /man/QA.rd: -------------------------------------------------------------------------------- 1 | \name{QA} 2 | 3 | \alias{QA} 4 | 5 | \title{ 6 | Quality assessment of geographic assignments 7 | } 8 | 9 | \description{ 10 | How well does a given isoscape and/or known origin data set constrain the geographic origin of samples? Uses iterative re-sampling of known origin data to evaluate sample assignments and reports a suite of quality metrics. 11 | } 12 | 13 | \usage{ 14 | QA(known, isoscape, bySite = TRUE, valiStation = 1, valiTime = 50, 15 | recal = TRUE, by = 2, prior = NULL, mask = NULL, setSeed = TRUE, 16 | name = NULL) 17 | } 18 | 19 | \arguments{ 20 | \item{known}{ 21 | subOrigData, list of subOrigData, or SpatVector. Known-origin tissue isotope data from the \code{subOrigData} function or provided by user. User-provided data must be formatted as subOrigData objects (see \code{\link{subOrigData}}) or a SpatVector (see Details). 22 | } 23 | \item{isoscape}{SpatRaster with two layers or \code{\link{isoStack}} object. For user-generated raster objects, the first layer must be the isoscape (mean prediction) and the second the isoscape prediction uncertainty (1 standard deviation). 24 | } 25 | \item{bySite}{logical. Resample known by site (TRUE) or by sample (FALSE)?} 26 | \item{valiStation}{numeric. How many sites or samples from known are withheld for validation? Must be two or more smaller than the length of \code{known}. 27 | } 28 | \item{valiTime}{numeric. How many times do you want to randomly draw validation samples and run the validation? Must be an integer greater than one. 29 | } 30 | \item{recal}{logical. Recalibrate the isoscape(s) using the known-origin data? If FALSE, \code{isoscape} should be a calibrated product appropriate to the samples, and a single iteration is run for each sample in \code{known}; parameters \code{bySite}, \code{valiStation}, and \code{valiTime} are ignored.} 31 | \item{by}{integer. Threshold increment to use in evaluating assignment performance. Must be between 1 and 25.} 32 | \item{prior}{SpatRaster. Optional layer with prior probabilities, which has the same projection, resolution and extent as \code{isoscape}. 33 | } 34 | \item{mask}{SpatVector. Constrains the area of the analysis. If this is not provided, the entire area of \code{isoscape} is used. 35 | } 36 | \item{setSeed}{logical. Do you want to \code{set.seed()} when you randomly draw validation stations? \dQuote{TRUE} gives the same sequence of random draws each time the function is called. 37 | } 38 | \item{name}{character. Useful for identifying the QA output in subsequent plotting. 39 | } 40 | } 41 | 42 | \details{ 43 | If \code{known} is a user-provided SpatVector, the first data field must include the measured value for the first (or only) isotope marker and the second the one standard deviation uncertainty on that value. Subsequent fields must include the same information for all other isotope markers included in the analysis, and these markers must appear in the same order as in \code{isoscape}. A user-provided SpatVector must include a field named \dQuote{Site_ID} containing unique values for each sampling site to support the \dQuote{bySite} option, otherwise use \code{bySite = FALSE}. 44 | } 45 | 46 | \value{ 47 | Returns an object of class \dQuote{QA}. 48 | \item{val_stations}{numeric. An X*Y data.frame of validation station IDs for all valiTime. X = \code{valiTime} and Y = \code{valiStation}. 49 | } 50 | \item{pd_val}{numeric. An X*Y data.frame containing the posterior probability density for the validation stations. X = \code{valiTime} and Y = \code{valiStation}. 51 | } 52 | \item{prption_byArea}{numeric. An X*Y data.frame showing the proportion of validation individuals for which the known origin is contained within the top 0.00 to 1.00 area quantile (with increment of \code{by / 100}; Y = \code{ceiling(100 / by) + 1}). X = \code{valiTime}. 53 | } 54 | \item{prption_byProb}{numeric. An X*Y data.frame showing the proportion of validation individuals for which the known origin is contained within the top 0.00 to 1.00 probability quantile (with increment of \code{by / 100}; Y = \code{ceiling(100 / by) + 1}). X = \code{valiTime}. 55 | } 56 | \item{precision}{list. The length of the list is \code{valiTime}. Each element is an X*Y matrix showing the proportional area of the total assignment surface covered by the assignment region at a given probability quantile from 0.00 to 1.00 (with increment of \code{by / 100}; X = \code{ceiling(100 / by) + 1}) for each validation sample (Y = \code{valiStation}).} 57 | \item{random_prob_density}{Random probability of assignment to any given grid cell on the assignment surface(i.e. 1 divided by the total number of grid cells). 58 | } 59 | \item{name}{character. Name assigned to the QA object.} 60 | \item{by}{integer. Value of by used.} 61 | } 62 | 63 | \note{ 64 | See Ma et al. (2020) for methodological details. 65 | } 66 | 67 | \references{ 68 | Ma, C. et al. (2020) assignR : An R package for isotope-based geographic assignment. \emph{Methods in Ecology and Evolution} \strong{11} 996--1001. \doi{10.1111/2041-210X.13426}. 69 | 70 | Vander Zanden, H. B. et al. (2014) Contrasting assignment of migratory organisms to geographic origins using long-term versus year-specific precipitation isotope maps. \emph{Methods in Ecology and Evolution} \strong{5} 891--900. \doi{10.1111/2041-210X.12229} 71 | } 72 | 73 | \seealso{ 74 | \code{\link[assignR]{plot.QA}} 75 | } 76 | 77 | \examples{ 78 | # extract some known-origin data 79 | d1 = subOrigData(taxon = "Buteo lagopus") 80 | 81 | # run quality assessment based on precipitation hydrogen isotopes and 82 | # known-origin samples; small values of valiStation and valiTime 83 | # are used in example to reduce run time 84 | 85 | # first with one example 86 | # gives warning because a small number of samples are available 87 | qa1 = QA(known = d1, isoscape = d2h_lrNA, valiTime = 2, by = 10, 88 | mask = naMap, name = "Buteo") 89 | 90 | # plot the qa result 91 | plot(qa1) 92 | 93 | # now compare with a second data set 94 | \donttest{d2 = subOrigData(taxon = "Charadrius montanus") 95 | qa2 = QA(known = d2, isoscape = d2h_lrNA, valiTime = 2, by = 10, 96 | mask = naMap, name = "Charadrius") 97 | plot(qa1, qa2)} 98 | } 99 | -------------------------------------------------------------------------------- /man/assignR.Rd: -------------------------------------------------------------------------------- 1 | \name{assignR} 2 | 3 | \alias{assignR} 4 | 5 | \title{Tools for inferring geographic origin from isotopic data 6 | } 7 | 8 | \description{ 9 | Routines for rescaling isoscapes using known-origin tissue isotope data, assigning origin of unknown samples, and summarizing and assessing assignment results. 10 | } 11 | 12 | \author{ 13 | \strong{Maintainer}: Gabe Bowen \email{gabe.bowen@utah.edu} 14 | \strong{Authors}: Chao Ma, Gabe Bowen 15 | } 16 | 17 | \seealso{ 18 | \url{https://spatial-lab.github.io/assignR/} 19 | } 20 | -------------------------------------------------------------------------------- /man/c.wDist.Rd: -------------------------------------------------------------------------------- 1 | \name{c.wDist} 2 | 3 | \alias{c.wDist} 4 | 5 | \title{ 6 | Combine method for wDist objects 7 | } 8 | 9 | \description{ 10 | Combine statistics from one or more \code{\link{wDist}} objects in a single data frame. 11 | } 12 | 13 | \usage{ 14 | \method{c}{wDist}(...) 15 | } 16 | 17 | \arguments{ 18 | \item{...}{ 19 | One or more wDist objects 20 | } 21 | } 22 | 23 | \value{ 24 | data.frame containing sample IDs, distance, and bearing statistics for each sample in \code{...} 25 | } 26 | 27 | \seealso{ 28 | \code{\link{wDist}} 29 | } 30 | 31 | \examples{ 32 | # load hydrogen isotope data for human hair in North America 33 | d = subOrigData(group = "Modern human", mask = naMap, niter = 100) 34 | 35 | # rescale from environmental isoscape to tissue isoscape 36 | r = calRaster(known = d, isoscape = d2h_lrNA, mask = naMap) 37 | 38 | # four unknown-origin examples 39 | id = c("A", "B", "C", "D") 40 | d2H = c(-110, -90, -105, -102) 41 | un = data.frame(id,d2H) 42 | 43 | # posterior probabilities 44 | pp = pdRaster(r, unknown = un, mask = naMap) 45 | 46 | # random collection locations 47 | sites = d$data[sample(seq(length(d$data)), 4),] 48 | 49 | # generate a wDist object 50 | wd = wDist(pp, sites) 51 | 52 | # combine stats and print 53 | c(wd) 54 | } 55 | -------------------------------------------------------------------------------- /man/calRaster.Rd: -------------------------------------------------------------------------------- 1 | \name{calRaster} 2 | 3 | \alias{calRaster} 4 | 5 | \title{ 6 | Rescale isoscape using linear regression 7 | } 8 | 9 | \description{ 10 | This function uses known-origin tissue data to rescale a map of environmental isotope values to a map of tissue value (and associated uncertainty) using a linear regression model. 11 | } 12 | 13 | \usage{ 14 | calRaster(known, isoscape, mask = NULL, interpMethod = 2, NA.value = NA, 15 | ignore.NA = TRUE, genplot = TRUE, outDir = NULL, verboseLM = TRUE) 16 | } 17 | 18 | \arguments{ 19 | \item{known}{ 20 | subOrigData or SpatVector. Known-origin tissue isotope data from the subOrigData function or provided by user. User-provided data must be formatted as a subOrigData object (see \code{\link[assignR]{subOrigData}}) or a SpatVector with point geometry in which the first data field contains the measured tissue isotope value and the second the 1 standard deviation uncertainty on that value. 21 | } 22 | \item{isoscape}{ 23 | SpatRaster. Isoscape raster with two layers. The first one is the mean and the second is one standard deviation. 24 | } 25 | \item{mask}{ 26 | SpatVector. Polygon layer that constrains the area of the output rasters. If this is not provided, the entire area of \code{isoscape} is returned. 27 | } 28 | \item{interpMethod}{ 29 | numeric. 1 or 2. Designate one of two methods for extracting values from \code{isoscape}. If 1, values for the cell in which a point falls are returned. If 2 the returned values are interpolated (bilinear interpolation) from the values of the four adjacent grid cells. 30 | } 31 | \item{NA.value}{ 32 | NA or numeric. Value representing the absence of data in \code{isoscape}. Commonly used values include NA, -9999, and 9999. 33 | } 34 | \item{ignore.NA}{ 35 | logical. If NA values are extracted from \code{isoscape} at the location of samples in known, ignore these values and proceed with \code{calRaster}. 36 | } 37 | \item{genplot}{ 38 | logical. Plot the results. 39 | } 40 | \item{outDir}{ 41 | character string. Directory path to which output will be saved. If NULL no files are written. 42 | } 43 | \item{verboseLM}{ 44 | logical. Print out the linear regression results. 45 | } 46 | } 47 | 48 | \value{ 49 | Returns an object of class \dQuote{rescale}. 50 | \item{isoscape.rescale}{SpatRaster. \code{isoscape} rescaled using a linear regression model between values of \code{known} and \code{isoscape}. The first layer is the mean prediction and the second the standard deviation.} 51 | \item{lm.data}{data.frame. Known origin data and extracted \code{isoscape} values used for linear regression modeling.} 52 | \item{lm.model}{list. Linear regression model.} 53 | } 54 | 55 | \seealso{ 56 | \code{\link[assignR]{pdRaster}} 57 | } 58 | 59 | \examples{ 60 | # load hydrogen isotope data for human hair in North America 61 | d = subOrigData(group = "Modern human", mask = naMap, niter = 100, genplot = FALSE) 62 | 63 | # rescale from environmental isoscape to tissue isoscape 64 | r = calRaster(d, d2h_lrNA, naMap) 65 | } 66 | -------------------------------------------------------------------------------- /man/d2h_lrNA.Rd: -------------------------------------------------------------------------------- 1 | \name{d2h_lrNA} 2 | 3 | \alias{d2h_lrNA} 4 | 5 | \docType{data} 6 | 7 | \title{ 8 | data: low resolution North American growing season H isoscape 9 | } 10 | 11 | \description{ 12 | Interpolated growing season precipitation H isoscape from waterisotopes.org. 13 | } 14 | 15 | \usage{ 16 | d2h_lrNA 17 | } 18 | 19 | \format{ 20 | SpatRaster with two layers. The first layer is the mean prediction and the second is 1 standard deviation 21 | } 22 | 23 | \references{ 24 | Bowen, G. J. (2018) Gridded maps of the isotopic composition of meteoric waters. http://www.waterisotopes.org. 25 | 26 | Bowen, G. J., Wassenaar, L. I. and Hobson, K. A. (2005) Global application of stable hydrogen and oxygen isotopes to wildlife forensics. \emph{Oecologia}, \bold{143}, 337--348. 27 | 28 | IAEA/WMO (2018) Global Network of Isotopes in Precipitation. The GNIP Database. https://nucleus.iaea.org/wiser. 29 | } 30 | 31 | \examples{ 32 | library(terra) 33 | 34 | plot(d2h_lrNA) 35 | } 36 | 37 | -------------------------------------------------------------------------------- /man/getIsoscapes.Rd: -------------------------------------------------------------------------------- 1 | \name{getIsoscapes} 2 | 3 | \alias{getIsoscapes} 4 | 5 | \title{ 6 | Download and unpack isoscapes from the web 7 | } 8 | 9 | \description{ 10 | This function retrieves gridded isotope maps from waterisotopes.org, unpacks the zip archives, and bundles the map layers as a RasterStack. 11 | } 12 | 13 | \usage{ 14 | getIsoscapes(isoType = "GlobalPrecipGS", timeout = 1200) 15 | } 16 | 17 | \arguments{ 18 | \item{isoType}{ 19 | character string indicating which isoscapes are requested: see 'Details'. 20 | } 21 | \item{timeout}{ 22 | integer. Maximum allowed file download time, in seconds. Some isoscape archives exceed 2 GB in size and may require long download times on slow connections. This option may not work on all system configurations. 23 | } 24 | } 25 | 26 | \details{ 27 | Accepted \code{isoType} values are: 28 | \describe{ 29 | \item{"GlobalPrecipGS"}{Global growing-season precipitation H and O isotope values} 30 | \item{"GlobalPrecipMA"}{Global mean-annual precipitation H and O isotope values} 31 | \item{"GlobalPrecipMO"}{Global monthly precipitation H and O isotope values} 32 | \item{"GlobalPrecipALL"}{Global mean-annual and monthly precipitation H and O isotope values} 33 | \item{"USPrecipMA"}{High-resolution contiguous USA mean-annual precipitation H and O isotope values} 34 | \item{"USPrecipMO"}{High-resolution contiguous USA monthly precipitation H and O isotope values} 35 | \item{"USPrecipALL"}{High-resolution contiguous USA mean-annual and monthly precipitation H and O isotope values} 36 | \item{"USSurf"}{High-resolution contiguous USA surface water H and O isotope values} 37 | \item{"USTap"}{High-resolution contiguous USA surface water H and O isotope values} 38 | \item{"USGround"}{Contiguous USA groundwater H and O isotope values in 7 depth intervals} 39 | \item{"GlobalSr"}{High-resolution bioavailable Sr isotope ratios for the global land surface} 40 | \item{"USSr"}{High-resolution contiguous USA Sr isotope ratios} 41 | \item{"CaribSr"}{High-resolution Sr isotope ratios for the circum-Caribbean region} 42 | } 43 | } 44 | 45 | \value{ 46 | RasterStack containing the requested isoscape layers. 47 | } 48 | 49 | \references{ 50 | \url{https://wateriso.utah.edu/waterisotopes/pages/data_access/ArcGrids.html} 51 | } 52 | 53 | \examples{ 54 | \dontrun{ 55 | iso = getIsoscapes("CaribSr") 56 | } 57 | } -------------------------------------------------------------------------------- /man/isoStack.Rd: -------------------------------------------------------------------------------- 1 | \name{isoStack} 2 | 3 | \alias{isoStack} 4 | 5 | \title{ 6 | Stack isoscapes 7 | } 8 | 9 | \description{ 10 | Combine multiple isoscapes into a single data object, including optional reconciliation of raster properties. 11 | } 12 | 13 | \usage{ 14 | isoStack(..., clean = TRUE) 15 | } 16 | 17 | \arguments{ 18 | \item{...}{ 19 | Two or more SpatRaster isoscapes, each with two layers, or \code{rescale} objects as produced by \code{\link{calRaster}}. For objects other than \code{rescale}, the first layer in each should contain the tissue-specific isoscape and the second the isoscape prediction uncertainty (1 standard deviation). 20 | } 21 | \item{clean}{ 22 | logical. Reconcile differences in raster properties within \code{...}? 23 | } 24 | } 25 | 26 | \details{ 27 | If \code{clean} = TRUE all raster layers are projected to the projection of the first object in \code{...} and then resampled to the highest spatial resolution and smallest common spatial extent within \code{...}. Finally, cells containing NA in any layer within \code{...} are masked across all layers. 28 | 29 | If \code{clean} = FALSE any differences in raster properties between isoscapes will produce an error. 30 | } 31 | 32 | \value{ 33 | Returns an object of class \dQuote{isoStack}, a list containing the isoscapes objects in \code{...} after any cleaning. 34 | } 35 | 36 | \examples{ 37 | #stack H and Sr isoscapes 38 | h_s = isoStack(d2h_lrNA, sr_MI) 39 | } 40 | -------------------------------------------------------------------------------- /man/jointP.Rd: -------------------------------------------------------------------------------- 1 | \name{jointP} 2 | 3 | \alias{jointP} 4 | 5 | \title{ 6 | Joint probability of origin 7 | } 8 | 9 | \description{ 10 | Joint probability for individuals of common origin (product of probabilities) 11 | } 12 | 13 | \usage{ 14 | jointP(pdR) 15 | } 16 | 17 | \arguments{ 18 | \item{pdR}{ 19 | SpatRaster of probability density maps, e.g., as produced by \code{pdRaster}. All layers must have common spatial extent and projection. 20 | } 21 | } 22 | 23 | \value{ 24 | SpatRaster. 25 | } 26 | 27 | \examples{ 28 | # load hydrogen isotope data for human hair in North America 29 | d = subOrigData(group = "Modern human", mask = naMap, genplot = FALSE) 30 | 31 | # rescale from environmental isoscape to tissue isoscape 32 | r = calRaster(d, d2h_lrNA, naMap, genplot = FALSE) 33 | 34 | # four unknown-origin examples 35 | id = c("A", "B", "C", "D") 36 | d2H = c(-110, -90, -105, -102) 37 | un = data.frame(id, d2H) 38 | 39 | # posterior probabilities 40 | pp = pdRaster(r, un, mask = naMap, genplot = FALSE) 41 | 42 | # joint probability for individuals of common origin 43 | jointP(pp) 44 | } 45 | -------------------------------------------------------------------------------- /man/knownOrig.Rd: -------------------------------------------------------------------------------- 1 | \name{knownOrig} 2 | 3 | \alias{knownOrig} 4 | 5 | \docType{data} 6 | 7 | \title{ 8 | data: database of H and O isotope data for tissues of known origin 9 | } 10 | 11 | \description{ 12 | This dataset consists of hydrogen and oxygen isotope values and metadata for human hair, insect wings, and bird feathers of known geographic origin. 13 | } 14 | 15 | \usage{ 16 | knownOrig 17 | } 18 | 19 | \format{ 20 | list. 21 | \describe{ 22 | \item{sites}{SpatVector with 5 fields. WGS84 unprojected geometry. 23 | \describe{ 24 | \item{[, 1]}{Site_ID: Unique ID} 25 | \item{[, 2]}{Site_name: Site name or descriptor} 26 | \item{[, 3]}{State: State or province of collection site, where recorded} 27 | \item{[, 4]}{Country: Country of collection site, where recorded} 28 | \item{[, 5]}{Site_comments: Site comments} 29 | } 30 | } 31 | \item{samples}{data.frame with 15 fields. 32 | \describe{ 33 | \item{[, 1]}{Sample_ID: Unique ID} 34 | \item{[, 2]}{Sample_ID_orig: ID used in original data report} 35 | \item{[, 3]}{Site_ID: ID for sample collection site} 36 | \item{[, 4]}{Dataset_ID: ID for dataset from which sample is derived} 37 | \item{[, 5]}{Taxon: Genus and species name} 38 | \item{[, 6]}{Group: Biological group (informal)} 39 | \item{[, 7]}{Source_quality: Code indicating level of certainty in geographic origin} 40 | \item{[, 8]}{Age_class: Code for age of individual} 41 | \item{[, 9]}{Material_type: Tissue sampled, e.g., \dQuote{Hair}} 42 | \item{[, 10]}{Matrix: Compound measured, e.g., \dQuote{Keratin}} 43 | \item{[, 11]}{d2H: Hydrogen isotope value (permil)} 44 | \item{[, 12]}{d2H.sd: Reported analytical uncertainty for hydrogen isotope value (permil)} 45 | \item{[, 13]}{d18O: Oxygen isotope value (permil)} 46 | \item{[, 14]}{d18O.sd: Reported analytical uncertainty for oxygen isotope value (permil)} 47 | \item{[, 15]}{Sample_comments: Sample comments} 48 | } 49 | } 50 | \item{sources}{data.frame with 17 fields. 51 | \describe{ 52 | \item{[, 1]}{Dataset_ID: Unique ID} 53 | \item{[, 2]}{Dataset_name: Short name or descriptor} 54 | \item{[, 3]}{Citation: Bibliographic citation for study} 55 | \item{[, 4]}{Sampling_method: How material was subsampled for analysis, if reported} 56 | \item{[, 5]}{Sample_powdered: Was sample powdered prior to analysis (Y/N/NA)?} 57 | \item{[, 6]}{Lipid_extraction: Were lipids chemically extracted prior to analysis (Y/N/NA)?} 58 | \item{[, 7]}{Lipid_extraction_method: Solvent used to extract lipids} 59 | \item{[, 8]}{Exchange: Was a correction for exchangeable H made (Y/N/NA)?} 60 | \item{[, 9]}{Exchange_method: Method used to correct for exchangeable H} 61 | \item{[, 10]}{Exchange_T: Was H exchange carried out at ambient or high temperature (Ambient/High/NA)?} 62 | \item{[, 11]}{H_cal: Reference scale used to calibrate H isotope data, see \code{\link[assignR]{stds}} object hstds} 63 | \item{[, 12]}{O_cal: Reference scale used to calibrate O isotope data, see \code{\link[assignR]{stds}} object ostds} 64 | \item{[, 13]}{Std_powdered: Were calibration standards powdered (Y/N/NA)?} 65 | \item{[, 14]}{Drying: Did the study document how samples were fully dried and transferred dry to instrument (Y/N/NA)?} 66 | \item{[, 15]}{Analysis_method: Instrument configuration used for analysis} 67 | \item{[, 16]}{Analysis_type: What elements were analyzed for stable isotope ratios (H/O/H_O)?} 68 | \item{[, 17]}{Source_comments: Data source comments} 69 | } 70 | } 71 | } 72 | } 73 | 74 | \seealso{ 75 | \code{\link[assignR]{subOrigData}} 76 | } 77 | 78 | \examples{ 79 | library(terra) 80 | 81 | class(knownOrig$sites) 82 | class(knownOrig$samples); class(knownOrig$sources) 83 | 84 | summary(knownOrig$samples) 85 | 86 | print(knownOrig$sources[, 1:2]) 87 | 88 | plot(wrld_simpl, border = "grey") 89 | points(knownOrig$sites) 90 | } 91 | 92 | \keyword{datasets} -------------------------------------------------------------------------------- /man/naMap.Rd: -------------------------------------------------------------------------------- 1 | \name{naMap} 2 | 3 | \alias{naMap} 4 | 5 | \docType{data} 6 | 7 | \title{ 8 | data: North America boundary map 9 | } 10 | 11 | \description{ 12 | Simplified spatial polygon layer representing the boundary of North America. 13 | } 14 | 15 | \usage{ 16 | naMap 17 | } 18 | 19 | \format{ 20 | SpatVector 21 | } 22 | 23 | \examples{ 24 | library(terra) 25 | 26 | plot(naMap) 27 | } 28 | -------------------------------------------------------------------------------- /man/oddsRatio.Rd: -------------------------------------------------------------------------------- 1 | \name{oddsRatio} 2 | 3 | \alias{oddsRatio} 4 | 5 | \title{ 6 | Odds ratio of points or regions 7 | } 8 | 9 | \description{ 10 | Calculate ratio of odds for two locations (points or polygons) 11 | } 12 | 13 | \usage{ 14 | oddsRatio(pdR, inputP) 15 | } 16 | 17 | \arguments{ 18 | \item{pdR}{ 19 | SpatRaster of probability density maps, e.g., as produced by \code{pdRaster}. 20 | } 21 | \item{inputP}{ 22 | SpatVector points object of length 1 or 2 or polygons object of length 2 23 | } 24 | } 25 | 26 | \examples{ 27 | library(terra) 28 | 29 | # load hydrogen isotope data for human hair in North America 30 | d = subOrigData(group = "Modern human", mask = naMap, genplot = FALSE) 31 | 32 | # rescale from environmental isoscape to tissue isoscape 33 | r = calRaster(d, d2h_lrNA, naMap, genplot = FALSE) 34 | 35 | # four unknown-origin examples 36 | id = c("A", "B", "C", "D") 37 | d2H = c(-110, -90, -105, -102) 38 | un = data.frame(id, d2H) 39 | 40 | # posterior probabilities 41 | pp = pdRaster(r, un, mask = naMap, genplot = FALSE) 42 | 43 | # SpatialPolygons for two regions of interest 44 | s1 = states[states$STATE_ABBR == "UT",] 45 | s2 = states[states$STATE_ABBR == "NM",] 46 | plot(naMap) 47 | plot(s1, border = "red", add = TRUE) 48 | plot(s2, border = "blue", add = TRUE) 49 | 50 | # Get odds ratio for two regions using SpatialPolygon method 51 | s12 = rbind(s1, s2) 52 | oddsRatio(pp, s12) 53 | 54 | # Create SpatialPoints for two points of interest 55 | p1 = c(-112, 40) 56 | p2 = c(-105, 33) 57 | p12 = vect(rbind(p1, p2), crs = "WGS84") 58 | points(p12, pch = 21, bg = "light blue") 59 | 60 | # Get odds ratio for two points using SpatialPoints method 61 | oddsRatio(pp, p12) 62 | } 63 | 64 | -------------------------------------------------------------------------------- /man/pdRaster.Rd: -------------------------------------------------------------------------------- 1 | \name{pdRaster} 2 | 3 | \alias{pdRaster} 4 | 5 | \title{ 6 | Probability of origin surfaces 7 | } 8 | 9 | \description{ 10 | Calculate posterior probabilities of origin for a sample based on its isotope ratio. 11 | } 12 | 13 | \usage{ 14 | pdRaster(r, unknown, prior = NULL, mask = NULL, genplot = TRUE, outDir = NULL) 15 | } 16 | 17 | \arguments{ 18 | \item{r}{ 19 | SpatRaster with two layers, \code{rescale} object (see \code{\link{calRaster}}), or \code{\link{isoStack}} object. For user-generated raster objects, the first layer must be the substrate-specific isoscape (mean prediction) and the second the isoscape prediction uncertainty (1 standard deviation). 20 | } 21 | \item{unknown}{ 22 | data.frame, \code{\link{refTrans}} object, or list of two or more \code{\link{refTrans}} objects. For user-created data.frame, first column should contain unique sample IDs, and subsequent columns should contain sample isotope values for one or more isotopes to be used in assignment. 23 | } 24 | \item{prior}{ 25 | SpatRaster. Optional raster layer with prior probabilities, which has the same projection, resolution and extent as \code{r}. 26 | } 27 | \item{mask}{ 28 | SpatVector. This polygon mask will constrain the assignment area. If this is not provided, a default of mask of the extent of \code{r} is used. 29 | } 30 | \item{genplot}{ 31 | logical. Plot results in R. 32 | } 33 | \item{outDir}{ 34 | character string. Directory path to which output will be saved. If NULL no files are written. 35 | } 36 | } 37 | 38 | \details{ 39 | If more than one isotope marker is to be used for multivariate assignment, \code{r} must be an \code{\link{isoStack}} object and the number of isoscapes in that object must be equal to the number of isotope-value columns or \code{\link{refTrans}} objects included in \code{unknown}. Isoscapes and unknown sample values will be matched based on order, so it is critical that the values appear in the same order in these two input objects. 40 | } 41 | 42 | \value{ 43 | SpatRaster including a probability density surface for each individual in \code{unknown}. If \code{outDir} is not NULL, writes individual rasters in GeoTIFF format and a single PDF file with images for each probability density raster to the designated directory. 44 | } 45 | 46 | \seealso{ 47 | \code{\link{calRaster}} 48 | \code{\link{refTrans}} 49 | \code{\link{isoStack}} 50 | } 51 | 52 | \examples{ 53 | # load hydrogen isotope data for human hair in North America 54 | d = subOrigData(group = "Modern human", mask = naMap, genplot = FALSE) 55 | 56 | # rescale from environmental isoscape to tissue isoscape 57 | r = calRaster(d, d2h_lrNA, naMap, genplot = FALSE) 58 | 59 | # sample to assign 60 | id = "smile" 61 | d2H = -80 62 | un = data.frame(id, d2H) 63 | 64 | # posterior probability surface 65 | pp = pdRaster(r, un, mask = naMap) 66 | } 67 | -------------------------------------------------------------------------------- /man/plot.QA.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.QA} 2 | 3 | \alias{plot.QA} 4 | 5 | \title{ 6 | Plot quality metrics for geographic assignments 7 | } 8 | 9 | \description{ 10 | Plot the output from \code{\link{QA}}, including spatial precision, bias, sensitivity and odds ratio of known locations for validation samples. 11 | } 12 | 13 | \usage{ 14 | \method{plot}{QA}(x, ..., outDir = NULL) 15 | } 16 | 17 | \arguments{ 18 | \item{x}{ 19 | One or more QA objects 20 | } 21 | \item{...}{ 22 | Other arguments to be passed to plot 23 | } 24 | \item{outDir}{ 25 | character string. Directory path to which output will be saved. If NULL no files are written. 26 | } 27 | } 28 | 29 | \references{ 30 | Ma, C. et al. (2020) assignR : An R package for isotope-based geographic assignment. \emph{Methods in Ecology and Evolution} \strong{11} 996--1001. \doi{10.1111/2041-210X.13426}. 31 | 32 | Vander Zanden, H. B. et al. (2014) Contrasting assignment of migratory organisms to geographic origins using long-term versus year-specific precipitation isotope maps. \emph{Methods in Ecology and Evolution} \strong{5} 891--900. \doi{10.1111/2041-210X.12229} 33 | } 34 | 35 | \seealso{ 36 | \code{\link[assignR]{QA}} 37 | } 38 | 39 | \examples{ 40 | # extract some known-origin data 41 | d1 = subOrigData(taxon = "Buteo lagopus") 42 | 43 | # run quality assessment based on precipitation hydrogen isotopes and 44 | # known-origin samples; small values of valiStation and valiTime 45 | # are used in example to reduce run time 46 | 47 | # first with one example 48 | # gives warning because a small number of samples are available 49 | qa1 = QA(isoscape = d2h_lrNA, known = d1, valiStation = 1, 50 | valiTime = 2, by = 10, mask = naMap, name = "Buteo") 51 | 52 | # plot the qa result 53 | plot(qa1) 54 | 55 | # now compare with a second data set 56 | \donttest{d2 = subOrigData(taxon = "Charadrius montanus") 57 | qa2 = QA(isoscape = d2h_lrNA, known = d2, valiStation = 1, 58 | valiTime = 2, by = 10, mask = naMap, name = "Charadrius") 59 | plot(qa1, qa2)} 60 | } 61 | -------------------------------------------------------------------------------- /man/plot.isoStack.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.isoStack} 2 | 3 | \alias{plot.isoStack} 4 | 5 | \title{ 6 | Plot method for stacked isoscapes 7 | } 8 | 9 | \description{ 10 | Plot the output from \code{\link{isoStack}}. 11 | } 12 | 13 | \usage{ 14 | \method{plot}{isoStack}(x, ...) 15 | } 16 | 17 | \arguments{ 18 | \item{x}{ 19 | An isoStack object 20 | } 21 | \item{...}{ 22 | Other arguments to be passed to plot 23 | } 24 | } 25 | 26 | \seealso{ 27 | \code{\link{isoStack}} 28 | } 29 | 30 | \examples{ 31 | #stack H and Sr isoscapes 32 | h_s = isoStack(d2h_lrNA, sr_MI) 33 | 34 | #plot isoStack 35 | plot(h_s) 36 | } 37 | -------------------------------------------------------------------------------- /man/plot.wDist.Rd: -------------------------------------------------------------------------------- 1 | \name{plot.wDist} 2 | 3 | \alias{plot.wDist} 4 | 5 | \title{ 6 | Plot weighted distance and bearing distributions 7 | } 8 | 9 | \description{ 10 | Plot the output from \code{\link{wDist}}, including weighted kernel density distributions for distance and bearing of travel. 11 | } 12 | 13 | \usage{ 14 | \method{plot}{wDist}(x, ..., bin = 20, pty = "both", index = c(1:5)) 15 | } 16 | 17 | \arguments{ 18 | \item{x}{ 19 | A wDist object 20 | } 21 | \item{...}{ 22 | Other arguments to be passed to plot 23 | } 24 | \item{bin}{ 25 | numeric. Bin width used to generate rose plot of travel bearings, in degrees. Must be a factor of 360. 26 | } 27 | \item{pty}{ 28 | character. Type of plot to produce. Must be one of \dQuote{dist}, \dQuote{bear}, or \dQuote{both}. 29 | } 30 | \item{index}{ 31 | numeric. Which items in x to plot? Numeric vector of up to 5 integers. Values in excess of 5 or exceeding the length of x will be ignored. 32 | } 33 | } 34 | 35 | \details{ 36 | For the default \code{pty}, two plot panels will be printed to the active graphical device showing the distance and bearing distributions for (up to) the first five samples in \code{wd}. If more than five items exist in \code{wd}, those beyond the fifth will be ignored and a message returned. 37 | } 38 | 39 | \seealso{ 40 | \code{\link{wDist}} 41 | } 42 | 43 | \examples{ 44 | # load hydrogen isotope data for human hair in North America 45 | d = subOrigData(group = "Modern human", mask = naMap, niter = 100) 46 | 47 | # rescale from environmental isoscape to tissue isoscape 48 | r = calRaster(known = d, isoscape = d2h_lrNA, mask = naMap) 49 | 50 | # four unknown-origin examples 51 | id = c("A", "B", "C", "D") 52 | d2H = c(-110, -90, -105, -102) 53 | un = data.frame(id,d2H) 54 | 55 | # posterior probabilities 56 | pp = pdRaster(r, unknown = un, mask = naMap) 57 | 58 | # random collection locations 59 | sites = d$data[sample(seq(length(d$data)), 4),] 60 | 61 | # generate a wDist object 62 | wd = wDist(pp, sites) 63 | 64 | # plot distributions 65 | plot(wd) 66 | 67 | # plot bearing distriubtion for sample B with a finer bin size 68 | plot(wd, bin = 5, pty = "bear", index = 2) 69 | } 70 | -------------------------------------------------------------------------------- /man/qtlRaster.Rd: -------------------------------------------------------------------------------- 1 | \name{qtlRaster} 2 | 3 | \alias{qtlRaster} 4 | 5 | \title{ 6 | Sample assignment using thresholds 7 | } 8 | 9 | \description{ 10 | Selects the grid cells of probability density rasters with the highest probability and returns rasters with these cell values set to 1. Cells are selected based on the user-specified quantile threshold so that the most-probable cells representing a given fraction of the assignment area or posterior probability are returned. 11 | } 12 | 13 | \usage{ 14 | qtlRaster(pdR, threshold, thresholdType = "area", genplot = TRUE, outDir = NULL) 15 | } 16 | 17 | \arguments{ 18 | \item{pdR}{ 19 | SpatRaster. Probability density maps for individual samples, e.g., as output by \code{pdRaster}. 20 | } 21 | \item{threshold}{ 22 | numeric from 0 to 1. Quantile to be selected. 23 | } 24 | \item{thresholdType}{ 25 | character. Either \dQuote{area} (default) or \dQuote{prob}. If \dQuote{area}, the most probable cells constituting \code{threshold} percent of the assignment area are selected. If \dQuote{prob}, the most probable cells constituting \code{threshold} percent of the posterior probability are selected. 26 | } 27 | \item{genplot}{ 28 | logical.Plot results in R. 29 | } 30 | \item{outDir}{ 31 | character string. Directory path to which output will be saved. If NULL no files are written. 32 | } 33 | } 34 | 35 | \value{ 36 | SpatRaster including a binary assignment surface for each individual in \code{pdR}. If \code{outDir} is not NULL, writes individual rasters in GeoTIFF format and a single PDF file with images for each raster to the designated directory. 37 | } 38 | 39 | \examples{ 40 | library(terra) 41 | 42 | # load hydrogen isotope data for human hair in North America 43 | d = subOrigData(group = "Modern human", mask = naMap, genplot = FALSE) 44 | 45 | # rescale from environmental isoscape to tissue isoscape 46 | r = calRaster(d, d2h_lrNA, naMap, genplot = FALSE) 47 | 48 | # four unknown-origin examples 49 | id = c("A", "B", "C", "D") 50 | d2H = c(-110, -90, -105, -102) 51 | un = data.frame(id, d2H) 52 | 53 | # posterior probabilities 54 | pp = pdRaster(r, un, mask = naMap, genplot = FALSE) 55 | 56 | # assign to most probable 10 percent of area 57 | \dontrun{qtlRaster(pp, threshold = 0.1)} 58 | 59 | # assign to most probable 10 percent of proabability distribution 60 | qtlRaster(pp, threshold = 0.1, thresholdType = "prob") 61 | } 62 | -------------------------------------------------------------------------------- /man/refTrans.Rd: -------------------------------------------------------------------------------- 1 | \name{refTrans} 2 | 3 | \alias{refTrans} 4 | 5 | \title{ 6 | Transform reference scale of data 7 | } 8 | 9 | \description{ 10 | This function conducts transformations to convert isotope measurements between reference scales. 11 | } 12 | 13 | \usage{ 14 | refTrans(samples, marker = "d2H", ref_scale = "VSMOW_H", niter = 5000) 15 | } 16 | 17 | \arguments{ 18 | \item{samples}{ 19 | data.frame. Must include a field with data to be transformed, analytical reproducibility of sample data (1 standard deviation), and original reference scale for calibration of data. These fields must be named \emph{marker}, \emph{marker.sd}, and \emph{marker_cal}, respectively, where \emph{marker} is \dQuote{d2H} or \dQuote{d18O}. Values for the cal field should correspond to \emph{Calibration} codes found in \code{\link[assignR]{stds}} tables \emph{hstds} and \emph{ostds}. 20 | } 21 | \item{marker}{ 22 | character string. Column name for isotopic data to be extracted, either \dQuote{d2H} or \dQuote{d18O}. 23 | } 24 | \item{ref_scale}{ 25 | character string. Text identifier for reference scale to which all isotope values will be transformed. See \code{\link[assignR]{stds}}.} 26 | \item{niter}{ 27 | integer. Number of random samples used to propagate uncertainty in calibration hierarchy transformations. 28 | } 29 | } 30 | 31 | \value{ 32 | Returns an object of class \dQuote{refTrans}. 33 | \item{data}{ 34 | data.frame. Formatted identically to input object \emph{samples}, with values for the data and data uncertainty fields replaced with transformed values.} 35 | \item{chains}{ 36 | list. Each item is a character string vector containing the hierarchy of calibrations used in the transformation for a set of selected samples. See \code{\link[assignR]{stds}}. 37 | } 38 | } 39 | 40 | \references{ 41 | Magozzi, S. et al. (in press) Calibration chain transformation to improve the comparability of organic hydrogen and oxygen isotope data. \emph{Methods in Ecology and Evolution} 42 | } 43 | 44 | \examples{ 45 | # Some fake sample data 46 | s = data.frame("d2H" = seq(-100, -10, by=10), "d2H.sd" = rep(2), "d2H_cal" = rep("OldUT_H_1")) 47 | 48 | # Transform to VSMOW-SLAP scale using default arguments 49 | d1 = refTrans(s) 50 | 51 | # Transformed values 52 | d1$data$d2H 53 | 54 | # error - target scale not valid for marker 55 | \dontrun{d2 = refTrans(s, ref_scale = "VSMOW_O") 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /man/sr_MI.Rd: -------------------------------------------------------------------------------- 1 | \name{sr_MI} 2 | 3 | \alias{sr_MI} 4 | 5 | \docType{data} 6 | 7 | \title{ 8 | data: low resolution locally weathered Sr isoscape for Michigan 9 | } 10 | 11 | \description{ 12 | Modeled 87Sr/86Sr value of the local rock weathering flux, obtained from waterisotopes.org and aggregated to 10 km resolution. 13 | } 14 | 15 | \usage{ 16 | sr_MI 17 | } 18 | 19 | \format{ 20 | SpatRaster with two layers. The first layer is the mean prediction and the second is 1 standard deviation (here estimated as 1 percent of the modeled mean) 21 | } 22 | 23 | \references{ 24 | Bataille, C. P. and Bowen, G. J. (2012) Mapping 87Sr/86Sr variations in bedrock and water for large scale provenance studies. \emph{Chemical Geology}, \bold{304--305}, 39--52. 25 | } 26 | 27 | \examples{ 28 | library(terra) 29 | 30 | plot(sr_MI) 31 | } 32 | 33 | -------------------------------------------------------------------------------- /man/states.Rd: -------------------------------------------------------------------------------- 1 | \name{states} 2 | 3 | \alias{states} 4 | 5 | \docType{data} 6 | 7 | \title{ 8 | data: outline of US states 9 | } 10 | 11 | \description{ 12 | Outline map of the of lower 48 U.S. states. 13 | } 14 | 15 | \usage{ 16 | states 17 | } 18 | 19 | \format{ 20 | SpatVector 21 | } 22 | 23 | \examples{ 24 | library(terra) 25 | 26 | plot(states) 27 | } 28 | -------------------------------------------------------------------------------- /man/stds.Rd: -------------------------------------------------------------------------------- 1 | \name{stds} 2 | 3 | \alias{stds} 4 | 5 | \docType{data} 6 | 7 | \title{ 8 | data: documentation of keratin H and O isotope standard calibrations 9 | } 10 | 11 | \description{ 12 | This data object contains information on keratin H and O isotope standard materials and calibrations used across multiple laboratories since the year 2000. 13 | } 14 | 15 | \usage{ 16 | data("stds") 17 | } 18 | 19 | \format{ 20 | list. 21 | \describe{ 22 | \item{hstds}{ 23 | data.frame with 18 fields. 24 | \describe{ 25 | \item{[, 1]}{Calibration: Calibration code} 26 | \item{[, 2]}{High_ID: Identifier for high-value standard} 27 | \item{[, 3]}{High_material: Description of high-value standard material} 28 | \item{[, 4]}{High: Mean hydrogen isotope value of high-value standard} 29 | \item{[, 5]}{High_sd: Standard deviation of calibration data for high-value standard} 30 | \item{[, 6]}{High_n: Number of calibration data for high-value standard} 31 | \item{[, 7]}{High_se: Standard error of the calibrated mean for high-value standard} 32 | \item{[, 8]}{Low_ID: Identifier for low-value standard} 33 | \item{[, 9]}{Low_material: Description of low-value standard material} 34 | \item{[, 10]}{Low: Mean hydrogen isotope value of low-value standard} 35 | \item{[, 11]}{Low_sd: Standard deviation of calibration data for low-value standard} 36 | \item{[, 12]}{Low_n: Number of calibration data for low-value standard} 37 | \item{[, 13]}{Low_se: Standard error of the calibrated mean for low-value standard} 38 | \item{[, 14]}{Ref_scale: Calibration scale against which the values for this calibration are anchored} 39 | \item{[, 15]}{Citation_val: Source for the calibrated values} 40 | \item{[, 16]}{Citation_cal: Source for the methodology used for this calibration} 41 | \item{[, 17]}{Treatment: Description of calibration procedure} 42 | \item{[, 18]}{H_calibration_comments: Comments} 43 | } 44 | } 45 | \item{ostds}{ 46 | data.frame with 18 fields. 47 | \describe{ 48 | \item{[, 1]}{Calibration: Calibration code} 49 | \item{[, 2]}{High_ID: Identifier for high-value standard} 50 | \item{[, 3]}{High_material: Description of high-value standard material} 51 | \item{[, 4]}{High: Mean oxygen isotope value of high-value standard} 52 | \item{[, 5]}{High_sd: Standard deviation of calibration data for high-value standard} 53 | \item{[, 6]}{High_n: Number of calibration data for high-value standard} 54 | \item{[, 7]}{High_se: Standard error of the calibrated mean for high-value standard} 55 | \item{[, 8]}{Low_ID: Identifier for low-value standard} 56 | \item{[, 9]}{Low_material: Description of low-value standard material} 57 | \item{[, 10]}{Low: Mean oxygen isotope value of low-value standard} 58 | \item{[, 11]}{Low_sd: Standard deviation of calibration data for low-value standard} 59 | \item{[, 12]}{Low_n: Number of calibration data for low-value standard} 60 | \item{[, 13]}{Low_se: Standard error of the calibrated mean for low-value standard} 61 | \item{[, 14]}{Ref_scale: Calibration scale against which the values for this calibration are anchored} 62 | \item{[, 15]}{Citation_val: Source for the calibrated values} 63 | \item{[, 16]}{Citation_cal: Source for the methodology used for this calibration} 64 | \item{[, 17]}{Treatment: Description of calibration procedure} 65 | \item{[, 18]}{O_calibration_comments: Comments} 66 | } 67 | } 68 | \item{ham}{ 69 | matrix. n x n symmetric, where n is the number of calibrations represented here and in \code{stds$hstds}. 70 | } 71 | \item{oam}{ 72 | matrix. n x n symmetric, where n is the number of calibrations represented here and in \code{stds$ostds}. 73 | } 74 | } 75 | } 76 | 77 | \references{ 78 | Magozzi, S. et al. (in press) Calibration chain transformation to improve the comparability of organic hydrogen and oxygen isotope data. \emph{Methods in Ecology and Evolution} 79 | } 80 | 81 | \examples{ 82 | library(graphics) 83 | data("stds") 84 | 85 | print(stds$hstds[, 1:5]) 86 | print(stds$ostds[, 1:5]) 87 | image(stds$ham) 88 | image(stds$oam) 89 | } 90 | 91 | \keyword{datasets} 92 | -------------------------------------------------------------------------------- /man/subOrigData.Rd: -------------------------------------------------------------------------------- 1 | \name{subOrigData} 2 | 3 | \alias{subOrigData} 4 | 5 | \title{ 6 | Extract known origin sample data 7 | } 8 | 9 | \description{ 10 | This function subsets the known-origin isotope dataset included in this package and conducts optional transformations to convert isotope measurements to a common reference scale. 11 | } 12 | 13 | \usage{ 14 | subOrigData(marker = "d2H", taxon = NULL, group = NULL, dataset = NULL, 15 | age_code = NULL, mask = NULL, ref_scale = "VSMOW_H", niter = 5000, genplot = TRUE) 16 | } 17 | 18 | \arguments{ 19 | \item{marker}{ 20 | character string. Column name for isotopic data to be extracted, either \dQuote{d2H} or \dQuote{d18O}. 21 | } 22 | \item{taxon}{ 23 | character string or string vector. Species name(s) for data to be extracted. 24 | } 25 | \item{group}{ 26 | character string or string vector. Taxonomic groups for data to be extracted. 27 | } 28 | \item{dataset}{ 29 | integer or integer vector. Dataset_ID(s) for data to be extracted. See \code{\link[assignR]{knownOrig}} feature \emph{sources}. 30 | } 31 | \item{age_code}{ 32 | character string or string vector. Animal age code for data to be extracted. 33 | } 34 | \item{mask}{ 35 | SpatVector. Polygon layer used to constrain the geographic area from which data are extracted. If not provided, global. 36 | } 37 | \item{ref_scale}{ 38 | character string. Text identifier for reference scale to which all isotope values will be transformed. See \code{\link[assignR]{stds}}. Use \dQuote{NULL} to obtain untransformed values on the originally reported scale.} 39 | \item{niter}{ 40 | integer. Number of random samples used to propagate uncertainty in calibration hierarchy transformations. 41 | } 42 | \item{genplot}{ 43 | logical. Plot results in R. 44 | } 45 | } 46 | 47 | \value{ 48 | Returns an object of class \dQuote{subOrigData}, formatted for use in \code{\link{calRaster}} or \code{\link{QA}} functions. 49 | \item{data}{ 50 | SpatVector including one point feature for each selected sample. Data fields are described in \code{\link{knownOrig}} feature \emph{samples}.} 51 | \item{sources}{ 52 | data.frame. Information for all data sources for the selected samples. Fields are described in \code{\link{knownOrig}} feature \emph{sources} 53 | } 54 | \item{chains}{ 55 | list. Each item is a character string vector containing the hierarchy of calibrations used in the transformation for a set of selected samples. See \code{\link{stds}}. 56 | } 57 | \item{marker}{ 58 | character string. The isotopic marker specified in the call to \code{subOrigData} 59 | } 60 | } 61 | 62 | \references{ 63 | Magozzi, S. et al. (in press) Calibration chain transformation to improve the comparability of organic hydrogen and oxygen isotope data. \emph{Methods in Ecology and Evolution} 64 | } 65 | 66 | \examples{ 67 | ## WITHOUT mask 68 | # extract d2H data for Jackdaw, Partridge and Willow Grouse, transformed 69 | # to the VSMOW/SLAP H reference scale by default 70 | d1 = subOrigData(taxon = c("Danaus plexippus", "Setophaga ruticilla", 71 | "Turdus migratorius"), niter = 100) 72 | summary(d1) 73 | 74 | # extract d2H data for insects and passerine birds without transformation 75 | d2 = subOrigData(group = c("Insect","Passerine"), ref_scale = NULL, genplot = FALSE) 76 | summary(d2) 77 | 78 | # extract d18O data for all humans, transformed to the VSMOW/SLAP O reference scale 79 | d3 = subOrigData(marker = "d18O", 80 | group = c("Modern human", "Indigenous human"), ref_scale = "VSMOW_O", 81 | niter = 100, genplot = FALSE) 82 | summary(d3) 83 | 84 | # extract d2H data for humans using taxon, transformed to the VSMOW/SLAP H reference scale 85 | d4 = subOrigData(marker = "d2H", taxon = "Homo sapiens", ref_scale = 86 | "VSMOW_H", niter = 100, genplot = FALSE) 87 | summary(d4) 88 | 89 | ## WITH mask 90 | # error - no samples found 91 | \dontrun{d5 = subOrigData(taxon = "Turdus philomelos", mask = naMap)} 92 | # this works OK 93 | d6 = subOrigData(taxon = c("Danaus plexippus", "Setophaga ruticilla", 94 | "Turdus migratorius"), mask = naMap, genplot = FALSE) 95 | } 96 | -------------------------------------------------------------------------------- /man/unionP.Rd: -------------------------------------------------------------------------------- 1 | \name{unionP} 2 | 3 | \alias{unionP} 4 | 5 | \title{ 6 | Union probability of origin 7 | } 8 | 9 | \description{ 10 | Probabilities that at least one individual came from each location in the assignment area (union of probabilities) 11 | } 12 | 13 | \usage{ 14 | unionP(pdR) 15 | } 16 | 17 | \arguments{ 18 | \item{pdR}{ 19 | SpatRaster of probability density maps, e.g., as produced by \code{pdRaster}. 20 | } 21 | } 22 | 23 | \value{ 24 | SpatRaster. 25 | } 26 | 27 | \examples{ 28 | # load hydrogen isotope data for human hair in North America 29 | d = subOrigData(group = "Modern human", mask = naMap, genplot = FALSE) 30 | 31 | # rescale from environmental isoscape to tissue isoscape 32 | r = calRaster(d, d2h_lrNA, naMap, genplot = FALSE) 33 | 34 | # four unknown-origin examples 35 | id = c("A", "B", "C", "D") 36 | d2H = c(-110, -90, -105, -102) 37 | un = data.frame(id, d2H) 38 | 39 | # posterior probabilities 40 | pp = pdRaster(r, un, mask = naMap, genplot = FALSE) 41 | 42 | # probability that one or more individuals are from a given location 43 | unionP(pp) 44 | } 45 | -------------------------------------------------------------------------------- /man/wDist.Rd: -------------------------------------------------------------------------------- 1 | \name{wDist} 2 | 3 | \alias{wDist} 4 | 5 | \title{ 6 | Probability weighted distances and bearings 7 | } 8 | 9 | \description{ 10 | Calculate the distance and bearing of migration for one or more samples, weighted by probabilities from a \code{pdRaster} analysis. 11 | } 12 | 13 | \usage{ 14 | wDist(pdR, sites, maxpts = 1e5, bw = "sj") 15 | } 16 | 17 | \arguments{ 18 | \item{pdR}{ 19 | SpatRaster of n probability density maps, e.g., as produced by \code{pdRaster}. 20 | } 21 | \item{sites}{ 22 | SpatVector object containing the collection locations for the n samples represented in \code{pdR}. 23 | } 24 | \item{maxpts}{ 25 | numeric. Maximum number of grid cells at which to calculate bearing and distance. 26 | } 27 | \item{bw}{ 28 | character or numeric. Smoothing bandwidth to be used in kernel density estimation. See \link[stats]{bandwidth}. 29 | } 30 | } 31 | 32 | \details{ 33 | \code{pdR} and \code{sites} must be of equal length and corresponding order, or if \code{length(sites) == 1 & nlyr(pdR) > 1} then the location in sites is recycled with a message. Names in the output object are taken from the names of the layers in \code{pdR}. 34 | 35 | Distances and bearings are calculated on the WGS84 geoid using functions from the \pkg{terra} and \pkg{geosphere} package. These calculations can take a long time for large rasters. If \code{maxpts} is less than the number of grid cells in each \code{pdR} layer, calculations are carried out for \code{maxpts} randomly selected cells. 36 | 37 | Bearing values correspond to the initial bearing from source to collection location, and are reported on a scale of -180 to +180 degrees. The statistical metrics are rectified so that values for distributions spanning due south are reported correctly. Both weighted bearing and distance distributions are often multimodal, and it is recommended to review the distribution densities to assess the representativeness of the statistics (e.g., using \code{\link{plot.wDist}}). 38 | 39 | When algorithmic bandwidth selection is used weights are ignored for this step and warnings to this effect are suppressed. 40 | } 41 | 42 | \value{ 43 | Returns an object of class \dQuote{wDist}, a list of length n. Each item contains three named objects: 44 | \item{stats}{ 45 | named number. Statistics for the distance (dist, meters) and bearing (bear, degrees) between source and collection locations, including the weighted mean (wMean) and quantile (wXX) values.} 46 | \item{d.dens}{ 47 | density. Weighted kernel density for the distance between source and collection locations (meters). See \code{\link[stats]{density}}. 48 | } 49 | \item{b.dens}{ 50 | density. Weighted kernel density for the bearing between source and collection locations (degrees). See \code{\link[stats]{density}}. 51 | } 52 | } 53 | 54 | \examples{ 55 | # load hydrogen isotope data for human hair in North America 56 | d = subOrigData(group = "Modern human", mask = naMap, genplot = FALSE) 57 | 58 | # rescale from environmental isoscape to tissue isoscape 59 | r = calRaster(d, d2h_lrNA, naMap, genplot = FALSE) 60 | 61 | # four unknown-origin examples 62 | id = c("A", "B", "C", "D") 63 | d2H = c(-110, -90, -105, -102) 64 | un = data.frame(id, d2H) 65 | 66 | # posterior probabilities 67 | pp = pdRaster(r, un, mask = naMap, genplot = FALSE) 68 | 69 | # random collection locations 70 | sites = d$data[sample(seq(length(d$data)), 4),] 71 | 72 | # generate a wDist object 73 | wd = wDist(pp, sites) 74 | 75 | # structure of the wDist object 76 | str(wd, 2) 77 | } 78 | 79 | -------------------------------------------------------------------------------- /man/wrld_simpl.Rd: -------------------------------------------------------------------------------- 1 | \name{wrld_simpl} 2 | 3 | \alias{wrld_simpl} 4 | 5 | \docType{data} 6 | 7 | \title{ 8 | data: world boundary map 9 | } 10 | 11 | \description{ 12 | Simplified spatial polygon layer representing the boundary of global continents. 13 | } 14 | 15 | \usage{ 16 | wrld_simpl 17 | } 18 | 19 | \format{ 20 | SpatVector 21 | } 22 | 23 | \examples{ 24 | library(terra) 25 | 26 | plot(wrld_simpl) 27 | } 28 | -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/MEE_script.R: -------------------------------------------------------------------------------- 1 | #Load packages 2 | library(assignR) 3 | library(rgdal) 4 | 5 | #Set up data and projection 6 | d = subOrigData(taxon = "Lanius ludovicianus", reference = "Hobson et al. 2012", mask = naMap) 7 | s = readOGR("states_shapefile/states.shp") 8 | p = "+proj=aea +lat_1=20 +lat_2=60 +lat_0=40 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83" 9 | 10 | #Project our spatial objects 11 | isona = crop(d2h_world, naMap) 12 | isona = projectRaster(isona, crs = p) 13 | s = spTransform(s, p) 14 | c = spTransform(naMap, p) 15 | 16 | #Calibrate tissue isoscape 17 | r = calRaster(known = d, isoscape = isona, mask = naMap) 18 | 19 | #Hypothetical unknown-origin sample 20 | un = data.frame("id" = "A", "d2H" = -110) 21 | 22 | #Posterior probability raster 23 | pdR = pdRaster(r, unknown = un) 24 | 25 | #Two states to use in comparing odds 26 | s1 = s[s$STATE_ABBR == "UT",] 27 | s2 = s[s$STATE_ABBR == "NM",] 28 | s12 = rbind(s1, s2) 29 | 30 | #Calculate odds ratio 31 | oddsRatio(pdR, s12) 32 | 33 | #Upper 90% probability region 34 | q = qtlRaster(pdR, 0.9, "prob") 35 | 36 | #Map figure 37 | png("Figure2.png", width = 10, height = 7.5, units = "in", res = 600) 38 | layout(matrix(c(1,2), nrow = 1)) 39 | plot(pdR*1000, xlim = c(-4.5e6, 3.5e6), ylim = c(-2e6, 5e6), axes = FALSE, box = FALSE) 40 | lines(c) 41 | lines(s1, col = "red") 42 | lines(s2, col = "blue") 43 | text(-4.2e6, 5e6, "(a)") 44 | text(3.3e6, 1.2e6, "Probability (x 1000)", srt = 90) 45 | 46 | plot(q, xlim = c(-4.5e6, 3.5e6), ylim = c(-2e6, 5e6), axes = FALSE, box = FALSE, legend = FALSE) 47 | lines(c) 48 | text(-4.2e6, 5e6, "(b)") 49 | 50 | dev.off() 51 | 52 | #Generate random points 53 | locs = spsample(c, 300, "random") 54 | 55 | #Get isotope values 56 | locs$vals = extract(isona[[1]], locs) 57 | locs = locs[!is.na(locs$vals),] 58 | locs = locs[1:200,] 59 | 60 | #Add some reasonable random noise to the known origin data 61 | locs$vals = locs$vals + rnorm(nrow(locs), 0, 10) 62 | k = SpatialPointsDataFrame(locs, data.frame(d2H = locs$vals), proj4string = p) 63 | 64 | #Create a version of the isoscape that has no uncertainty 65 | isoperf = isona 66 | isoperf[[2]] = setValues(isoperf[[2]], 0) 67 | 68 | #Now assign to the perfect raster; this is 'correct' since the isoscape values 69 | #used to generate the synthetic data were known perfectly 70 | qa_perf = QA(isoperf, k, name = "Not inflated") 71 | 72 | #Now assign using the original isoscape, with error 73 | qa_err = QA(isona, k, name = "Inflated") 74 | 75 | #Plot it 76 | plot(qa_perf, qa_err, outDir = "C:/Users/u0133977/Dropbox/Hypomirror/assignR_MEE") 77 | 78 | -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/states_shapefile/states.dbf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/manuscripts/Ma_2020_MEE/states_shapefile/states.dbf -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/states_shapefile/states.prj: -------------------------------------------------------------------------------- 1 | GEOGCS["GCS_North_American_1983",DATUM["D_North_American_1983",SPHEROID["GRS_1980",6378137.0,298.257222101]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]] -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/states_shapefile/states.sbn: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/manuscripts/Ma_2020_MEE/states_shapefile/states.sbn -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/states_shapefile/states.sbx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/manuscripts/Ma_2020_MEE/states_shapefile/states.sbx -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/states_shapefile/states.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/manuscripts/Ma_2020_MEE/states_shapefile/states.shp -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/states_shapefile/states.shp.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | {6C2FDF67-E8D4-4EE4-BE98-859E452FFE24}2006110120281300TRUECreateFeatureclass C:\ESRI\AEJEE_XTRA\AEJEE23data\usa states # states_Layer SAME_AS_TEMPLATE SAME_AS_TEMPLATE "GEOGCS['GCS_North_American_1983',DATUM['D_North_American_1983',SPHEROID['GRS_1980',6378137.0,298.257222101]],PRIMEM['Greenwich',0.0],UNIT['Degree',0.0174532925199433]];-178.217598362366 18.921786345087 999999.999068677;0 100000;0 100000" # 0 0 0 C:\ESRI\AEJEE_XTRA\AEJEE23data\usa\states.shpAppend states_Layer C:\ESRI\AEJEE_XTRA\AEJEE23data\usa\states.shp TEST C:\ESRI\AEJEE_XTRA\AEJEE23data\usa\states.shpFeatureClassToFeatureClass D:\usa\census\states.sdc\states C:\ESRI\AEJEE_XTRA\AEJEE23data\usa states # "STATE_NAME STATE_NAME VISIBLE;STATE_FIPS STATE_FIPS VISIBLE;SUB_REGION SUB_REGION VISIBLE;STATE_ABBR STATE_ABBR VISIBLE;POP2000 POP2000 VISIBLE;POP2005 POP2005 VISIBLE;POP00_SQMI POP00_SQMI VISIBLE;POP05_SQMI POP05_SQMI VISIBLE;WHITE WHITE VISIBLE;BLACK BLACK VISIBLE;AMERI_ES AMERI_ES VISIBLE;ASIAN ASIAN VISIBLE;HAWN_PI HAWN_PI VISIBLE;OTHER OTHER VISIBLE;MULT_RACE MULT_RACE VISIBLE;HISPANIC HISPANIC VISIBLE;MALES MALES VISIBLE;FEMALES FEMALES VISIBLE;AGE_UNDER5 AGE_UNDER5 VISIBLE;AGE_5_17 AGE_5_17 VISIBLE;AGE_18_21 AGE_18_21 VISIBLE;AGE_22_29 AGE_22_29 VISIBLE;AGE_30_39 AGE_30_39 VISIBLE;AGE_40_49 AGE_40_49 VISIBLE;AGE_50_64 AGE_50_64 VISIBLE;AGE_65_UP AGE_65_UP VISIBLE;MED_AGE MED_AGE VISIBLE;MED_AGE_M MED_AGE_M VISIBLE;MED_AGE_F MED_AGE_F VISIBLE;HOUSEHOLDS HOUSEHOLDS VISIBLE;AVE_HH_SZ AVE_HH_SZ VISIBLE;HSEHLD_1_M HSEHLD_1_M VISIBLE;HSEHLD_1_F HSEHLD_1_F VISIBLE;MARHH_CHD MARHH_CHD VISIBLE;MARHH_NO_C MARHH_NO_C VISIBLE;MHH_CHILD MHH_CHILD VISIBLE;FHH_CHILD FHH_CHILD VISIBLE;FAMILIES FAMILIES VISIBLE;AVE_FAM_SZ AVE_FAM_SZ VISIBLE;HSE_UNITS HSE_UNITS VISIBLE;VACANT VACANT VISIBLE;OWNER_OCC OWNER_OCC VISIBLE;RENTER_OCC RENTER_OCC VISIBLE;NO_FARMS97 NO_FARMS97 VISIBLE;AVG_SIZE97 AVG_SIZE97 VISIBLE;CROP_ACR97 CROP_ACR97 VISIBLE;AVG_SALE97 AVG_SALE97 VISIBLE;SQMI SQMI VISIBLE" SAME_AS_TEMPLATE SAME_AS_TEMPLATE # 0 C:\ESRI\AEJEE_XTRA\AEJEE23data\usa\states.shp 4 | -------------------------------------------------------------------------------- /manuscripts/Ma_2020_MEE/states_shapefile/states.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SPATIAL-Lab/assignR/26d2a5530f57e1ff03278743fc09b66454dd404c/manuscripts/Ma_2020_MEE/states_shapefile/states.shx -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(assignR) 3 | 4 | test_check("assignR") 5 | -------------------------------------------------------------------------------- /tests/testthat/.gitignore: -------------------------------------------------------------------------------- 1 | temp -------------------------------------------------------------------------------- /tests/testthat/test_getIsoscapes.R: -------------------------------------------------------------------------------- 1 | iso = getIsoscapes("CaribSr") 2 | iso2 = getIsoscapes("CaribSr") 3 | 4 | test_that("getIsoscapes works",{ 5 | if(!is.null(iso)){ 6 | expect_is(iso, "SpatRaster") 7 | } 8 | expect_equal(iso, iso2) 9 | expect_error(getIsoscapes("USPrecipALLs")) 10 | }) -------------------------------------------------------------------------------- /tests/testthat/test_pdRaster.R: -------------------------------------------------------------------------------- 1 | d = subOrigData(group = "Modern human", mask = naMap) 2 | dmp = capture_output({ 3 | r = calRaster(d, d2h_lrNA, naMap, genplot = FALSE) 4 | }) 5 | id = "smile" 6 | d2H = -80 7 | d2H.sd = 2 8 | un = data.frame(id, d2H, d2H.sd, d2H_cal = "UT_H_1") 9 | site = d$data[1,] 10 | r2 = r 11 | r2[[1]][[1]] = setValues(r2[[1]][[1]], values(r2[[1]][[1]]) + 12 | rnorm(ncell(r2[[1]][[1]]), 0, 10)) 13 | rmulti = isoStack(r, r2) 14 | un2 = refTrans(un) 15 | 16 | r3 = isoStack(r, sr_MI) 17 | un3 = data.frame(id, d2H, "Sr" = 0.710) 18 | 19 | mask_noCRS = naMap 20 | crs(mask_noCRS) = "" 21 | 22 | mask_diffProj = project(naMap, "+init=epsg:28992") 23 | 24 | un_hasNA = un 25 | un_hasNA[1,2] = NA 26 | 27 | test_that("pdRaster works",{ 28 | expect_warning(pdRaster(r, unknown = un, mask = naMap, genplot = FALSE)) 29 | expect_error(pdRaster(rmulti, list(un, un), mask = naMap, 30 | genplot = FALSE)) 31 | expect_is(suppressWarnings(pdRaster(rmulti, list(un2, un2), mask = naMap, 32 | genplot = FALSE)), "SpatRaster") 33 | dmp = capture_output(expect_is(pdRaster(r3, un3), "SpatRaster")) 34 | expect_error(pdRaster(r$lm.model, unknown = un)) 35 | expect_error(pdRaster(r$isoscape.rescale$mean, unknown = un)) 36 | expect_error(pdRaster(stack(r$isoscape.rescale,r$isoscape.rescale), un)) 37 | expect_error(pdRaster(r, unknown = as.matrix(un))) 38 | expect_error(pdRaster(r, unknown = un_hasNA)) 39 | expect_error(pdRaster(r, unknown = data.frame(un$id,un$id))) 40 | expect_error(pdRaster(r, unknown = data.frame(un[,1]))) 41 | expect_error(suppressWarnings(pdRaster(r, unknown = un, genplot = 2))) 42 | expect_error(suppressWarnings(pdRaster(r, unknown = un, outDir = 2))) 43 | expect_error(suppressWarnings(pdRaster(r, unknown = un, mask = mask_noCRS))) 44 | expect_error(suppressWarnings(pdRaster(r, unknown = un, mask = 2))) 45 | expect_message(suppressWarnings(pdRaster(r, unknown = un, 46 | mask = mask_diffProj, genplot = FALSE))) 47 | }) 48 | 49 | pdr = suppressWarnings(pdRaster(r, unknown = un, mask = naMap, genplot = FALSE)) 50 | wd = wDist(pdr, site) 51 | 52 | test_that("wDist works",{ 53 | expect_is(wd, "wDist") 54 | expect_is(c(wd), "data.frame") 55 | expect_error(plot(wd, bin = 11)) 56 | expect_silent(plot(wd)) 57 | }) 58 | -------------------------------------------------------------------------------- /tests/testthat/test_plot.QA.R: -------------------------------------------------------------------------------- 1 | library(terra) 2 | dmp = capture_output({ 3 | r1 = aggregate(sr_MI, 5) 4 | r2 = project(d2h_lrNA, r1) 5 | r3 = isoStack(r1, r2) 6 | dpts = spatSample(c(r1, r2), 20, na.rm = TRUE, as.points = TRUE) 7 | dpts$weathered.mean = dpts$weathered.mean + rnorm(20, 0, 0.0005) 8 | dpts$d2h = dpts$d2h + rnorm(20, 0, 8) 9 | dpts$Site_ID = letters[1:20] 10 | d1 = dpts[,1:2] 11 | d2 = dpts 12 | d3 = suppressWarnings(subOrigData(group = c("Raptor", "Passerine", "Water bird"), 13 | mask = states[states$STATE_ABBR == "MI",], 14 | ref_scale = NULL, genplot = FALSE)) 15 | 16 | qa1 = suppressWarnings(QA(d1, r1, valiTime = 2, by = 25, 17 | name = "Sr", bySite = FALSE)) 18 | qa2 = suppressWarnings(QA(d2, r3, valiTime = 2, by = 25, 19 | name = "Multi", setSeed = F)) 20 | qa3 = suppressWarnings(QA(d3, r2, valiTime = 2, by = 25, 21 | name = "SOD", setSeed = F)) 22 | }) 23 | 24 | test_that("QA and plot.QA work",{ 25 | expect_is(qa1, "QA") 26 | expect_is(qa2, "QA") 27 | expect_silent(plot(qa1, qa2)) 28 | expect_silent(plot(qa3)) 29 | expect_silent(plot(qa1, qa2)) 30 | expect_silent(plot(qa1, outDir = tempdir())) 31 | }) 32 | -------------------------------------------------------------------------------- /tests/testthat/test_plot.isoStack.R: -------------------------------------------------------------------------------- 1 | d2h_crop = crop(d2h_lrNA, ext(-100, -60, 25, 45)) 2 | d2h_proj = project(d2h_lrNA, "+proj=longlat +ellps=clrk66 3 | +datum=NAD27 +no_defs") 4 | s = suppressWarnings(isoStack(d2h_lrNA, d2h_crop)) 5 | 6 | test_that("isoStack can stack isoscapes and plot can plot them",{ 7 | expect_error(isoStack(d2h_lrNA[[1]], d2h_lrNA)) 8 | expect_error(isoStack(d2h_lrNA)) 9 | expect_error(isoStack(d2h_lrNA, d2h_proj, clean = FALSE)) 10 | expect_s3_class(s, "isoStack") 11 | expect_s3_class(suppressWarnings(isoStack(d2h_lrNA, d2h_proj)), "isoStack") 12 | expect_error(plot.isoStack(d2h_lrNA)) 13 | expect_silent(plot(s)) 14 | }) -------------------------------------------------------------------------------- /tests/testthat/test_processing.R: -------------------------------------------------------------------------------- 1 | dmp = capture_output({ 2 | d = subOrigData(taxon = "Homo sapiens", dataset = 10, mask = naMap, 3 | genplot = FALSE) 4 | }) 5 | 6 | test_that("suOrigData works",{ 7 | expect_equal(class(d), "subOrigData") 8 | expect_is(d$data, "SpatVector") 9 | expect_error(subOrigData(taxon = "Turdus philomelos", mask = naMap)) 10 | expect_error(subOrigData(taxon = "Turdus philomelos", marker = "d14C")) 11 | expect_warning(subOrigData(taxon = "Serin serin", 12 | age_code = c("juvenile", "newborn"), 13 | ref_scale = NULL, genplot = FALSE)) 14 | expect_warning(subOrigData(taxon = c("Serin serin", "Vanellus malabaricus"), 15 | ref_scale = NULL, genplot = FALSE)) 16 | expect_warning(subOrigData(group = c("Indigenous human", "Badgers"), 17 | ref_scale = NULL, genplot = FALSE)) 18 | expect_warning(subOrigData(dataset = c(8, "Ma 2020"), 19 | ref_scale = NULL, genplot = FALSE)) 20 | expect_warning(subOrigData(dataset = c(8, 100), 21 | ref_scale = NULL, genplot = FALSE)) 22 | }) 23 | 24 | dmp = capture_output({ 25 | d_hasNA = d 26 | d_hasNA$data$d2H[1] = NA 27 | d_diffProj = d 28 | d_diffProj$data = project(d$data, "+init=epsg:28992") 29 | d_usr_bad = d$data 30 | d_usr_good = d_usr_bad 31 | values(d_usr_good) = data.frame(d$data$d2H, d$data$d2H.sd) 32 | d_usr_2row = d_usr_good[1:2, ] 33 | d_noCRS = d 34 | crs(d_noCRS$data) = "" 35 | 36 | d2h_lrNA_noCRS = d2h_lrNA 37 | crs(d2h_lrNA_noCRS) = "" 38 | 39 | mask_diffProj = project(naMap, "+init=epsg:28992") 40 | 41 | mask_noCRS = naMap 42 | crs(mask_noCRS) = "" 43 | 44 | tempVals = values(d2h_lrNA) 45 | tempVals[is.nan(tempVals)] = 9999 46 | d2h_lrNA_with9999 = setValues(d2h_lrNA, tempVals) 47 | 48 | s1 = states[states$STATE_ABBR == "UT",] 49 | d2h_lrNA_na = mask(d2h_lrNA, s1) 50 | 51 | r = calRaster(known = d, isoscape = d2h_lrNA_with9999, NA.value = 9999, 52 | interpMethod = 1, genplot = FALSE, mask = naMap) 53 | }) 54 | 55 | test_that("calRaster works",{ 56 | capture_output({ 57 | expect_is(r, "rescale") 58 | expect_is(calRaster(known = d_usr_good, isoscape = d2h_lrNA, 59 | genplot = FALSE), "rescale") 60 | expect_output(calRaster(known = d, isoscape = d2h_lrNA, 61 | genplot = FALSE, outDir = tempdir())) 62 | expect_equal(nlyr(r$isoscape.rescale), 2) 63 | expect_error(calRaster(known = d$data$d2H, isoscape = d2h_lrNA)) 64 | expect_error(calRaster(known = d, isoscape = d2h_lrNA, 65 | outDir = 2)) 66 | expect_error(calRaster(known = d, isoscape = d2h_lrNA, interpMethod = 3)) 67 | expect_message(calRaster(known = d, isoscape = d2h_lrNA, genplot = 2)) 68 | expect_error(calRaster(known = d, isoscape = d2h_lrNA_noCRS)) 69 | expect_error(calRaster(known = d, isoscape = d2h_lrNA$mean)) 70 | expect_error(calRaster(known = d_usr_bad, isoscape = d2h_lrNA)) 71 | expect_error(calRaster(known = d_usr_2row, isoscape = d2h_lrNA)) 72 | expect_error(calRaster(known = d, isoscape = d2h_lrNA, mask = mask_noCRS)) 73 | expect_error(calRaster(known = d, isoscape = d2h_lrNA, mask = d)) 74 | expect_error(calRaster(known = d_noCRS, isoscape = d2h_lrNA)) 75 | expect_error(calRaster(known = d_hasNA, isoscape = d2h_lrNA, 76 | ignore.NA = FALSE)) 77 | expect_error(calRaster(known = d, isoscape = d2h_lrNA_na, ignore.NA = FALSE)) 78 | expect_message(calRaster(known = d_diffProj, isoscape = d2h_lrNA, 79 | genplot = FALSE)) 80 | expect_message(calRaster(known = d, isoscape = d2h_lrNA, 81 | mask = mask_diffProj, genplot = FALSE)) 82 | expect_warning(calRaster(known = d, isoscape = d2h_lrNA_na, genplot = FALSE)) 83 | }) 84 | }) 85 | 86 | dmp = capture_output({ 87 | id = c("A", "B", "C", "D") 88 | d2H = c(-110, -90, -105, -102) 89 | un = data.frame(id,d2H) 90 | asn = suppressWarnings(pdRaster(r, unknown = un, mask = naMap, genplot = FALSE)) 91 | 92 | j = jointP(asn) 93 | }) 94 | 95 | test_that("jointP works",{ 96 | expect_equal(global(j, sum, na.rm = TRUE)[1, 1], 1) 97 | expect_is(j, "SpatRaster") 98 | expect_error(jointP(d)) 99 | }) 100 | 101 | dmp = capture_output({ 102 | u = unionP(asn) 103 | }) 104 | 105 | test_that("unionP works",{ 106 | expect_is(u, "SpatRaster") 107 | expect_error(unionP(d2H)) 108 | }) 109 | 110 | dmp = capture_output({ 111 | s1 = states[states$STATE_ABBR == "UT",] 112 | s2 = states[states$STATE_ABBR == "NM",] 113 | s12 = rbind(s1, s2) 114 | o1 = suppressWarnings(oddsRatio(asn, s12)) 115 | 116 | pp1 = c(-112,40) 117 | pp2 = c(-105,33) 118 | pp12 = vect(rbind(pp1,pp2), crs = "WGS84") 119 | o2 = suppressWarnings(oddsRatio(asn, pp12)) 120 | o3 = suppressWarnings(oddsRatio(asn, pp12[1])) 121 | o4 = suppressWarnings(oddsRatio(asn$A, pp12)) 122 | o5 = suppressWarnings(oddsRatio(asn$A, s12)) 123 | 124 | s12_diffProj = suppressWarnings(project(s12, "+init=epsg:28992")) 125 | pp12_diffProj = suppressWarnings(project(pp12, "+init=epsg:28992")) 126 | 127 | pp12_noCRS = pp12 128 | crs(pp12_noCRS) = "" 129 | s12_noCRS = s12 130 | crs(s12_noCRS) = "" 131 | 132 | pp121 = vect(rbind(pp1, pp2, pp3 = pp1), crs = "WGS84") 133 | }) 134 | 135 | test_that("oddsRatio works",{ 136 | expect_is(o1, "list") 137 | expect_is(o2, "list") 138 | expect_is(o3, "data.frame") 139 | expect_is(o4, "list") 140 | expect_is(o5, "list") 141 | 142 | expect_error(oddsRatio(naMap,s12)) 143 | expect_error(oddsRatio(asn, data.frame(30.6, 50.5))) 144 | expect_error(oddsRatio(asn, s12_noCRS)) 145 | expect_error(suppressWarnings(oddsRatio(asn, pp121))) 146 | expect_error(oddsRatio(asn, s1)) 147 | expect_error(oddsRatio(asn, pp12_noCRS)) 148 | 149 | expect_message(suppressWarnings(oddsRatio(asn, s12_diffProj))) 150 | expect_message(suppressWarnings(oddsRatio(asn, pp12_diffProj))) 151 | }) 152 | 153 | dmp = capture_output({ 154 | q1 = qtlRaster(asn, threshold = 0.1, thresholdType = "area", outDir = tempdir()) 155 | q2 = qtlRaster(asn, threshold = 0.1, thresholdType = "prob", genplot = FALSE) 156 | q3 = qtlRaster(asn, threshold = 0, genplot = FALSE) 157 | }) 158 | 159 | test_that("qtlRaster works",{ 160 | expect_is(q1, "SpatRaster") 161 | expect_equal(nlyr(q1), 4) 162 | expect_equal(nlyr(q2), 4) 163 | expect_equal(nlyr(q3), 4) 164 | expect_error(qtlRaster(asn, threshold = "a")) 165 | expect_error(qtlRaster(asn, threshold = 10)) 166 | expect_error(qtlRaster(asn, thresholdType = "probability")) 167 | expect_message(qtlRaster(asn, threshold = 0.1, genplot = "A")) 168 | expect_error(qtlRaster(asn, threshold = 0.1, outDir = 1)) 169 | }) 170 | 171 | -------------------------------------------------------------------------------- /tests/testthat/test_refTrans.R: -------------------------------------------------------------------------------- 1 | id = letters[1:5] 2 | set.seed(123) 3 | d2H = rnorm(5, -110, 8) 4 | d2H.sd = runif(5, 1.5, 2.5) 5 | d2H_cal = rep("UT_H_1", 5) 6 | un1 = data.frame(id, d2H, d2H.sd, d2H_cal) 7 | un2 = data.frame(id, "sam" = d2H, d2H.sd, d2H_cal) 8 | un3 = data.frame(id, d2H, "sam" = d2H.sd, d2H_cal) 9 | un4 = data.frame(id, d2H, d2H.sd, "sam" = d2H_cal) 10 | un5 = data.frame(id, d2H, d2H.sd, "d2H_cal" = rep("sam", 5)) 11 | un6 = data.frame(id, "d18O" = d2H, "d18O.sd" = d2H.sd, 12 | "d18O_cal" = rep("UT_O_4", 5)) 13 | r = refTrans(un1, niter = 100) 14 | 15 | test_that("refTrans can correctly transform data",{ 16 | expect_s3_class(r, "refTrans") 17 | expect_equal(length(r[[2]]), 1) 18 | expect_error(refTrans(un2)) 19 | expect_error(refTrans(un3)) 20 | expect_error(refTrans(un4)) 21 | expect_error(suppressWarnings(refTrans(un5))) 22 | expect_error(refTrans(un1, marker = "d18O")) 23 | expect_s3_class(refTrans(un6, marker = "d18O", ref_scale = "VSMOW_O", 24 | niter = 100), "refTrans") 25 | }) 26 | --------------------------------------------------------------------------------