├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── pkgdown.yaml │ └── rcmdcheck.yml ├── .gitignore ├── CHANGES ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── circEmbed.R ├── fit.lmc.R ├── fit.variogram.R ├── fit.variogram.gls.R ├── fit.variogram.reml.R ├── get.contr.R ├── gstat.R ├── gstat.cv.R ├── gstat.debug.R ├── gstat.formula.R ├── gstat.formula.predict.R ├── gstatOptions.R ├── hscat.R ├── image.data.frame.R ├── krige.R ├── krige.cv.R ├── krige0.R ├── krigeST.R ├── krigeTg.R ├── load.variogram.model.R ├── map.to.lev.R ├── ossfim.R ├── panel.pointPairs.R ├── plot.gstatVariogram.R ├── plot.pointPairs.R ├── plot.variogramCloud.R ├── predict.gstat.R ├── print.gstat.R ├── print.variogram.R ├── print.variogramCloud.R ├── print.variogramModel.R ├── set.R ├── show.vgms.R ├── spplot.R ├── stVariogramModels.R ├── turningLayers.R ├── variogram.default.R ├── variogram.formula.R ├── variogram.gstat.R ├── variogramLine.R ├── variogramST.R ├── vgm.R ├── vgm.panel.R ├── xyz2img.R └── zzz.R ├── README.md ├── _pkgdown.yml ├── appveyor.yml ├── cleanup ├── data ├── DE_RB_2005.rda ├── coalash.rda ├── fulmar.rda ├── jura.rda ├── meuse.all.rda ├── meuse.alt.rda ├── ncp.grid.rda ├── oxford.rda ├── pcb.rda ├── sic2004.rda ├── sic97.rda ├── tull.rda ├── vv.rda ├── walker.rda └── wind.rda ├── demo ├── 00Index ├── a2p.R ├── a2pinST.R ├── block.R ├── blue.R ├── cc.R ├── circEmbeddingMeuse.R ├── cokriging.R ├── comp_geoR.R ├── cosimulation.R ├── depend.R ├── examples.R ├── fulmar.R ├── grass.R ├── gstat3D.R ├── ikr.R ├── krige.R ├── lhs.R ├── line.R ├── lnsim.R ├── localKrigeST.R ├── pcb.R ├── pcb_sf.R ├── rep.R ├── sftime.R ├── sic2004.R ├── snow.R ├── stkrige-crossvalidation.R ├── stkrige-prediction.R ├── stkrige.R ├── ugsim.R ├── uisim.R ├── weight.R ├── wind.R └── zonal.R ├── inst ├── CITATION ├── ChangeLog ├── ChangeLog1 └── external │ ├── cluster.txt │ ├── ncp.dbf │ ├── ncp.shp │ ├── ncp.shx │ ├── no2.csv │ └── oxford.jpg ├── man ├── DE_RB_2005.Rd ├── coalash.Rd ├── estiStAni.Rd ├── extractPar.Rd ├── fit.StVariogram.Rd ├── fit.lmc.Rd ├── fit.variogram.Rd ├── fit.variogram.gls.Rd ├── fit.variogram.reml.Rd ├── fulmar.Rd ├── get.contr.Rd ├── gstat-internal.Rd ├── gstat.Rd ├── hscat.Rd ├── image.Rd ├── jura.Rd ├── krige.Rd ├── krige.cv.Rd ├── krigeST.Rd ├── krigeSTSimTB.Rd ├── krigeSimCE.Rd ├── krigeTg.Rd ├── map.to.lev.Rd ├── meuse.all.Rd ├── meuse.alt.Rd ├── ncp.grid.Rd ├── ossfim.Rd ├── oxford.Rd ├── pcb.Rd ├── plot.gstatVariogram.Rd ├── plot.pointPairs.Rd ├── plot.variogramCloud.Rd ├── predict.gstat.Rd ├── progress.Rd ├── show.vgms.Rd ├── sic2004.Rd ├── sic97.Rd ├── spplot.vcov.Rd ├── tull.Rd ├── variogram.Rd ├── variogramLine.Rd ├── variogramST.Rd ├── variogramSurface.Rd ├── vgm.Rd ├── vgm.panel.Rd ├── vgmArea.Rd ├── vgmAreaST.Rd ├── vgmST.Rd ├── vv.Rd ├── walker.Rd └── wind.Rd ├── src ├── Makevars ├── block.c ├── block.h ├── data.c ├── data.h ├── debug.h ├── defaults.h ├── defs.h ├── direct.c ├── direct.h ├── fit.c ├── fit.h ├── gcdist.c ├── gcdist.h ├── getest.c ├── getest.h ├── gls.c ├── gls.h ├── glvars.c ├── glvars.h ├── init.c ├── lm.c ├── lm.h ├── mapio.c ├── mapio.h ├── msim.c ├── msim.h ├── mtrx.c ├── mtrx.h ├── nsearch.c ├── nsearch.h ├── pqueue.c ├── pqueue.h ├── reml.c ├── reml.h ├── s.c ├── s.h ├── select.c ├── select.h ├── sem.c ├── sem.h ├── sim.c ├── sim.h ├── userio.c ├── userio.h ├── utils.c ├── utils.h ├── vario.c ├── vario.h ├── vario_fn.c ├── vario_fn.h ├── vario_io.c └── vario_io.h ├── tests ├── allier.R ├── allier.Rout.save ├── blockkr.R ├── blockkr.Rout.save ├── covtable.R ├── covtable.Rout.save ├── cv.R ├── cv.Rout.save ├── cv3d.R ├── cv3d.Rout.save ├── fit.R ├── fit.Rout.save ├── krige0.R ├── krige0.Rout.save ├── line.R ├── line.Rout.save ├── merge.R ├── merge.Rout.save ├── na.action.R ├── na.action.Rout.save ├── rings.R ├── rings.Rout.save ├── sim.R ├── sim.Rout.save ├── stars.R ├── stars.Rout.save ├── unproj.R ├── unproj.Rout.save ├── variogram.R ├── variogram.Rout.save ├── vdist.R ├── vdist.Rout.save ├── windst.R └── windst.Rout.save └── vignettes ├── .install_extras ├── figures ├── allVgmsDiffWireframe.png ├── allVgmsWireframe.png ├── daily_means_PM10.png ├── diffs_daily_means_PM10.png ├── pred_daily_means_PM10.png ├── singleStationTimeSeries.png └── vgmVsMetricDist.png ├── gstat.Rnw ├── gstat.pdf ├── ifgi-logo_int.pdf ├── prs.Rnw ├── prs.pdf ├── spatio-temporal-kriging.Rnw ├── spatio-temporal-kriging.bib ├── spatio-temporal-kriging.pdf ├── st.Rnw └── st.pdf /.Rbuildignore: -------------------------------------------------------------------------------- 1 | tags 2 | spatio-temporal-kriging.aux 3 | spatio-temporal-kriging.log 4 | spatio-temporal-kriging.out 5 | spatio-temporal-kriging.synctex 6 | spatio-temporal-kriging.tex 7 | spatio-temporal-kriging.bbl 8 | spatio-temporal-kriging.blg 9 | LICENSE 10 | README.md 11 | .travis.yml 12 | appveyor.yml 13 | ChangeLog 14 | ^.*\.Rproj$ 15 | ^\.Rproj\.user$ 16 | ^docs$ 17 | ^\.github$ 18 | tic.R 19 | ^\.ccache$ 20 | _pkgdown.yml 21 | attic 22 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | permissions: 23 | contents: write 24 | steps: 25 | - uses: actions/checkout@v3 26 | 27 | - uses: r-lib/actions/setup-pandoc@v2 28 | 29 | - uses: r-lib/actions/setup-r@v2 30 | with: 31 | use-public-rspm: true 32 | 33 | - uses: r-lib/actions/setup-r-dependencies@v2 34 | with: 35 | extra-packages: any::pkgdown, local::. 36 | needs: website 37 | 38 | - name: Build site 39 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 40 | shell: Rscript {0} 41 | 42 | - name: Deploy to GitHub pages 🚀 43 | if: github.event_name != 'pull_request' 44 | uses: JamesIves/github-pages-deploy-action@v4.4.1 45 | with: 46 | clean: false 47 | branch: gh-pages 48 | folder: docs 49 | -------------------------------------------------------------------------------- /.github/workflows/rcmdcheck.yml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: rcmdcheck 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macos-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | 26 | env: 27 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 28 | R_KEEP_PKG_SOURCE: yes 29 | 30 | steps: 31 | - uses: actions/checkout@v4 32 | 33 | - uses: r-lib/actions/setup-tinytex@v2 34 | 35 | - name: Update tlmgr 36 | run: tlmgr update --self 37 | 38 | - name: Install additional LaTeX packages 39 | run: tlmgr install grfext multirow caption setspace 40 | 41 | - uses: r-lib/actions/setup-pandoc@v2 42 | 43 | - uses: r-lib/actions/setup-r@v2 44 | with: 45 | r-version: ${{ matrix.config.r }} 46 | http-user-agent: ${{ matrix.config.http-user-agent }} 47 | use-public-rspm: true 48 | 49 | - uses: r-lib/actions/setup-r-dependencies@v2 50 | with: 51 | extra-packages: any::rcmdcheck 52 | needs: check 53 | 54 | - uses: r-lib/actions/check-r-package@v2 55 | with: 56 | upload-snapshots: true 57 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | src/*.o 6 | src/*.so 7 | src/*.dll 8 | *.Rproj 9 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | Dec 5, 2002: started porting gstat to R 2 | 3 | Tue Dec 17 14:35:26 CET 2002 4 | - added multivariate gstat(), 5 | 6 | Tue Aug 12 14:42:16 CEST 2003 7 | - see src/CHANGES file in main gstat directory for more information 8 | 9 | 10 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: gstat 2 | Version: 2.1-3 3 | Title: Spatial and Spatio-Temporal Geostatistical Modelling, Prediction 4 | and Simulation 5 | Authors@R: c(person(given = "Edzer", 6 | family = "Pebesma", 7 | role = c("aut", "cre"), 8 | email = "edzer.pebesma@uni-muenster.de", 9 | comment = c(ORCID = "0000-0001-8049-7069")), 10 | person("Benedikt", "Graeler", role = "aut")) 11 | Description: Variogram modelling; simple, ordinary and universal point or block (co)kriging; spatio-temporal kriging; sequential Gaussian or indicator (co)simulation; variogram and variogram map plotting utility functions; supports sf and stars. 12 | Depends: R (>= 2.10) 13 | Imports: utils, stats, graphics, methods, lattice, sp (>= 0.9-72), zoo, 14 | sf (>= 0.7-2), sftime, spacetime (>= 1.2-8), stars, FNN 15 | Suggests: fields, maps, mapdata, xts, raster, future, future.apply, 16 | RColorBrewer, geoR, ggplot2 17 | License: GPL (>= 2.0) 18 | URL: https://github.com/r-spatial/gstat/, 19 | https://r-spatial.github.io/gstat/ 20 | Encoding: UTF-8 21 | BugReports: https://github.com/r-spatial/gstat/issues/ 22 | NeedsCompilation: yes 23 | RoxygenNote: 6.1.1 24 | Packaged: 2025-02-13 19:30:04 UTC; edzer 25 | Author: Edzer Pebesma [aut, cre] (ORCID: 26 | ), 27 | Benedikt Graeler [aut] 28 | Maintainer: Edzer Pebesma 29 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | useDynLib(gstat, 2 | gstat_debug_level, 3 | gstat_exit, 4 | gstat_fit_variogram, 5 | gstat_get_variogram_models, 6 | gstat_init, 7 | gstat_load_ev, 8 | gstat_load_variogram, 9 | gstat_new_data, 10 | gstat_new_dummy_data, 11 | gstat_predict, 12 | gstat_set_merge, 13 | gstat_set_method, 14 | gstat_set_set, 15 | gstat_variogram, 16 | gstat_variogram_values 17 | ) 18 | 19 | importFrom(utils, setTxtProgressBar, stack, txtProgressBar, head, tail) 20 | importFrom(stats, as.formula, cor, cov2cor, delete.response, .getXlevels, 21 | lm, median, model.extract, model.frame, model.matrix, na.exclude, 22 | na.fail, na.omit, na.pass, optim, optimise, optimize, predict, 23 | residuals, terms, 24 | rnorm, fft, numericDeriv, runif, setNames) 25 | importFrom(graphics, image.default, lines, locator, text) 26 | importFrom(zoo, is.regular) 27 | import(methods) 28 | import(lattice) 29 | importFrom(zoo, zoo, is.regular) 30 | import(sp) 31 | import(spacetime) 32 | import(FNN) 33 | 34 | export(as.vgm.variomodel, 35 | cross.name, 36 | fit.lmc, 37 | fit.variogram, 38 | fit.variogram.reml, 39 | fit.variogram.gls, 40 | fit.StVariogram, 41 | estiStAni, 42 | get.contr, 43 | get_gstat_progress, 44 | gstat, 45 | gstat.cv, 46 | "[.gstat", 47 | hscat, 48 | idw0, 49 | krigeTg, 50 | krige0, krigeST, krigeSTTg, krigeSimCE, krigeSTSimTB, vgmAreaST, 51 | map.to.lev, 52 | ossfim, 53 | show.vgms, 54 | spplot.vcov, 55 | variogram, 56 | variogramST, 57 | extractPar, 58 | extractParNames, 59 | variogramLine, 60 | variogramSurface, 61 | vgm, vgmArea, vgmST, 62 | vgm.panel.xyplot, 63 | panel.pointPairs, 64 | set_gstat_progress, 65 | xyz2img) 66 | 67 | exportMethods(krige, idw, krige.cv) 68 | 69 | S3method("[", gstat) 70 | 71 | S3method(as.data.frame, variogramCloud) 72 | 73 | S3method(image, data.frame) 74 | 75 | S3method(plot, pointPairs) 76 | S3method(plot, gstatVariogram) 77 | S3method(plot, variogramMap) 78 | S3method(plot, variogramCloud) 79 | S3method(plot, variogramModel) 80 | S3method(plot, StVariogram) 81 | 82 | S3method(predict, gstat) 83 | 84 | S3method(print, gstat) 85 | S3method(print, gstatVariogram) 86 | S3method(print, variogramCloud) 87 | S3method(print, variogramModel) 88 | S3method(print, StVariogramModel) 89 | 90 | S3method(variogram, default) 91 | S3method(variogram, formula) 92 | S3method(variogram, gstat) 93 | -------------------------------------------------------------------------------- /R/fit.lmc.R: -------------------------------------------------------------------------------- 1 | # $Id: fit.lmc.q,v 1.8 2009-10-06 07:52:00 edzer Exp $ 2 | 3 | "fit.lmc" <- 4 | function (v, g, model, fit.ranges = FALSE, fit.lmc = !fit.ranges, 5 | correct.diagonal = 1.0, ...) 6 | { 7 | posdef = function(X) { 8 | q = eigen(X) 9 | d = q$values 10 | d[d < 0] = 0 11 | q$vectors %*% diag(d, nrow = length(d)) %*% t(q$vectors) 12 | } 13 | if (!inherits(v, "gstatVariogram")) 14 | stop("v should be of class gstatVariogram") 15 | if (!inherits(g, "gstat")) 16 | stop("g should be of class gstat") 17 | if (!missing(model)) { 18 | if (!inherits(model, "variogramModel")) 19 | stop("model should be of class variogramModel") 20 | } 21 | n = names(g$data) 22 | for (i in 1:length(n)) { 23 | for (j in i:length(n)) { 24 | name = ifelse(i == j, n[i], cross.name(n[i], n[j])) 25 | x = v[v$id == name, ] 26 | if (nrow(x) == 0) 27 | stop(paste("gstatVariogram", name, "not present")) 28 | m = g$model[[name]] 29 | if (!missing(model)) 30 | m = model 31 | g$model[[name]] = fit.variogram(x, m, fit.ranges = fit.ranges, 32 | ...) 33 | } 34 | } 35 | if (fit.lmc) { 36 | m = g$model[[n[1]]] 37 | for (k in 1:nrow(m)) { 38 | psill = matrix(NA, nrow = length(n), ncol = length(n)) 39 | for (i in 1:length(n)) { 40 | for (j in i:length(n)) { 41 | name = ifelse(i == j, n[i], cross.name(n[i], n[j])) 42 | psill[i, j] = psill[j, i] = g$model[[name]][k, 43 | "psill"] 44 | } 45 | } 46 | psill = posdef(psill) 47 | diag(psill) = diag(psill) * correct.diagonal 48 | for (i in 1:length(n)) { 49 | for (j in i:length(n)) { 50 | name = ifelse(i == j, n[i], cross.name(n[i], n[j])) 51 | g$model[[name]][k, "psill"] = psill[i, j] 52 | } 53 | } 54 | } 55 | } 56 | g 57 | } 58 | -------------------------------------------------------------------------------- /R/fit.variogram.reml.R: -------------------------------------------------------------------------------- 1 | # $Id: fit.variogram.reml.q,v 1.14 2009-11-02 21:33:17 edzer Exp $ 2 | 3 | "fit.variogram.reml" <- 4 | function (formula, locations, data, model, debug.level = 1, set, degree = 0) 5 | { 6 | if (missing(formula)) 7 | stop("nothing to fit to") 8 | if (!inherits(formula, "formula")) 9 | stop("first argument should be of class formula") 10 | if (!missing(locations)) { 11 | if (inherits(locations, "formula")) 12 | coordinates(data) = locations 13 | else if (is(locations, "Spatial")) 14 | data = as(locations, "SpatialPointsDataFrame") 15 | } 16 | if (!is(data, "SpatialPointsDataFrame")) 17 | stop("data should (now) be of class SpatialPointsDataFrame") 18 | if (missing(model)) 19 | stop("no model to fit") 20 | if (!inherits(model, "variogramModel")) 21 | stop("model should be of class variogramModel (use vgm)") 22 | fit.sills = rep(TRUE, length(model$model)) 23 | fit.ranges = rep(FALSE, length(model$model)) 24 | .Call(gstat_init, as.integer(debug.level)) 25 | ret = gstat.formula(formula, data) 26 | ret$y <- residuals(lm(formula, data)) 27 | .Call(gstat_new_data, as.double(ret$y), as.double(ret$locations), 28 | as.double(ret$X), as.integer(1), double(0), as.integer(-1), 29 | as.integer(0), as.double(-1), as.integer(0), as.integer(1), 30 | double(0), double(0), as.integer(degree), 31 | as.integer(is.projected(data)), as.integer(0), 32 | as.double(1.0), as.integer(0)) 33 | load.variogram.model(model) 34 | if (!missing(set)) 35 | gstat.load.set(set) 36 | ret = .Call(gstat_fit_variogram, as.integer(5), 37 | as.integer(fit.sills), as.integer(fit.ranges)) 38 | .Call(gstat_exit, 0) 39 | model$psill = ret[[1]] 40 | model$range = ret[[2]] 41 | model 42 | } 43 | -------------------------------------------------------------------------------- /R/get.contr.R: -------------------------------------------------------------------------------- 1 | # $Id: get.contr.q,v 1.8 2006-03-20 15:18:14 edzer Exp $ 2 | 3 | "get.contr" <- 4 | function (data, gstat.object, X, ids = names(gstat.object$data)) 5 | { 6 | contr.fun <- function(x, n, pr.idx, cov.idx, contr) { 7 | y = matrix(x[pr.idx], n, 1) 8 | V = matrix(x[cov.idx], n, n) 9 | beta = t(contr) %*% y 10 | Vbeta = t(contr) %*% V %*% contr 11 | ret = c(beta, diag(Vbeta)) 12 | for (j in 1:nrow(Vbeta)) { 13 | if (j > 1) 14 | for (k in 1:(j - 1)) 15 | ret = c(ret, Vbeta[j, k]) 16 | } 17 | ret 18 | } 19 | lti <- function(i, j) { # lower triangular matrix index, when repr as array 20 | mx = max(i, j) - 1 21 | mn = min(i, j) - 1 22 | ((mx) * (mx - 1))/2 + mn + 1 23 | } 24 | n = length(ids) 25 | if (!is.matrix(X)) 26 | X = as.matrix(X) 27 | if (n != nrow(X)) 28 | stop("length(ids) should equal nrow(X) or length(X)") 29 | gstat.names = create.gstat.names(ids) 30 | names.pr = gstat.names[seq(1, 2 * n, 2)] 31 | names.cov = matrix("", n, n) 32 | for (i in 1:n) 33 | for (j in 1:n) 34 | names.cov[i, j] = ifelse(i == j, gstat.names[2 * i], 35 | gstat.names[2 * n + lti(i, j)]) 36 | pr.idx = match(names.pr, names(data)) 37 | cov.idx = match(names.cov, names(data)) 38 | if (any(is.na(pr.idx)) || any(is.na(cov.idx))) 39 | stop("colunn names in data not matched") 40 | 41 | res = data.frame(t(apply(as.data.frame(data)[names(data)], 1, 42 | contr.fun, n = n, pr.idx = pr.idx, cov.idx = cov.idx, 43 | contr = X))) 44 | 45 | col.names = NULL 46 | for (j in 1:NCOL(X)) 47 | col.names = c(col.names, paste("beta", j, sep = ".")) 48 | for (j in 1:NCOL(X)) 49 | col.names = c(col.names, paste("var.beta", j, sep = ".")) 50 | for (j in 1:NCOL(X)) { 51 | if (j > 1) { 52 | for (k in 1:(j - 1)) { 53 | col.names = c(col.names, paste("cov.beta", 54 | k, j, sep = ".")) 55 | } 56 | } 57 | } 58 | names(res) = col.names 59 | if (is(data, "data.frame")) 60 | row.names(res) = row.names(data) 61 | else if (is(data, "SpatialPolygonsDataFrame")) { 62 | rownames(res) = sapply(data@polygons, function(x) slot(x, "ID")) 63 | res = SpatialPolygonsDataFrame(as(data, "SpatialPolygons"), res, 64 | match.ID = TRUE) 65 | } else if (is(data, "Spatial")) { 66 | coordinates(res) = coordinates(data) 67 | gridded(res) = gridded(data) 68 | } 69 | res 70 | } 71 | -------------------------------------------------------------------------------- /R/gstat.debug.R: -------------------------------------------------------------------------------- 1 | # $Id: gstat.debug.q,v 1.3 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "gstat.debug" <- function(level = 0) { 4 | invisible(.Call(gstat_debug_level, as.integer(level))) 5 | } 6 | -------------------------------------------------------------------------------- /R/gstat.formula.R: -------------------------------------------------------------------------------- 1 | # $Id: gstat.formula.q,v 1.8 2007-06-08 06:45:52 edzer Exp $ 2 | 3 | "gstat.formula" <- 4 | function (formula, data) 5 | { 6 | # check for duplicated pixels; if yes coerce to SpatialPointsDataFrame: 7 | if (is(data, "SpatialPixels") && anyDuplicated(data@grid.index) != 0) 8 | gridded(data) = FALSE 9 | 10 | m = model.frame(terms(formula), as(data, "data.frame"), na.action = na.fail) 11 | Y = model.extract(m, "response") 12 | if (length(Y) == 0) 13 | stop("no response variable present in formula") 14 | Terms = attr(m, "terms") 15 | X = model.matrix(Terms, m) 16 | has.intercept = attr(Terms, "intercept") 17 | 18 | if (gridded(data)) 19 | grid = gridparameters(data) 20 | else 21 | grid = numeric(0) 22 | 23 | xlevels = .getXlevels(Terms, m) 24 | 25 | list(y = Y, locations = coordinates(data), X = X, call = call, 26 | has.intercept = has.intercept, grid = as.double(unlist(grid)), 27 | xlevels = xlevels) 28 | } 29 | -------------------------------------------------------------------------------- /R/gstat.formula.predict.R: -------------------------------------------------------------------------------- 1 | # $Id: gstat.formula.predict.q,v 1.14 2008-02-19 10:01:22 edzer Exp $ 2 | 3 | "gstat.formula.predict" <- 4 | function (formula, newdata, na.action, BLUE.estimates = FALSE, xlev = NULL) 5 | { 6 | if (is(newdata, "SpatialPolygons")) { 7 | # locs = coordinates(getSpatialPolygonsLabelPoints(newdata)) -- deprecated, now use: 8 | 9 | locs = t(sapply(slot(newdata, "polygons"), function(x) slot(x, "labpt"))) 10 | SpatialPoints(locs, slot(newdata, "proj4string")) 11 | locs = coordinates(locs) 12 | 13 | colnames(locs) = c("x", "y") 14 | if (is(newdata, "SpatialPolygonsDataFrame")) 15 | newdata = as.data.frame(newdata) 16 | else 17 | newdata = data.frame(a = rep(1, nrow(locs))) 18 | } else if (is(newdata, "SpatialLines")) { 19 | # locs = coordinates(getSpatialLinesMidPoints(newdata)) -- deprecated, now use: 20 | 21 | ret = lapply(newdata@lines, 22 | function(x) sapply(x@Lines, 23 | function(X) apply(X@coords, 2, mean) 24 | ) 25 | ) 26 | ret = t(sapply(ret, function(x) apply(x, 1, mean))) 27 | locs = coordinates(SpatialPoints(ret, slot(newdata, "proj4string"))) 28 | colnames(locs) = c("x", "y") 29 | 30 | if (is(newdata, "SpatialLinesDataFrame")) 31 | newdata = as.data.frame(newdata) 32 | else 33 | newdata = data.frame(a = rep(1, nrow(locs))) 34 | } else { 35 | if (gridded(newdata)) 36 | fullgrid(newdata) = FALSE 37 | locs = coordinates(newdata) 38 | newdata = as.data.frame(newdata) 39 | } 40 | 41 | # resolve formula: 42 | terms.f = delete.response(terms(formula)) 43 | mf.f = model.frame(terms.f, newdata, na.action = na.action, xlev = xlev) 44 | X = model.matrix(terms.f, mf.f) 45 | 46 | if (BLUE.estimates) { # fake the whole thing to get a matrix with BLUE parameter estimates: 47 | cnames = colnames(X) 48 | X = matrix(0, ncol(X), ncol(X)) 49 | diag(X) = 1 50 | locs = locs[1,,drop=FALSE] 51 | if (ncol(X) > 1) { 52 | for (i in 2:ncol(X)) 53 | locs = rbind(locs, locs[1,]) 54 | } 55 | rownames(locs) = cnames 56 | } 57 | 58 | if (NROW(locs) != NROW(X)) { 59 | # NA's were filtered in X, but not in coords: 60 | mf.f = model.frame(terms.f, newdata, na.action = na.pass) 61 | valid.pattern = !(apply(mf.f, 1, function(x) any(is.na(x)))) 62 | X = model.matrix(terms.f, mf.f[valid.pattern, , drop = FALSE]) 63 | locs = locs[valid.pattern, ] 64 | if (NROW(locs) != NROW(X)) 65 | stop("NROW(locs) != NROW(X): this should not occur") 66 | } 67 | list(locations = as.matrix(locs), X = as.matrix(X)) 68 | } 69 | -------------------------------------------------------------------------------- /R/gstatOptions.R: -------------------------------------------------------------------------------- 1 | .gstatOptions <- new.env(FALSE, globalenv()) 2 | 3 | assign("gstat_progress", TRUE, envir = .gstatOptions) 4 | 5 | get_gstat_progress <- function() { 6 | get("gstat_progress", envir = .gstatOptions) 7 | } 8 | 9 | set_gstat_progress <- function(value) { 10 | stopifnot(is.logical(value)) 11 | stopifnot(length(value) == 1) 12 | assign("gstat_progress", value, envir = .gstatOptions) 13 | get_gstat_progress() 14 | } 15 | -------------------------------------------------------------------------------- /R/hscat.R: -------------------------------------------------------------------------------- 1 | hscat = function(formula, data, breaks, pch = 3, cex = .6, mirror = FALSE, 2 | variogram.alpha = 0, as.table = TRUE, ...) { 3 | stopifnot(!missing(breaks)) 4 | x = variogram(formula, data, cloud = TRUE, cutoff = max(breaks), 5 | alpha = variogram.alpha, ...) 6 | x = as.data.frame(x) 7 | x$class = cut(x$dist, breaks = breaks) 8 | y = model.frame(formula, data)[[1]] 9 | x$xx = y[x$left] 10 | x$yy = y[x$right] 11 | if (mirror) 12 | x = data.frame( 13 | xx = c(x$yy, y[x$left]), 14 | yy = c(x$xx, y[x$right]), 15 | class = c(x$class, x$class)) 16 | lab = as.character(formula)[2] 17 | panel = function(x,y,subscripts, ...) { 18 | xr = c(min(x),max(x)) 19 | llines(xr, xr) 20 | lpoints(x,y,...) 21 | ltext(min(x), max(y), paste("r =", signif(cor(x,y),3)), adj=c(0,0.5)) 22 | } 23 | xyplot(xx~yy|class, x, panel = panel, 24 | main = "lagged scatterplots", xlab = lab, ylab = lab, 25 | as.table = as.table, ...) 26 | } 27 | 28 | -------------------------------------------------------------------------------- /R/image.data.frame.R: -------------------------------------------------------------------------------- 1 | # $Id: image.data.frame.q,v 1.4 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "image.data.frame" <- 4 | function (x, zcol = 3, xcol = 1, ycol = 2, asp = 1, ...) 5 | { 6 | image.default(xyz2img(xyz = x, zcol = zcol, xcol = xcol, ycol = ycol), 7 | asp = asp, 8 | ...) 9 | } 10 | -------------------------------------------------------------------------------- /R/krige.cv.R: -------------------------------------------------------------------------------- 1 | # $Id: krige.cv.q,v 1.18 2009-10-30 16:11:21 edzer Exp $ 2 | 3 | if (!isGeneric("krige.cv")) 4 | setGeneric("krige.cv", function(formula, locations, ...) 5 | standardGeneric("krige.cv")) 6 | 7 | krige.cv.locations = function (formula, locations, data = sys.frame(sys.frame(sys.parent())), 8 | model = NULL, ..., beta = NULL, nmax = Inf, nmin = 0, maxdist = Inf, 9 | nfold = nrow(data), verbose = interactive(), debug.level = 0) { 10 | 11 | gstat.cv(gstat(g = NULL, id = "var1", formula = formula, locations = 12 | locations, data = data, model = model, beta = beta, nmax = nmax, 13 | nmin = nmin, maxdist = maxdist, ...), nfold = nfold, verbose = verbose, 14 | debug.level = debug.level) 15 | } 16 | setMethod("krige.cv", c("formula", "formula"), krige.cv.locations) 17 | 18 | krige.cv.spatial = function (formula, locations, model = NULL, ..., beta = NULL, 19 | nmax = Inf, nmin = 0, maxdist = Inf, nfold = nrow(locations), verbose = interactive(), 20 | debug.level = 0) { 21 | 22 | # data = locations 23 | gstat.cv(gstat(g = NULL, id = "var1", formula = formula, 24 | data = locations, model = model, beta = 25 | beta, nmax = nmax, nmin = nmin, maxdist = maxdist, 26 | ...), nfold = nfold, verbose = verbose, debug.level = debug.level) 27 | } 28 | setMethod("krige.cv", c("formula", "Spatial"), krige.cv.spatial) 29 | 30 | krige.cv.sf = function (formula, locations, model = NULL, ..., beta = NULL, 31 | nmax = Inf, nmin = 0, maxdist = Inf, nfold = nrow(locations), verbose = interactive(), 32 | debug.level = 0) { 33 | 34 | # data = locations 35 | if (!requireNamespace("sf", quietly = TRUE)) 36 | stop("sf required: install that first") # nocov 37 | 38 | sf::st_as_sf(gstat.cv(gstat(g = NULL, id = "var1", formula = formula, 39 | data = as(locations, "Spatial"), model = model, beta = 40 | beta, nmax = nmax, nmin = nmin, maxdist = maxdist, 41 | ...), nfold = nfold, verbose = verbose, debug.level = debug.level)) 42 | } 43 | setMethod("krige.cv", c("formula", "sf"), krige.cv.sf) 44 | -------------------------------------------------------------------------------- /R/krigeTg.R: -------------------------------------------------------------------------------- 1 | # $Id: krigeTg.q,v 1.4 2009-07-07 15:42:39 edzer Exp $ 2 | 3 | phiInv <- function (x, lambda) 4 | if (lambda==0) log(x) else (x^lambda-1)/lambda 5 | 6 | phi <- function(x, lambda) 7 | if (lambda==0) exp(x) else (x*lambda+1)^(1/lambda) 8 | 9 | phiPrime <- function (x, lambda) 10 | if (lambda==0) exp(x) else (x*lambda+1)^(1/lambda-1) 11 | 12 | phiDouble <- function (x, lambda) 13 | if (lambda==0) exp(x) else 14 | lambda * (1/lambda - 1) * (lambda * x + 1)^(1/lambda-2) 15 | 16 | krigeTg <- function(formula, locations, newdata, model = NULL, ..., 17 | nmax = Inf, nmin = 0, maxdist = Inf, block = numeric(0), 18 | nsim = 0, na.action = na.pass, debug.level = 1, 19 | lambda = 1.0) 20 | { 21 | m = model.frame(terms(formula), as.data.frame(locations)) 22 | Y = model.extract(m, "response") 23 | if (length(Y) == 0) 24 | stop("no response variable present in formula") 25 | Terms = attr(m, "terms") 26 | X = model.matrix(Terms, m) 27 | has.intercept = attr(Terms, "intercept") 28 | if (ncol(X) > 1) 29 | stop("only formula with intercept allowed, e.g. y ~ 1") 30 | locations$value = phiInv(Y, lambda) 31 | locations$value1 = rep(1, length(locations$value)) 32 | 33 | OK = krige(value ~ 1, locations, newdata, model, 34 | nmax = nmax, nmin = nmin, 35 | maxdist = maxdist, block = block, nsim = nsim, 36 | na.action = na.action, debug.level = debug.level, ...) 37 | 38 | if (nsim > 0) { 39 | OK@data = as.data.frame(phi(OK@data,lambda)) 40 | return(OK) 41 | } 42 | 43 | # else: 44 | # estimate mu: 45 | g = gstat(formula = value ~ 1, # locations = locations, 46 | data = locations, model = model, nmax = nmax, nmin = nmin, 47 | maxdist = maxdist, ...) 48 | mu = predict(g, newdata = newdata, block = block, nsim = nsim, 49 | na.action = na.action, debug.level = debug.level, BLUE = TRUE) 50 | OK$muhat = mu$var1.pred 51 | 52 | SK = krige(value1 ~ 1, locations, newdata, 53 | model = model, beta = 0.0, nmax = nmax, nmin = nmin, 54 | maxdist = maxdist, block = block, nsim = nsim, 55 | na.action = na.action, debug.level = debug.level, ...) 56 | 57 | # find m: 58 | OK$m = (OK$var1.var - SK$var1.var)/(1 - SK$var1.pred) 59 | 60 | # copy SK output: 61 | OK$var1SK.pred = SK$var1.pred 62 | OK$var1SK.var = SK$var1.var 63 | 64 | # compute transGaussian kriging estimate & variance: 65 | OK$var1TG.pred = phi(OK$var1.pred, lambda) + 66 | phiDouble(mu$var1.pred, lambda) * (OK$var1.var/2 - OK$m) 67 | OK$var1TG.var = phiPrime(mu$var1.pred, lambda)^2 * OK$var1.var 68 | OK 69 | } 70 | -------------------------------------------------------------------------------- /R/load.variogram.model.R: -------------------------------------------------------------------------------- 1 | # $Id: load.variogram.model.q,v 1.7 2008-11-12 10:04:22 edzer Exp $ 2 | 3 | "load.variogram.model" <- function(model, ids = c(0, 0), max_dist = rep(-1.0, 3)) { 4 | if (missing(model)) 5 | stop("model is missing"); 6 | if (!inherits(model, "variogramModel")) 7 | stop("model should be of mode variogramModel (use function vgm)") 8 | if (any(model$range < 0.0)) { 9 | print(model) 10 | stop("variogram range can never be negative") 11 | } 12 | stopifnot(length(max_dist) == 3) 13 | anis = c(model$ang1, model$ang2, model$ang3, model$anis1, model$anis2) 14 | if (is.null(attr(model, "table"))) 15 | covtable = numeric(0) 16 | else { 17 | covtable = attr(model, "table") 18 | if (dim(model)[1] > 1 || model$model != "Tab") 19 | stop("table can only have one single model") 20 | } 21 | # max_dist hack here for Lin(0) models: 22 | # if (max_dist > 0) { 23 | # w = which(model$model %in% c("Lin") & model$range == 0) 24 | # if (length(w) > 0) { 25 | # model[w,"psill"] = max_dist * model[w,"psill"] 26 | # model[w,"range"] = max_dist 27 | # cat("Conversion into equivalent model:\n") 28 | # print(model) 29 | # } 30 | # } 31 | if (!any(model$model %in% c("Lin", "Pow"))) 32 | max_dist = rep(-1.0, 3) # ignore 33 | .Call(gstat_load_variogram, 34 | as.integer(ids), 35 | as.character(model$model), 36 | as.numeric(model$psill), 37 | as.numeric(model$range), 38 | as.numeric(model$kappa), 39 | as.numeric(anis), 40 | covtable, 41 | as.numeric(max_dist)) 42 | } 43 | -------------------------------------------------------------------------------- /R/map.to.lev.R: -------------------------------------------------------------------------------- 1 | # $Id: map.to.lev.q,v 1.2 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "map.to.lev" <- 4 | function (data, xcol = 1, ycol = 2, zcol = c(3, 4), ns = names(data)[zcol]) 5 | { 6 | len = nrow(data) 7 | d = matrix(nrow = len * length(zcol), ncol = 3) 8 | xnames = NULL 9 | if (length(ns) > 1 && length(ns) != length(zcol)) 10 | stop("names should have length 1 or equal to length of zcol") 11 | nr = 1 12 | for (i in zcol) { 13 | if (length(ns) == 1) 14 | nm = rep(paste(ns, nr), len) 15 | else nm = rep(ns[nr], len) 16 | range = (1 + (nr - 1) * len):(nr * len) 17 | d[range, ] = cbind(data[, xcol], data[, ycol], data[, 18 | i]) 19 | xnames = c(xnames, nm) 20 | nr = nr + 1 21 | } 22 | nms <- factor(xnames, levels = unique(xnames)) 23 | d = data.frame(d, nms) 24 | names(d) = c("x", "y", "z", "name") 25 | d 26 | } 27 | -------------------------------------------------------------------------------- /R/ossfim.R: -------------------------------------------------------------------------------- 1 | # $Id: ossfim.q,v 1.3 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "ossfim" <- 4 | function(spacings = 1:5, block.sizes = 1:5, model, nmax = 25, debug = 0) 5 | { 6 | n = floor(sqrt(nmax)) + 1 7 | x = 0:(n-1) + .5 8 | x = sort(c(-x, x)) 9 | ret = matrix(NA, length(spacings) * length(block.sizes), 3) 10 | r = 1 11 | for (sp in spacings) { 12 | for (bl in block.sizes) { 13 | data.grid = data.frame(expand.grid(x * sp, x * sp), 14 | z = rep(1, length(x)^2)) 15 | names(data.grid) = c("x", "y", "z") 16 | gridded(data.grid) = c("x", "y") 17 | x0 = SpatialPoints(matrix(0, 1, 2)) 18 | kr = krige(z~1, data.grid, x0, 19 | block = c(bl, bl), model = model, nmax = nmax, 20 | set = list(debug = debug)) 21 | ret[r, ] = c(sp, bl, sqrt(kr[["var1.var"]][1])) 22 | r = r + 1 23 | } 24 | } 25 | ret = data.frame(ret) 26 | names(ret) = c("spacing", "block.size", "kriging.se") 27 | ret 28 | } 29 | -------------------------------------------------------------------------------- /R/panel.pointPairs.R: -------------------------------------------------------------------------------- 1 | # $Id: panel.pointPairs.q,v 1.3 2008-03-10 10:00:10 edzer Exp $ 2 | 3 | "panel.pointPairs" <- 4 | function (x, y, type = "p", pch = plot.symbol$pch, col, col.line = 5 | plot.line$col, col.symbol = plot.symbol$col, lty = plot.line$lty, 6 | cex = plot.symbol$cex, lwd = plot.line$lwd, pairs = pairs, 7 | line.pch = line.pch, ...) 8 | { 9 | x = as.numeric(x) 10 | y = as.numeric(y) 11 | if (length(x) > 0) { 12 | if (!missing(col)) { 13 | if (missing(col.line)) 14 | col.line = col 15 | if (missing(col.symbol)) 16 | col.symbol = col 17 | } 18 | plot.symbol = trellis.par.get("plot.symbol") 19 | plot.line = trellis.par.get("plot.line") 20 | lpoints(x = x, y = y, cex = cex, col = col.symbol, pch = pch, ...) 21 | if (!missing(pairs)) { 22 | for (i in seq(along.with = pairs[,1])) { 23 | xx = c(x[pairs[i,1]], x[pairs[i,2]]) 24 | yy = c(y[pairs[i,1]], y[pairs[i,2]]) 25 | llines(x = xx, y = yy, lty = lty, col = col.line, lwd = lwd) 26 | if (line.pch > 0) 27 | lpoints(mean(xx), mean(yy), pch = line.pch, col = col.line) 28 | } 29 | } 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /R/plot.pointPairs.R: -------------------------------------------------------------------------------- 1 | # $Id: plot.pointPairs.q,v 1.4 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "plot.pointPairs" <- 4 | function(x, data, xcol = data$x, ycol = data$y, xlab = "x coordinate", 5 | ylab = "y coordinate", col.line = 2, line.pch = 0, 6 | main = "selected point pairs", ...) { 7 | 8 | if (inherits(data, "sf")) 9 | data = as(data, "Spatial") 10 | 11 | if (is(data, "SpatialPoints")) { 12 | cc = coordinates(data) 13 | xcol = cc[,1] 14 | ycol = cc[,2] 15 | xlab = colnames(cc)[1] 16 | ylab = colnames(cc)[2] 17 | asp = mapasp(data) 18 | } else 19 | asp = "iso" 20 | xyplot(ycol ~ xcol, aspect = asp, 21 | panel = panel.pointPairs, xlab = xlab, ylab = ylab, pairs = x, 22 | col.line = col.line, line.pch = line.pch, main = main, ...) 23 | } 24 | -------------------------------------------------------------------------------- /R/plot.variogramCloud.R: -------------------------------------------------------------------------------- 1 | # $Id: plot.variogramCloud.q,v 1.7 2007-10-18 10:13:13 edzer Exp $ 2 | 3 | "plot.variogramCloud" <- 4 | function (x, identify = FALSE, digitize = FALSE, 5 | xlim = c(0, max(x$dist)), ylim, # = c(0, max(x$gamma)), 6 | xlab = "distance", ylab = "semivariance", keep = FALSE, ...) 7 | { 8 | if (identify || digitize) { 9 | if (missing(ylim)) ylim = c(0, max(x$gamma)) 10 | dots = list(...) 11 | if ("log" %in% names(dots)) { 12 | log = dots$log 13 | if (grep("x", log) & xlim[1] == 0) 14 | xlim[1] = min(x$dist)/2 15 | if (grep("y", log) & ylim[1] == 0) 16 | ylim[1] = min(x$gamma)/2 17 | } 18 | plot(x$dist, x$gamma, xlim = xlim, ylim = ylim, xlab = xlab, 19 | ylab = ylab, ...) 20 | .BigInt = attr(x, ".BigInt") 21 | head = floor(x$np %/% .BigInt) + 1 22 | tail = floor(x$np %% .BigInt) + 1 23 | if (identify) { 24 | print("mouse-left identifies, mouse-right or Esc stops") 25 | labs = paste(head, tail, sep = ",") 26 | sel = identify(x$dist, x$gamma, labs, pos = keep) 27 | ret = data.frame(cbind(head, tail)[sel,, drop = FALSE]) 28 | } else { 29 | print("mouse-left digitizes, mouse-right closes polygon") 30 | poly = locator(n = 512, type = "l") 31 | if (!is.null(poly)) 32 | sel = point.in.polygon(x$dist, x$gamma, poly$x, poly$y) 33 | else stop("digitized selection is empty") 34 | ret = data.frame(cbind(head, tail)[sel == 1,,drop = FALSE]) 35 | } 36 | class(ret) = c("pointPairs", "data.frame") 37 | if (keep) { 38 | if (identify) { 39 | attr(x, "sel") = sel 40 | attr(x, "text") = labs[sel$ind] 41 | } else # digitize 42 | attr(x, "poly") = poly 43 | attr(x, "ppairs") = ret 44 | return(x) 45 | } else 46 | return(ret) 47 | } else { 48 | sel = attr(x, "sel") 49 | lab = attr(x, "text") 50 | poly = attr(x, "poly") 51 | if (!is.null(sel) && !is.null(lab)) { 52 | if (missing(ylim)) ylim = c(0, max(x$gamma)) 53 | plot(x$dist, x$gamma, xlim = xlim, ylim = ylim, xlab = xlab, 54 | ylab = ylab, ...) 55 | text(x$dist[sel$ind], x$gamma[sel$ind], labels=lab, pos= sel$pos) 56 | } else if (!is.null(poly)) { 57 | if (missing(ylim)) ylim = c(0, max(x$gamma)) 58 | plot(x$dist, x$gamma, xlim = xlim, ylim = ylim, xlab = xlab, 59 | ylab = ylab, ...) 60 | lines(poly$x, poly$y) 61 | } else { 62 | x$np = rep(1, length(x$gamma)) 63 | plot.gstatVariogram(x, xlim = xlim, ylim = ylim, xlab = xlab, 64 | ylab = ylab, ...) 65 | } 66 | } 67 | } 68 | -------------------------------------------------------------------------------- /R/print.gstat.R: -------------------------------------------------------------------------------- 1 | # $Id: print.gstat.q,v 1.7 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "print.gstat" <- 4 | function (x, ...) 5 | { 6 | if (missing(x) || !inherits(x, "gstat")) 7 | stop("wrong call") 8 | data.names <- names(x$data) 9 | if (length(data.names)) 10 | cat("data:\n") 11 | for (n in data.names) { 12 | fstr = paste(x$data[[n]]$formula[c(2, 1, 3)], collapse = "") 13 | #lstr = paste(x$data[[n]]$locations[c(1, 2)], collapse = "") 14 | cat(n, ": formula =", fstr, ";") 15 | if (!is.null(x$data[[n]]$data)) { 16 | data.dim = dim(x$data[[n]]$data) 17 | cat(" data dim =", data.dim[1], "x", data.dim[2]) 18 | } 19 | else { 20 | if (x$data[[n]]$dummy) 21 | cat(" dummy data") 22 | else cat(" NULL data") 23 | } 24 | if (x$data[[n]]$nmax != Inf) 25 | cat(" nmax =", x$data[[n]]$nmax) 26 | if (x$data[[n]]$nmin > 0) 27 | cat(" nmin =", x$data[[n]]$nmin) 28 | if (x$data[[n]]$maxdist < Inf) 29 | cat(" radius =", x$data[[n]]$maxdist) 30 | if (x$data[[n]]$vfn > 1) 31 | cat(" variance function =", 32 | c("identity", "mu", "mu(1-mu)", "mu^2", "mu^3")[x$data[[n]]$vfn]) 33 | if (length(x$data[[n]]$beta) > 0) 34 | cat(" beta =", x$data[[n]]$beta) 35 | if (x$data[[n]]$degree > 0) 36 | cat(" degree =", x$data[[n]]$degree) 37 | cat("\n") 38 | } 39 | xx.names = xx = NULL 40 | for (n in data.names) { 41 | m = x$model[[n]] 42 | if (!is.null(m)) { 43 | xx = rbind(xx, m) 44 | if (nrow(m) == 1) 45 | xx.names = c(xx.names, n) 46 | else xx.names = c(xx.names, paste(n, "[", 1:nrow(m), 47 | "]", sep = "")) 48 | } 49 | } 50 | if (length(data.names) > 1) { 51 | for (j in 2:length(data.names)) { 52 | for (i in 1:(j - 1)) { 53 | n = cross.name(data.names[i], data.names[j]) 54 | m = x$model[[n]] 55 | if (!is.null(m)) { 56 | xx = rbind(xx, m) 57 | if (nrow(m) == 1) 58 | xx.names = c(xx.names, n) 59 | else xx.names = c(xx.names, paste(n, "[", 1:nrow(m), 60 | "]", sep = "")) 61 | } 62 | } 63 | } 64 | } 65 | if (!is.null(xx)) { 66 | cat("variograms:\n") 67 | row.names(xx) = xx.names 68 | print(xx, ...) 69 | } 70 | if (!is.null(x$set)) { 71 | s = gstat.set(x$set) 72 | for (i in 1:length(s)) cat(s[i], "\n") 73 | } 74 | if (!is.null(x$locations)) 75 | print(x$locations) 76 | invisible(x) 77 | } 78 | -------------------------------------------------------------------------------- /R/print.variogram.R: -------------------------------------------------------------------------------- 1 | # $Id: print.variogram.q,v 1.3 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "print.gstatVariogram" <- 4 | function(x, ...) 5 | { 6 | print(data.frame(x), ...) 7 | } 8 | -------------------------------------------------------------------------------- /R/print.variogramCloud.R: -------------------------------------------------------------------------------- 1 | # $Id: print.variogramCloud.q,v 1.4 2007-10-18 10:13:13 edzer Exp $ 2 | 3 | as.data.frame.variogramCloud = function(x, row.names, optional, ...) { 4 | .BigInt = attr(x, ".BigInt") 5 | x$left = x$np %% .BigInt + 1 6 | x$right = x$np %/% .BigInt + 1 7 | x$np = NULL 8 | class(x) = "data.frame" 9 | x 10 | } 11 | 12 | print.variogramCloud <- function (x, ...) { 13 | print(as.data.frame(x), ...) 14 | } 15 | -------------------------------------------------------------------------------- /R/print.variogramModel.R: -------------------------------------------------------------------------------- 1 | # $Id: print.variogramModel.q,v 1.5 2009-02-20 13:53:38 edzer Exp $ 2 | 3 | "print.variogramModel" = 4 | function (x, ...) 5 | { 6 | df = data.frame(x) 7 | shape.models = c("Mat", "Exc", "Cau", "Ste") 8 | if (!any(match(df[, "model"], shape.models, nomatch=0))) 9 | df$kappa = NULL 10 | if (!any(df[, "anis2"] != 1)) { 11 | df$anis2 = NULL 12 | df$ang2 = NULL 13 | df$ang3 = NULL 14 | if (!any(df[, "anis1"] != 1)) { 15 | df$anis1 = NULL 16 | df$ang1 = NULL 17 | } 18 | } 19 | if (any(match(df[, "model"], "Tab", nomatch=0))) { 20 | df$maxdist = df$range 21 | df$range = NULL 22 | print(df, ...) 23 | cat("covariance table:\n") 24 | tab = attr(x, "table") 25 | idx = round(seq(1, length(tab), length=6)) 26 | print(tab[idx]) 27 | } else 28 | print(df, ...) 29 | invisible(x) 30 | } 31 | -------------------------------------------------------------------------------- /R/set.R: -------------------------------------------------------------------------------- 1 | # $Id: set.q,v 1.7 2008-12-16 14:59:22 edzer Exp $ 2 | gstat.set <- function(set) { 3 | if(!is.list(set)) 4 | stop("set should be a list") 5 | if (length(set) == 0) 6 | return(NULL) 7 | ret = NULL 8 | n = names(set) 9 | for (i in (1:length(set))) { 10 | val = set[[i]] 11 | if (n[i] == "method") 12 | str = paste("method: ", val, ";", sep="") 13 | else { 14 | if (is.character(val)) 15 | val = paste("'", val, "'", sep = "") 16 | str = paste("set ", n[i], " = ", val, ";", sep="") 17 | } 18 | ret = c(ret, str) 19 | } 20 | ret 21 | } 22 | 23 | gstat.load.set <- function(set) { 24 | if(!is.list(set)) 25 | stop("set should be a list") 26 | if (length(set) == 0) 27 | return(NULL) 28 | n = names(set) 29 | for (i in (1:length(set))) { 30 | if (n[i] == "method") 31 | ret = .Call(gstat_set_method, set[[i]]) 32 | else 33 | ret = .Call(gstat_set_set, n[i], set[[i]]) 34 | } 35 | invisible(ret) 36 | } 37 | 38 | gstat.load.merge <- function(obj) { 39 | 40 | if (is.character(obj$merge) && length(obj$merge) == 2) 41 | obj$merge = list(c(obj$merge[1], 1, obj$merge[2], 1)) 42 | 43 | if (!is.list(obj$merge)) 44 | stop("merge argument should be list or character vector of lenght 2") 45 | 46 | ret = NULL 47 | for (i in 1:length(obj$merge)) { 48 | m = obj$merge[[i]] 49 | if (is.character(m) && length(m) == 4) { 50 | id = match(m[c(1,3)], names(obj$data)) - 1 # name ->> id 51 | if (any(is.na(id))) 52 | stop(paste("could not match all ids:", m[c(1,3)])) 53 | col = as.integer(m[c(2,4)]) - 1 54 | if (any(is.na(col)) || any(col < 0)) 55 | stop("merge: parameters should be positive integers") 56 | ret = .Call(gstat_set_merge, id[1], col[1], id[2], col[2]) 57 | } else stop( 58 | "list elements of merge should be lenght 4 character vectors") 59 | } 60 | ret 61 | } 62 | -------------------------------------------------------------------------------- /R/show.vgms.R: -------------------------------------------------------------------------------- 1 | # $Id: show.vgms.q,v 1.6 2008-12-15 14:27:29 edzer Exp $ 2 | 3 | "show.vgms" <- 4 | function(min = 1e-12 * max, max = 3, n = 50, sill = 1, range = 1, 5 | models = as.character(vgm()$short[c(1:17)]), nugget = 0, kappa.range = 0.5, 6 | plot = TRUE, ..., as.groups = FALSE) 7 | { 8 | 9 | zero.range.models = c("Nug", "Int", "Lin", "Err") 10 | # print(models) 11 | L = max(length(sill), length(range), length(nugget), length(models), length(kappa.range)) 12 | sill = rep(sill, length.out = L) 13 | range = rep(range, length.out = L) 14 | nugget = rep(nugget, length.out = L) 15 | i = 0 16 | if (length(kappa.range) > 1) { # loop over kappa values for Matern model: 17 | if (missing(models)) 18 | models = "Mat" 19 | stopifnot(models == "Mat" || models == "Ste" || models == "Exc") 20 | data = matrix(NA, n * length(kappa.range), 2) 21 | v.level = rep("", n * length(kappa.range)) 22 | for (kappa in kappa.range) { 23 | v = vgm(sill[i+1], models, range[i+1], nugget = nugget[i+1], kappa = kappa) 24 | x = variogramLine(v, 0, 1, 0) 25 | data[(i*n+1), ] = as.matrix(x) 26 | x = variogramLine(v, max, n - 1, min) 27 | data[(i*n+2):((i+1)*n), ] = as.matrix(x) 28 | m.name = paste("vgm(", sill[i+1], ",\"", models, "\",", range, sep = "") 29 | if (nugget[i+1] > 0) 30 | m.name = paste(m.name, ",nugget=", nugget[i+1], sep = "") 31 | m.name = paste(m.name, ",kappa=", kappa, ")", sep = "") 32 | v.level[(i*n+1):((i+1)*n)] = rep(m.name, n) 33 | i = i + 1 34 | } 35 | } else { 36 | models = rep(models, length.out = L) 37 | data = matrix(NA, n * length(models), 2) 38 | v.level = rep("", n * length(models)) 39 | for (m in models) { 40 | this.range = ifelse(!is.na(pmatch(m, zero.range.models)), 0, range[i+1]) 41 | v = vgm(sill[i+1], m, this.range, nugget = nugget[i+1], kappa = kappa.range) 42 | x = variogramLine(v, 0, 1, 0) 43 | data[(i*n+1), ] = as.matrix(x) 44 | x = variogramLine(v, max, n - 1, min) 45 | data[(i*n+2):((i+1)*n), ] = as.matrix(x) 46 | m.name = paste("vgm(", sill[i+1], ",\"", m, "\",", this.range, sep = "") 47 | if (nugget[i+1] > 0) 48 | m.name = paste(m.name, ",nugget=", nugget[i+1], sep = "") 49 | m.name = paste(m.name, ")", sep = "") 50 | v.level[(i*n+1):((i+1)*n)] = rep(m.name, n) 51 | i = i + 1 52 | } 53 | } 54 | dframe = data.frame(semivariance = data[,2], distance = data[,1], 55 | model = factor(v.level, levels = unique(v.level))) 56 | vgm.panel = function(x,y, ...) { 57 | n = length(x) 58 | lpoints(x[1],y[1]) 59 | llines(x[2:n],y[2:n]) 60 | } 61 | vgm.panel2 = function(x, y, subscripts, groups, ...) { 62 | lpoints(0, 0, col = 1) 63 | panel.superpose(x, y, subscripts, groups, ...) 64 | } 65 | if (!plot) 66 | dframe 67 | else { 68 | if (as.groups) { 69 | model = 0 # avoid NOTE on cran check 70 | xyplot(semivariance ~ distance, groups = model, dframe[dframe$distance > 0,], 71 | panel = vgm.panel2, as.table = TRUE, auto.key = TRUE, type = 'l', ...) 72 | } else 73 | xyplot(semivariance ~ distance | model, dframe, 74 | panel = vgm.panel, as.table = TRUE, ...) 75 | } 76 | } 77 | -------------------------------------------------------------------------------- /R/spplot.R: -------------------------------------------------------------------------------- 1 | spplot.vcov = function(x, ...) { 2 | basenames = sub(".pred", "", names(x)[grep(".pred",names(x))]) 3 | n = length(basenames) 4 | names = NULL 5 | skip = NULL 6 | for (i in 1:n) { 7 | skp = rep(TRUE, n) 8 | pos = 1 9 | if (i > 1) { 10 | for (j in 1:(i-1)) { 11 | names = c(names, paste("cov", basenames[j], basenames[i], sep = ".")) 12 | skp[pos] = FALSE 13 | pos = pos + 1 14 | } 15 | } 16 | names = c(names, paste(basenames[i], ".var", sep = "")) 17 | skp[pos] = FALSE 18 | skip = c(skip, skp) 19 | } 20 | spplot(x, names, skip = skip, layout = c(n,n), as.table = TRUE, ...) 21 | } 22 | -------------------------------------------------------------------------------- /R/variogram.formula.R: -------------------------------------------------------------------------------- 1 | # $Id: variogram.formula.q,v 1.8 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "variogram.formula" <- 4 | function (object, locations = coordinates(data), data, ...) 5 | { 6 | if ((missing(locations) && inherits(data, c("sf", "stars"))) || (inherits(locations, c("sf", "stars")))) { 7 | if (!requireNamespace("sf", quietly = TRUE)) 8 | stop("sf required: install that first") # nocov 9 | if (missing(locations)) 10 | data = as(data, "Spatial") 11 | else 12 | locations = as(locations, "Spatial") 13 | } 14 | 15 | # gstat.formula takes care of the case where locations contains 16 | # both data and coordinates --- see there. 17 | ## ret = gstat.formula(object, locations, data) 18 | ## variogram(object = ret$y, locations = ret$locations, X = ret$X, ...) 19 | if ((missing(locations) && is(data, "ST")) || (is(locations, "ST"))) 20 | variogramST(formula = object, locations = locations, data = data, ...) 21 | else { 22 | g = gstat(formula = object, locations = locations, data = data) 23 | variogram(g, ...) 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /R/variogram.gstat.R: -------------------------------------------------------------------------------- 1 | # $Id: variogram.gstat.q,v 1.9 2007-04-06 11:29:58 edzer Exp $ 2 | 3 | "variogram.gstat" = function (object, ...) { 4 | if (!inherits(object, "gstat")) 5 | stop("first argument should be of class gstat") 6 | y = list() 7 | locations = list() 8 | X = list() 9 | beta = list() 10 | grid = list() 11 | projected = TRUE 12 | for (i in seq(along.with = object$data)) { 13 | d = object$data[[i]] 14 | beta[[i]] = d$beta 15 | if (i > 1 && !identical(object$data[[1]]$data@proj4string@projargs, d$data@proj4string@projargs)) 16 | stop("data items in gstat object have different coordinate reference systems") 17 | raw = gstat.formula(d$formula, d$data) 18 | y[[i]] = raw$y 19 | locations[[i]] = raw$locations 20 | X[[i]] = raw$X 21 | grid[[i]] = raw$grid 22 | if (is(d$data, "Spatial")) 23 | projected = is.projected(d$data) 24 | if (d$degree != 0) 25 | stop("degree != 0: residual variograms wrt coord trend using degree not supported") 26 | } 27 | names(y) = names(locations) = names(X) = names(object$data) 28 | # call variogram.default() next: 29 | variogram(y, locations, X, trend.beta = beta, grid = grid, g = object, ..., 30 | projected = projected) 31 | } 32 | -------------------------------------------------------------------------------- /R/variogramLine.R: -------------------------------------------------------------------------------- 1 | # $Id: variogramLine.q,v 1.4 2008-08-18 16:32:42 edzer Exp $ 2 | 3 | "variogramLine" <- 4 | function(object, maxdist, n = 200, min=1.0e-6 * maxdist, dir = c(1,0,0), 5 | covariance = FALSE, ..., dist_vector = numeric(0), debug.level = 0) 6 | { 7 | if (missing(object)) 8 | stop("model is missing"); 9 | if (!inherits(object, "variogramModel")) 10 | stop("model should be of mode variogramModel (use function vgm)") 11 | if (length(dist_vector) > 0) 12 | maxdist = 0.0 13 | else if (missing(maxdist)) 14 | stop("maxdist or dist_vector needs to be set"); 15 | if (length(dir) != 3) 16 | stop("dir should be numeric vector of length 3") 17 | .Call(gstat_init, as.integer(debug.level)) 18 | pars = c(min,maxdist,n,dir) 19 | load.variogram.model(object, c(0,0)) # loads object into gstat 20 | ret = .Call(gstat_variogram_values, as.integer(c(0,0)), 21 | as.numeric(pars), as.integer(covariance), as.numeric(dist_vector)) 22 | .Call(gstat_exit, 0); 23 | if (is.matrix(dist_vector)) 24 | matrix(ret[[2]], nrow(dist_vector), ncol(dist_vector)) 25 | else 26 | data.frame(dist=ret[[1]], gamma=ret[[2]]) 27 | } 28 | 29 | # Sat Mar 14 15:11:55 CET 2015: removed this: 30 | # "variogram.line" <- function(..., deprecate = TRUE) { 31 | # if (deprecate) 32 | # cat("variogram.line is DEPRECATED, please use variogramLine instead\n") 33 | # variogramLine(...) 34 | # } 35 | -------------------------------------------------------------------------------- /R/vgm.panel.R: -------------------------------------------------------------------------------- 1 | # $Id: vgm.panel.q,v 1.7 2007-06-08 06:45:52 edzer Exp $ 2 | 3 | "get.direction.unitv" <- function(alpha, beta) { 4 | cb = cos(beta) 5 | c(cb * sin(alpha), cb * cos(alpha), sin(beta)) 6 | } 7 | 8 | "vgm.panel.xyplot" <- 9 | function (x, y, subscripts, type = "p", pch = plot.symbol$pch, 10 | col, col.line = plot.line$col, col.symbol = plot.symbol$col, 11 | lty = plot.line$lty, cex = plot.symbol$cex, ids, lwd = plot.line$lwd, 12 | model = model, direction = direction, labels, shift = shift, mode = mode, ...) 13 | { 14 | x <- as.numeric(x) 15 | y <- as.numeric(y) 16 | if (length(x) > 0) { 17 | if (!missing(col)) { 18 | if (missing(col.line)) 19 | col.line <- col 20 | if (missing(col.symbol)) 21 | col.symbol <- col 22 | } 23 | plot.symbol <- trellis.par.get("plot.symbol") 24 | plot.line <- trellis.par.get("plot.line") 25 | lpoints(x = x, y = y, cex = cex, col = col.symbol, pch = pch, type = type, ...) 26 | if (!is.null(labels)) 27 | ltext(x = x + shift * max(x), y = y, labels = labels[subscripts]) 28 | 29 | if (mode == "direct") { 30 | if (!missing(model) && !is.null(model)) { 31 | ang.hor <- pi * (direction[1]/180) 32 | ang.ver <- pi * (direction[2]/180) 33 | dir <- get.direction.unitv(ang.hor, ang.ver) 34 | ret <- variogramLine(model, max(x), dir = dir) 35 | llines(x = ret$dist, y = ret$gamma, lty = lty, col = col.line, lwd = lwd) 36 | } 37 | } else if (mode == "cross") { 38 | id <- as.character(ids[subscripts][1]) 39 | if (!missing(model) && !is.null(model)) { 40 | if (inherits(model, "gstat")) 41 | m = model$model 42 | else 43 | m = model 44 | if (!is.list(m)) 45 | stop("model argument not of class gstat or list") 46 | if (is.list(m) && !is.null(m[[id]])) { 47 | ang.hor <- pi * (direction[1]/180) 48 | ang.ver <- pi * (direction[2]/180) 49 | dir <- get.direction.unitv(ang.hor, ang.ver) 50 | ret <- variogramLine(m[[id]], max(x), dir = dir) 51 | llines(x = ret$dist, y = ret$gamma, lty = lty, col = col.line, lwd = lwd) 52 | } 53 | } 54 | } else if (mode == "directional") { 55 | if (!missing(model) && !is.null(model)) { 56 | dir <- c(1, 0, 0) 57 | if (!missing(direction)) { 58 | ang.hor <- pi * (direction[subscripts][1]/180.0) 59 | dir <- get.direction.unitv(ang.hor, 0) 60 | } 61 | ret <- variogramLine(model, max(x), dir = dir) 62 | llines(x = ret$dist, y = ret$gamma, lty = lty, col = col.line, lwd = lwd) 63 | } 64 | } 65 | 66 | } 67 | } 68 | -------------------------------------------------------------------------------- /R/xyz2img.R: -------------------------------------------------------------------------------- 1 | # $Id: xyz2img.q,v 1.4 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | "xyz2img" <- 4 | function (xyz, zcol = 3, xcol = 1, ycol = 2, tolerance = 10 * .Machine$double.eps) 5 | { 6 | if (ncol(xyz) < 3) 7 | stop("xyz object should have at least three columns") 8 | z = xyz[, zcol] 9 | x = xyz[, xcol] 10 | y = xyz[, ycol] 11 | xx = sort(unique(x)) 12 | yy = sort(unique(y)) 13 | nx = length(xx) 14 | ny = length(yy) 15 | nmax = max(nx, ny) 16 | difx = diff(xx) 17 | if (diff(range(unique(difx))) > tolerance) 18 | stop("x intervals are not constant") 19 | dify = diff(yy) 20 | if (diff(range(unique(dify))) > tolerance) 21 | stop("y intervals are not constant") 22 | dx = mean(difx) 23 | dy = mean(dify) 24 | xmin = min(xx) 25 | xmax = max(xx) 26 | xrange = xmax - xmin 27 | ymin = min(yy) 28 | ymax = max(yy) 29 | yrange = ymax - ymin 30 | row = round((x - xmin)/dx) + 1 31 | col = round((y - ymin)/dy) + 1 32 | zz = rep(as.numeric(NA), nx * ny) 33 | zz[row + nx * (col - 1)] = z 34 | zz = matrix(zz, nrow = nx, ncol = ny) 35 | list(x = seq(xmin, xmax, dx), y = seq(ymin, ymax, dy), z = zz) 36 | } 37 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | # $Id: zzz.q,v 1.10 2006-02-10 19:01:07 edzer Exp $ 2 | 3 | ### NAMESPACE VERSION: 4 | 5 | .onLoad <- function(lib, pkg) { 6 | # remove the require() call for 2.0.0: 7 | # require(lattice) 8 | # .Call(gstat_init, as.integer(1)) 9 | } 10 | 11 | ### pre-NAMESPACE VERSION: 12 | ## ".First.lib" <- 13 | ## function(lib, pkg) { 14 | ## require(lattice) 15 | ## library.dynam("gstat", pkg, lib) 16 | ## .Call(gstat_init, as.integer(1)) 17 | ## } 18 | 19 | variogram <- function(object, ...) UseMethod("variogram") 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | gstat 2 | ===== 3 | 4 | [![R-CMD-check](https://github.com/r-spatial/gstat/workflows/rcmdcheck/badge.svg)](https://github.com/r-spatial/gstat/actions/workflows/rcmdcheck.yml) 5 | [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/r-spatial/gstat?branch=master&svg=true)](https://ci.appveyor.com/project/edzerpebesma/gstat) 6 | [![License](http://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-2.0.html) 7 | [![CRAN](http://www.r-pkg.org/badges/version/gstat)](https://cran.r-project.org/package=gstat) 8 | [![cran checks](https://badges.cranchecks.info/worst/gstat.svg)](https://cran.r-project.org/web/checks/check_results_gstat.html) 9 | [![Downloads](http://cranlogs.r-pkg.org/badges/gstat?color=brightgreen)](http://www.r-pkg.org/pkg/gstat) 10 | 11 | 12 | Spatial and spatio-temporal geostatistical modelling, prediction and simulation. 13 | 14 | See: 15 | 16 | * Pebesma, E.J., 2004. Multivariable geostatistics in S: the gstat package. Computers & Geosciences, 30: [683-691](http://www.sciencedirect.com/science/article/pii/S0098300404000676). 17 | * Benedikt Gräler, Edzer Pebesma and Gerard Heuvelink, 2016. Spatio-Temporal Interpolation using gstat. The R Journal 8(1), [204-218](https://journal.r-project.org/archive/2016-1/na-pebesma-heuvelink.pdf) 18 | 19 | The older publication, 20 | 21 | * Pebesma, E.J. and C.G. Wesseling, 1998. Gstat, 22 | a program for geostatistical modelling, prediction 23 | and simulation. Computers & Geosciences 24 (1), 24 | [17–31](http://www.sciencedirect.com/science/article/pii/S0098300497000824). 25 | 26 | describes material that is now archived in branch [attic](https://github.com/r-spatial/gstat/tree/attic) 27 | 28 | ## Installing 29 | 30 | Install either from CRAN with 31 | 32 | ``` r 33 | install.packages("gstat") 34 | ``` 35 | 36 | or development version from GitHub with 37 | 38 | ``` r 39 | library(remotes) 40 | install_github("r-spatial/gstat") 41 | ``` 42 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | template: 2 | bootstrap: 5 3 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | # https://github.com/r-spatial/stars/issues/113: 4 | environment: 5 | PKGTYPE: win.binary 6 | 7 | # Download script file from GitHub 8 | init: 9 | ps: | 10 | $ErrorActionPreference = "Stop" 11 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 12 | Import-Module '..\appveyor-tool.ps1' 13 | 14 | install: 15 | ps: Bootstrap 16 | 17 | # Adapt as necessary starting from here 18 | 19 | build_script: 20 | - travis-tool.sh install_deps 21 | 22 | test_script: 23 | - travis-tool.sh run_tests 24 | 25 | on_failure: 26 | - 7z a failure.zip *.Rcheck\* 27 | - appveyor PushArtifact failure.zip 28 | 29 | artifacts: 30 | - path: '*.Rcheck\**\*.log' 31 | name: Logs 32 | 33 | - path: '*.Rcheck\**\*.out' 34 | name: Logs 35 | 36 | - path: '*.Rcheck\**\*.fail' 37 | name: Logs 38 | 39 | - path: '*.Rcheck\**\*.Rout' 40 | name: Logs 41 | 42 | - path: '\*_*.tar.gz' 43 | name: Bits 44 | 45 | - path: '\*_*.zip' 46 | name: Bits 47 | -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | rm -f src/*.o src/gstat.so makefile src/makefile src/lex.l src/parse.y src/tags 2 | -------------------------------------------------------------------------------- /data/DE_RB_2005.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/DE_RB_2005.rda -------------------------------------------------------------------------------- /data/coalash.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/coalash.rda -------------------------------------------------------------------------------- /data/fulmar.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/fulmar.rda -------------------------------------------------------------------------------- /data/jura.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/jura.rda -------------------------------------------------------------------------------- /data/meuse.all.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/meuse.all.rda -------------------------------------------------------------------------------- /data/meuse.alt.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/meuse.alt.rda -------------------------------------------------------------------------------- /data/ncp.grid.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/ncp.grid.rda -------------------------------------------------------------------------------- /data/oxford.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/oxford.rda -------------------------------------------------------------------------------- /data/pcb.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/pcb.rda -------------------------------------------------------------------------------- /data/sic2004.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/sic2004.rda -------------------------------------------------------------------------------- /data/sic97.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/sic97.rda -------------------------------------------------------------------------------- /data/tull.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/tull.rda -------------------------------------------------------------------------------- /data/vv.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/vv.rda -------------------------------------------------------------------------------- /data/walker.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/walker.rda -------------------------------------------------------------------------------- /data/wind.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/data/wind.rda -------------------------------------------------------------------------------- /demo/00Index: -------------------------------------------------------------------------------- 1 | a2p area-to-point kriging with krige0 2 | a2pinST area-to-point kriging in space-time with krigeST 3 | block block kriging -- effect of block size and irregular blocks 4 | blue how to get BLUE coefficients out of a predict.gstat call 5 | cc collocated cokriging example 6 | circEmbeddingMeuse simulation based in circular embedding allowing fft 7 | cokriging fitting a linear model of coregionalization and cokriging 8 | comp_geoR compare gstat kriging output with that obtained from geoR 9 | cosimulation fitting a linear model of coregionalization and cosimulation 10 | depend check gstat package dependencies 11 | examples how to do the original gstat example files in S 12 | grass example grass/R/gstat run; requires grass meuse data set installed 13 | gstat3D example of 3D interpolation of random points 14 | ikr example indicator kriging on zinc w. threshold 500 ppm 15 | krige sample run of ordinary and universal kriging 16 | lhs create latin hypercube sample of Gaussian random field 17 | lnsim carry out log-normal kriging, based on conditional simulation 18 | sic2004 part of sic2004 excercise; see ?sic2004 19 | sftime demo using package sftime, derived from demo(stkrige) 20 | pcb pcb North Sea data analysis as used for geoENV2004 paper; see ?pcb 21 | pcb_sf pcb North Sea data analysis as used for geoENV2004 paper, using sf, stars and ggplot2; see ?pcb 22 | fulmar analysis of Fulmaris glacialis data on Dutch part of the North Sea 23 | uisim unconditional indicator simulation, 2 and 3 category examples 24 | ugsim unconditional Gaussian simulation 25 | snow parallel kriging using package snow (not on Windows) 26 | line examples for lines support prediction 27 | weight compute (the expensive way) kriging weights for a single prediction location 28 | wind space-time kriging with the Irish wind data sets 29 | rep 10 x 10 matrix of fitted variograms from 100 simulated fields 30 | sftime demonstration for using the classes of sftime, local spatio-temporal kriging 31 | stkrige model estimation for Vignette spatio-temporal kriging 32 | stkrige-prediction prediction as in Vignette spatio-temporal kriging [!time consuming!] 33 | stkrige-crossvalidation crossvalidation as in Vignette spatio-temporal kriging [!very time consuming!] 34 | localKrigeST locally krige an irregular spatio-temporal data set to a regular spatio-temporal grid 35 | zonal approximate zonal anisotropy with geometrically anistropic model 36 | -------------------------------------------------------------------------------- /demo/a2p.R: -------------------------------------------------------------------------------- 1 | Rprof() 2 | # import NC SIDS data: 3 | library(sp) 4 | library(maptools) 5 | fname = system.file("shapes/sids.shp", package="maptools")[1] 6 | nc = readShapePoly(fname, proj4string = 7 | CRS("+proj=longlat +datum=NAD27 +ellps=clrk66")) 8 | 9 | # reproject to UTM17, so we can use Euclidian distances: 10 | library(rgdal) 11 | nc = spTransform(nc, CRS("+proj=utm +zone=17 +datum=WGS84 +ellps=WGS84")) 12 | 13 | # create a target (newdata) grid, and plot: 14 | grd = spsample(nc, "regular", n = 1000) 15 | class(grd) 16 | plot(nc, axes = TRUE) 17 | points(grd, pch = 3) 18 | 19 | library(gstat) 20 | 21 | # area-to-point kriging: 22 | kr = krige0(SID74 ~ 1, nc, grd, vgmArea, ndiscr = 9, 23 | vgm = vgm(1, "Exp", 1e5, 0), # point variogram, 24 | verbose = TRUE) 25 | out = SpatialPixelsDataFrame(grd, data.frame(pred = kr)) 26 | 27 | pl0 = spplot(nc["SID74"], main = "areas") 28 | pl1 = spplot(out, sp.layout = list("sp.polygons", nc, first=F,col='grey'), 29 | main = "points on a grid") 30 | print(pl0, split = c(1,1,1,2), more = TRUE) 31 | print(pl1, split = c(1,2,1,2), more = FALSE) 32 | 33 | -------------------------------------------------------------------------------- /demo/a2pinST.R: -------------------------------------------------------------------------------- 1 | ## area2point in space and time 2 | library(sp) 3 | library(gstat) 4 | data("meuse") 5 | coordinates(meuse) <- ~x+y 6 | 7 | data("meuse.grid") 8 | coordinates(meuse.grid) <- ~x+y 9 | gridded(meuse.grid) <- TRUE 10 | 11 | meuse.coarse.grid <- SpatialGrid(GridTopology(meuse.grid@grid@cellcentre.offset, c(600,600), c(5, 7))) 12 | 13 | separableModel <- vgmST("separable", 14 | space=vgm(0.85,"Exp", 831, 0.15), 15 | time =vgm(0.9,"Exp", 3.25, 0.1), 16 | sill=135000) 17 | attr(separableModel,"temporal unit") <- "days" 18 | 19 | library(spacetime) 20 | stf <- STF(meuse[sample(155, 25),], Sys.time()-2:0*24*3600) 21 | 22 | stf_grid <- STF(geometry(meuse.coarse.grid), stf@time) 23 | 24 | krigedSim <- krigeSTSimTB(newdata = stf_grid, modelList = separableModel, nsim = 1, nLyrs = 100) 25 | 26 | # area-to-point kriging: 27 | a2pST = krigeST(sim1 ~ 1, krigedSim, stf, modelList = vgmAreaST, ndiscr = 9, 28 | model = separableModel, # point variogram, 29 | verbose = TRUE) 30 | 31 | p1 <- stplot(krigedSim, color.key=F) 32 | p2 <- stplot(a2pST, color.key=F) 33 | 34 | print(p1, position=c(0,0.5,1,1), more=TRUE) 35 | print(p2, position=c(0,0,1,0.5)) 36 | -------------------------------------------------------------------------------- /demo/block.R: -------------------------------------------------------------------------------- 1 | # $Id: block.R,v 1.5 2006-02-10 19:05:02 edzer Exp $ 2 | library(sp) 3 | data(meuse) 4 | coordinates(meuse) = ~x+y 5 | data(meuse.grid) 6 | gridded(meuse.grid) = ~x+y 7 | 8 | vgm.fit = fit.variogram(variogram(zinc~1, meuse), vgm(1, "Sph", 800, 1)) 9 | bl0 = krige(zinc~1, meuse, meuse.grid, model = vgm.fit, block = c(0,0)) 10 | bl1 = krige(zinc~1, meuse, meuse.grid, model = vgm.fit, block = c(40,40)) 11 | bl2 = krige(zinc~1, meuse, meuse.grid, model = vgm.fit,block = c(100,100)) 12 | bl3 = krige(zinc~1, meuse, meuse.grid, model = vgm.fit,block = c(400,400)) 13 | bl0$"block=0x0" = bl0$var1.pred 14 | bl0$"block=40x40" = bl1$var1.pred 15 | bl0$"block=100x100" = bl2$var1.pred 16 | bl0$"block=400x400" = bl3$var1.pred 17 | 18 | plt1 = spplot(bl0, 3:6, layout=c(4,1), col.regions=bpy.colors(), main = "kriging predictions") 19 | 20 | bl0$"block=0x0" = bl0$var1.var 21 | bl0$"block=40x40" = bl1$var1.var 22 | bl0$"block=100x100" = bl2$var1.var 23 | bl0$"block=400x400" = bl3$var1.var 24 | 25 | plt2 = spplot(bl0, 3:6, layout=c(4,1), col.regions=bpy.colors(), main = "kriging standard errors") 26 | 27 | print(plt1, split = c(1, 1, 1, 2), more = T) 28 | print(plt2, split = c(1, 2, 1, 2), more = F) 29 | # block krige the full area: 30 | 31 | bl = krige(zinc~1, meuse, newdata = SpatialPoints(data.frame(x=0,y=0)), 32 | model = vgm.fit, block = coordinates(meuse.grid)) 33 | bl 34 | # block kriging standard error: 35 | sqrt(bl$var1.var) 36 | # classical statistical standard error of mean: 37 | sqrt(var(meuse$zinc)/155) 38 | -------------------------------------------------------------------------------- /demo/blue.R: -------------------------------------------------------------------------------- 1 | # how to get the BLUE trend coefficients out of a predict.gstat call? 2 | # prepare data 3 | library(sp) 4 | library(gstat) 5 | data(meuse) 6 | coordinates(meuse) = ~x+y 7 | data(meuse.grid) 8 | gridded(meuse.grid) = ~x+y 9 | 10 | # create a manual, non-automatic intercept 11 | meuse$Int = rep(1, length(meuse$zinc)) 12 | meuse.grid$Int = rep(1, length(meuse.grid$dist)) 13 | 14 | # create a gstat object without an automatic intercept: 15 | g = gstat(formula = log(zinc)~-1+Int+sqrt(dist), data=meuse, model = vgm(1, "Exp", 300)) 16 | newdat = meuse.grid[1:2,c("Int", "dist")] 17 | gridded(newdat) = FALSE 18 | newdat$dist = c(0,1) 19 | newdat$Int = c(1,0) 20 | # (in the more general case of n predictors, make sure that the matrix with 21 | # predictors, or design matrix, equals the identity matrix.) 22 | newdat 23 | out = as.data.frame(predict(g, newdat, BLUE = TRUE))[,3:4] 24 | rownames(out) = c("Intercept", "slope") 25 | colnames(out) = c("BLUE", "Variance") 26 | out 27 | -------------------------------------------------------------------------------- /demo/cc.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | demo(meuse, ask = FALSE, echo = FALSE) 3 | 4 | library(gstat) 5 | 6 | # use collocated data: 7 | g = gstat(NULL, "lzinc", log(zinc)~1, meuse) 8 | g.coll = gstat(g, "dist", dist~1, meuse, nmax = 1, merge = c("lzinc", "dist")) 9 | 10 | g.fit = fit.lmc(variogram(g.coll), g.coll, vgm(1, "Sph", 900, 1), 11 | correct.diagonal = 1.01) 12 | 13 | g.non_coll = gstat(g, "dist", dist~1, meuse.grid, nmax = 1, merge = c("lzinc", "dist")) 14 | g.non_coll$model = g.fit$model 15 | 16 | # collocated cokriging: 17 | 18 | pr = predict(g.non_coll, meuse.grid) 19 | spplot(pr[c(1,3)]) 20 | -------------------------------------------------------------------------------- /demo/cokriging.R: -------------------------------------------------------------------------------- 1 | # $Id: cokriging.R,v 1.4 2006-02-10 19:05:02 edzer Exp $ 2 | library(stars) 3 | library(gstat) 4 | data(meuse, package = "sp") 5 | meuse = st_as_sf(meuse, coords = c("x", "y")) 6 | data(meuse.grid, package = "sp") 7 | meuse.grid = st_as_stars(meuse.grid) 8 | 9 | # cokriging of the four heavy metal variables 10 | # create gstat object, stepwise: 11 | gstat(id="zn", formula=log(zinc)~1, data=meuse, nmax = 10) |> 12 | gstat("cu", log(copper)~1, meuse, nmax = 10) |> 13 | gstat("cd", log(cadmium)~1, meuse, nmax = 10) |> 14 | gstat("pb", log(lead)~1, meuse, nmax = 10) |> 15 | gstat(model=vgm(1, "Sph", 900, 1), fill.all=T) -> meuse.g 16 | 17 | x <- variogram(meuse.g, cutoff=1000) 18 | meuse.fit = fit.lmc(x, meuse.g) 19 | plot(x, model = meuse.fit) 20 | z <- predict(meuse.fit, newdata = meuse.grid) 21 | 22 | z[c(1,3,5,7)] |> merge() |> plot() 23 | # compute & plot standard errors: 24 | z[c(2,4,6,9)] |> setNames(paste0(c("zn", "cu", "pb", "cd"), ": se")) |> 25 | merge() |> sqrt() |> plot() 26 | 27 | # old-style, with sp: 28 | # indicator cokriging for the 9 percentiles of zinc: 29 | q <- quantile(meuse$zinc, seq(.1,.9,.1)) 30 | gstat(id = "zn1", formula = I(zinc < q[1])~1, 31 | data = meuse, nmax = 7, beta = .1, set = list(order = 4, zero = 1e-5)) |> 32 | gstat("zn2", I(zinc < q[2])~1, meuse, nmax = 7, beta=.2) |> 33 | gstat("zn3", I(zinc < q[3])~1, meuse, nmax = 7, beta=.3) |> 34 | gstat("zn4", I(zinc < q[4])~1, meuse, nmax = 7, beta=.4) |> 35 | gstat("zn5", I(zinc < q[5])~1, meuse, nmax = 7, beta=.5) |> 36 | gstat("zn6", I(zinc < q[6])~1, meuse, nmax = 7, beta=.6) |> 37 | gstat("zn7", I(zinc < q[7])~1, meuse, nmax = 7, beta=.7) |> 38 | gstat("zn8", I(zinc < q[8])~1, meuse, nmax = 7, beta=.8) |> 39 | gstat("zn9", I(zinc < q[9])~1, meuse, nmax = 7, beta=.9) |> 40 | gstat(model=vgm(1, "Sph", 900, 1), fill.all=T) -> meuse.i 41 | 42 | x <- variogram(meuse.i, cutoff=1000) 43 | meuse.fit = fit.lmc(x, meuse.i, correct.diagonal = 1.01) 44 | plot(x, model = meuse.fit) 45 | z <- predict(meuse.fit, newdata = meuse.grid) 46 | 47 | z[c(1,3,5,7,9,11,13,15,17)] |> 48 | setNames(paste("est.Pr(Zn < ", signif(q,4), ")", sep = "")) |> merge() |> plot() 49 | -------------------------------------------------------------------------------- /demo/comp_geoR.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | library(geoR) 4 | xyz = data.frame(x = c(0,0,1), y = c(0, 1, 1), z = c(1,2,3)) 5 | coordinates(xyz)=~x+y 6 | x0 = SpatialPoints(data.frame(x=0,y=.5)) 7 | kr1 = krige(z~1,xyz,x0,vgm(1, "Exp", 1)) 8 | kr2 = krige.conv(as.geodata(xyz), locations=coordinates(x0), 9 | krige=list(cov.model="exponential", cov.par=c(1,1))) 10 | kr1 11 | c(kr2$predict, kr2$krige.var) 12 | kr1[[1]] - kr2$predict 13 | kr1[[2]] - kr2$krige.var 14 | -------------------------------------------------------------------------------- /demo/cosimulation.R: -------------------------------------------------------------------------------- 1 | # $Id: cosimulation.R,v 1.5 2006-02-10 19:05:02 edzer Exp $ 2 | library(sp) 3 | data(meuse) 4 | coordinates(meuse) = ~x+y 5 | data(meuse.grid) 6 | gridded(meuse.grid) = ~x+y 7 | 8 | # cosimulation the four heavy metal variables 9 | meuse.g <- gstat(id="zn", formula=zinc~1, data=meuse, nmax = 10, 10 | set = list(zero = 1e-10)) 11 | meuse.g <- gstat(meuse.g, "cu", copper~1, meuse, nmax = 10) 12 | meuse.g <- gstat(meuse.g, "cd", cadmium~1, meuse, nmax = 10) 13 | meuse.g <- gstat(meuse.g, "pb", lead~1, meuse, nmax = 10) 14 | meuse.g <- gstat(meuse.g, model=vgm(1, "Sph", 900, 1), fill.all=T) 15 | x <- variogram(meuse.g, cutoff=1000) 16 | meuse.fit = fit.lmc(x, meuse.g) 17 | plot(x, model = meuse.fit) 18 | z <- predict(meuse.fit, newdata = meuse.grid, nsim = 2) 19 | 20 | library(lattice) 21 | 22 | pl1 <- spplot(z, c(1,2), main = "zinc simulations") 23 | pl2 <- spplot(z, c(3,4), main = "copper simulations") 24 | pl3 <- spplot(z, c(5,6), main = "cadmium simulations") 25 | pl4 <- spplot(z, c(7,8), main = "lead simulations") 26 | print(pl1, split = c(1,1,2,2), more=TRUE) 27 | print(pl2, split = c(1,2,2,2), more=TRUE) 28 | print(pl3, split = c(2,1,2,2), more=TRUE) 29 | print(pl4, split = c(2,2,2,2)) 30 | 31 | # indicator cosimulation for the 9 deciles of zinc: 32 | q <- quantile(meuse$zinc, seq(.1,.9,.1)) 33 | meuse.i <- gstat(id = "zn1", formula = I(zinc < q[1])~1, 34 | data = meuse, nmax = 7, beta = .1, set = list(order = 4, zero = 1e-5)) 35 | meuse.i <- gstat(meuse.i, "zn2", I(zinc < q[2])~1, meuse, 36 | nmax = 7, beta=.2) 37 | meuse.i <- gstat(meuse.i, "zn3", I(zinc < q[3])~1, meuse, 38 | nmax = 7, beta=.3) 39 | meuse.i <- gstat(meuse.i, "zn4", I(zinc < q[4])~1, meuse, 40 | nmax = 7, beta=.4) 41 | meuse.i <- gstat(meuse.i, "zn5", I(zinc < q[5])~1, meuse, 42 | nmax = 7, beta=.5) 43 | meuse.i <- gstat(meuse.i, "zn6", I(zinc < q[6])~1, meuse, 44 | nmax = 7, beta=.6) 45 | meuse.i <- gstat(meuse.i, "zn7", I(zinc < q[7])~1, meuse, 46 | nmax = 7, beta=.7) 47 | meuse.i <- gstat(meuse.i, "zn8", I(zinc < q[8])~1, meuse, 48 | nmax = 7, beta=.8) 49 | meuse.i <- gstat(meuse.i, "zn9", I(zinc < q[9])~1, meuse, 50 | nmax = 7, beta=.9) 51 | 52 | meuse.i <- gstat(meuse.i, model=vgm(1, "Sph", 900, 1), fill.all=T) 53 | x <- variogram(meuse.i, cutoff=1000) 54 | meuse.fit = fit.lmc(x, meuse.i) 55 | plot(x, model = meuse.fit) 56 | 57 | z <- predict(meuse.fit, newdata = meuse.grid, nsim = 2, indicators = TRUE) 58 | spplot(z, main = "indicator simulations for 9 deciles") 59 | -------------------------------------------------------------------------------- /demo/depend.R: -------------------------------------------------------------------------------- 1 | require(tools) 2 | packages_to_check <- function(dep, which = c("Depends", "Imports", "LinkingTo", "Suggests"), recursive = FALSE){ 3 | 4 | download.file("https://cran.R-project.org/web/packages/packages.rds", "packages.rds", mode="wb") 5 | x <- readRDS("packages.rds") 6 | x <- x[!duplicated(x[,1]),] 7 | packages <- x[,1] 8 | rdeps <- package_dependencies(packages = dep, x, 9 | which = which, 10 | recursive = recursive, reverse = TRUE) 11 | paste(apply(x[x[,1] %in% rdeps[[1]], 1:2], 1, paste, collapse="_"), ".tar.gz", sep="") 12 | } 13 | 14 | #RCheck = function(x, URL = "http://ftp5.gwdg.de/pub/misc/cran/src/contrib/") { 15 | RCheck = function(x, URL = "https://cran.r-project.org/src/contrib/") { 16 | if (!file.exists(x)) 17 | download.file(paste(URL, x, sep=""), x) 18 | cmd = paste("R CMD check --as-cran ", x, " > ", x, ".log", sep = "") 19 | print(cmd) 20 | ret = system(cmd) 21 | print(ret) 22 | ret 23 | } 24 | 25 | result <- packages_to_check("gstat") 26 | result 27 | sel = TRUE 28 | library(parallel) 29 | ncores_to_use = 2 30 | cl <- makeCluster(getOption("cl.cores", ncores_to_use)) 31 | clusterExport(cl, c("RCheck", "sel", "result")) 32 | out = parLapply(cl, result[sel], function(x) RCheck(x)) 33 | succ = unlist(out) 34 | x = which(succ != 0) 35 | result[x] 36 | bla = lapply(result[x], function(y) { 37 | cat(paste(y, ":\n")) 38 | system(paste("tail -20 ",y,".log", sep="")) 39 | } 40 | ) 41 | 42 | #result <- packages_to_check("sp", recursive=TRUE) 43 | -------------------------------------------------------------------------------- /demo/fulmar.R: -------------------------------------------------------------------------------- 1 | # $Id: fulmar.R,v 1.3 2006-02-10 19:05:02 edzer Exp $ 2 | library(sp) 3 | library(gstat) 4 | data(fulmar) 5 | data(ncp.grid) 6 | 7 | glm98 <- glm(formula = fulmar ~ depth + coast, family = quasipoisson, 8 | data = fulmar[fulmar$year == 1998, ]) 9 | glm99 <- glm(formula = fulmar ~ depth + coast, family = quasipoisson, 10 | data = fulmar[fulmar$year == 1999, ]) 11 | fulmar98 = data.frame(fulmar[fulmar$year == 1998,], 12 | pr98 = predict(glm98, type = "response")) 13 | fulmar99 <- data.frame(fulmar[fulmar$year == 1999,], 14 | pr99 = predict(glm99, type = "response")) 15 | pr98.grd <- predict(glm98, newdata = ncp.grid, type = "response", se.fit=TRUE) 16 | pr99.grd <- predict(glm99, newdata = ncp.grid, type = "response", se.fit=TRUE) 17 | pr <- data.frame(ncp.grid, pr98=pr98.grd$fit, pr99=pr99.grd$fit, 18 | se98 = pr98.grd$se.fit, se99 = pr99.grd$se.fit) 19 | 20 | # B.3 create gstat object 21 | g <- gstat(id = "fulmar98", formula = fulmar~pr98, locations = ~x+y, 22 | data = fulmar98, model = vgm(1.89629, "Exp", 50000, 0.852478), 23 | beta = c(0,1), variance = "mu") 24 | g <- gstat(g, id = "fulmar99", formula = fulmar~pr99, locations = ~x+y, 25 | data = fulmar99, model = vgm(2.52259, "Exp", 50000, 1.76474), 26 | beta = c(0,1), variance = "mu") 27 | h <- g 28 | h <- gstat(h, id = c("fulmar98","fulmar99"), 29 | model = vgm(2.18, "Exp", 50000, 1.22)) 30 | 31 | # predict block means for blocks in ncp.grid$area (table 2; cokriging) 32 | library(maptools) 33 | areas.r = readShapePoly(system.file("external/ncp.shp", package="gstat")) 34 | #areas.r <- as.SpatialRings.Shapes(areas.shp$Shapes, areas.shp$att.data$WSVGEB_) 35 | coordinates(pr) = ~x+y 36 | #pr.df = overlay(pr, areas.r, fn = mean) 37 | pr.df = na.omit(as(aggregate(pr, areas.r, FUN = mean), "data.frame")) 38 | # match non-empty (and relevant) areas: 39 | #areas = SpatialPolygonsDataFrame(areas.r[c(2,3,4,16),"WSVGEB_"], pr.df[c(1,2,3,5),])#,match.ID=F) 40 | areas = SpatialPolygonsDataFrame(areas.r[c(1,2,12,7),"WSVGEB_"], 41 | pr.df[c(1,2,3,5),], match.ID=F) 42 | # areas ID's 0 1 2 14 43 | sk = predict(g, areas) 44 | cok = predict(h, areas) 45 | spplot(cok, c(3,5), names.attr = c("1998", "1999"), 46 | main = "Fulmaris glacialis, density estimates\n(by irregular block cokriging)") 47 | sk = as.data.frame(sk) 48 | cok = as.data.frame(cok) 49 | print(data.frame(area = c(1,2,3,16), 50 | SK98 = sk$fulmar98.pred, SE98 = sqrt(sk$fulmar98.var), 51 | SK99 = sk$fulmar99.pred, SE99 = sqrt(sk$fulmar99.var), 52 | CK98 = cok$fulmar98.pred, SE98 = sqrt(cok$fulmar98.var), 53 | CK99 = cok$fulmar99.pred, SE99 = sqrt(cok$fulmar99.var)), 54 | digits=3) 55 | print(data.frame(area = c(1,2,3,16), 56 | dSK = sk$fulmar99.pred - sk$fulmar98.pred, 57 | SEdSK = sqrt(sk$fulmar98.var+sk$fulmar99.var), 58 | dCOK = cok$fulmar99.pred - cok$fulmar98.pred, 59 | SEdCOK = sqrt(cok$fulmar98.var+cok$fulmar99.var 60 | - 2*cok$cov.fulmar98.fulmar99)), 61 | digits=3) 62 | -------------------------------------------------------------------------------- /demo/grass.R: -------------------------------------------------------------------------------- 1 | # $Id: grass.R,v 1.4 2006-02-10 19:05:02 edzer Exp $ 2 | # this demo assumes quite a lot: 3 | # a. it assumes GRASS gis is running 4 | # b. it assumes that the meuse data zinc variable is available as a site list 5 | # c. it assumes that mask_map is present, and contains the mask map values 6 | # (i.e., the study area) 7 | 8 | library(sp) 9 | library(GRASS) # load R GRASS interface 10 | 11 | G = gmeta() # retrieves active data base locations and topology 12 | d = sites.get(G, "zinc") # retrieve zinc observations 13 | plot(d$east, d$north, asp=1) 14 | names(d)[4] = "zinc" # rename attribute 15 | mask = rast.get 16 | 17 | hist(d$zinc) 18 | hist(log(d$zinc)) 19 | 20 | mask = rast.get(G, "mask_map") 21 | plot(G, mask$mask.map) 22 | points(d$east,d$north, pch="+") 23 | 24 | library(gstat) # load gstat library 25 | 26 | bubble(d, zcol = "zinc", col=c(4,5), maxsize=2) 27 | 28 | # explain S formulae: ~ 29 | v = variogram(log(zinc)~1, ~east+north, d) 30 | plot(v) 31 | 32 | v.mod = vgm(.6, "Sph", 900, .1) 33 | plot(v, model = v.mod) 34 | 35 | v.fit = fit.variogram(v, v.mod) 36 | plot(v, model = v.fit) 37 | 38 | zinc.g = gstat(NULL, "lzinc", log(zinc)~1, ~east+north, d, model = v.fit) 39 | new.data = data.frame(east = east(G), north = north(G)) 40 | new.data[is.na(mask$mask.map), ] = c(NA,NA) 41 | 42 | zinc.kr = predict(zinc.g, new.data) 43 | image(zinc.kr) 44 | 45 | library(lattice) 46 | 47 | levelplot(lzinc.pred~east+north, zinc.kr, asp=1.34, col.regions=bpy.colors(100)) 48 | 49 | # push prediction and variances grids back into GRASS data base: 50 | rast.put(G, "lzinc.pred", zinc.kr$lzinc.pred) 51 | rast.put(G, "lzinc.var", zinc.kr$lzinc.var) 52 | 53 | # push cross validation residuals back to GRASS data base: 54 | xv = krige.cv(log(zinc)~1, ~east+north, d, v.fit, nmax = 40, verb=F) 55 | sites.put2(G, data = xv, dims = c("east", "north", "residual", "zscore"), 56 | lname = "lzinc.xv") 57 | -------------------------------------------------------------------------------- /demo/gstat3D.R: -------------------------------------------------------------------------------- 1 | # $Id: gstat3D.R,v 1.5 2007-02-23 13:34:07 edzer Exp $ 2 | # simple demo of 3D interpolation of 50 points with random normal values, 3 | # randomly located in the unit cube 4 | library(sp) 5 | library(gstat) 6 | n <- 50 7 | 8 | data3D <- data.frame(x = runif(n), y = runif(n), z = runif(n), v = rnorm(n)) 9 | coordinates(data3D) = ~x+y+z 10 | 11 | range1D <- seq(from = 0, to = 1, length = 20) 12 | grid3D <- expand.grid(x = range1D, y = range1D, z = range1D) 13 | gridded(grid3D) = ~x+y+z 14 | 15 | res3D <- krige(formula = v ~ 1, data3D, grid3D, model = vgm(1, "Exp", .2)) 16 | 17 | library(lattice) 18 | 19 | levelplot(var1.pred ~ x + y | z, as.data.frame(res3D)) 20 | rm(n, data3D, range1D, grid3D, res3D) 21 | -------------------------------------------------------------------------------- /demo/ikr.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | data(meuse) 4 | data(meuse.grid) 5 | coordinates(meuse)=~x+y 6 | gridded(meuse.grid)=~x+y 7 | v = variogram(I(zinc < 500)~1,meuse) 8 | plot(v) 9 | vm = fit.variogram(v, vgm(1, "Sph", 300, 1)) 10 | plot(v,vm) 11 | vm 12 | # possibly adjust sum of sill to be max. 0.25? 13 | ik = krige(I(zinc>500)~1, meuse, meuse.grid, vm) 14 | spplot(ik[1],col.regions=bpy.colors()) 15 | summary(ik[[1]]) 16 | # adjust values outside [0,1] to nearest limit: 17 | ik[[1]][ik[[1]]<0] = 0 18 | ik[[1]][ik[[1]]>1] = 1 19 | summary(ik[[1]]) 20 | spplot(ik[1],col.regions=bpy.colors()) 21 | -------------------------------------------------------------------------------- /demo/krige.R: -------------------------------------------------------------------------------- 1 | # $Id: krige.R,v 1.5 2007-02-27 22:09:31 edzer Exp $ 2 | library(sp) 3 | data(meuse) 4 | coordinates(meuse) = ~x+y 5 | data(meuse.grid) 6 | gridded(meuse.grid) = ~x+y 7 | 8 | # ordinary kriging 9 | v <- variogram(log(zinc)~1, meuse) 10 | m <- fit.variogram(v, vgm(1, "Sph", 300, 1)) 11 | plot(v, model = m) 12 | lzn.kr <- krige(formula = log(zinc)~1, meuse, meuse.grid, model = m) 13 | 14 | 15 | pl1 <- spplot(lzn.kr[1], main = "ordinary kriging prediction of log-zinc") 16 | lzn.kr$se = sqrt(lzn.kr$var1.var) 17 | pl2 <- spplot(lzn.kr["se"], main = "ordinary kriging prediction error") 18 | 19 | # universal kriging 20 | v <- variogram(log(zinc)~sqrt(dist), meuse) 21 | m <- fit.variogram(v, vgm(1, "Exp", 300, 1)) 22 | plot(v, model = m) 23 | lzn.kr <- krige(log(zinc)~sqrt(dist), meuse, meuse.grid, model = m) 24 | pl3 <- spplot(lzn.kr[1], main = "universal kriging prediction of log-zinc") 25 | lzn.kr$se = sqrt(lzn.kr$var1.var) 26 | pl4 <- spplot(lzn.kr["se"], main = "universal kriging prediction error") 27 | print(pl1, split = c(1,1,2,2), more = T) 28 | print(pl2, split = c(1,2,2,2), more = T) 29 | print(pl3, split = c(2,1,2,2), more = T) 30 | print(pl4, split = c(2,2,2,2)) 31 | -------------------------------------------------------------------------------- /demo/lhs.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | 4 | # roughly follows the case presented in: 5 | # E.J. Pebesma and G.B.M. Heuvelink, 1999. Latin hypercube sampling 6 | # of Gaussian random fields. Technometrics 41 (4), pp. 303-312. 7 | 8 | data(meuse) 9 | data(meuse.grid) 10 | coordinates(meuse) = ~x+y 11 | gridded(meuse.grid) = ~x+y 12 | 13 | x <- variogram(log(zinc) ~ 1, meuse) 14 | v <- vgm(.5, "Sph", 800, nug = .1) 15 | v.fit = fit.variogram(x, model = v) 16 | plot(x, model = v.fit) 17 | 18 | n = 100 19 | ok = krige(log(zinc)~1, meuse, meuse.grid, v.fit, nmax=40) 20 | sim = krige(log(zinc)~1, meuse, meuse.grid, v.fit, nsim = n, nmax=40) 21 | simo = t(apply(as.data.frame(sim)[1:n], 1, order)) # rank order 22 | nr = nrow(simo) # number of prediction locations 23 | simo = (simo - 1.0 + matrix(runif(n * nr), nr, n))/n 24 | summary(simo) # LHS on uniform [0,1] distribution; back to Gaussian: 25 | lhs = t(apply(cbind(ok$var1.pred, sqrt(ok$var1.var), simo), 1, 26 | function(x) qnorm(x[-(1:2)], x[1], x[2]))) 27 | sim2 = sim 28 | sim2@data = data.frame(lhs) 29 | spplot(sim2[1:10], main = 'lhs', col.regions=bpy.colors()) 30 | # verify that simulated and true mean/var are close: 31 | m = apply(lhs, 1, mean) 32 | v = apply(lhs, 1, var) 33 | summary(m - ok$var1.pred) 34 | summary(v - ok$var1.var) 35 | -------------------------------------------------------------------------------- /demo/line.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | data(meuse.grid) 4 | gridded(meuse.grid) = ~x+y 5 | data(meuse) 6 | coordinates(meuse) = ~x+y 7 | 8 | # choose arbitrary line over the grid: 9 | image(meuse.grid["dist"],axes=T) 10 | pp = rbind(c(180000,331000),c(180000,332000),c(181000,333500)) 11 | Sl = SpatialLines(list(Lines(list(Line(pp)), "a"))) 12 | plot(Sl,add=T,col='green') 13 | 14 | # use the default spsample arguments of predict.gstat: 15 | pts=spsample(Sl,n=500,'regular',offset=c(.5,.5)) 16 | plot(pts, pch=3, cex=.2, add=T) 17 | 18 | v = vgm(.6, "Sph", 900, .06) 19 | out1 = krige(log(zinc)~1, meuse, Sl, v) 20 | out1 21 | 22 | points(180333,332167,pch=3,cex=2) 23 | 24 | # use the same line as block discretization, and predict for (0,0) 25 | # (because the block discretizing points are not centered) 26 | out2 = krige(log(zinc)~1, meuse, SpatialPoints(matrix(0,1,2)), v, block=coordinates(pts)) 27 | out2 28 | 29 | compare.krigingLines = function(formula, data, newdata, model) { 30 | out1 = krige(formula, data, newdata, model) 31 | pts = spsample(newdata, n=500, 'regular', offset=.5) 32 | out2 = krige(formula, data, SpatialPoints(matrix(0,1,2)), model, block = coordinates(pts)) 33 | print("difference:") 34 | as.data.frame(out1)[3:4]- as.data.frame(out2)[3:4] 35 | } 36 | 37 | compare.krigingLines(log(zinc)~1, meuse, Sl, v) 38 | 39 | # one line, consisting of two line segments: 40 | pp2 = rbind(c(181000,333500),c(181000,332500)) 41 | Sl2 = SpatialLines(list(Lines(list(Line(pp),Line(pp2)), "a"))) 42 | krige(log(zinc)~1, meuse, Sl2, v) 43 | compare.krigingLines(log(zinc)~1, meuse, Sl2, v) 44 | 45 | # two seperate line segments: 46 | Sl3 = SpatialLines(list(Lines(list(Line(pp)), "a"),Lines(list(Line(pp2)),"b"))) 47 | krige(log(zinc)~1, meuse, Sl3, v) 48 | -------------------------------------------------------------------------------- /demo/lnsim.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | data(meuse) 4 | coordinates(meuse) = ~x+y 5 | data(meuse.grid) 6 | gridded(meuse.grid) = ~x+y 7 | 8 | # NLKrige: non-linear kriging (e.g. log-normal kriging), simulation based. 9 | # arguments: 10 | # formula, data, newdata, vgm: see ?krige 11 | # trans: transformation and back-transformation function; 12 | # summarize: optional, summarize the simulations, see example below; 13 | # nmax, nsim: see ?krige 14 | # density: number of points to discretize each block PROVIDED BLOCK SIZES 15 | # ARE CONSTANT (note that newdata can also be SpatialPolygons -- if newdata is 16 | # a grid, cell size is used as block size) 17 | NLKrige = function(formula, data, newdata, vgm, trans = c(log,exp), summarize, 18 | nmax = 50, nsim = 100, density = 16, ...) { 19 | # transform target: 20 | target = as.character(as.list(formula)[[2]]) 21 | data[[target]] = trans[[1]](data[[target]]) 22 | # conditional simulation sample at finer grid: 23 | finegrid = spsample(newdata, n = density * length(newdata), 24 | type = "regular", offset = c(.5,.5)) 25 | sim = krige(formula, data, finegrid, vgm, nmax = nmax, nsim = nsim) 26 | # back transform ALL simulations: 27 | sim@data = trans[[2]](sim@data) 28 | # spatial aggregation of each simulation, taking block MEAN: 29 | aggr = aggregate(sim, newdata, mean) 30 | # aggregation to summary: 31 | if (!missing(summarize)) { 32 | ret = apply(aggr@data, 1, summarize, ...) 33 | if (is.matrix(ret)) 34 | aggr@data = data.frame(t(ret)) 35 | else 36 | aggr@data = data.frame(ret) 37 | } 38 | aggr 39 | } 40 | 41 | aggr = NLKrige(zinc~1, meuse, meuse.grid, vgm(.5, "Sph", 900, .1), nmax = 10, 42 | summarize = mean) 43 | spplot(aggr, main = "expected value of block means") 44 | 45 | aggr = NLKrige(zinc~1, meuse, meuse.grid, vgm(.5, "Sph", 900, .1), nmax = 10, 46 | summarize = quantile, probs = c(0.025, 0.975)) 47 | spplot(aggr, main = "95% CI for block means") 48 | -------------------------------------------------------------------------------- /demo/localKrigeST.R: -------------------------------------------------------------------------------- 1 | ## FNN local prediction 2 | ######################## 3 | library(sp) 4 | library(spacetime) 5 | library(gstat) 6 | library(lattice) 7 | 8 | # create n space-time points over [0,1] x [0,1] x [Now, Now+some days] 9 | t0 = Sys.time() # now 10 | n = 1000 11 | set.seed(13131) # fix outcomes 12 | x = runif(n) 13 | y = runif(n) 14 | t = t0 + 1e6 * runif(n) 15 | z = rnorm(n) 16 | stidf = STIDF(SpatialPoints(cbind(x,y)), sort(t), data.frame(z=z)) 17 | 18 | stplot(stidf, number=21, main="random spatio-temporal noise") 19 | 20 | # create a regular 20 x 20 x 10 grid of prediction locations: 21 | grd = as(SpatialGrid(GridTopology(c(0.025,0.025), c(.05, .05), c(20,20))), "SpatialPixels") 22 | tgrd = seq(min(t)+10000, max(t)-10000, length.out = 10) 23 | stf = STF(grd, tgrd) 24 | 25 | # define a variogram model 26 | sumMetricModel <- vgmST("sumMetric", 27 | space=vgm(1/6, "Sph", 0.25, 1/60), 28 | time =vgm(2/6, "Exp", 1e5, 1/60), 29 | joint=vgm(0.4, "Exp", 0.3, 0.1), 30 | stAni=1/1e6) 31 | attr(sumMetricModel, "temporal unit") <- "secs" 32 | 33 | dg <- data.frame(spacelag=rep(c(0.001,1:10)/10,6), 34 | timelag=rep(0:5*50e3, each=11)) 35 | wireframe(model~spacelag+timelag, 36 | variogramSurface(sumMetricModel, dist_grid = dg), 37 | scales=list(arrows=F), 38 | drape=T, col.regions=bpy.colors(), 39 | zlim=c(0,1.2), 40 | main="imposed sum-metric model") 41 | 42 | locKrig <- krigeST(z~1, stidf, stf, sumMetricModel, nmax=50, computeVar = T) 43 | stplot(locKrig[,,"var1.pred"], col.regions=bpy.colors(), scales=list(draw=T)) 44 | stplot(locKrig[,,"var1.var"], col.regions=bpy.colors(), scales=list(draw=T)) -------------------------------------------------------------------------------- /demo/rep.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | data(meuse) 4 | coordinates(meuse) = ~x + y 5 | data(meuse.grid) 6 | coordinates(meuse.grid) = ~x + y 7 | 8 | # Variogram log Zn 9 | 10 | lzn.vgm = variogram(log(zinc) ~ 1, meuse) 11 | lzn.fit = fit.variogram(lzn.vgm, model = vgm(1, "Sph", 900, 1)) 12 | 13 | #Conditional simulation 14 | 15 | nsim = 100 16 | lzn.sim = krige(log(zinc) ~ 1, meuse, meuse.grid, model = lzn.fit, 17 | nmax = 30, nsim = nsim) 18 | 19 | # Variogram of all relizations 20 | 21 | m = out = list() 22 | for (i in 1:nsim) { 23 | s = paste("sim", i, sep="") 24 | f = as.formula(paste(s, "~1")) 25 | v = variogram(f, lzn.sim) 26 | v$id = rep(s, nrow(v)) 27 | out[[s]] = v 28 | m[[s]] = fit.variogram(v, lzn.fit) 29 | } 30 | plot(do.call(rbind, out), m, layout=c(10,10), skip = FALSE, 31 | scales = list(y = list(relation = "same"))) 32 | -------------------------------------------------------------------------------- /demo/sftime.R: -------------------------------------------------------------------------------- 1 | ## FNN local prediction 2 | ######################## 3 | library(sp) 4 | library(spacetime) 5 | library(gstat) 6 | library(lattice) 7 | 8 | # create n space-time points over [0,1] x [0,1] x [Now, Now+some days] 9 | t0 = Sys.time() # now 10 | n = 1000 11 | set.seed(13131) # fix outcomes 12 | x = runif(n) 13 | y = runif(n) 14 | t = t0 + 1e6 * runif(n) 15 | z = rnorm(n) 16 | stidf = STIDF(SpatialPoints(cbind(x,y)), sort(t), data.frame(z=z)) 17 | 18 | stplot(stidf, number=21, main="random spatio-temporal noise") 19 | 20 | library(sftime) 21 | sft = st_as_sftime(stidf) 22 | 23 | # create a regular 20 x 20 x 10 grid of prediction locations: 24 | grd = as(SpatialGrid(GridTopology(c(0.025,0.025), c(.05, .05), c(20,20))), "SpatialPixels") 25 | tgrd = seq(min(t)+10000, max(t)-10000, length.out = 10) 26 | 27 | stf = STF(grd, tgrd) 28 | #stf = STFDF(grd, tgrd, data.frame(x=rep(0,400*10))) 29 | 30 | library(stars) 31 | st = st_as_stars(stf) 32 | 33 | # define a variogram model 34 | sumMetricModel <- vgmST("sumMetric", 35 | space=vgm(1/6, "Sph", 0.25, 1/60), 36 | time =vgm(2/6, "Exp", 1e5, 1/60), 37 | joint=vgm(0.4, "Exp", 0.3, 0.1), 38 | stAni=1/1e6) 39 | attr(sumMetricModel, "temporal unit") <- "secs" 40 | 41 | dg <- data.frame(spacelag=rep(c(0.001,1:10)/10,6), 42 | timelag=rep(0:5*50e3, each=11)) 43 | #wireframe(model~spacelag+timelag, 44 | # variogramSurface(sumMetricModel, dist_grid = dg), 45 | # scales=list(arrows=F), 46 | # drape=T, col.regions=bpy.colors(), 47 | # zlim=c(0,1.2), 48 | # main="imposed sum-metric model") 49 | 50 | locKrig_sft <- krigeST(z~1, sft, st, sumMetricModel, nmax=20, computeVar = T) 51 | locKrig <- krigeST(z~1, stidf, stf, sumMetricModel, nmax=20, computeVar = T) 52 | stplot(locKrig[,,"var1.pred"], col.regions=bpy.colors(), scales=list(draw=T)) 53 | plot(locKrig_sft[1], col = sf.colors(), breaks = "equal") 54 | stplot(locKrig[,,"var1.var"], col.regions=bpy.colors(), scales=list(draw=T)) 55 | plot(locKrig_sft[2], col = sf.colors(), breaks = "equal") 56 | 57 | st$foo = 0 58 | st_as_sf(st, long = TRUE) |> st_as_sftime() -> st.sftime 59 | locKrig_sft <- krigeST(z~1, sft, st.sftime, sumMetricModel, nmax=20, computeVar = T) 60 | plot(locKrig_sft["var1.pred"]) 61 | 62 | -------------------------------------------------------------------------------- /demo/snow.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | data(meuse.grid) 4 | gridded(meuse.grid) = ~x+y 5 | data(meuse) 6 | coordinates(meuse) = ~x+y 7 | 8 | ncell = 1000000 9 | # sample 1000000 points over meuse.grid: 10 | newd = spsample(meuse.grid, ncell, type="regular") 11 | ncell = dim(coordinates(newd))[1] 12 | v = vgm(0.6, "Sph", 900, 0.05) 13 | 14 | library(parallel) 15 | 16 | nclus = detectCores() 17 | clus <- c(rep("localhost", nclus)) 18 | 19 | # set up cluster and data 20 | cl <- makeCluster(clus, type = "SOCK") 21 | clusterEvalQ(cl, library(gstat)) 22 | clusterExport(cl, list("meuse", "meuse.grid", "v")) 23 | 24 | # split prediction locations: 25 | 26 | # either at random: 27 | splt = sample(1:nclus, nrow(coordinates(newd)), replace = TRUE) 28 | 29 | # or regular: 30 | splt = rep(1:nclus, each = ceiling(ncell/nclus), length.out = ncell) 31 | newdlst = lapply(as.list(1:nclus), function(w) newd[splt == w,]) 32 | 33 | # no cluster: 34 | system.time(out.noclus <- krige(log(zinc)~1, meuse, newd, v)) 35 | 36 | # with cluster: 37 | system.time(out.clus <- do.call("rbind", parLapply(cl, newdlst, function(lst) 38 | krige(log(zinc)~1, meuse, lst, v) 39 | ))) 40 | stopCluster(cl) 41 | all.equal(out.clus, out.noclus) 42 | gridded(out.clus) = TRUE 43 | image(out.clus) 44 | -------------------------------------------------------------------------------- /demo/ugsim.R: -------------------------------------------------------------------------------- 1 | # $Id: ugsim.R,v 1.2 2006-02-10 19:05:02 edzer Exp $ 2 | library(sp) 3 | library(gstat) 4 | 5 | # prediction grid: 6 | data(meuse.grid) 7 | gridded(meuse.grid) = ~x+y 8 | 9 | # define variable as dummy data (parameters from log-zinc, meuse) 10 | v = vgm(.55, "Sph", 900, .05) 11 | g = gstat(NULL, "var1", lzn~1, beta = 5.9, nmax = 20, model = v, dummy = TRUE) 12 | 13 | # simulation of a single variable 14 | out = predict(g, meuse.grid, nsim = 20) 15 | spplot(out) 16 | 17 | # simulation of two negatively correlated variables: 18 | v = vgm(.55, "Sph", 900, .05) 19 | g = gstat(g, "var2", x~1, beta = 5.9, nmax = 20, model = v, dummy = TRUE) 20 | 21 | v = vgm(-.3, "Sph", 900, 0.00001) 22 | g = gstat(g, c("var1", "var2"), model = v) 23 | out = predict(g, meuse.grid, nsim = 10) 24 | spplot(out) 25 | -------------------------------------------------------------------------------- /demo/uisim.R: -------------------------------------------------------------------------------- 1 | # $Id: uisim.R,v 1.5 2008-09-25 10:26:00 edzer Exp $ 2 | library(sp) 3 | library(gstat) 4 | 5 | # prediction grid: 6 | data(meuse.grid) 7 | gridded(meuse.grid) = ~x+y 8 | 9 | # define variable as dummy data 10 | v = vgm(.25, "Sph", 900) 11 | g = gstat(NULL, "var1", x~1, beta = .5, nmax = 20, model = v, dummy = TRUE) 12 | 13 | # simulation of a single variable 14 | out = predict(g, meuse.grid, nsim = 20, indicators = TRUE) 15 | spplot(out) 16 | 17 | # simulation of two correlated variables: 18 | v = vgm(.1, "Sph", 900) 19 | g = gstat(g, "var2", x~1, beta = .25, nmax = 20, model = v, dummy = TRUE) 20 | 21 | v = vgm(-.1, "Sph", 900) 22 | g = gstat(g, c("var1", "var2"), model = v) 23 | out = predict(g, meuse.grid, nsim = 10, indicators = TRUE, set = list(order = 2)) 24 | spplot(out) 25 | 26 | # merge all 10 individual simulations into three-group factors: 27 | for (i in 1:10) { 28 | v1 = paste("var1.sim", i, sep = "") 29 | v2 = paste("var2.sim", i, sep = "") 30 | m = cbind(out[[v1]], out[[v2]], 1 - (out[[v1]]+out[[v2]])) 31 | mout = factor(apply(m, 1, function(x) which(x == 1))) 32 | if (i == 1) 33 | out2 = SpatialPixelsDataFrame(as(out, "SpatialPixels"), data.frame(mout)) 34 | else 35 | out2[[i]] = mout 36 | } 37 | names(out2) = paste("sim", 1:10, sep="") 38 | spplot(out2) 39 | 40 | require(RColorBrewer) 41 | spplot(out2, col.regions=brewer.pal(3, "Set2")) 42 | -------------------------------------------------------------------------------- /demo/weight.R: -------------------------------------------------------------------------------- 1 | kriging.weights = function(x, formula, newdata, model) { 2 | weighti = function(x, i, formula,...) { 3 | ret =rep(0,nrow(x)) 4 | ret[i]=1 5 | x[[1]]=ret 6 | krige(formula = formula,locations = x,...) 7 | } 8 | ret = sapply(1:nrow(x), weighti, x=x, newdata=newdata[1,], model=model,formula=formula) 9 | ret = t(sapply(ret, as.data.frame)) 10 | unlist(ret[,3]) 11 | } 12 | # example, at first cell of meuse.grid: 13 | require(sp) 14 | require(gstat) 15 | data(meuse) 16 | data(meuse.grid) 17 | coordinates(meuse) = ~x+y 18 | coordinates(meuse.grid) = ~x+y 19 | meuse$wts = kriging.weights(meuse["zinc"], zinc~1, meuse.grid[1,], vgm(1, "Exp", 300)) 20 | summary(meuse$wts) 21 | spplot(meuse["wts"], col.regions=bpy.colors(), cuts=(0:10)/20) 22 | -------------------------------------------------------------------------------- /demo/wind.R: -------------------------------------------------------------------------------- 1 | #pdf("wind.pdf") 2 | # PLEASE read the vignette of package spacetime for a more 3 | # clever way to do all this! 4 | library(sp) 5 | library(gstat) 6 | library(rgdal) 7 | library(maptools) 8 | # load wind data, run test: 9 | example(wind) 10 | 11 | m = map2SpatialLines( 12 | map("worldHires", xlim = c(-11,-5.4), ylim = c(51,55.5), plot=F)) 13 | proj4string(m) = "+proj=longlat +datum=WGS84 +ellps=WGS84" 14 | m = spTransform(m, CRS("+proj=utm +zone=29 +datum=WGS84 +ellps=WGS84")) 15 | 16 | # model temporal autocorrelation 17 | acf(wind[7]) 18 | tdiscr = 0:40 19 | lines(tdiscr, exp(- tdiscr/1.5)) 20 | 21 | # set up data, last year 22 | years = 61 23 | months = 1 24 | jday = c(1,6,11,16,21,26) 25 | sel = wind[wind$year %in% years & 26 | wind$month %in% months & 27 | wind$jday %in% jday,] 28 | 29 | #stations = 4:15 30 | stations = 4:15 31 | 32 | sels = stack(sel[stations]) 33 | sels$t = rep(sel$jday, length(stations)) 34 | sels$x = coordinates(wind.loc)[match(sels$ind, wind.loc$Code),1] 35 | sels$y = coordinates(wind.loc)[match(sels$ind, wind.loc$Code),2] 36 | summary(sels) 37 | 38 | coordinates(sels) = ~x+y 39 | proj4string(sels) = "+proj=longlat +datum=WGS84 +ellps=WGS84" 40 | sels = spTransform(sels, CRS("+proj=utm +zone=29 +datum=WGS84 +ellps=WGS84")) 41 | grd = makegrid(m, n = 1000) 42 | grd$t = rep(1, nrow(grd)) 43 | coordinates(grd) = ~x1+x2 44 | gridded(grd)=TRUE 45 | proj4string(grd) = proj4string(sels) 46 | 47 | #sels = as(sels, "data.frame") 48 | 49 | # setup grid 50 | covfn = function(x, y = x) { 51 | u = spDists(coordinates(x), coordinates(y)) 52 | t = abs(outer(x$t,y$t,"-")) 53 | 0.6 * exp(-u/750000) * exp(-t/1.5) 54 | } 55 | for (i in 1:120) { 56 | grd$t = rep(i/4, nrow(grd)) 57 | n = paste("t", i/4, sep="") 58 | grd[[n]] = krige0(sqrt(values)~1, sels, grd, covfn) 59 | } 60 | grd$t = NULL 61 | #grd$pr = out$pred 62 | #library(lattice) 63 | #levelplot(pr~x1+x2|t,grd,col.regions=bpy.colors()) 64 | spl = list(list("sp.points", sels,first=F, cex=.5), 65 | list("sp.lines", m, col='grey')) 66 | spplot(grd, sp.layout = spl, col.regions=bpy.colors()) 67 | -------------------------------------------------------------------------------- /demo/zonal.R: -------------------------------------------------------------------------------- 1 | 2 | library(sp) 3 | demo(meuse,ask=FALSE,echo=FALSE) 4 | library(gstat) 5 | v = variogram(log(zinc)~1, meuse, alpha = c(0,45,90,135)) 6 | vm = vgm(.25, "Sph", 1000, anis = c(45, 0.5)) 7 | plot(v, vm, main = "geometric") 8 | zonal = vgm(.5, "Sph", 1e9, anis = c(45, 1/1e6)) 9 | # range is 1e9, effectively infinity, in 45 direction; 10 | # it is 1e9/1e6 = 1000 in 135 direction. 11 | vm = vgm(.25, "Sph", 1000, add.to = zonal) 12 | plot(v, vm, main = "zonal") 13 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite package gstat in publications use:") 2 | 3 | bibentry(bibtype="Article", 4 | title = "Multivariable geostatistics in {S}: the gstat package", 5 | author = "Edzer J. Pebesma", 6 | journal = "Computers & Geosciences", 7 | year = 2004, 8 | volume = 30, 9 | pages = "683-691", 10 | url = "https://doi.org/10.1016/j.cageo.2004.03.012", 11 | textVersion = 12 | paste("Pebesma, E.J., 2004. Multivariable geostatistics in S: the gstat package.", 13 | "Computers & Geosciences, 30: 683-691.") 14 | ) 15 | bibentry(bibtype="Article", 16 | title = "Spatio-Temporal Interpolation using gstat", 17 | author = "Benedikt Gräler and Edzer Pebesma and Gerard Heuvelink", 18 | year = 2016, 19 | journal = "The R Journal", 20 | volume = 8, 21 | issue = 1, 22 | pages = "204-218", 23 | url = "https://journal.r-project.org/archive/2016/RJ-2016-014/index.html", 24 | textVersion = 25 | paste("Benedikt Gräler, Edzer Pebesma and Gerard Heuvelink, 2016.", 26 | "Spatio-Temporal Interpolation using gstat. The R Journal 8(1), 204-218") 27 | ) 28 | -------------------------------------------------------------------------------- /inst/ChangeLog: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/inst/ChangeLog -------------------------------------------------------------------------------- /inst/external/ncp.dbf: -------------------------------------------------------------------------------- 1 | drWAREAN PERIMETERN WSVGEB_N WSVGEB_IDN WSVGEBIEDC(WSVNUMNWSV_ENGELSC 31647227904 805264.750 2 1Centrale Noordzee 60Central North Sea 23836518400 991292.438 3 2Zuidelijke Noordzee 59Southern Bight 2996116992 608006.813 4 3Kustzone 58Coastal Zone 21310684.000 25581.318 5 4 0 529338496 176858.797 6 5Eems-Dollard 39 809406144 237455.656 7 6Waddenzee oost 63 2482308.000 8782.396 8 7 0 8828493.000 12204.778 9 8 0 37539448.000 36667.668 10 9 0 58258608.000 52365.965 11 10 0 92012928.000 71875.711 12 11 0 1566943488 222147.938 13 12Waddenzee West 62Wadden Sea 37442780.000 43513.047 14 14 0 160017344 60477.840 15 15 0 890277632 192198.391 16 16Voordelta 57Delta 116148648 69161.266 17 17Grevelingenmeer 56 371725664 182730.094 18 18Oosterschelde 55 455953504 212864.031 19 19Westerschelde 47 25196141.700 47435.919 0 0 0  -------------------------------------------------------------------------------- /inst/external/ncp.shp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/inst/external/ncp.shp -------------------------------------------------------------------------------- /inst/external/ncp.shx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/inst/external/ncp.shx -------------------------------------------------------------------------------- /inst/external/oxford.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/inst/external/oxford.jpg -------------------------------------------------------------------------------- /man/coalash.Rd: -------------------------------------------------------------------------------- 1 | % $Id: coalash.Rd,v 1.2 2007-03-21 15:14:25 edzer Exp $ 2 | \name{coalash} 3 | \alias{coalash} 4 | \title{Coal ash samples from a mine in Pennsylvania} 5 | \description{ 6 | Data obtained from Gomez and Hazen (1970, Tables 19 and 20) on coal ash 7 | for the Robena Mine Property in Greene County Pennsylvania. 8 | } 9 | \format{ 10 | This data frame contains the following columns: 11 | \describe{ 12 | \item{x}{a numeric vector; x-coordinate; reference unknown } 13 | \item{y}{a numeric vector; x-coordinate; reference unknown } 14 | \item{coalash}{the target variable} 15 | } 16 | } 17 | \usage{ 18 | data(coalash) 19 | } 20 | \author{ unknown; R version prepared by Edzer Pebesma; data obtained from 21 | \url{http://homepage.divms.uiowa.edu/~dzimmer/spatialstats/}, Dale Zimmerman's 22 | course page } 23 | \references{ N.A.C. Cressie, 1993, Statistics for Spatial Data, 24 | Wiley. 25 | 26 | Gomez, M. and Hazen, K. (1970). Evaluating sulfur and ash 27 | distribution in coal seems by statistical response surface regression 28 | analysis. U.S. Bureau of Mines Report RI 7377. 29 | 30 | see also fields manual: 31 | \url{https://www.image.ucar.edu/GSP/Software/Fields/fields.manual.coalashEX.Krig.shtml} 32 | } 33 | \note{ data are also present in package fields, as coalash. } 34 | \keyword{datasets} 35 | \examples{ 36 | data(coalash) 37 | summary(coalash) 38 | } 39 | -------------------------------------------------------------------------------- /man/extractPar.Rd: -------------------------------------------------------------------------------- 1 | \name{extractPar} 2 | \alias{extractPar} 3 | \alias{extractParNames} 4 | 5 | \title{ 6 | Extracting parameters and their names from a spatio-temporal variogram model 7 | } 8 | \description{ 9 | All spatio-temporal variogram models have a different set of parameters. These functions extract the parameters and their names from the spatio-temporal variogram model. Note, this function is as well used to pass the parameters to the optim function. The arguments lower and upper passed to optim should follow the same structure. 10 | } 11 | \usage{ 12 | extractPar(model) 13 | extractParNames(model) 14 | } 15 | 16 | \arguments{ 17 | \item{model}{a spatio-temporal variogram model from \code{\link{vgmST}}} 18 | } 19 | 20 | \value{ 21 | A named numeric vector of parameters or a vector of characters holding the parameters' names. 22 | } 23 | 24 | \author{ 25 | Benedikt Graeler 26 | } 27 | 28 | 29 | \seealso{ 30 | \code{\link{fit.StVariogram}} and \code{\link{vgmST}} 31 | } 32 | 33 | \examples{ 34 | sumMetricModel <- vgmST("sumMetric", 35 | space=vgm(30, "Sph", 200, 6), 36 | time =vgm(30, "Sph", 15, 7), 37 | joint=vgm(60, "Exp", 84, 22), 38 | stAni=100) 39 | 40 | extractPar(sumMetricModel) 41 | extractParNames(sumMetricModel) 42 | } -------------------------------------------------------------------------------- /man/fit.lmc.Rd: -------------------------------------------------------------------------------- 1 | % $Id: fit.lmc.Rd,v 1.4 2007-11-16 12:59:35 edzer Exp $ 2 | \name{fit.lmc} 3 | \alias{fit.lmc} 4 | \title{ Fit a Linear Model of Coregionalization to a Multivariable Sample Variogram } 5 | \description{ 6 | Fit a Linear Model of Coregionalization to a Multivariable Sample Variogram; 7 | in case of a single variogram model (i.e., no nugget) this is equivalent to 8 | Intrinsic Correlation 9 | } 10 | \usage{ 11 | fit.lmc(v, g, model, fit.ranges = FALSE, fit.lmc = !fit.ranges, 12 | correct.diagonal = 1.0, ...) 13 | } 14 | \arguments{ 15 | \item{v}{ multivariable sample variogram, output of \link{variogram} } 16 | \item{g}{ gstat object, output of \link{gstat} } 17 | \item{model}{ variogram model, output of \link{vgm}; if supplied 18 | this value is used as initial value for each fit } 19 | \item{fit.ranges}{ logical; determines whether the range coefficients 20 | (excluding that of the nugget component) should be fitted; or logical 21 | vector: determines for each range parameter of the variogram model 22 | whether it should be fitted or fixed. } 23 | \item{fit.lmc}{ logical; if TRUE, each coefficient matrices of partial 24 | sills is guaranteed to be positive definite } 25 | \item{correct.diagonal}{ multiplicative correction factor to be applied 26 | to partial sills of direct variograms only; the default value, 1.0, does 27 | not correct. If you encounter problems with singular covariance matrices 28 | during cokriging or cosimulation, you may want to try to increase this 29 | to e.g. 1.01 } 30 | \item{...}{ parameters that get passed to \link{fit.variogram} } 31 | } 32 | \value{ 33 | returns an object of class \code{gstat}, with fitted variograms; 34 | } 35 | \references{ \url{http://www.gstat.org/} } 36 | \author{ Edzer Pebesma } 37 | \note{ This function does not use the iterative procedure proposed by 38 | M. Goulard and M. Voltz (Math. Geol., 24(3): 269-286; reproduced in 39 | Goovaerts' 1997 book) but uses simply two steps: first, each variogram 40 | model is fitted to a direct or cross variogram; next each of the partial 41 | sill coefficient matrices is approached by its in least squares sense 42 | closest positive definite matrices (by setting any negative eigenvalues 43 | to zero). 44 | 45 | The argument \code{correct.diagonal} was introduced by experience: by 46 | zeroing the negative eigenvalues for fitting positive definite partial 47 | sill matrices, apparently still perfect correlation may result, leading 48 | to singular cokriging/cosimulation matrices. If someone knows of a more 49 | elegant way to get around this, please let me know. 50 | } 51 | \seealso{ \link{variogram}, \link{vgm}, \link{fit.variogram}, 52 | \code{demo(cokriging)} } 53 | \keyword{models} 54 | -------------------------------------------------------------------------------- /man/fit.variogram.gls.Rd: -------------------------------------------------------------------------------- 1 | % $Id: fit.variogram.gls,v 1.4 2009-02-20 13:53:38 edzer Exp $ 2 | \name{fit.variogram.gls} 3 | \alias{fit.variogram.gls} 4 | \title{ GLS fitting of variogram parameters } 5 | \description{ 6 | Fits variogram parameters (nugget, sill, range) to variogram cloud, 7 | using GLS (generalized least squares) fitting. Only for direct variograms. 8 | } 9 | \usage{ 10 | fit.variogram.gls(formula, data, model, maxiter = 30, 11 | eps = .01, trace = TRUE, ignoreInitial = TRUE, cutoff = Inf, 12 | plot = FALSE) 13 | } 14 | \arguments{ 15 | \item{formula}{formula defining the response vector and (possible) 16 | regressors; in case of absence of regressors, use e.g. \code{z~1}} 17 | \item{data}{object of class Spatial} 18 | \item{model}{variogram model to be fitted, output of \code{vgm}} 19 | \item{maxiter}{maximum number of iterations} 20 | \item{eps}{ convergence criterium } 21 | \item{trace}{ logical; if TRUE, prints parameter trace} 22 | \item{ignoreInitial}{ logical; 23 | if FALSE, initial parameter are taken from model; 24 | if TRUE, initial values of model are 25 | ignored and taken from variogram cloud: 26 | nugget: \code{mean(y)/2}, sill: \code{mean(y)/2}, range \code{median(h0)/4} 27 | with \code{y} the semivariance cloud value and \code{h0} the distances } 28 | \item{cutoff}{maximum distance up to which point pairs are taken into 29 | consideration} 30 | \item{plot}{logical; if TRUE, a plot is returned with variogram cloud and 31 | fitted model; else, the fitted model is returned.} 32 | } 33 | 34 | \value{ an object of class "variogramModel"; see \link{fit.variogram}; if 35 | \code{plot} is TRUE, a plot is returned instead. } 36 | 37 | \references{ 38 | Mueller, W.G., 1999: Least-squares fitting from the variogram 39 | cloud. Statistics and Probability Letters, 43, 93-98. 40 | 41 | Mueller, W.G., 2007: Collecting Spatial Data. Springer, Heidelberg. 42 | } 43 | 44 | \author{ Edzer Pebesma } 45 | \note{ 46 | Inspired by the code of Mihael Drinovac, which was again inspired by 47 | code from Ernst Glatzer, author of package vardiag. 48 | } 49 | \seealso{ 50 | \link{fit.variogram}, 51 | } 52 | \examples{ 53 | library(sp) 54 | data(meuse) 55 | coordinates(meuse) = ~x+y 56 | \dontrun{ 57 | fit.variogram.gls(log(zinc)~1, meuse[1:40,], vgm(1, "Sph", 900,1)) 58 | } 59 | } 60 | \keyword{models} 61 | -------------------------------------------------------------------------------- /man/fit.variogram.reml.Rd: -------------------------------------------------------------------------------- 1 | % $Id: fit.variogram.reml.Rd,v 1.4 2009-02-20 13:53:38 edzer Exp $ 2 | \name{fit.variogram.reml} 3 | \alias{fit.variogram.reml} 4 | \title{ REML Fit Direct Variogram Partial Sills to Data } 5 | \description{ 6 | Fit Variogram Sills to Data, using REML (only for direct variograms; 7 | not for cross variograms) 8 | } 9 | \usage{ 10 | fit.variogram.reml(formula, locations, data, model, debug.level = 1, set, degree = 0) 11 | } 12 | \arguments{ 13 | \item{formula}{formula defining the response vector and (possible) 14 | regressors; in case of absence of regressors, use e.g. \code{z~1}} 15 | \item{locations}{ spatial data locations; a formula with the 16 | coordinate variables in the right hand (dependent variable) side. } 17 | \item{data}{data frame where the names in formula and locations 18 | are to be found} 19 | \item{model}{variogram model to be fitted, output of \code{vgm}} 20 | \item{debug.level}{debug level; set to 65 to see the iteration trace and 21 | log likelihood} 22 | \item{set}{additional options that can be set; use \code{set=list(iter=100)} 23 | to set the max. number of iterations to 100. } 24 | \item{degree}{order of trend surface in the location, between 0 and 3} 25 | } 26 | 27 | \value{ an object of class "variogramModel"; see \link{fit.variogram} } 28 | 29 | \references{ 30 | Christensen, R. Linear models for multivariate, Time Series, 31 | and Spatial Data, Springer, NY, 1991. 32 | 33 | Kitanidis, P., Minimum-Variance Quadratic Estimation of Covariances of 34 | Regionalized Variables, Mathematical Geology 17 (2), 195--208, 1985 } 35 | 36 | \author{ Edzer Pebesma } 37 | \note{ 38 | This implementation only uses REML fitting of sill parameters. For each 39 | iteration, an \eqn{n \times n}{n x n} matrix is inverted, with $n$ the number of 40 | observations, so for large data sets this method becomes 41 | demanding. I guess there is much more to likelihood variogram fitting in 42 | package \code{geoR}, and probably also in \code{nlme}. 43 | } 44 | \seealso{ 45 | \link{fit.variogram}, 46 | } 47 | \examples{ 48 | library(sp) 49 | data(meuse) 50 | fit.variogram.reml(log(zinc)~1, ~x+y, meuse, model = vgm(1, "Sph", 900,1)) 51 | } 52 | \keyword{models} 53 | -------------------------------------------------------------------------------- /man/fulmar.Rd: -------------------------------------------------------------------------------- 1 | % $Id: fulmar.Rd,v 1.7 2008-07-03 11:49:08 edzer Exp $ 2 | \name{fulmar} 3 | \alias{fulmar} 4 | \title{Fulmaris glacialis data} 5 | \description{ Airborne counts of Fulmaris glacialis during the 6 | Aug/Sept 1998 and 1999 flights on the Dutch (Netherlands) part of 7 | the North Sea (NCP, Nederlands Continentaal Plat). } 8 | \format{ 9 | This data frame contains the following columns: 10 | \describe{ 11 | \item{year}{year of measurement: 1998 or 1999} 12 | \item{x}{x-coordinate in UTM zone 31} 13 | \item{y}{y-coordinate in UTM zone 31} 14 | \item{depth}{sea water depth, in m} 15 | \item{coast}{distance to coast of the Netherlands, in km.} 16 | \item{fulmar}{observed density (number of birds per square km)} 17 | } 18 | } 19 | \usage{ 20 | data(fulmar) 21 | } 22 | \author{ Dutch National Institute for Coastal and Marine Management (RIKZ) } 23 | \seealso{\link{ncp.grid} 24 | 25 | E.J. Pebesma, R.N.M. Duin, P.A. Burrough, 2005. Mapping Sea Bird 26 | Densities over the North Sea: Spatially Aggregated Estimates and Temporal 27 | Changes. Environmetrics 16, (6), p 573-587. 28 | } 29 | \keyword{datasets} 30 | \examples{ 31 | data(fulmar) 32 | summary(fulmar) 33 | \dontrun{ 34 | demo(fulmar) 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /man/get.contr.Rd: -------------------------------------------------------------------------------- 1 | % $Id: get.contr.Rd,v 1.6 2009-02-20 13:53:38 edzer Exp $ 2 | \name{get.contr} 3 | \alias{get.contr} 4 | \title{ Calculate contrasts from multivariable predictions } 5 | \description{ Given multivariable predictions and prediction (co)variances, 6 | calculate contrasts and their (co)variance } 7 | \usage{ get.contr(data, gstat.object, X, ids = names(gstat.object$data)) } 8 | \arguments{ 9 | \item{data}{data frame, output of \link[gstat]{predict} } 10 | \item{gstat.object}{object of class \code{gstat}, used to 11 | extract ids; may be missing if \code{ids} is used } 12 | \item{X}{ contrast vector or matrix; the number of variables in 13 | \code{gstat.object} should equal the number of elements in \code{X} 14 | if \code{X} is a vector, or the number of rows in \code{X} if \code{X} 15 | is a matrix. } 16 | \item{ids}{ character vector with (selection of) id names, present in data } 17 | } 18 | 19 | \details{ 20 | From data, we can extract the \eqn{n \times 1}{n x 1} vector with multivariable 21 | predictions, say $y$, and its \eqn{n \times n}{n x n} covariance matrix $V$. Given 22 | a contrast matrix in $X$, this function computes the contrast vector 23 | $C=X'y$ and its variance $Var(C)=X'V X$. 24 | } 25 | 26 | \value{ 27 | a data frame containing for each row in \code{data} the generalized 28 | least squares estimates (named beta.1, beta.2, ...), their 29 | variances (named var.beta.1, var.beta.2, ...) and covariances 30 | (named cov.beta.1.2, cov.beta.1.3, ...) 31 | } 32 | 33 | \references{ 34 | \url{http://www.gstat.org/} 35 | } 36 | \author{ Edzer Pebesma } 37 | \seealso{\link[gstat]{predict}} 38 | 39 | 40 | \keyword{ models } 41 | -------------------------------------------------------------------------------- /man/gstat-internal.Rd: -------------------------------------------------------------------------------- 1 | % $Id: gstat-internal.Rd,v 1.6 2008-03-10 10:36:04 edzer Exp $ 2 | \name{gstat-internal} 3 | \alias{load.variogram.model} 4 | \alias{gstat.formula} 5 | \alias{gstat.formula.predict} 6 | \alias{gstat.debug} 7 | \alias{gstat.set} 8 | \alias{cross.name} 9 | \alias{gstat.load.set} 10 | 11 | \title{Gstat Internal Functions} 12 | \description{gstat internal functions} 13 | \author{Edzer Pebesma} 14 | \note{these functions are not meant to be called by users directly} 15 | \keyword{internal} 16 | -------------------------------------------------------------------------------- /man/hscat.Rd: -------------------------------------------------------------------------------- 1 | % $Id: hscat.Rd,v 1.3 2008-02-04 10:06:44 edzer Exp $ 2 | \name{hscat} 3 | \alias{hscat} 4 | \title{ 5 | Produce h-scatterplot 6 | } 7 | \description{ 8 | Produces h-scatterplots, where point pairs having specific separation distances 9 | are plotted. This function is a wrapper around xyplot. 10 | } 11 | \usage{ 12 | hscat(formula, data, breaks, pch = 3, cex = .6, mirror = FALSE, 13 | variogram.alpha = 0, as.table = TRUE,...) 14 | } 15 | \arguments{ 16 | \item{formula}{ specifies the dependent variable } 17 | \item{data}{ data where the variable in formula is resolved } 18 | \item{breaks}{ distance class boundaries } 19 | \item{pch}{ plotting symbol } 20 | \item{cex}{ plotting symbol size } 21 | \item{mirror}{ logical; duplicate all points mirrored along x=y? 22 | (note that correlations are those of the points plotted) } 23 | \item{variogram.alpha}{ parameter to be passed as alpha parameter to 24 | \link{variogram}; if alpha is specified it will only affect xyplot by 25 | being passed through ...} 26 | \item{as.table}{logical; if \code{TRUE}, panels plot top-to-bottom } 27 | \item{...}{ parameters, passed to variogram and xyplot } 28 | } 29 | \value{ 30 | an object of class trellis; normally the h scatter plot 31 | } 32 | \author{ Edzer Pebesma } 33 | \note{ 34 | Data pairs are plotted once, so the h-scatterplot are not symmetric. 35 | } 36 | 37 | \references{ \url{http://www.gstat.org/} 38 | 39 | Pebesma, E.J., 2004. Multivariable geostatistics in S: the gstat package. 40 | Computers and Geosciences, 30: 683-691. 41 | 42 | } 43 | \examples{ 44 | library(sp) 45 | data(meuse) 46 | coordinates(meuse) = ~x+y 47 | hscat(log(zinc)~1, meuse, c(0, 80, 120, 250, 500, 1000)) 48 | } 49 | 50 | \keyword{models} 51 | -------------------------------------------------------------------------------- /man/image.Rd: -------------------------------------------------------------------------------- 1 | % $Id: image.Rd,v 1.10 2007-11-16 12:59:47 edzer Exp $ 2 | \name{image} 3 | \alias{image.data.frame} 4 | \alias{image} 5 | \alias{xyz2img} 6 | \title{ 7 | Image Gridded Coordinates in Data Frame 8 | } 9 | \description{ 10 | Image gridded data, held in a data frame, keeping the 11 | right aspect ratio for axes, and the right cell shape 12 | } 13 | \usage{ 14 | \method{image}{data.frame}(x, zcol = 3, xcol = 1, ycol = 2, asp = 1, ...) 15 | xyz2img(xyz, zcol = 3, xcol = 1, ycol = 2, tolerance = 10 * .Machine$double.eps) 16 | } 17 | \arguments{ 18 | \item{x}{ data frame (or matrix) with x-coordinate, 19 | y-coordinate, and z-coordinate in its columns } 20 | \item{zcol}{ column number or name of z-variable } 21 | \item{xcol}{ column number or name of x-coordinate } 22 | \item{ycol}{ column number or name of y-coordinate } 23 | \item{asp}{ aspect ratio for the x and y axes } 24 | \item{...}{ arguments, passed to image.default } 25 | \item{xyz}{data frame (same as \code{x})} 26 | \item{tolerance}{ maximum allowed deviation for coordinats from being 27 | exactly on a regularly spaced grid } 28 | } 29 | \value{ 30 | \link{image.data.frame} plots an image from gridded data, organized 31 | in arbritrary order, in a data frame. It uses \link{xyz2img} and 32 | \link{image.default} for this. In the S-Plus version, \link{xyz2img} 33 | tries to make an image object with a size such that it will plot with 34 | an equal aspect ratio; for the R version, image.data.frame uses the 35 | \code{asp=1} argument to guarantee this. 36 | 37 | \link{xyz2img} returns a list with components: \code{z}, a matrix 38 | containing the z-values; \code{x}, the increasing coordinates of the 39 | rows of \code{z}; \code{y}, the increasing coordinates of the columns 40 | of \code{z}. This list is suitable input to \link{image.default}. 41 | } 42 | \note{ 43 | I wrote this function before I found out about \code{levelplot}, 44 | a Lattice/Trellis function that lets you control the aspect ratio by 45 | the \code{aspect} argument, and that automatically draws a legend, and 46 | therefore I now prefer levelplot over \code{image}. Plotting points 47 | on a levelplots is probably done with providing a panel function and 48 | using \code{lpoints}. 49 | 50 | (for S-Plus only -- ) it is hard (if not impossible) to get exactly right 51 | cell shapes (e.g., square for a square grid) without altering the size of 52 | the plotting region, but this function tries hard to do so by extending 53 | the image to plot in either x- or y-direction. The larger the grid, the 54 | better the approximation. Geographically correct images can be obtained 55 | by modifiying \code{par("pin")}. Read the examples, image a 2 x 2 grid, 56 | and play with \code{par("pin")} if you want to learn more about this. 57 | } 58 | \author{ Edzer Pebesma } 59 | \examples{ 60 | library(sp) 61 | data(meuse) 62 | data(meuse.grid) 63 | g <- gstat(formula=log(zinc)~1,locations=~x+y,data=meuse,model=vgm(1,"Exp",300)) 64 | x <- predict(g, meuse.grid) 65 | image(x, 4, main="kriging variance and data points") 66 | points(meuse$x, meuse$y, pch = "+") 67 | } 68 | 69 | \keyword{dplot} 70 | 71 | -------------------------------------------------------------------------------- /man/krigeSTSimTB.Rd: -------------------------------------------------------------------------------- 1 | \name{krigeSTSimTB} 2 | \alias{krigeSTSimTB} 3 | 4 | \title{conditional/unconditional spatio-temporal simulation} 5 | \description{ 6 | conditional/unconditional spatio-temporal simulation based on turning bands 7 | } 8 | \usage{ 9 | krigeSTSimTB(formula, data, newdata, modelList, nsim, progress = TRUE, 10 | nLyrs = 500, tGrid = NULL, sGrid = NULL, ceExt = 2, nmax = Inf) 11 | } 12 | \arguments{ 13 | \item{formula}{the formula of the kriging predictor} 14 | \item{data}{conditioning data} 15 | \item{newdata}{locations in space and time where the simulation is carried out} 16 | \item{modelList}{the spatio-temporal variogram (from \code{\link{vgmST}}) defining the spatio-temporal covariance structure of the simulated Gaussian random field} 17 | \item{nsim}{number of simulations} 18 | \item{progress}{boolean; whether the progress should be shown in progress bar} 19 | \item{nLyrs}{number of layers used in the turning bands approach (default = 500) } 20 | \item{tGrid}{optional explicit temporal griding that shall be used} 21 | \item{sGrid}{optional explicit spatial griding that shall be used} 22 | \item{ceExt}{expansion in the circulant embedding, defaults to 2} 23 | \item{nmax}{number of nearest neighbours that shall e used, defaults to 'Inf' meaning all available points are used} 24 | } 25 | \value{a spatio-temporal data frame with \code{nSim} simulations} 26 | \references{ 27 | Turning bands 28 | 29 | Lantuejoul, C. (2002) Geostatistical Simulation: Models and Algorithms. Springer. 30 | 31 | Matheron, G. (1973). The intrinsic random functions and their applications. Adv. Appl. Probab., 5, 439-468. 32 | 33 | Strokorb, K., Ballani, F., and Schlather, M. (2014) Tail correlation functions of max-stable processes: Construction principles, recovery and diversity of some mixing max-stable processes with identical TCF. Extremes, Submitted. 34 | 35 | Turning layers 36 | 37 | Schlather, M. (2011) Construction of covariance functions and unconditional simulation of random fields. In Porcu, E., Montero, J.M. and Schlather, M., Space-Time Processes and Challenges Related to Environmental Problems. New York: Springer. 38 | } 39 | 40 | \author{Benedikt Graeler} 41 | 42 | \seealso{\code{\link{krigeSimCE}}} 43 | \examples{ 44 | # see demo('circEmbeddingMeuse') 45 | } -------------------------------------------------------------------------------- /man/krigeSimCE.Rd: -------------------------------------------------------------------------------- 1 | \name{krigeSimCE} 2 | \alias{krigeSimCE} 3 | \title{Simulation based on circulant embedding} 4 | \description{Simulating a conditional/unconditional Gaussian random field via kriging and circulant embedding} 5 | \usage{ 6 | krigeSimCE(formula, data, newdata, model, n = 1, ext = 2) 7 | } 8 | 9 | \arguments{ 10 | \item{formula}{ the formula of the kriging predictor} 11 | \item{data}{ spatial data frame that conditions the simulation} 12 | \item{newdata}{locations in space where the Gaussian random field shall be simulated} 13 | \item{model}{a vgm model that defines the spatial covariance structure} 14 | \item{n}{number of simulations} 15 | \item{ext}{extension factor of the circulant embedding, defaults to 2} 16 | } 17 | \value{A spatial data frame as defined in \code{newdata} with \code{n} simulations.} 18 | 19 | \references{ 20 | Davies, Tilman M., and David Bryant: "On circulant embedding for Gaussian random fields in R." 21 | Journal of Statistical Software 55.9 (2013): 1-21. 22 | See i.e. the supplementary files at (retrieved 2018-05-25): 23 | https://www.jstatsoft.org/index.php/jss/article/downloadSuppFile/v055i09/v55i09.R 24 | } 25 | 26 | \author{Benedikt Graeler} 27 | 28 | \seealso{\code{\link{krigeSTSimTB}}} 29 | 30 | \examples{# see demo('circEmbeddingMeuse')} -------------------------------------------------------------------------------- /man/map.to.lev.Rd: -------------------------------------------------------------------------------- 1 | % $Id: map.to.lev.Rd,v 1.4 2006-02-10 19:03:27 edzer Exp $ 2 | \name{map.to.lev} 3 | \alias{map.to.lev} 4 | \title{ rearrange data frame for plotting with levelplot } 5 | \description{ rearrange data frame for plotting with levelplot } 6 | \usage{ 7 | map.to.lev(data, xcol = 1, ycol = 2, zcol = c(3, 4), ns = names(data)[zcol]) 8 | } 9 | \arguments{ 10 | \item{data}{ data frame, e.g. output from \link{krige} or \link[gstat]{predict} } 11 | \item{xcol}{ x-coordinate column number } 12 | \item{ycol}{ y-coordinate column number } 13 | \item{zcol}{ z-coordinate column number range } 14 | \item{ns}{names of the set of z-columns to be viewed} 15 | } 16 | \value{ 17 | data frame with the following elements: 18 | \item{x}{ x-coordinate for each row} 19 | \item{y}{ y-coordinate for each row} 20 | \item{z}{ column vector with each of the elements in columns \code{zcol} 21 | of \code{data} stacked } 22 | \item{name}{ factor; name of each of the stacked \code{z} columns } 23 | } 24 | \seealso{ 25 | \link{image.data.frame}, \link{krige}; 26 | for examples see \link[gstat]{predict}; 27 | \code{levelplot} in package lattice. 28 | } 29 | \keyword{dplot} 30 | -------------------------------------------------------------------------------- /man/meuse.all.Rd: -------------------------------------------------------------------------------- 1 | % $Id: meuse.all.Rd,v 1.5 2006-02-10 19:03:27 edzer Exp $ 2 | \name{meuse.all} 3 | \alias{meuse.all} 4 | \title{Meuse river data set -- original, full data set} 5 | \description{ 6 | This data set gives locations and top soil heavy metal concentrations 7 | (ppm), along with a number of soil and landscape variables, collected in 8 | a flood plain of the river Meuse, near the village Stein. Heavy metal 9 | concentrations are bulk sampled from an area of approximately 15 m 10 | x 15 m. 11 | } 12 | \format{ 13 | This data frame contains the following columns: 14 | \describe{ 15 | \item{sample}{sample number} 16 | \item{x}{a numeric vector; x-coordinate (m) 17 | in RDM (Dutch topographical map coordinates) } 18 | \item{y}{a numeric vector; y-coordinate (m) 19 | in RDM (Dutch topographical map coordinates)} 20 | \item{cadmium}{topsoil cadmium concentration, ppm.; note that zero cadmium 21 | values in the original data set have been shifted to 0.2 (half the lowest 22 | non-zero value) } 23 | \item{copper}{topsoil copper concentration, ppm. } 24 | \item{lead}{topsoil lead concentration, ppm. } 25 | \item{zinc}{topsoil zinc concentration, ppm. } 26 | \item{elev}{relative elevation} 27 | \item{om}{organic matter, as percentage } 28 | \item{ffreq}{flooding frequency class} 29 | \item{soil}{soil type} 30 | \item{lime}{lime class} 31 | \item{landuse}{landuse class} 32 | \item{dist.m}{distance to river Meuse (metres), as obtained during 33 | the field survey} 34 | \item{in.pit}{logical; indicates whether this is a sample taken in 35 | a pit} 36 | \item{in.meuse155}{logical; indicates whether the sample is part of 37 | the \code{meuse} (i.e., filtered) data set; in addition to the samples 38 | in a pit, an sample (139) with outlying zinc content was removed } 39 | \item{in.BMcD}{logical; indicates whether the sample is used as part 40 | of the subset of 98 points in the various interpolation examples of 41 | Burrough and McDonnell} 42 | } 43 | } 44 | \usage{ 45 | data(meuse.all) 46 | } 47 | \author{ The actual field data were collected by Ruud van Rijn and 48 | Mathieu Rikken; data compiled for R by Edzer Pebesma } 49 | \references{ 50 | P.A. Burrough, R.A. McDonnell, 1998. Principles of Geographical Information 51 | Systems. Oxford University Press. 52 | 53 | \url{http://www.gstat.org/} 54 | } 55 | \note{ \code{sample} refers to original sample number. Eight samples 56 | were left out because they were not indicative for the metal content of 57 | the soil. They were taken in an old pit. One sample contains an outlying 58 | zinc value, which was also discarded for the meuse (155) data set. 59 | } 60 | \seealso{\link{meuse.alt}} 61 | \keyword{datasets} 62 | \examples{ 63 | data(meuse.all) 64 | summary(meuse.all) 65 | } 66 | -------------------------------------------------------------------------------- /man/meuse.alt.Rd: -------------------------------------------------------------------------------- 1 | % $Id: meuse.alt.Rd,v 1.6 2006-02-10 19:03:27 edzer Exp $ 2 | \name{meuse.alt} 3 | \alias{meuse.alt} 4 | \title{Meuse river altitude data set} 5 | \description{ 6 | This data set gives a point set with altitudes, digitized from the 7 | 1:10,000 topographical map of the Netherlands. 8 | } 9 | \format{ 10 | This data frame contains the following columns: 11 | \describe{ 12 | \item{x}{a numeric vector; x-coordinate (m) in RDM (Dutch topographical map coordinates) } 13 | \item{y}{a numeric vector; y-coordinate (m) in RDM (Dutch topographical map coordinates)} 14 | \item{alt}{altitude in m. above NAP (Dutch zero for sea level)} 15 | } 16 | } 17 | \usage{ 18 | data(meuse.alt) 19 | } 20 | \references{ 21 | \url{http://www.gstat.org/} 22 | } 23 | \seealso{\link{meuse.all}} 24 | \keyword{datasets} 25 | \examples{ 26 | data(meuse.alt) 27 | library(lattice) 28 | xyplot(y~x, meuse.alt, aspect = "iso") 29 | } 30 | -------------------------------------------------------------------------------- /man/ncp.grid.Rd: -------------------------------------------------------------------------------- 1 | % $Id: ncp.grid.Rd,v 1.5 2007-11-16 12:59:47 edzer Exp $ 2 | \name{ncp.grid} 3 | \alias{ncp.grid} 4 | \title{Grid for the NCP, the Dutch part of the North Sea} 5 | \description{ 6 | Gridded data for the NCP (Nederlands Continentaal Plat, the Dutch 7 | part of the North Sea), for a 5 km x 5 km grid; stored as data.frame. 8 | } 9 | \format{ 10 | This data frame contains the following columns: 11 | \describe{ 12 | \item{x}{x-coordinate, UTM zone 31} 13 | \item{y}{y-coordinate, UTM zone 31} 14 | \item{depth}{sea water depth, m.} 15 | \item{coast}{distance to the coast of the Netherlands, in km.} 16 | \item{area}{identifier for administrative sub-areas} 17 | } 18 | } 19 | \usage{ 20 | data(ncp.grid) 21 | } 22 | \author{Dutch National Institute for Coastal and Marine Management (RIKZ); 23 | data compiled for R by Edzer Pebesma } 24 | \seealso{\link{fulmar}} 25 | \keyword{datasets} 26 | \examples{ 27 | data(ncp.grid) 28 | summary(ncp.grid) 29 | } 30 | -------------------------------------------------------------------------------- /man/ossfim.Rd: -------------------------------------------------------------------------------- 1 | % $Id: ossfim.Rd,v 1.3 2006-02-10 19:03:27 edzer Exp $ 2 | \name{ossfim} 3 | \alias{ossfim} 4 | \title{ Kriging standard errors as function of grid spacing and block size} 5 | \description{ Calculate, for a given variogram model, ordinary block 6 | kriging standard errors as a function of sampling spaces and block sizes } 7 | \usage{ 8 | ossfim(spacings = 1:5, block.sizes = 1:5, model, nmax = 25, debug = 0) 9 | } 10 | \arguments{ 11 | \item{spacings}{range of grid (data) spacings to be used} 12 | \item{block.sizes}{ range of block sizes to be used} 13 | \item{model}{variogram model, output of \code{vgm}} 14 | \item{nmax}{set the kriging neighbourhood size} 15 | \item{debug}{debug level; set to 32 to see a lot of output} 16 | } 17 | 18 | \value{ data frame with columns \code{spacing} (the grid spacing), 19 | \code{block.size} (the block size), and \code{kriging.se} (block kriging 20 | standard error) } 21 | 22 | \references{ 23 | Burrough, P.A., R.A. McDonnell (1999) Principles of Geographical 24 | Information Systems. Oxford University Press (e.g., figure 10.11 on 25 | page 261) 26 | 27 | Burgess, T.M., R. Webster, A.B. McBratney (1981) Optimal interpolation and 28 | isarithmic mapping of soil properties. IV Sampling strategy. The journal 29 | of soil science 32(4), 643-660. 30 | 31 | McBratney, A.B., R. Webster (1981) The design of optimal sampling schemes 32 | for local estimation and mapping of regionalized variables: 2 program 33 | and examples. Computers and Geosciences 7: 335-365. 34 | } 35 | 36 | \author{ Edzer Pebesma } 37 | \note{ The idea is old, simple, but still of value. If you want to map 38 | a variable with a given accuracy, you will have to sample it. Suppose 39 | the variogram of the variable is known. Given a regular sampling scheme, 40 | the kriging standard error decreases when either (i) the data spacing 41 | is smaller, or (ii) predictions are made for larger blocks. This function 42 | helps quantifying this relationship. Ossfim probably refers to ``optimal 43 | sampling scheme for isarithmic mapping''. 44 | } 45 | 46 | \seealso{ 47 | \link{krige} 48 | } 49 | \examples{ 50 | \dontrun{ 51 | x <- ossfim(1:15,1:15, model = vgm(1,"Exp",15)) 52 | library(lattice) 53 | levelplot(kriging.se~spacing+block.size, x, 54 | main = "Ossfim results, variogram 1 Exp(15)") 55 | } 56 | # if you wonder about the decrease in the upper left corner of the graph, 57 | # try the above with nmax set to 100, or perhaps 200. 58 | } 59 | \keyword{models} 60 | -------------------------------------------------------------------------------- /man/pcb.Rd: -------------------------------------------------------------------------------- 1 | % $Id: pcb.Rd,v 1.8 2009-07-03 12:10:55 edzer Exp $ 2 | \name{pcb} 3 | \alias{pcb} 4 | \title{PCB138 measurements in sediment at the NCP, the Dutch part of the North Sea} 5 | \description{ 6 | PCB138 measurements in sediment at the NCP, which is the 7 | Dutch part of the North Sea 8 | } 9 | \format{ 10 | This data frame contains the following columns: 11 | \describe{ 12 | \item{year}{ measurement year } 13 | \item{x}{ x-coordinate; UTM zone 31 } 14 | \item{y}{ y-coordinate; UTM zone 31 } 15 | \item{coast}{ distance to coast of the Netherlands, in km.} 16 | \item{depth}{ sea water depth, m. } 17 | \item{PCB138}{ PCB-138, measured on the sediment fraction smaller than 18 | 63 \eqn{\mu}{mu}, in \eqn{\mu g/kg}{mu g/kg} dry matter; BUT SEE NOTE BELOW } 19 | \item{yf}{ year; as factor} 20 | } 21 | } 22 | 23 | \usage{ 24 | data(pcb) 25 | } 26 | \note{ A note of caution: The PCB-138 data are provided only to be able 27 | to re-run the analysis done in Pebesma and Duin (2004; see references 28 | below). If you want to use these data for comparison with PCB measurements 29 | elsewhere, or if you want to compare them to regulation standards, or 30 | want to use these data for any other purpose, you should first contact 31 | \url{mailto:basisinfodesk@rikz.rws.minvenw.nl}. The reason for this is 32 | that several normalisations were carried out that are not reported here, 33 | nor in the paper below. } 34 | 35 | \references{ 36 | Pebesma, E. J., and Duin, R. N. M. (2005). Spatial patterns of temporal 37 | change in North Sea sediment quality on different spatial scales. In 38 | P. Renard, H. Demougeot-Renard and R. Froidevaux (Eds.), Geostatistics for 39 | Environmental Applications: Proceedings of the Fifth European Conference 40 | on Geostatistics for Environmental Applications (pp. 367-378): Springer. 41 | } 42 | 43 | \seealso{\link{ncp.grid}} 44 | \keyword{datasets} 45 | \examples{ 46 | data(pcb) 47 | library(lattice) 48 | xyplot(y~x|as.factor(yf), pcb, aspect = "iso") 49 | # demo(pcb) 50 | } 51 | -------------------------------------------------------------------------------- /man/plot.pointPairs.Rd: -------------------------------------------------------------------------------- 1 | % $Id: plot.pointPairs.Rd,v 1.5 2006-12-12 20:44:07 edzer Exp $ 2 | \name{plot.pointPairs} 3 | \alias{plot.pointPairs} 4 | \title{ 5 | Plot a point pairs, identified from a variogram cloud 6 | } 7 | \description{ 8 | Plot a point pairs, identified from a variogram cloud 9 | } 10 | \usage{ 11 | \method{plot}{pointPairs}(x, data, xcol = data$x, ycol = data$y, xlab = "x coordinate", 12 | ylab = "y coordinate", col.line = 2, line.pch = 0, main = "selected point pairs", ...) 13 | } 14 | \arguments{ 15 | \item{x}{ object of class "pointPairs", obtained from the function 16 | \link{plot.variogramCloud}, containing point pair indices } 17 | \item{data}{ data frame to which the indices refer (from which the 18 | variogram cloud was calculated) } 19 | \item{xcol}{ numeric vector with x-coordinates of data } 20 | \item{ycol}{ numeric vector with y-coordinates of data } 21 | \item{xlab}{ x-axis label } 22 | \item{ylab}{ y-axis label } 23 | \item{col.line}{ color for lines connecting points } 24 | \item{line.pch}{ if non-zero, symbols are also plotted at the middle of 25 | line segments, to mark lines too short to be visible on the plot; 26 | the color used is \code{col.line}; the value passed to this argument 27 | will be used as plotting symbol (pch) } 28 | \item{main}{ title of plot } 29 | \item{...}{ arguments, further passed to \code{xyplot}} 30 | } 31 | \value{ 32 | plots the data locations, with lines connecting the point pairs identified 33 | (and refered to by indices in) x 34 | } 35 | \references{ \url{http://www.gstat.org}} 36 | \author{ Edzer Pebesma } 37 | \seealso{ 38 | \link{plot.variogramCloud} 39 | } 40 | \examples{ 41 | ### The following requires interaction, and is therefore outcommented 42 | #data(meuse) 43 | #coordinates(meuse) = ~x+y 44 | #vgm1 <- variogram(log(zinc)~1, meuse, cloud = TRUE) 45 | #pp <- plot(vgm1, id = TRUE) 46 | ### Identify the point pairs 47 | #plot(pp, data = meuse) # meuse has x and y as coordinates 48 | } 49 | \keyword{dplot} 50 | -------------------------------------------------------------------------------- /man/progress.Rd: -------------------------------------------------------------------------------- 1 | % $Id: hscat.Rd,v 1.3 2008-02-04 10:06:44 edzer Exp $ 2 | \name{progress} 3 | \alias{get_gstat_progress} 4 | \alias{set_gstat_progress} 5 | \title{ Get or set progress indicator } 6 | \description{ Get or set progress indicator } 7 | \usage{ 8 | get_gstat_progress() 9 | set_gstat_progress(value) 10 | } 11 | \arguments{ 12 | \item{value}{ logical } 13 | } 14 | \value{ 15 | return the logical value indicating whether progress bars should be given 16 | } 17 | \author{ Edzer Pebesma } 18 | 19 | \examples{ 20 | set_gstat_progress(FALSE) 21 | get_gstat_progress() 22 | } 23 | \keyword{models} 24 | -------------------------------------------------------------------------------- /man/show.vgms.Rd: -------------------------------------------------------------------------------- 1 | % $Id: show.vgms.Rd,v 1.7 2008-12-15 14:27:29 edzer Exp $ 2 | \name{show.vgms} 3 | \alias{show.vgms} 4 | \title{ 5 | Plot Variogram Model Functions 6 | } 7 | \description{ 8 | Creates a trellis plot for a range of variogram models, possibly with nugget; 9 | and optionally a set of Matern models with varying smoothness. 10 | } 11 | \usage{ 12 | show.vgms(min = 1e-12 * max, max = 3, n = 50, sill = 1, range = 1, 13 | models = as.character(vgm()$short[c(1:17)]), nugget = 0, kappa.range = 0.5, 14 | plot = TRUE, ..., as.groups = FALSE) 15 | } 16 | \arguments{ 17 | \item{min}{ numeric; start distance value for semivariance calculation 18 | beyond the first point at exactly zero } 19 | \item{max}{ numeric; maximum distance for semivariance calculation 20 | and plotting } 21 | \item{n}{ integer; number of points to calculate distance values } 22 | \item{sill}{ numeric; (partial) sill(s) of the variogram model } 23 | \item{range}{ numeric; range(s) of the variogram model } 24 | \item{models}{ character; variogram model(s) to be plotted } 25 | \item{nugget}{ numeric; nugget component(s) for variogram models } 26 | \item{kappa.range}{ numeric; if this is a vector with more than one 27 | element, only a range of Matern models is plotted with these kappa 28 | values } 29 | \item{plot}{ logical; if TRUE, a plot is returned with the models 30 | specified; if FALSE, the data prepared for this plot is returned } 31 | \item{...}{ passed on to the call to xyplot } 32 | \item{as.groups}{ logical; if TRUE, different models are plotted with 33 | different lines in a single panel, else, in one panel per model } 34 | } 35 | \value{ 36 | returns a (Trellis) plot of the variogram models requested; see 37 | examples. I do currently have strong doubts about the ``correctness'' 38 | of the ``Hol'' model. The ``Spl'' model does seem to need a very 39 | large range value (larger than the study area?) to be of some value. 40 | 41 | If plot is FALSE, a data frame with the data prepared to plot 42 | is being returned. 43 | } 44 | \references{ \url{http://www.gstat.org}} 45 | \author{ Edzer Pebesma } 46 | \note{ the \code{min} argument is supplied because the variogram 47 | function may be discontinuous at distance zero, surely when a positive 48 | nugget is present. } 49 | \seealso{ 50 | \link{vgm}, \link{variogramLine}, 51 | } 52 | \examples{ 53 | show.vgms() 54 | show.vgms(models = c("Exp", "Mat", "Gau"), nugget = 0.1) 55 | # show a set of Matern models with different smoothness: 56 | show.vgms(kappa.range = c(.1, .2, .5, 1, 2, 5, 10), max = 10) 57 | # show a set of Exponential class models with different shape parameter: 58 | show.vgms(kappa.range = c(.05, .1, .2, .5, 1, 1.5, 1.8, 1.9, 2), models = "Exc", max = 10) 59 | # show a set of models with different shape parameter of M. Stein's representation of the Matern: 60 | show.vgms(kappa.range = c(.01, .02, .05, .1, .2, .5, 1, 2, 5, 1000), models = "Ste", max = 2) 61 | 62 | } 63 | 64 | \keyword{dplot} 65 | -------------------------------------------------------------------------------- /man/sic97.Rd: -------------------------------------------------------------------------------- 1 | % $Id: sic97.Rd,v 1.2 2008-10-30 13:47:05 edzer Exp $ 2 | \name{sic97} 3 | \alias{sic_obs} 4 | \alias{sic_full} 5 | \alias{demstd} 6 | \title{ Spatial Interpolation Comparison 1997 data set: Swiss Rainfall} 7 | \description{ 8 | The text below is copied from the data item at ai-geostats, 9 | (link no longer working). 10 | } 11 | 12 | \format{ 13 | The data frames contain the following columns: 14 | \describe{ 15 | \item{ID}{this integer value is the number (unique value) of 16 | the monitoring station} 17 | \item{rainfall}{ rainfall amount, in 10th of mm } 18 | } 19 | } 20 | \note{ 21 | See the pdf that accompanies the original file for a description of the data. 22 | The .dxf file with the Swiss border is not included here. 23 | } 24 | 25 | \usage{ 26 | data(sic97) # 27 | } 28 | \author{ 29 | Gregoire Dubois and others. 30 | } 31 | 32 | \keyword{datasets} 33 | \examples{ 34 | data(sic97) 35 | image(demstd) 36 | points(sic_full, pch=1) 37 | points(sic_obs, pch=3) 38 | } 39 | -------------------------------------------------------------------------------- /man/spplot.vcov.Rd: -------------------------------------------------------------------------------- 1 | % $Id: spplot.vcov.Rd,v 1.2 2007-11-16 12:59:47 edzer Exp $ 2 | \name{spplot.vcov} 3 | \alias{spplot.vcov} 4 | \title{ Plot map matrix of prediction error variances and covariances } 5 | \description{ 6 | Plot map matrix of prediction error variances and covariances 7 | } 8 | \usage{ 9 | spplot.vcov(x, ...) 10 | } 11 | \arguments{ 12 | \item{x}{ Object of class SpatialPixelsDataFrame or SpatialGridDataFrame, 13 | resulting from a krige call with multiple variables (cokriging } 14 | \item{...}{remaining arguments passed to spplot } 15 | } 16 | \value{ The plotted object, of class trellis; see \code{spplot} in 17 | package \pkg{sp}. } 18 | \author{ Edzer Pebesma } 19 | \keyword{dplot} 20 | 21 | -------------------------------------------------------------------------------- /man/variogramLine.Rd: -------------------------------------------------------------------------------- 1 | % $Id: variogramLine.Rd,v 1.3 2008-08-19 07:27:02 edzer Exp $ 2 | \name{variogramLine} 3 | \alias{variogramLine} 4 | \alias{getGammas} 5 | \title{ Semivariance Values For a Given Variogram Model } 6 | \description{ Generates a semivariance values given a variogram model } 7 | \usage{ 8 | variogramLine(object, maxdist, n = 200, min = 1.0e-6 * maxdist, 9 | dir = c(1,0,0), covariance = FALSE, ..., dist_vector, debug.level = 0) 10 | } 11 | \arguments{ 12 | \item{object}{ variogram model for which we want semivariance function values } 13 | \item{maxdist}{ maximum distance for which we want semivariance values } 14 | \item{n}{ number of points } 15 | \item{min}{ minimum distance; a value slightly larger than zero is usually 16 | used to avoid the discontinuity at distance zero if a nugget component is 17 | present } 18 | \item{dir}{ direction vector: unit length vector pointing the direction in 19 | x (East-West), y (North-South) and z (Up-Down) } 20 | \item{covariance}{logical; if TRUE return covariance values, otherwise 21 | return semivariance values } 22 | \item{...}{ignored} 23 | \item{dist_vector}{numeric vector or matrix with distance values} 24 | \item{debug.level}{gstat internal debug level} 25 | } 26 | \value{ 27 | a data frame of dimension (\code{n} x 2), with columns distance and gamma 28 | (semivariances or covariances), or in case \code{dist_vector} is a matrix, a 29 | conforming matrix with semivariance/covariance values is returned. 30 | } 31 | \note{variogramLine is used to generate data for plotting a variogram model.} 32 | \author{ Edzer Pebesma } 33 | \seealso{ \link{plot.gstatVariogram}} 34 | 35 | \examples{ 36 | variogramLine(vgm(5, "Exp", 10, 5), 10, 10) 37 | # anisotropic variogram, plotted in E-W direction: 38 | variogramLine(vgm(1, "Sph", 10, anis=c(0,0.5)), 10, 10) 39 | # anisotropic variogram, plotted in N-S direction: 40 | variogramLine(vgm(1, "Sph", 10, anis=c(0,0.5)), 10, 10, dir=c(0,1,0)) 41 | variogramLine(vgm(1, "Sph", 10, anis=c(0,0.5)), dir=c(0,1,0), dist_vector = 0.5) 42 | variogramLine(vgm(1, "Sph", 10, anis=c(0,0.5)), dir=c(0,1,0), dist_vector = c(0, 0.5, 0.75)) 43 | } 44 | 45 | \keyword{models} 46 | -------------------------------------------------------------------------------- /man/variogramSurface.Rd: -------------------------------------------------------------------------------- 1 | \name{variogramSurface} 2 | \alias{variogramSurface} 3 | \title{Semivariance values for a given spatio-temporal variogram model} 4 | \description{ 5 | Generates a surface of semivariance values given a spatio-temporal variogram model (one of separable, productSum, sumMetric, simpleSumMetric or metric) 6 | } 7 | \usage{ 8 | variogramSurface(model, dist_grid, covariance = FALSE) 9 | } 10 | 11 | \arguments{ 12 | \item{model}{ 13 | A spatio-temporal variogram model generated through \code{\link{vgmST}} or \code{\link{fit.StVariogram}}. 14 | } 15 | \item{dist_grid}{ 16 | A data.frame with two columns: \code{spacelag} and \code{timelag}. 17 | } 18 | \item{covariance}{ 19 | Whether the covariance should be computed instead of the variogram (default: FALSE). 20 | } 21 | } 22 | \value{ 23 | A data.frame with columns \code{spacelag}, \code{timelag} and \code{gamma}. 24 | } 25 | \author{ 26 | Benedikt Graeler 27 | } 28 | \seealso{ 29 | See \code{\link{variogramLine}} for the spatial version and \code{\link{fit.StVariogram}} for the estimation of spatio-temporal variograms. 30 | } 31 | \examples{ 32 | separableModel <- vgmST("separable", 33 | space=vgm(0.86, "Exp", 476, 0.14), 34 | time =vgm( 1, "Exp", 3, 0), 35 | sill=113) 36 | 37 | data(vv) 38 | 39 | if(require(lattice)) { 40 | plot(vv, separableModel, wireframe=TRUE, all=TRUE) 41 | } 42 | 43 | # plotting of sample and model variogram 44 | plot(vv, separableModel) 45 | 46 | } 47 | \keyword{models} 48 | \keyword{spatio-temporal} 49 | -------------------------------------------------------------------------------- /man/vgm.panel.Rd: -------------------------------------------------------------------------------- 1 | % $Id: vgm.panel.Rd,v 1.3 2008-10-30 13:47:05 edzer Exp $ 2 | \name{vgm.panel.xyplot} 3 | \alias{vgm.panel.xyplot} 4 | \alias{panel.pointPairs} 5 | \title{ panel functions for most of the variogram plots through lattice } 6 | \description{ 7 | Variogram plots contain symbols and lines; more control over them can 8 | be gained by writing your own panel functions, or extending the ones 9 | described here; see examples. 10 | } 11 | \usage{ 12 | vgm.panel.xyplot(x, y, subscripts, type = "p", pch = plot.symbol$pch, 13 | col, col.line = plot.line$col, col.symbol = plot.symbol$col, 14 | lty = plot.line$lty, cex = plot.symbol$cex, ids, lwd = plot.line$lwd, 15 | model = model, direction = direction, labels, shift = shift, mode = mode, ...) 16 | panel.pointPairs(x, y, type = "p", pch = plot.symbol$pch, col, col.line = 17 | plot.line$col, col.symbol = plot.symbol$col, lty = plot.line$lty, 18 | cex = plot.symbol$cex, lwd = plot.line$lwd, pairs = pairs, 19 | line.pch = line.pch, ...) 20 | } 21 | \arguments{ 22 | \item{x}{ x coordinates of points in this panel} 23 | \item{y}{ y coordinates of points in this panel} 24 | \item{subscripts }{ subscripts of points in this panel} 25 | \item{type}{ plot type: "l" for connected lines } 26 | \item{pch}{ plotting symbol } 27 | \item{col}{ symbol and line color (if set) } 28 | \item{col.line}{ line color } 29 | \item{col.symbol}{ symbol color } 30 | \item{lty}{ line type for variogram model } 31 | \item{cex}{ symbol size } 32 | \item{ids}{ gstat model ids } 33 | \item{lwd}{ line width } 34 | \item{model}{ variogram model } 35 | \item{direction}{ direction vector \code{c(dir.horizontal, dir.ver)}} 36 | \item{labels}{ labels to plot next to points } 37 | \item{shift}{ amount to shift the label right of the symbol } 38 | \item{mode}{ to be set by calling function only } 39 | \item{line.pch}{ symbol type to be used for point of selected point pairs, e.g. 40 | to highlight point pairs with distance close to zero } 41 | \item{pairs}{ two-column matrix with pair indexes to be highlighted } 42 | \item{...}{ parameters that get passed to \link[lattice]{lpoints} } 43 | } 44 | \value{ 45 | ignored; the enclosing function returns a plot of class \code{trellis} 46 | } 47 | \references{ \url{http://www.gstat.org/} } 48 | \author{ Edzer Pebesma } 49 | \seealso{ \link{plot.gstatVariogram}, \link{vgm}} 50 | \examples{ 51 | library(sp) 52 | data(meuse) 53 | coordinates(meuse) <- c("x", "y") 54 | library(lattice) 55 | mypanel = function(x,y,...) { 56 | vgm.panel.xyplot(x,y,...) 57 | panel.abline(h=var(log(meuse$zinc)), color = 'red') 58 | } 59 | plot(variogram(log(zinc)~1,meuse), panel = mypanel) 60 | } 61 | \keyword{models} 62 | -------------------------------------------------------------------------------- /man/vgmArea.Rd: -------------------------------------------------------------------------------- 1 | % $Id: variogramLine.Rd,v 1.3 2008-08-19 07:27:02 edzer Exp $ 2 | \name{vgmArea} 3 | \alias{vgmArea} 4 | \title{ point-point, point-area or area-area semivariance } 5 | \description{ Compute point-point, point-area or area-area variogram values from point model } 6 | \usage{ 7 | vgmArea(x, y = x, vgm, ndiscr = 16, verbose = FALSE, covariance = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{ object of class \link[sp]{SpatialPoints} or \link[sp]{SpatialPolygons}} 11 | \item{y}{ object of class \link[sp]{SpatialPoints} or \link[sp]{SpatialPolygons}} 12 | \item{vgm}{ variogram model, see \link{vgm}} 13 | \item{ndiscr}{ number of points to discretize an area, using \link[sp]{spsample}} 14 | \item{verbose}{ give progress bar } 15 | \item{covariance}{ logical; compute covariances, rather than semivariances? } 16 | } 17 | \value{ semivariance or covariance matrix of dimension \code{length(x)} x \code{lenght(y)}} 18 | 19 | \author{ Edzer Pebesma } 20 | 21 | \examples{ 22 | library(sp) 23 | demo(meuse, ask = FALSE, echo = FALSE) 24 | vgmArea(meuse[1:5,], vgm = vgm(1, "Exp", 1000)) # point-point 25 | vgmArea(meuse[1:5,], meuse.area, vgm = vgm(1, "Exp", 1000)) # point-area 26 | } 27 | 28 | \keyword{models} 29 | -------------------------------------------------------------------------------- /man/vgmAreaST.Rd: -------------------------------------------------------------------------------- 1 | \name{vgmAreaST} 2 | \alias{vgmAreaST} 3 | \title{ 4 | Function that returns the covariances for areas 5 | } 6 | \description{ 7 | Function that returns the covariances for areas based on spatio-temporal point variograms for use in the spatio-temporal area-to-point kriging 8 | } 9 | \usage{ 10 | vgmAreaST(x, y = x, model, ndiscrSpace = 16, verbose = FALSE, covariance = TRUE) 11 | } 12 | \arguments{ 13 | \item{x}{spatio-temporal data frame} 14 | \item{y}{spatio-temporal data frame} 15 | \item{model}{spatio-temporal variogram model for point support} 16 | \item{ndiscrSpace}{number of discretisation in space} 17 | \item{verbose}{Boolean: default to FALSE, set to TRUE for debugging} 18 | \item{covariance}{Boolean: whether the covariance shall be evaluated, currently disfunction and set to TRUE} 19 | } 20 | \value{The covariance between 'x' and 'y'.} 21 | \author{Benedikt Graeler} 22 | 23 | \seealso{\code{\link{vgmArea}}} 24 | \examples{ 25 | # see demo('a2pinST') 26 | } 27 | -------------------------------------------------------------------------------- /man/vv.Rd: -------------------------------------------------------------------------------- 1 | \name{vv} 2 | \alias{vv} 3 | \title{Precomputed variogram for PM10 in data set air} 4 | \description{ 5 | Precomputed variogram for PM10 in data set air 6 | } 7 | \format{ 8 | data set structure is explained in \link{variogramST}. 9 | } 10 | \usage{ 11 | data(vv) 12 | } 13 | \examples{ 14 | \dontrun{ 15 | # obtained by: 16 | library(spacetime) 17 | library(gstat) 18 | data(air) 19 | suppressWarnings(proj4string(stations) <- CRS(proj4string(stations))) 20 | rural = STFDF(stations, dates, data.frame(PM10 = as.vector(air))) 21 | rr = rural[,"2005::2010"] 22 | unsel = which(apply(as(rr, "xts"), 2, function(x) all(is.na(x)))) 23 | r5to10 = rr[-unsel,] 24 | vv = variogram(PM10~1, r5to10, width=20, cutoff = 200, tlags=0:5) 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /man/walker.Rd: -------------------------------------------------------------------------------- 1 | % $Id: walker.Rd,v 1.2 2006-02-10 19:03:27 edzer Exp $ 2 | \name{walker} 3 | \alias{walker} 4 | \alias{walker.exh} 5 | \title{Walker Lake sample and exhaustive data sets} 6 | \description{ 7 | This is the Walker Lake data sets (sample and exhaustive 8 | data set), used in Isaaks and Srivastava's Applied Geostatistics. 9 | } 10 | \format{ 11 | This data frame contains the following columns: 12 | \describe{ 13 | \item{Id}{Identification Number} 14 | \item{X}{Xlocation in meter} 15 | \item{Y}{Ylocation in meter} 16 | \item{V}{V variable, concentration in ppm} 17 | \item{U}{U variable, concentration in ppm} 18 | \item{T}{T variable, indicator variable} 19 | } 20 | } 21 | \usage{ 22 | data(walker) 23 | } 24 | \references{ 25 | Applied Geostatistics 26 | by Edward H. Isaaks, R. Mohan Srivastava; 27 | Oxford University Press. 28 | } 29 | \note{ This data sets was obtained from the data sets on 30 | ai-geostats (link no longer functioning) } 31 | \keyword{datasets} 32 | \examples{ 33 | library(sp) 34 | data(walker) 35 | summary(walker) 36 | summary(walker.exh) 37 | } 38 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 2 | PKG_CPPFLAGS = -DR_NO_REMAP 3 | -------------------------------------------------------------------------------- /src/block.h: -------------------------------------------------------------------------------- 1 | DATA *block_discr(DATA *d, const DPOINT *block, const DPOINT *where); 2 | void reset_block_discr(void); 3 | -------------------------------------------------------------------------------- /src/debug.h: -------------------------------------------------------------------------------- 1 | #ifndef DEBUG_H 2 | # define DEBUG_H /* avoid multiple inclusion */ 3 | 4 | extern int debug_level; 5 | 6 | /* 7 | * DEBUG macro's: 8 | */ 9 | #define DB_HELP (-1) /* print debug help */ 10 | #define DB_SILENT (0) 11 | #define DB_NORMAL (1UL << 0) 12 | #define DB_DUMP (1UL << 1) /* dump global variabels */ 13 | #define DB_FIT (1UL << 2) /* fit diagnostics */ 14 | #define DB_DATA (1UL << 3) /* drop data */ 15 | #define DB_SEL (1UL << 4) /* drop selection */ 16 | #define DB_COV (1UL << 5) /* drop covariances */ 17 | #define DB_ORDER (1UL << 6) /* order relation violation */ 18 | #define DB_FORCE (1UL << 7) /* print warning if neighbourhood selection */ 19 | #define DB_TRACE (1UL << 8) /* print numbers */ 20 | #define DB_BLOCK (1UL << 9) /* block discretization diagnostics (data) */ 21 | 22 | extern void printlog(const char *fmt, ...); 23 | #define DUMP(a); {if(debug_level & DB_DUMP) { printlog("%s", a); }} 24 | #define DEBUG_HELP (debug_level & DB_HELP) 25 | #define DEBUG_SILENT (debug_level == DB_SILENT) 26 | #define DEBUG_NORMAL (debug_level & DB_NORMAL) 27 | #define DEBUG_DUMP (debug_level & DB_DUMP) 28 | #define DEBUG_FIT (debug_level & DB_FIT) 29 | #define DEBUG_DATA (debug_level & DB_DATA) 30 | #define DEBUG_SEL (debug_level & DB_SEL) 31 | #define DEBUG_COV (debug_level & DB_COV) 32 | #define DEBUG_ORDER (debug_level & DB_ORDER) 33 | #define DEBUG_VGMFIT (debug_level & DB_ORDER) 34 | #define DEBUG_FORCE (debug_level & DB_FORCE) 35 | #define DEBUG_TRACE (debug_level & DB_TRACE) 36 | #define DEBUG_BLOCK (debug_level & DB_BLOCK) 37 | 38 | #define DEBUG_OPTIONS "\ 39 | # gstat debug option values:\n\ 40 | 0: no output, be silent (same as -s)\n\ 41 | 1: normal output (default value)\n\ 42 | 2: print all global variables and extended error messages\n\ 43 | 4: print OLS and WLS fit diagnostics\n\ 44 | 8: print all data\n\ 45 | 16: print every neighbourhood selection\n\ 46 | 32: print all covariance matrices, solutions, design matrices etc.\n\ 47 | 64: print variogram fit diagnostics and order relation violations\n\ 48 | 128: print warning on forced neighbourhoods\n\ 49 | 256: print current row,column or record number\n\ 50 | 512: print block discretization points (data)\n\ 51 | to combine options, sum their values -- 1023 invokes them all\n" 52 | 53 | #endif /* DEBUG_H */ 54 | -------------------------------------------------------------------------------- /src/defaults.h: -------------------------------------------------------------------------------- 1 | #ifndef DEFAULTS_H 2 | #include /* INT_MAX */ 3 | #include /* DBL_EPSILON */ 4 | # define DEFAULTS_H /* avoid multiple inclusion */ 5 | 6 | #define DEF_alpha 0.0 7 | #define DEF_beta 0.0 8 | #define DEF_blas 1 9 | #define DEF_bounds NULL 10 | #define DEF_coincide -1 11 | #define DEF_choleski 1 12 | #define DEF_cressie 0 13 | #define DEF_cutoff -1.0 14 | #define DEF_dots 500 15 | #define DEF_fit 0 16 | #define DEF_fit_limit 1.0E-5 17 | #define DEF_fraction 0.33333 /* fraction of max_dist for def. cutoff */ 18 | #define DEF_gauss 1 19 | #define DEF_gpterm NULL 20 | #define DEF_idp 2.0 21 | #define DEF_intervals 15 /* default number of intervals */ 22 | #define DEF_is_pdf 0 /* default to cdf indicator simulation */ 23 | #define DEF_iter 200 24 | #define DEF_iwidth -1.0 25 | #define DEF_jgraph 0 26 | #define DEF_lhs 0 27 | #define DEF_longlat 0 28 | #define DEF_n_marginals 0 29 | #define DEF_nocheck 0 /* do check */ 30 | #define DEF_marginal_names NULL 31 | #define DEF_marginal_values NULL 32 | #define DEF_nblockdiscr 4 33 | #define DEF_n_uk INT_MAX 34 | #define DEF_numbers 1 35 | #define DEF_nsim 1 36 | #define DEF_ofilename NULL 37 | #define DEF_order 0 38 | #define DEF_plotweights 0 39 | #define DEF_pairs 0 40 | #define DEF_quantile 0.5 41 | #define DEF_rowwise 1 42 | #define DEF_rp 1 43 | #define DEF_seed 0 44 | #define DEF_sim_beta 0 45 | #define DEF_sparse 0 46 | #define DEF_spiral 0 47 | #define DEF_split 4 48 | #define DEF_sym_ev 0 49 | #define DEF_table_size 0 50 | #define DEF_tol_hor 180.0 51 | #define DEF_tol_ver 180.0 52 | #define DEF_gls_residuals 0 53 | #define DEF_xvalid 0 54 | #define DEF_zero (DBL_EPSILON * 10.0) 55 | #define DEF_zero_est 0 /* ZERO_DEFAULT */ 56 | #define DEF_zmap 0.0 57 | 58 | #endif /* DEFAULTS_H */ 59 | -------------------------------------------------------------------------------- /src/defs.h: -------------------------------------------------------------------------------- 1 | /* 2 | * provides some definitions 3 | */ 4 | 5 | #ifndef DEFS_H 6 | #define DEFS_H /* avoid multiple inclusion */ 7 | 8 | #include /* but assertions are off, by default */ 9 | 10 | #define CDECL /* empty */ 11 | 12 | /* 13 | * several buffer sizes 14 | */ 15 | #define MAX_DATA 1250 /* not a maximum, but an increment step size */ 16 | #define INIT_N_VGMM 2 17 | /* 18 | * (for glvars.c:) something, not bigger than 127 19 | * because of user interface (crazy though) 20 | */ 21 | #define ERROR_BUFFER_SIZE 1280 22 | 23 | #endif /* DEFS_H */ 24 | -------------------------------------------------------------------------------- /src/direct.h: -------------------------------------------------------------------------------- 1 | double valid_direction(DPOINT *a, DPOINT *b, int symmetric, const DATA *d); 2 | void set_direction_values(double a, double b, double t_h, double t_v); 3 | -------------------------------------------------------------------------------- /src/fit.h: -------------------------------------------------------------------------------- 1 | #ifndef FIT_H 2 | # define FIT_H 3 | 4 | #if defined(__cplusplus) 5 | extern "C" { 6 | #endif 7 | 8 | int fit_variogram(VARIOGRAM *v); 9 | 10 | #if defined(__cplusplus) 11 | } 12 | #endif 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /src/gcdist.c: -------------------------------------------------------------------------------- 1 | #include /* sin() etc */ 2 | 3 | #include 4 | #include 5 | #include 6 | #define POWDI(x,i) R_pow_di(x,i) 7 | 8 | #include "gcdist.h" 9 | 10 | double gstat_gcdist(double lon1, double lon2, double lat1, double lat2) { 11 | /* http://home.att.net/~srschmitt/script_greatcircle.html */ 12 | /* taken from R package sp source; Copyright by Roger Bivand (C) 2005 */ 13 | 14 | double F, G, L, sinG2, cosG2, sinF2, cosF2, sinL2, cosL2, S, C; 15 | double w, R, a, f, D, H1, H2; 16 | double lat1R, lat2R, lon1R, lon2R, DE2RA; 17 | 18 | if (lon1 == lon2 && lat1 == lat2) 19 | return 0.0; 20 | 21 | DE2RA = M_PI/180; 22 | a = 6378.137; /* WGS-84 equatorial radius in km */ 23 | f = 1.0/298.257223563; /* WGS-84 ellipsoid flattening factor */ 24 | 25 | lat1R = lat1 * DE2RA; 26 | lat2R = lat2 * DE2RA; 27 | lon1R = lon1 * DE2RA; 28 | lon2R = lon2 * DE2RA; 29 | 30 | F = (lat1R + lat2R) / 2.0; 31 | G = (lat1R - lat2R) / 2.0; 32 | L = (lon1R - lon2R) / 2.0; 33 | 34 | sinG2 = POWDI(sin(G), 2); 35 | cosG2 = POWDI(cos(G), 2); 36 | sinF2 = POWDI(sin(F), 2); 37 | cosF2 = POWDI(cos(F), 2); 38 | sinL2 = POWDI(sin(L), 2); 39 | cosL2 = POWDI(cos(L), 2); 40 | 41 | S = sinG2 * cosL2 + cosF2 * sinL2; 42 | C = cosG2 * cosL2 + sinF2 * sinL2; 43 | 44 | w = atan(sqrt(S / C)); 45 | R = sqrt(S * C) / w; 46 | 47 | D = 2 * w * a; 48 | H1 = (3 * R - 1)/(2 * C); 49 | H2 = (3 * R + 1)/(2 * S); 50 | 51 | return D * (1 + f * H1 * sinF2 * cosG2 - f * H2 * cosF2 * sinG2); 52 | } 53 | -------------------------------------------------------------------------------- /src/gcdist.h: -------------------------------------------------------------------------------- 1 | double gstat_gcdist(double lon1, double lon2, double lat1, double lat2); 2 | -------------------------------------------------------------------------------- /src/getest.h: -------------------------------------------------------------------------------- 1 | void get_est(DATA **data, METHOD method, DPOINT *where, double *est); 2 | -------------------------------------------------------------------------------- /src/gls.h: -------------------------------------------------------------------------------- 1 | enum GLS_WHAT { 2 | GLS_BLUE /* generalized least squares best linear unbiased estimate */, 3 | GLS_BLUP /* gls best linear unbiased predictor */, 4 | GLS_BLP /* gls best linear predictor */, 5 | UPDATE /* update estimate: use previously calculated weights */, 6 | GLS_INIT /* initial value */ 7 | }; 8 | 9 | void gls(DATA **d, int n_vars, enum GLS_WHAT pred, DPOINT *where, double *est); 10 | double *make_gls(DATA *d, int calc_residuals); 11 | double *make_gls_mv(DATA **d, int n_vars); 12 | void free_glm(void *v_glm); 13 | -------------------------------------------------------------------------------- /src/glvars.h: -------------------------------------------------------------------------------- 1 | #ifndef GLVARS_H 2 | # define GLVARS_H /* avoid multiple inclusion */ 3 | 4 | typedef enum { 5 | NSP = 0, /* initial value */ 6 | UIF, /* variogram modelling user interface */ 7 | OKR, UKR, SKR, /* ordinary, universal or simple kriging */ 8 | IDW, /* inverse distance interpolation */ 9 | MED, /* (local) sample median or quantile */ 10 | NRS, /* neighbourhood size */ 11 | LSLM, /* uncorrelated (or weighted) linear model */ 12 | GSI, ISI, /* Gaussian/indicator (conditional) simulation */ 13 | SEM, COV, /* sample (cross) semivariance or covariance */ 14 | SPREAD, /* distance to nearest sample */ 15 | DIV, /* diversity, range */ 16 | SKEW, /* skewness, kurtosis */ 17 | LSEM, /* locally fitted semivariogram parameters */ 18 | TEST /* does nothing really */ 19 | } METHOD; 20 | 21 | typedef struct { 22 | METHOD m; 23 | int is_simulation; 24 | const char *name; 25 | } METHODS; 26 | 27 | extern const METHODS methods[]; 28 | 29 | typedef enum { 30 | MODE_NSP = 0, 31 | SIMPLE, 32 | STRATIFY, 33 | MULTIVARIABLE 34 | } MODE; 35 | 36 | #if defined(__cplusplus) 37 | extern "C" { 38 | #endif 39 | 40 | int init_global_variables(void); 41 | const char *get_outfile_namei(int i); 42 | const char **get_outfile_name(void); 43 | int dump_all(void); 44 | void check_global_variables(void); 45 | const char *method_string(METHOD i); 46 | int get_n_vars(void); 47 | int get_n_vgms(void); 48 | int get_n_outputs(void); 49 | int get_n_beta_set(void); 50 | int which_identifier(const char *id); 51 | const char *name_identifier(int i); 52 | void push_bound(double value); 53 | void set_method(METHOD); 54 | int is_simulation(METHOD m); 55 | METHOD get_default_method(void); 56 | METHOD get_method(void); 57 | void set_mode(void); 58 | MODE get_mode(void); 59 | double max_block_dimension(int reset); 60 | int n_variograms_set(void); 61 | int decide_on_coincide(void); 62 | int remove_id(const int id); 63 | void remove_all(void); 64 | 65 | #ifdef VARIO_H /* vario.h was included before this point: */ 66 | VARIOGRAM *get_vgm(int i); 67 | #endif 68 | 69 | #ifdef DATA_H /* data.h was included before this point: */ 70 | DATA **get_gstat_data(void); 71 | DATA *get_dataval(void); 72 | DATA *get_data_area(void); 73 | DATA *create_data_area(void); 74 | DPOINT *get_block_p(void); 75 | void setup_valdata_X(DATA *d); 76 | #endif 77 | 78 | #if defined(__cplusplus) 79 | } 80 | #endif 81 | 82 | extern int gl_nblockdiscr, gl_seed, gl_n_uk, gl_cressie, gl_zero_est, 83 | gl_fit, gl_iter, gl_xvalid, gl_gauss, gl_sym_ev, gl_jgraph, gl_blas, 84 | gl_order, gl_n_intervals, gl_gls_residuals, gl_asym_vgm, 85 | gl_numbers, gl_nsim, gl_lhs, gl_longlat, gl_n_marginals, gl_sparse, gl_rp, 86 | gl_coincide, gl_nocheck, gl_spiral, gl_secure, gl_split, 87 | gl_register_pairs, gl_sim_beta, gl_rowwise, gl_choleski; 88 | extern double gl_rho, gl_idp, gl_cutoff, gl_iwidth, gl_zmap, 89 | gl_quantile, gl_fit_limit, gl_fraction, gl_alpha, 90 | gl_beta, gl_tol_hor, gl_tol_ver, *gl_bounds, 91 | *gl_marginal_values, gl_zero, gl_zero2; 92 | 93 | extern const char *method_code[]; 94 | 95 | #endif /* GLVARS_H */ 96 | -------------------------------------------------------------------------------- /src/init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // for NULL 4 | #include 5 | 6 | extern SEXP gstat_init(SEXP s_debug_level); 7 | extern SEXP gstat_load_ev(SEXP np, SEXP dist, SEXP gamma); 8 | extern SEXP gstat_fit_variogram(SEXP fit, SEXP fit_sill, SEXP fit_range); 9 | extern SEXP gstat_exit(SEXP x); 10 | extern SEXP gstat_new_data(SEXP sy, SEXP slocs, SEXP sX, SEXP has_intercept, 11 | SEXP beta, SEXP nmax, SEXP nmin, SEXP maxdist, SEXP force, 12 | SEXP vfn, SEXP sw, SEXP grid, SEXP degree, SEXP is_projected, 13 | SEXP vdist, SEXP lambda, SEXP omax); 14 | extern SEXP gstat_new_dummy_data(SEXP loc_dim, SEXP has_intercept, SEXP beta, 15 | SEXP nmax, SEXP nmin, SEXP maxdist, SEXP vfn, SEXP is_projected, 16 | SEXP vdist); 17 | extern SEXP gstat_debug_level(SEXP level); 18 | extern SEXP gstat_load_variogram(SEXP s_ids, SEXP s_model, SEXP s_sills, SEXP s_ranges, 19 | SEXP s_kappas, SEXP s_anis_all, SEXP s_table, SEXP s_max_val); 20 | extern SEXP gstat_predict(SEXP sn, SEXP slocs, SEXP sX, SEXP block_cols, SEXP block, 21 | SEXP weights, SEXP nsim, SEXP blue); 22 | extern SEXP gstat_set_method(SEXP to); 23 | extern SEXP gstat_set_set(SEXP arg, SEXP val); 24 | extern SEXP gstat_set_merge(SEXP a, SEXP b, SEXP c, SEXP d); 25 | extern SEXP gstat_variogram(SEXP s_ids, SEXP cutoff, SEXP width, SEXP direction, 26 | SEXP cressie, SEXP dX, SEXP boundaries, SEXP grid, SEXP cov, 27 | SEXP pseudo); 28 | extern SEXP gstat_variogram_values(SEXP ids, SEXP pars, SEXP covariance, SEXP dist_values); 29 | extern SEXP gstat_get_variogram_models(SEXP dolong); 30 | 31 | #define CALLDEF(name, n) {#name, (DL_FUNC) &name, n} 32 | 33 | const static R_CallMethodDef R_CallDef[] = { 34 | CALLDEF(gstat_init, 1), 35 | CALLDEF(gstat_load_ev, 3), 36 | CALLDEF(gstat_fit_variogram, 3), 37 | CALLDEF(gstat_exit, 1), 38 | CALLDEF(gstat_new_data, 17), 39 | CALLDEF(gstat_new_dummy_data, 9), 40 | CALLDEF(gstat_debug_level, 1), 41 | CALLDEF(gstat_load_variogram, 8), 42 | CALLDEF(gstat_predict, 8), 43 | CALLDEF(gstat_set_method, 1), 44 | CALLDEF(gstat_set_set, 2), 45 | CALLDEF(gstat_set_merge, 4), 46 | CALLDEF(gstat_variogram, 10), 47 | CALLDEF(gstat_variogram_values, 4), 48 | CALLDEF(gstat_get_variogram_models, 1), 49 | {NULL, NULL, 0} 50 | }; 51 | 52 | void 53 | // attribute_visible // optional 54 | R_init_gstat(DllInfo *dll) 55 | { 56 | R_registerRoutines(dll, NULL, R_CallDef, NULL, NULL); 57 | R_useDynamicSymbols(dll, FALSE); 58 | R_forceSymbols(dll, TRUE); 59 | } 60 | -------------------------------------------------------------------------------- /src/lm.h: -------------------------------------------------------------------------------- 1 | #ifndef LM_H 2 | # define LM_H 3 | void pred_lm(DATA **data, int n_vars, DPOINT *where, double *est); 4 | void make_residuals_lm(DATA *d); 5 | double *make_ols(DATA *d); 6 | 7 | MAT *get_X(DATA **d, MAT *X, int nvars); 8 | MAT *get_X0(DATA **d, MAT *X0, DPOINT *where, int nvars); 9 | double calc_mu(const DATA *d, const DPOINT *pt); 10 | VEC *get_y(DATA **d, VEC *y, int nvars); 11 | int is_singular(MAT *X, double epsilon); 12 | 13 | typedef struct { 14 | VEC *beta, /* parameter vector */ 15 | *y, /* data vector */ 16 | *Xty, /* X'y */ 17 | *weights; /* weights in a WLS model: V-1, 1/sigma^2_i */ 18 | MAT *X, /* design matrix */ 19 | *Cov, /* covariance matrix of beta */ 20 | *Chol; /* Choleski decomposition of X'X or X'V-1X */ 21 | double MSErr, /* Mean Square Error */ 22 | MSReg, /* Mean Square due to regression */ 23 | SSErr, /* Sum of Squares error */ 24 | SSReg; /* Sum of Squares regression */ 25 | int dfE, /* degrees of freedom error */ 26 | dfReg, /* degrees of freedom regression */ 27 | is_singular, /* flag if X'X is singular */ 28 | has_intercept; /* model has intercept, J is part of X */ 29 | } LM ; 30 | 31 | LM *calc_lm(LM *lm); 32 | void logprint_lm(DATA *d, LM *lm); 33 | 34 | LM *init_lm(LM *lm); 35 | void free_lm(LM *lm); 36 | 37 | #endif /* LM_H */ 38 | -------------------------------------------------------------------------------- /src/msim.h: -------------------------------------------------------------------------------- 1 | void save_sim(DATA **data, DPOINT *where, int sim, int n_vars, 2 | const double *value, int *is_pt); 3 | void save_sim_strat(DATA *d, DPOINT *where, int sim, double value, int is_pt); 4 | void restore_data_sel(DATA **data, int sim, int n_vars); 5 | void save_simulations_to_ascii(const char *fname); 6 | void save_simulations_to_maps(GRIDMAP *mask); 7 | void lhs(DATA **d, int n_vars, int stratify); 8 | void init_simulations(DATA **d); 9 | void set_beta(DATA **d, int sim, int n_vars, METHOD method); 10 | void setup_beta(DATA **d, int n_vars, int n_sim); 11 | void print_sim(void); 12 | void free_simulations(void); 13 | float ***get_msim(void); 14 | -------------------------------------------------------------------------------- /src/mtrx.h: -------------------------------------------------------------------------------- 1 | #ifndef MTRXH 2 | # define MTRXH 3 | /* interface copied from meschach; implementation rewritten from scratch */ 4 | typedef struct { 5 | size_t m, n, /* #rows, #cols */ 6 | max; /* max size, memory allocated */ 7 | double *v; 8 | } MAT; /* dense matrix */ 9 | #define ME(X,i,j) X->v[j * X->m + i] /* row i, column j, column-major access */ 10 | 11 | typedef struct { 12 | size_t dim, max; 13 | double *ve; 14 | } VEC; /* vector: row or column, whatever matches */ 15 | 16 | typedef struct { 17 | size_t size, max; 18 | int *pe; 19 | } PERM; 20 | 21 | typedef struct { 22 | size_t size, max; 23 | int *ive; 24 | } IVEC; 25 | 26 | #define PNULL (PERM *) NULL 27 | #define MNULL (MAT *) NULL 28 | #define VNULL (VEC *) NULL 29 | #define IVNULL (IVEC *) NULL 30 | 31 | #define M_FREE(x) { if (x != NULL) m_free(x); x = MNULL; } 32 | #define V_FREE(x) { if (x != NULL) v_free(x); x = VNULL; } 33 | #define P_FREE(x) { if (x != NULL) px_free(x); x = PNULL; } 34 | void m_free(MAT *m); 35 | void v_free(VEC *v); 36 | void iv_free(IVEC *v); 37 | void px_free(PERM *p); 38 | #define m_get(i,j) m_resize(MNULL, i, j) 39 | #define v_get(i) v_resize(VNULL, i) 40 | 41 | MAT *m_resize(MAT *mat, size_t m, size_t n); 42 | VEC *v_resize(VEC *v, size_t n); 43 | PERM *px_resize(PERM *p, size_t n); 44 | IVEC *iv_resize(IVEC *v, size_t n); 45 | MAT *m_zero(MAT *m); 46 | VEC *v_zero(VEC *v); 47 | MAT *m_inverse(MAT *in, int *info); 48 | VEC *vm_mlt(MAT *m, VEC *v, VEC *out); 49 | VEC *mv_mlt(MAT *m, VEC *v, VEC *out); 50 | MAT *m_mlt(MAT *m1, MAT *m2, MAT *out); 51 | MAT *mtrm_mlt(MAT *m1, MAT *m2, MAT *out); 52 | VEC *v_sub(VEC *v1, VEC *v2, VEC *out); 53 | MAT *m_sub(MAT *m1, MAT *m2, MAT *out); 54 | VEC *v_add(VEC *v1, VEC *v2, VEC *out); 55 | VEC *sv_mlt(double s, VEC *v1, VEC *v2); 56 | MAT *m_add(MAT *m1, MAT *m2, MAT *out); 57 | MAT *m_copy(MAT *in, MAT *out); 58 | VEC *v_copy(VEC *in, VEC *out); 59 | double v_norm2(VEC *v); 60 | MAT *CHsolve(MAT *A, MAT *b, MAT *out, PERM *piv); 61 | VEC *CHsolve1(MAT *A, VEC *b, VEC *out, PERM *piv); 62 | MAT *CHfactor(MAT *A, PERM *piv, int *info); 63 | double in_prod(VEC *a, VEC *b); 64 | MAT *sm_mlt(double s, MAT *m1, MAT *out); 65 | MAT *ms_mltadd(MAT *m1, MAT *m2, double s, MAT *out); 66 | MAT *mmtr_mlt(MAT *m1, MAT *m2, MAT *out); 67 | void m_logoutput(MAT *a); 68 | void v_logoutput(VEC *x); 69 | #endif 70 | -------------------------------------------------------------------------------- /src/nsearch.h: -------------------------------------------------------------------------------- 1 | #ifndef SEARCH_H 2 | # define SEARCH_H /* avoid multiple inclusion */ 3 | 4 | void qtree_free(QTREE_NODE *node); 5 | void qtree_pop_point(DPOINT *p, DATA *d); 6 | void qtree_push_point(DATA *d, DPOINT *p); 7 | void qtree_rebuild(DATA *d); 8 | int qtree_select(DPOINT *where, DATA *d); 9 | /* 2-norm distances from point to block: */ 10 | double pb_norm_3D(const DPOINT *where, BBOX bbox); 11 | double pb_norm_2D(const DPOINT *where, BBOX bbox); 12 | double pb_norm_1D(const DPOINT *where, BBOX bbox); 13 | 14 | /* define the maximum depth of the quadtree; 15 | * Fri Jul 4 12:05:47 CEST 2003 16 | * if this is not defined, more than gl_split points at 17 | * a single spatial location cause infinite recursion 18 | * 10 seems a reasonable value: 1/2048 of the bbox dim 19 | * */ 20 | #define MAX_RECURSION_DEPTH 11 21 | 22 | #endif /* SEARCH_H */ 23 | -------------------------------------------------------------------------------- /src/pqueue.h: -------------------------------------------------------------------------------- 1 | #define Q_BUFFER_SIZE 100 /* something more practical */ 2 | 3 | typedef struct { 4 | union { 5 | QTREE_NODE *n; 6 | DPOINT *p; 7 | } u; 8 | int is_node; /* is u the QTREE_NODE (1) or rather the DPOINT (0) ? */ 9 | double dist2; /* squared distance to target location */ 10 | } QUEUE_NODE; 11 | 12 | typedef struct q_element { 13 | struct q_element *next; 14 | QUEUE_NODE el; 15 | } Q_ELEMENT; 16 | 17 | typedef struct { 18 | int length, max_length; 19 | Q_ELEMENT 20 | *head, /* pointer to first element in queue, NULL if empty */ 21 | *empty; /* pointer to empty elements (a stack), NULL if none left */ 22 | int blocks; /* size of memory block */ 23 | Q_ELEMENT **block; /* pointers to malloc'ed memory blocks */ 24 | int (CDECL *cmp)(const QUEUE_NODE *a, const QUEUE_NODE *b); 25 | /* qsort-able element comparison function */ 26 | } QUEUE; 27 | 28 | QUEUE *init_queue(QUEUE *q, int (CDECL *cmp)(const QUEUE_NODE *a, const QUEUE_NODE *b)); 29 | QUEUE_NODE dequeue(QUEUE *q); 30 | void enqueue(QUEUE *q, QUEUE_NODE *qpt, int n); 31 | void free_queue(QUEUE *q); 32 | -------------------------------------------------------------------------------- /src/reml.h: -------------------------------------------------------------------------------- 1 | VARIOGRAM *reml_sills(DATA *d, VARIOGRAM *vp); 2 | 3 | #ifdef MATRIXH 4 | MAT *XVXt_mlt(MAT *X, MAT *V, MAT *out); 5 | MAT *XtVX_mlt(MAT *X, MAT *V, MAT *out); 6 | MAT *XdXt_mlt(MAT *X, VEC *d, MAT *out); 7 | MAT *XtdX_mlt(MAT *X, VEC *d, MAT *out); 8 | #endif 9 | -------------------------------------------------------------------------------- /src/s.h: -------------------------------------------------------------------------------- 1 | void s_gstat_error(const char *mess, int level); 2 | void s_gstat_warning(const char *mess); 3 | double r_normal(void); 4 | double r_uniform(void); 5 | extern int do_print_progress; 6 | -------------------------------------------------------------------------------- /src/select.h: -------------------------------------------------------------------------------- 1 | int select_at(DATA *d, DPOINT *where); 2 | -------------------------------------------------------------------------------- /src/sem.h: -------------------------------------------------------------------------------- 1 | /* sem.c */ 2 | #ifndef SEM_H 3 | # define SEM_H /* avoid multiple inclusion */ 4 | 5 | #if defined(__cplusplus) 6 | extern "C" { 7 | #endif 8 | 9 | int calc_variogram(VARIOGRAM *v, const char *fname); 10 | void fill_cutoff_width(DATA *data, VARIOGRAM *v); 11 | int is_directional(VARIOGRAM *v); 12 | void fprint_header_vgm(FILE *f, const DATA *d1, const DATA *d2, 13 | const SAMPLE_VGM *ev); 14 | void fprint_sample_vgm(const SAMPLE_VGM *ev); 15 | 16 | #if defined(__cplusplus) 17 | } 18 | #endif 19 | 20 | #define LONGSIZE (sizeof(unsigned long)) 21 | #define MAX_NH (1UL << (4 * LONGSIZE)) 22 | #define TO_NH(x,y) (x + ((unsigned long)y << (4 * LONGSIZE))) 23 | #define HIGH_NH(x) (x / (1UL << (4 * LONGSIZE))) 24 | #define LOW_NH(x) (x % (1UL << (4 * LONGSIZE))) 25 | #endif /* SEM_H */ 26 | -------------------------------------------------------------------------------- /src/sim.h: -------------------------------------------------------------------------------- 1 | const double *cond_sim(double *est, int n_sim, METHOD m, int *is_pt, int orc); 2 | void correct_orv(double *est, int n_vars, int orc); 3 | void print_orvc(void); 4 | -------------------------------------------------------------------------------- /src/userio.h: -------------------------------------------------------------------------------- 1 | #ifndef USERIO_H 2 | #define USERIO_H 3 | 4 | enum Gstat_errno { 5 | ER_NOERROR = 0 /* no error */, 6 | ER_NULL = 1 /* internal error: should not occur */, 7 | ER_VARNOTSET = 2 /* a required variable was not set by the user */, 8 | ER_RANGE = 3 /* range error (outside permitted values) */, 9 | ER_IMPOSVAL = 4 /* a variable was set to an illegal value */, 10 | ER_WRITE = 6 /* write error on file */, 11 | ER_READ = 7 /* read error on file */, 12 | ER_RDFLT = 8 /* error while converting a string to a float */, 13 | ER_RDINT = 9 /* error while converting a string to an int */, 14 | ER_SYNTAX = 10 /* syntax error */, 15 | ER_ARGOPT = 11 /* error in command line option arguments */, 16 | ER_DOMAIN = 12 /* math error */, 17 | ER_MEMORY = 13 /* memory exhausted */, 18 | ER_IO = 14 /* i/o conflict (e.g. redirection not permitted) */, 19 | ER_NOCMD = 15 /* no command file specified */, 20 | ER_NOCURSES = 16 /* no curses user interface compiled in */, 21 | ER_PWRITE = 17 /* error while writing to a pipe */, 22 | ER_PREAD = 18 /* error while reading from a pipe */, 23 | ER_SECURE = 19 /* secure mode: operation not allowed */ 24 | }; 25 | 26 | #define MAX_ERRNO 19 27 | void message(char *fmt, ...); /* message() calls always preceed ErrMsg() */ 28 | #define ErrMsg(a,b) gstat_error(__FILE__,__LINE__,a,b) 29 | void gstat_error(char *fname, int line, enum Gstat_errno err_nr, const char *msg); 30 | 31 | void pr_warning(char *fmt, ...); 32 | void printlog(const char *fmt, ...); 33 | void print_progress(unsigned int current, unsigned int total); 34 | 35 | #endif /* USERIO_H */ 36 | -------------------------------------------------------------------------------- /src/utils.c: -------------------------------------------------------------------------------- 1 | /* 2 | * utils.c: error checking functions for file, memory and string handling 3 | */ 4 | #include /* free(), malloc() etc */ 5 | #include /* tolower(), isspace() */ 6 | #include /* strlen(), memcmp() */ 7 | 8 | #include "defs.h" 9 | #include "userio.h" 10 | #include "utils.h" 11 | #include "glvars.h" 12 | #include "debug.h" 13 | 14 | void efree(void *p) { 15 | if (p == NULL) 16 | pr_warning("efree(): NULL pointer as argument"); 17 | else /* there's little point in calling free(NULL) */ 18 | free(p); 19 | } 20 | 21 | void *emalloc(size_t size) { 22 | void *p = NULL; 23 | if (size == 0) { 24 | pr_warning("emalloc(): size 0 requested"); 25 | return NULL; 26 | } 27 | p = (void *) malloc(size); 28 | if (p == NULL) { 29 | if (DEBUG_DUMP) 30 | message("malloc(%u) returned NULL", size); 31 | ErrMsg(ER_MEMORY, ""); 32 | } 33 | return p; 34 | } 35 | 36 | void *ecalloc(size_t nobj, size_t size) { 37 | void *p = NULL; 38 | 39 | if (size == 0) { 40 | pr_warning("ecalloc(): size 0 requested"); 41 | return NULL; 42 | } 43 | p = (void *) calloc(nobj, size); 44 | if (p == NULL) { 45 | if (DEBUG_DUMP) 46 | message("calloc(%u,%u) returned NULL", nobj, size); 47 | ErrMsg(ER_MEMORY, ""); 48 | } 49 | return p; 50 | } 51 | 52 | void *erealloc(void *p, size_t size) { 53 | if (size == 0) { 54 | pr_warning("erealloc(): size 0 requested"); 55 | return NULL; 56 | } 57 | if (p == NULL) 58 | p = (void *) malloc(size); 59 | else 60 | p = (void *) realloc(p, size); 61 | if (p == NULL) { 62 | if (DEBUG_DUMP) 63 | message("realloc(%u) returned NULL\n", size); 64 | ErrMsg(ER_MEMORY, ""); 65 | } 66 | return p; 67 | } 68 | 69 | void set_mv_float(float *f) { 70 | memset(f, 0xFF, sizeof(float)); 71 | } 72 | 73 | void set_mv_double(double *d) { 74 | memset(d, 0xFF, sizeof(double)); 75 | } 76 | 77 | int is_mv_float(const float *f) { 78 | const unsigned char u[sizeof(float)] = { 0xFF, 0xFF, 0xFF, 0xFF }; 79 | /* will choke if sizeof(float) != 4 */ 80 | return (memcmp(f, u, sizeof(float)) == 0); 81 | } 82 | 83 | int is_mv_double(const double *d) { 84 | const unsigned char u[sizeof(double)] = 85 | { 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF }; 86 | /* will choke if sizeof(double) != 8 */ 87 | return (memcmp(d, &u, sizeof(double)) == 0); 88 | } 89 | 90 | /* 91 | * almost_equals() compares string value of token tok with str[], and 92 | * returns TRUE if they are identical up to the first $ in str[]. 93 | */ 94 | int almost_equals(const char *tok, const char *str) { 95 | int i, after = 0, start = 0, len; 96 | 97 | if (tok == NULL) 98 | return 0; /* must be a value--can't be equal */ 99 | len = strlen(tok); 100 | for (i = 0; i < len + after; i++) { 101 | if (str[i] != tok[start + i]) { 102 | if (str[i] != '$') 103 | return 0; 104 | else { 105 | after = 1; 106 | start--; 107 | } 108 | } 109 | } 110 | /* i now beyond end of token string */ 111 | return(after || str[i] == '$' || str[i] == '\0'); 112 | } 113 | -------------------------------------------------------------------------------- /src/utils.h: -------------------------------------------------------------------------------- 1 | #ifndef UTILS_H 2 | #define UTILS_H 3 | 4 | # include /* size_t */ 5 | 6 | /* some famous beware-of-side-effects macro's ! */ 7 | #ifndef MAX 8 | # define MAX(a,b) (((a) > (b)) ? (a) : (b)) 9 | #endif 10 | #ifndef MIN 11 | # define MIN(a,b) (((a) < (b)) ? (a) : (b)) 12 | #endif 13 | #ifndef ABS 14 | #define ABS(a) (((a) >= 0) ? (a) : (-(a))) 15 | #endif 16 | #ifndef SQR 17 | # define SQR(a) ((a)*(a)) 18 | #endif 19 | #ifndef PI 20 | # define PI 3.14159265359 21 | #endif 22 | #define NULS(a) (a==NULL ? "" : a) 23 | 24 | /* 25 | LTI: lower triangular matrix index, stored in an array: 26 | col | 0 1 2 3 27 | ----+------- 28 | 0 | 0 29 | r 1 | 1 2 30 | o 2 | 3 4 5 31 | w 3 | 6 7 8 9 32 | 33 | row and col may be interchanged: LTI(a,b)==LTI(b,a) 34 | 35 | LTI2(a,b) is the index of an off-diagonal lower triangular matrix: 36 | col | 0 1 2 3 37 | ----+------- 38 | 0 | x 39 | r 1 | 0 x 40 | o 2 | 1 2 x 41 | w 3 | 3 4 5 x 42 | */ 43 | 44 | #define LTI(r,c) ((r) >= (c) ? (((r)*(r+1))>>1)+(c) : (((c)*(c+1))>>1)+(r)) 45 | #define LTI2(r,c) ((r) >= (c) ? (((r)*(r-1))>>1)+(c) : (((c)*(c-1))>>1)+(r)) 46 | /* Note: `>>1' replaced `/2' to circumvent an hp 10.20 optimizer bug */ 47 | 48 | #if defined(__cplusplus) 49 | extern "C" { 50 | #endif 51 | 52 | typedef struct { 53 | char *str; 54 | unsigned int max_length; 55 | } STRING_BUFFER; 56 | 57 | void set_mv_float(float *f); 58 | void set_mv_double(double *d); 59 | int is_mv_float(const float *f); 60 | int is_mv_double(const double *d); 61 | int almost_equals(const char *tok, const char *str); 62 | 63 | void *emalloc(size_t size); 64 | void *ecalloc(size_t nobj, size_t size); 65 | void *erealloc(void *p, size_t size); 66 | void efree(void *p); 67 | 68 | #if defined(__cplusplus) 69 | } 70 | #endif 71 | 72 | #endif /* UTILS_H */ 73 | -------------------------------------------------------------------------------- /src/vario_fn.h: -------------------------------------------------------------------------------- 1 | /* unit basic variogram models */ 2 | double fn_nugget(double h, double *r); 3 | double fn_linear(double h, double *r); 4 | double fn_circular(double h, double *r); 5 | double fn_spherical(double h, double *r); 6 | double fn_bessel(double h, double *r); 7 | double fn_gaussian(double h, double *r); 8 | double fn_exclass(double h, double *r); 9 | double fn_matern(double h, double *r); 10 | double fn_matern2(double h, double *r); 11 | double fn_exponential(double h, double *r); 12 | double fn_pentaspherical(double h, double *r); 13 | double fn_periodic(double h, double *r); 14 | double fn_wave(double h, double *r); 15 | double fn_hole(double h, double *r); 16 | double fn_logarithmic(double h, double *r); 17 | double fn_power(double h, double *r); 18 | double fn_spline(double h, double *r); 19 | double fn_legendre(double h, double *r); 20 | double fn_intercept(double h, double *r); 21 | 22 | /* the following functions are not all defined */ 23 | double da_is_zero(double h, double *r); /* NUG, INT */ 24 | double da_fn_linear(double h, double *r); 25 | double da_fn_circular(double h, double *r); 26 | double da_fn_spherical(double h, double *r); 27 | double da_fn_bessel(double h, double *r); 28 | double da_fn_gaussian(double h, double *r); 29 | double da_fn_exponential(double h, double *r); 30 | double da_fn_pentaspherical(double h, double *r); 31 | double da_fn_periodic(double h, double *r); 32 | double da_fn_wave(double h, double *r); 33 | double da_fn_hole(double h, double *r); 34 | double da_fn_logarithmic(double h, double *r); 35 | double da_fn_power(double h, double *r); 36 | 37 | /* unit derivative-to-range of basic variogram models */ 38 | double da_fn_exponential(double h, double *r); 39 | double da_fn_nugget(double h, double *r); 40 | -------------------------------------------------------------------------------- /src/vario_io.h: -------------------------------------------------------------------------------- 1 | double sem_cov_ab(VARIOGRAM *v, DPOINT *a, DPOINT *b, int sem); 2 | /* covariance: */ 3 | #define COVARIANCE(v,a,b) ((IS_POINT(a) && IS_POINT(b) && !gl_longlat) ? \ 4 | (get_covariance(v,a->x - b->x,a->y - b->y, a->z - b->z)) : \ 5 | sem_cov_ab(v,a,b,0)) 6 | /* generalized covariance: */ 7 | #define GCV(v,a,b) ((IS_POINT(a) && IS_POINT(b) && !gl_longlat) ? \ 8 | (v->max_val - get_semivariance(v,a->x - b->x,a->y - b->y, a->z - b->z)) : \ 9 | (v->max_val - sem_cov_ab(v,a,b,1))) 10 | /* 11 | * CME is the measurement error-adjustment to GCV or COVARIANCE: 12 | * see Cressie, Statistics for Spatial Data, revised ed. 1993, 13 | * eq. 3.2.25-3.2.27, and page 379 14 | */ 15 | #define CME(v,a,b,dist) ((IS_POINT(a) && IS_POINT(b) && \ 16 | (a == b || dist(a, b) == 0.0)) ? v->measurement_error : 0.0) 17 | #define GCV0(v,a,b,dist) (GCV(v,a,b) - CME(v,a,b,dist)) 18 | #define COVARIANCE0(v,a,b,dist) (COVARIANCE(v,a,b) - CME(v,a,b,dist)) 19 | -------------------------------------------------------------------------------- /tests/allier.R: -------------------------------------------------------------------------------- 1 | # Sytze de Bruin's post to r-sig-geo, Nov 16, 2015: 2 | library(sp) 3 | library(gstat) 4 | 5 | # some data 6 | x <- c(215, 330, 410, 470, 545) 7 | y <- c(230, 310, 330, 340, 365) 8 | fc <- c(0.211, 0.251, 0.281, 0.262, 0.242) 9 | por <- c(0.438, 0.457, 0.419, 0.430, 0.468) 10 | Allier <- data.frame(x, y, fc, por) 11 | coordinates(Allier) = ~x+y 12 | 13 | # gstat object for co-kriging using linear model of co-regionalization 14 | g <- gstat(id=c("fc"), formula=fc~1, data=Allier, 15 | model=vgm(0.00247, "Sph", 480, 0.00166)) 16 | g <- gstat(g, id="por", formula=por~1, data=Allier, 17 | model=vgm(0.00239, "Sph", 480, 0.00118)) 18 | g <- gstat(g, id=c("fc", "por"), 19 | model=vgm(0.00151, "Sph", 480, -0.00124)) 20 | 21 | # predict at single point 22 | g$set = list(choleski = 0) # LDL' 23 | A <- predict(g, SpatialPoints(data.frame(x=450, y=350)), debug = 32) 24 | g$set = list(choleski = 1) # Choleski 25 | B <- predict(g, SpatialPoints(data.frame(x=450, y=350)), debug = 32) 26 | all.equal(A,B) 27 | 28 | # TRUE 29 | -------------------------------------------------------------------------------- /tests/blockkr.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | data(meuse) 3 | coordinates(meuse) = c("x", "y") 4 | new.locs <- SpatialPoints(data.frame( 5 | x = c(181170, 180310, 180205, 178673, 178770, 178270), 6 | y = c(333250, 332189, 331707, 330066, 330675, 331075))) 7 | library(gstat) 8 | krige(zinc ~ 1, meuse, new.locs, vgm(1.34e5, "Sph", 800, nug = 2.42e4), 9 | block = c(40,40), nmax = 40) 10 | 11 | new.locs <- SpatialPoints(data.frame(x = c(181170), y = c(333250))) 12 | 13 | disc = c(-15,-5,5,15) 14 | block.irreg <- data.frame(expand.grid(x = disc, y = disc)) 15 | block.irreg 16 | 17 | # first disable default Gaussian quadrature used for block integration, by 18 | # setting nblockdiscr explicitly: 19 | krige(zinc ~ 1, meuse, new.locs, model = vgm(1.34e5, "Sph", 800, nug = 2.42e4), 20 | block = c(40,40), nmax = 40, set = list(nblockdiscr=4)) 21 | # now pass the same block discretization as block.irreg: 22 | krige(zinc ~ 1, meuse, new.locs, vgm(1.34e5, "Sph", 800, nug = 2.42e4), 23 | block = block.irreg, nmax = 40) 24 | # check weights argument: 25 | block.irreg <- data.frame(expand.grid(x = disc, y = disc), weights = rep(1/16, 16)) 26 | krige(zinc ~ 1, meuse, new.locs, vgm(1.34e5, "Sph", 800, nug = 2.42e4), 27 | block = block.irreg, nmax = 40) 28 | -------------------------------------------------------------------------------- /tests/blockkr.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.0.1 (2013-05-16) -- "Good Sport" 3 | Copyright (C) 2013 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(sp) 19 | > data(meuse) 20 | > coordinates(meuse) = c("x", "y") 21 | > new.locs <- SpatialPoints(data.frame( 22 | + x = c(181170, 180310, 180205, 178673, 178770, 178270), 23 | + y = c(333250, 332189, 331707, 330066, 330675, 331075))) 24 | > library(gstat) 25 | > krige(zinc ~ 1, meuse, new.locs, vgm(1.34e5, "Sph", 800, nug = 2.42e4), 26 | + block = c(40,40), nmax = 40) 27 | [using ordinary kriging] 28 | coordinates var1.pred var1.var 29 | 1 (181170, 333250) 268.7576 19447.67 30 | 2 (180310, 332189) 663.4915 16991.33 31 | 3 (180205, 331707) 251.4606 21579.71 32 | 4 (178673, 330066) 532.5776 73807.91 33 | 5 (178770, 330675) 664.4039 23589.17 34 | 6 (178270, 331075) 565.5436 155113.23 35 | > 36 | > new.locs <- SpatialPoints(data.frame(x = c(181170), y = c(333250))) 37 | > 38 | > disc = c(-15,-5,5,15) 39 | > block.irreg <- data.frame(expand.grid(x = disc, y = disc)) 40 | > block.irreg 41 | x y 42 | 1 -15 -15 43 | 2 -5 -15 44 | 3 5 -15 45 | 4 15 -15 46 | 5 -15 -5 47 | 6 -5 -5 48 | 7 5 -5 49 | 8 15 -5 50 | 9 -15 5 51 | 10 -5 5 52 | 11 5 5 53 | 12 15 5 54 | 13 -15 15 55 | 14 -5 15 56 | 15 5 15 57 | 16 15 15 58 | > 59 | > # first disable default Gaussian quadrature used for block integration, by 60 | > # setting nblockdiscr explicitly: 61 | > krige(zinc ~ 1, meuse, new.locs, model = vgm(1.34e5, "Sph", 800, nug = 2.42e4), 62 | + block = c(40,40), nmax = 40, set = list(nblockdiscr=4)) 63 | [using ordinary kriging] 64 | coordinates var1.pred var1.var 65 | 1 (181170, 333250) 268.7324 19568.76 66 | > # now pass the same block discretization as block.irreg: 67 | > krige(zinc ~ 1, meuse, new.locs, vgm(1.34e5, "Sph", 800, nug = 2.42e4), 68 | + block = block.irreg, nmax = 40) 69 | [using ordinary kriging] 70 | coordinates var1.pred var1.var 71 | 1 (181170, 333250) 268.7324 19568.76 72 | > # check weights argument: 73 | > block.irreg <- data.frame(expand.grid(x = disc, y = disc), weights = rep(1/16, 16)) 74 | > krige(zinc ~ 1, meuse, new.locs, vgm(1.34e5, "Sph", 800, nug = 2.42e4), 75 | + block = block.irreg, nmax = 40) 76 | [using ordinary kriging] 77 | coordinates var1.pred var1.var 78 | 1 (181170, 333250) 268.7324 19568.76 79 | > 80 | > proc.time() 81 | user system elapsed 82 | 1.080 0.056 1.139 83 | -------------------------------------------------------------------------------- /tests/covtable.R: -------------------------------------------------------------------------------- 1 | library(gstat) 2 | d=expand.grid(x=c(-.5,.5), y=c(-.5,.5)) 3 | d$z=1:4 4 | vv=vgm(model = "Tab", covtable = 5 | variogramLine(vgm(1, "Sph", 1), 1, n=1e4,min = 0, covariance = TRUE)) 6 | vv 7 | krige(z~1,~x+y,d,data.frame(x=0,y=0),vgm(1, "Sph", 1)) 8 | krige(z~1,~x+y,d,data.frame(x=0,y=0),vv) 9 | krige(z~1,~x+y,d[1:2,],data.frame(x=0,y=0),vgm(1, "Sph", 1)) 10 | krige(z~1,~x+y,d[1:2,],data.frame(x=0,y=0),vv) 11 | -------------------------------------------------------------------------------- /tests/covtable.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.2.3 (2015-12-10) -- "Wooden Christmas-Tree" 3 | Copyright (C) 2015 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(gstat) 19 | > d=expand.grid(x=c(-.5,.5), y=c(-.5,.5)) 20 | > d$z=1:4 21 | > vv=vgm(model = "Tab", covtable = 22 | + variogramLine(vgm(1, "Sph", 1), 1, n=1e4,min = 0, covariance = TRUE)) 23 | > vv 24 | model psill maxdist 25 | 1 Tab NA 1 26 | covariance table: 27 | [1] 1.0000000 0.7039712 0.4319496 0.2080384 0.0560108 0.0000000 28 | > krige(z~1,~x+y,d,data.frame(x=0,y=0),vgm(1, "Sph", 1)) 29 | [using ordinary kriging] 30 | x y var1.pred var1.var 31 | 1 0 0 2.5 1.017767 32 | > krige(z~1,~x+y,d,data.frame(x=0,y=0),vv) 33 | [using ordinary kriging] 34 | x y var1.pred var1.var 35 | 1 0 0 2.5 1.017863 36 | > krige(z~1,~x+y,d[1:2,],data.frame(x=0,y=0),vgm(1, "Sph", 1)) 37 | [using ordinary kriging] 38 | x y var1.pred var1.var 39 | 1 0 0 1.5 1.267767 40 | > krige(z~1,~x+y,d[1:2,],data.frame(x=0,y=0),vv) 41 | [using ordinary kriging] 42 | x y var1.pred var1.var 43 | 1 0 0 1.5 1.267863 44 | > 45 | > proc.time() 46 | user system elapsed 47 | 0.704 0.276 0.670 48 | -------------------------------------------------------------------------------- /tests/cv.R: -------------------------------------------------------------------------------- 1 | # try bivariate cokriging; cross validate first variable 2 | library(sp) 3 | data(meuse) 4 | library(gstat) 5 | g=gstat(NULL, "log-zinc", log(zinc)~1, ~x+y, meuse, nmax=10) 6 | g=gstat(g, "log-lead", log(lead)~1, ~x+y, meuse, nmax=10) 7 | g=gstat(g, "log-copper", log(copper)~1, ~x+y, meuse, nmax=10) 8 | v=variogram(g) 9 | g=gstat(g, model=vgm(1, "Sph", 1000), fill.all=T) 10 | g=fit.lmc(v, g) 11 | g 12 | set.seed(13131) 13 | summary(gstat.cv(g, remove.all=TRUE, nfold=5)) 14 | summary(gstat.cv(g, remove.all=FALSE, nfold=5)) 15 | -------------------------------------------------------------------------------- /tests/cv3d.R: -------------------------------------------------------------------------------- 1 | options(digits = 4) 2 | set.seed(1131) 3 | d = data.frame(x=runif(50),y=runif(50),z=runif(50),v=rnorm(50)) 4 | library(gstat) 5 | xx = krige.cv(v~1,~x+y+z,d,model=vgm(1,"Exp",1), verbose=F, set=list(debug=0)) 6 | summary(xx) 7 | -------------------------------------------------------------------------------- /tests/cv3d.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R Under development (unstable) (2025-02-03 r87683 ucrt) -- "Unsuffered Consequences" 3 | Copyright (C) 2025 The R Foundation for Statistical Computing 4 | Platform: x86_64-w64-mingw32/x64 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > options(digits = 4) 19 | > set.seed(1131) 20 | > d = data.frame(x=runif(50),y=runif(50),z=runif(50),v=rnorm(50)) 21 | > library(gstat) 22 | > xx = krige.cv(v~1,~x+y+z,d,model=vgm(1,"Exp",1), verbose=F, set=list(debug=0)) 23 | > summary(xx) 24 | var1.pred var1.var observed residual 25 | Min. :-1.163 Min. :0.116 Min. :-2.240 Min. :-2.1755 26 | 1st Qu.:-0.571 1st Qu.:0.175 1st Qu.:-0.876 1st Qu.:-0.7881 27 | Median :-0.201 Median :0.192 Median :-0.219 Median : 0.1175 28 | Mean :-0.165 Mean :0.208 Mean :-0.142 Mean : 0.0233 29 | 3rd Qu.: 0.161 3rd Qu.:0.240 3rd Qu.: 0.501 3rd Qu.: 0.8508 30 | Max. : 1.085 Max. :0.426 Max. : 1.857 Max. : 2.5224 31 | zscore fold x y 32 | Min. :-5.1678 Min. : 1.0 Min. :0.00678 Min. :0.0034 33 | 1st Qu.:-1.8749 1st Qu.:13.2 1st Qu.:0.23966 1st Qu.:0.2466 34 | Median : 0.2453 Median :25.5 Median :0.48668 Median :0.4525 35 | Mean : 0.0167 Mean :25.5 Mean :0.49966 Mean :0.4969 36 | 3rd Qu.: 2.0201 3rd Qu.:37.8 3rd Qu.:0.74730 3rd Qu.:0.7394 37 | Max. : 7.3541 Max. :50.0 Max. :0.98754 Max. :0.9872 38 | z 39 | Min. :0.00164 40 | 1st Qu.:0.18646 41 | Median :0.44850 42 | Mean :0.47142 43 | 3rd Qu.:0.72403 44 | Max. :0.99420 45 | > 46 | > proc.time() 47 | user system elapsed 48 | 1.23 0.17 1.39 49 | -------------------------------------------------------------------------------- /tests/fit.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | data(meuse) 3 | library(gstat) 4 | v=variogram(log(zinc)~1,~x+y,meuse,cutoff=500,wi=100) 5 | v$gamma=c(0.5,1,2,3,3) 6 | fit.variogram(v, vgm(1, "Sph", 300, 0),warn.if.neg=TRUE) 7 | fit.variogram(v, vgm(1, "Sph", 300, 0),warn.if.neg=FALSE) 8 | -------------------------------------------------------------------------------- /tests/fit.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.2.2 (2015-08-14) -- "Fire Safety" 3 | Copyright (C) 2015 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(sp) 19 | > data(meuse) 20 | > library(gstat) 21 | > v=variogram(log(zinc)~1,~x+y,meuse,cutoff=500,wi=100) 22 | > v$gamma=c(0.5,1,2,3,3) 23 | > fit.variogram(v, vgm(1, "Sph", 300, 0),warn.if.neg=TRUE) 24 | model psill range 25 | 1 Nug 0.000000 0.00 26 | 2 Sph 7.878195 1567.77 27 | Warning message: 28 | In fit.variogram(v, vgm(1, "Sph", 300, 0), warn.if.neg = TRUE) : 29 | partial sill or nugget fixed at zero value 30 | > fit.variogram(v, vgm(1, "Sph", 300, 0),warn.if.neg=FALSE) 31 | model psill range 32 | 1 Nug 0.000000 0.00 33 | 2 Sph 7.878195 1567.77 34 | > 35 | > proc.time() 36 | user system elapsed 37 | 0.708 0.244 0.718 38 | -------------------------------------------------------------------------------- /tests/krige0.R: -------------------------------------------------------------------------------- 1 | # test -- load data: 2 | library(sp) 3 | data(meuse) 4 | coordinates(meuse) = ~x+y 5 | data(meuse.grid) 6 | gridded(meuse.grid) = ~x+y 7 | 8 | library(gstat) 9 | # test -- idw 10 | meuse.grid$idw <- idw0(zinc~1, meuse, meuse.grid)[,1] 11 | x <- idw(zinc~1, meuse, meuse.grid) 12 | all.equal(x$var1.pred, meuse.grid$idw) 13 | spplot(meuse.grid["idw"],col.regions=bpy.colors()) 14 | v = vgm(1, "Exp", 500) 15 | # test sk: 16 | x0 <- krige0(zinc~1, meuse, meuse.grid, v, beta = 500, computeVar = TRUE) 17 | rownames(x0$pred)=NULL 18 | x <- krige(zinc~1, meuse, meuse.grid, v, beta = 500) 19 | all.equal(x$var1.pred, x0$pred[,1]) 20 | all.equal(x$var1.var, x0$var) 21 | # test ok: 22 | x0 <- krige0(zinc~1, meuse, meuse.grid, v, computeVar = TRUE) 23 | rownames(x0$pred)=NULL 24 | names(x0$var)=NULL 25 | x <- krige(zinc~1, meuse, meuse.grid, v) 26 | all.equal(x$var1.pred, x0$pred[,1]) 27 | all.equal(x$var1.var, x0$var) 28 | # test uk: 29 | x0 <- krige0(zinc~sqrt(dist), meuse, meuse.grid, v, computeVar = TRUE) 30 | rownames(x0$pred)=NULL 31 | names(x0$var)=NULL 32 | x <- krige(zinc~sqrt(dist), meuse, meuse.grid, v) 33 | all.equal(x$var1.pred, x0$pred[,1]) 34 | all.equal(x$var1.var, x0$var) -------------------------------------------------------------------------------- /tests/krige0.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.0.2 (2013-09-25) -- "Frisbee Sailing" 3 | Copyright (C) 2013 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > # test -- load data: 19 | > library(sp) 20 | > data(meuse) 21 | > coordinates(meuse) = ~x+y 22 | > data(meuse.grid) 23 | > gridded(meuse.grid) = ~x+y 24 | > 25 | > library(gstat) 26 | > # test -- idw 27 | > meuse.grid$idw <- idw0(zinc~1, meuse, meuse.grid)[,1] 28 | > x <- idw(zinc~1, meuse, meuse.grid) 29 | [inverse distance weighted interpolation] 30 | > all.equal(x$var1.pred, meuse.grid$idw) 31 | [1] TRUE 32 | > spplot(meuse.grid["idw"],col.regions=bpy.colors()) 33 | > v = vgm(1, "Exp", 500) 34 | > # test sk: 35 | > x0 <- krige0(zinc~1, meuse, meuse.grid, v, beta = 500, computeVar = TRUE) 36 | > rownames(x0$pred)=NULL 37 | > x <- krige(zinc~1, meuse, meuse.grid, v, beta = 500) 38 | [using simple kriging] 39 | > all.equal(x$var1.pred, x0$pred[,1]) 40 | [1] TRUE 41 | > all.equal(x$var1.var, x0$var) 42 | [1] TRUE 43 | > # test ok: 44 | > x0 <- krige0(zinc~1, meuse, meuse.grid, v, computeVar = TRUE) 45 | > rownames(x0$pred)=NULL 46 | > names(x0$var)=NULL 47 | > x <- krige(zinc~1, meuse, meuse.grid, v) 48 | [using ordinary kriging] 49 | > all.equal(x$var1.pred, x0$pred[,1]) 50 | [1] TRUE 51 | > all.equal(x$var1.var, x0$var) 52 | [1] TRUE 53 | > # test uk: 54 | > x0 <- krige0(zinc~sqrt(dist), meuse, meuse.grid, v, computeVar = TRUE) 55 | > rownames(x0$pred)=NULL 56 | > names(x0$var)=NULL 57 | > x <- krige(zinc~sqrt(dist), meuse, meuse.grid, v) 58 | [using universal kriging] 59 | > all.equal(x$var1.pred, x0$pred[,1]) 60 | [1] TRUE 61 | > all.equal(x$var1.var, x0$var) 62 | [1] TRUE 63 | > 64 | > proc.time() 65 | user system elapsed 66 | 3.424 0.064 3.490 67 | -------------------------------------------------------------------------------- /tests/line.R: -------------------------------------------------------------------------------- 1 | options(digits=5) 2 | library(sp) 3 | data(meuse.grid) 4 | gridded(meuse.grid) = ~x+y 5 | data(meuse) 6 | coordinates(meuse) = ~x+y 7 | 8 | # choose arbitrary line over the grid: 9 | image(meuse.grid["dist"],axes=T) 10 | pp = rbind(c(180000,331000),c(180000,332000),c(181000,333500)) 11 | Sl = SpatialLines(list(Lines(list(Line(pp)), "a"))) 12 | plot(Sl,add=T,col='green') 13 | 14 | # use the default spsample arguments of predict.gstat: 15 | pts=spsample(Sl,n=500,'regular',offset=c(.5,.5)) 16 | plot(pts, pch=3, cex=.2, add=T) 17 | 18 | library(gstat) 19 | v = vgm(.6, "Sph", 900, .06) 20 | out1 = krige(log(zinc)~1, meuse, Sl, v) 21 | out1 22 | 23 | points(180333,332167,pch=3,cex=2) 24 | 25 | # use the same line as block discretization, and predict for (0,0) 26 | # (because the block discretizing points are not centered) 27 | out2 = krige(log(zinc)~1, meuse, SpatialPoints(matrix(0,1,2)), v, block=coordinates(pts)) 28 | out2 29 | 30 | compare.krigingLines = function(formula, data, newdata, model) { 31 | out1 = krige(formula, data, newdata, model) 32 | pts = spsample(newdata, n=500, 'regular', offset=.5) 33 | out2 = krige(formula, data, SpatialPoints(matrix(0,1,2)), model, block = coordinates(pts)) 34 | print("difference:") 35 | as.data.frame(out1)[3:4]- as.data.frame(out2)[3:4] 36 | } 37 | 38 | compare.krigingLines(log(zinc)~1, meuse, Sl, v) 39 | 40 | # one line, consisting of two line segments: 41 | pp2 = rbind(c(181000,333500),c(181000,332500)) 42 | Sl2 = SpatialLines(list(Lines(list(Line(pp),Line(pp2)), "a"))) 43 | krige(log(zinc)~1, meuse, Sl2, v) 44 | compare.krigingLines(log(zinc)~1, meuse, Sl2, v) 45 | 46 | # two seperate line segments: 47 | Sl3 = SpatialLines(list(Lines(list(Line(pp)), "a"),Lines(list(Line(pp2)),"b"))) 48 | krige(log(zinc)~1, meuse, Sl3, v) 49 | -------------------------------------------------------------------------------- /tests/merge.R: -------------------------------------------------------------------------------- 1 | options(digits=6) 2 | # illustrates the use of merge, for merging parameters accross variables: 3 | # Z1=m+e1(s) 4 | # Z2=m+e2(s) 5 | # Z1 and Z2 each have a different variogram, but share the parameter m 6 | # see documentation of gstat() function 7 | library(gstat) 8 | d1 = data.frame(x=c(0,2),y=c(0,0),z=c(0,1)) 9 | d2 = data.frame(x=c(0,2),y=c(2,2),z=c(4,5)) 10 | g = gstat(NULL,"d1", z~1,~x+y,d1,model=vgm(1, "Exp", 1)) 11 | g = gstat(g,"d2", z~1,~x+y,d2,model=vgm(1, "Exp", 1), merge=c("d1","d2")) 12 | g = gstat(g, c("d1", "d2"), model = vgm(0.5, "Exp", 1)) 13 | predict(g, data.frame(x=1,y=1), debug = 32) 14 | 15 | # Z1 and Z2 share a regression slope: 16 | g = gstat(NULL,"d1", z~x,~x+y,d1,model=vgm(1, "Exp", 1)) 17 | g = gstat(g,"d2", z~x,~x+y,d2,model=vgm(1, "Exp", 1), 18 | merge=list(c("d1",2,"d2",2))) 19 | g = gstat(g, c("d1", "d2"), model = vgm(0.5, "Exp", 1)) 20 | predict(g, data.frame(x=1,y=1), debug = 32) 21 | -------------------------------------------------------------------------------- /tests/na.action.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | 3 | data(meuse) 4 | data(meuse.grid) 5 | 6 | set.seed(13131) # reproduce results 7 | 8 | # select 10 random rows; 9 | # create two missing values in the coordinates: 10 | m = meuse.grid[sample(nrow(meuse.grid), 10), ] 11 | m[c(2,8), "x"] = NA 12 | 13 | library(gstat) 14 | ## this is not allowed anymore: 15 | try(krige(log(zinc)~1,~x+y,meuse,m, na.action = na.pass)) 16 | try(krige(log(zinc)~1,~x+y,meuse,m, na.action = na.omit)) 17 | try(krige(log(zinc)~1,~x+y,meuse,m, na.action = na.exclude)) 18 | try(krige(log(zinc)~1,~x+y,meuse,m, na.action = na.fail)) 19 | 20 | # select 10 random rows; 21 | # create two missing values in the regressor variable: 22 | m = meuse.grid[sample(nrow(meuse.grid), 10), ] 23 | m[c(3,7), "dist"] = NA 24 | krige(log(zinc)~dist,~x+y,meuse,m, na.action = na.pass) 25 | krige(log(zinc)~dist,~x+y,meuse,m, na.action = na.omit) 26 | krige(log(zinc)~dist,~x+y,meuse,m, na.action = na.exclude) 27 | try(krige(log(zinc)~dist,~x+y,meuse,m, na.action = na.fail)) 28 | -------------------------------------------------------------------------------- /tests/sim.R: -------------------------------------------------------------------------------- 1 | options(digits=6) 2 | library(sp) 3 | data(meuse) 4 | set.seed(158229572) 5 | new.locs <- data.frame(x = c(181170, 180310, 180205, 178673, 178770, 178270), 6 | y = c(333250, 332189, 331707, 330066, 330675, 331075)) 7 | library(gstat) 8 | krige(zinc ~ 1, ~ x + y, meuse, newdata = new.locs, 9 | model = vgm(1.34e5, "Sph", 800, nug = 2.42e4), 10 | block = c(40,40), nmax = 40, nsim = 10) 11 | -------------------------------------------------------------------------------- /tests/sim.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.6.0 (2019-04-26) -- "Planting of a Tree" 3 | Copyright (C) 2019 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > options(digits=6) 19 | > library(sp) 20 | > data(meuse) 21 | > set.seed(158229572) 22 | > new.locs <- data.frame(x = c(181170, 180310, 180205, 178673, 178770, 178270), 23 | + y = c(333250, 332189, 331707, 330066, 330675, 331075)) 24 | > library(gstat) 25 | > krige(zinc ~ 1, ~ x + y, meuse, newdata = new.locs, 26 | + model = vgm(1.34e5, "Sph", 800, nug = 2.42e4), 27 | + block = c(40,40), nmax = 40, nsim = 10) 28 | drawing 10 GLS realisations of beta... 29 | [using conditional Gaussian simulation] 30 | x y sim1 sim2 sim3 sim4 sim5 sim6 sim7 31 | 1 181170 333250 267.385 27.5686 428.144 381.576 151.119 175.890 293.273 32 | 2 180310 332189 429.437 659.6579 564.023 611.666 612.756 619.791 771.961 33 | 3 180205 331707 205.978 412.7276 271.827 380.349 169.488 369.822 266.026 34 | 4 178673 330066 117.479 684.0663 399.148 585.096 606.396 867.866 807.634 35 | 5 178770 330675 780.072 837.4628 682.690 911.052 600.984 783.019 749.476 36 | 6 178270 331075 1025.778 1582.0269 614.235 332.377 660.228 589.447 972.018 37 | sim8 sim9 sim10 38 | 1 294.107 113.347 279.991 39 | 2 776.498 724.160 901.692 40 | 3 338.021 630.244 140.272 41 | 4 127.301 957.242 444.007 42 | 5 533.773 748.144 623.960 43 | 6 1084.170 537.604 -214.972 44 | > 45 | > proc.time() 46 | user system elapsed 47 | 0.467 0.020 0.479 48 | -------------------------------------------------------------------------------- /tests/unproj.R: -------------------------------------------------------------------------------- 1 | # DOI 10.1007/s11004-011-9344-7 2 | # http://mypage.iu.edu/~srobeson/Pubs/variogram_sphere_mathgeo_2011.pdf 3 | 4 | suppressPackageStartupMessages(library(sp)) 5 | library(gstat) 6 | 7 | if (require(sp, quietly = TRUE) && 8 | suppressPackageStartupMessages(require(fields, quietly = TRUE)) && 9 | suppressPackageStartupMessages(require(sf, quietly = TRUE))) { 10 | data(meuse) 11 | coordinates(meuse) = ~x+y 12 | proj4string(meuse) = CRS("+init=epsg:28992") 13 | ll = "+proj=longlat +ellps=WGS84" 14 | # meuse.ll = spTransform(meuse, CRS("+proj=longlat +ellps=WGS84")) 15 | meuse.ll = as(st_transform(sf::st_as_sf(meuse), sf::st_crs(ll)), "Spatial") 16 | meuse.ll[1:10,] 17 | variogram(log(zinc)~1, meuse.ll) 18 | 19 | cloud1 = variogram(log(zinc)~1, meuse, cloud=T, cutoff=6000) 20 | cloud2 = variogram(log(zinc)~1, meuse.ll, cloud=T, cutoff=6) 21 | 22 | plot(cloud1$dist/1000, cloud2$dist, xlab="Amersfoort, km", ylab = "Long/lat") 23 | abline(0,1) 24 | 25 | data(ozone2) 26 | oz = SpatialPointsDataFrame(ozone2$lon.lat, 27 | data.frame(t(ozone2$y)), 28 | proj4string=CRS("+proj=longlat +ellps=WGS84")) 29 | variogram(X870731~1,oz[!is.na(oz$X870731),]) 30 | utm16 = "+proj=utm +zone=16" 31 | # oz.utm = spTransform(oz, utm16) 32 | oz.utm = as(sf::st_transform(sf::st_as_sf(oz), utm16) , "Spatial") 33 | variogram(X870731~1,oz.utm[!is.na(oz$X870731),]) 34 | 35 | # Timothy Hilton, r-sig-geo, Sept 14, 2008: 36 | 37 | foo <- 38 | structure(list(z = c(-1.95824831109744, -1.9158901643563, 4.22211761150161, 39 | 3.23356929459598, 1.12038389231868, 0.34613850821113, 1.12589932643631, 40 | 23.517912251617, 3.0519158690268, 3.20261431141517, -2.10947106854739 41 | ), lon = c(-125.29228, -82.1556, -98.524722, -99.948333, -104.691741, 42 | -79.420833, -105.100533, -88.291867, -72.171478, -121.556944, 43 | -89.34765), lat = c(49.87217, 48.2167, 55.905833, 56.635833, 44 | 53.916264, 39.063333, 48.307883, 40.0061, 42.537756, 44.448889, 45 | 46.242017)), .Names = c("z", "lon", "lat"), row.names = c(NA, 46 | -11L), class = "data.frame") 47 | 48 | coordinates(foo) <- ~lon+lat 49 | 50 | proj4string(foo) <- CRS('+proj=longlat +ellps=WGS84') 51 | 52 | vg.foo <- variogram(z~1, foo, cloud=TRUE, cutoff=1e10) 53 | 54 | cat('==========\nvariogram:\n') 55 | print(head(vg.foo)) 56 | 57 | cat('==========\nspDistsN1 Distances:\n') 58 | print(spDistsN1(coordinates(foo), coordinates(foo)[1,], longlat=TRUE)) 59 | } 60 | -------------------------------------------------------------------------------- /tests/variogram.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | data(meuse) 4 | variogram(log(zinc)~1, ~x+y, meuse) 5 | 6 | coordinates(meuse) <- ~ x + y 7 | variogram(log(zinc)~1, meuse) 8 | 9 | ind=seq(1,155,2) 10 | var1= meuse[ind,] 11 | var2= meuse[-ind,] 12 | g <- gstat(NULL, id = "lead", form = lead ~ 1, data=var1) 13 | g <- gstat(g, id = "zinc", form = zinc ~ 1, data=var2) 14 | v.cross <- variogram(g) 15 | plot(v.cross) 16 | 17 | -------------------------------------------------------------------------------- /tests/variogram.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.0.1 (2013-05-16) -- "Good Sport" 3 | Copyright (C) 2013 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(sp) 19 | > library(gstat) 20 | > data(meuse) 21 | > variogram(log(zinc)~1, ~x+y, meuse) 22 | np dist gamma dir.hor dir.ver id 23 | 1 57 79.29244 0.1234479 0 0 var1 24 | 2 299 163.97367 0.2162185 0 0 var1 25 | 3 419 267.36483 0.3027859 0 0 var1 26 | 4 457 372.73542 0.4121448 0 0 var1 27 | 5 547 478.47670 0.4634128 0 0 var1 28 | 6 533 585.34058 0.5646933 0 0 var1 29 | 7 574 693.14526 0.5689683 0 0 var1 30 | 8 564 796.18365 0.6186769 0 0 var1 31 | 9 589 903.14650 0.6471479 0 0 var1 32 | 10 543 1011.29177 0.6915705 0 0 var1 33 | 11 500 1117.86235 0.7033984 0 0 var1 34 | 12 477 1221.32810 0.6038770 0 0 var1 35 | 13 452 1329.16407 0.6517158 0 0 var1 36 | 14 457 1437.25620 0.5665318 0 0 var1 37 | 15 415 1543.20248 0.5748227 0 0 var1 38 | > 39 | > coordinates(meuse) <- ~ x + y 40 | > variogram(log(zinc)~1, meuse) 41 | np dist gamma dir.hor dir.ver id 42 | 1 57 79.29244 0.1234479 0 0 var1 43 | 2 299 163.97367 0.2162185 0 0 var1 44 | 3 419 267.36483 0.3027859 0 0 var1 45 | 4 457 372.73542 0.4121448 0 0 var1 46 | 5 547 478.47670 0.4634128 0 0 var1 47 | 6 533 585.34058 0.5646933 0 0 var1 48 | 7 574 693.14526 0.5689683 0 0 var1 49 | 8 564 796.18365 0.6186769 0 0 var1 50 | 9 589 903.14650 0.6471479 0 0 var1 51 | 10 543 1011.29177 0.6915705 0 0 var1 52 | 11 500 1117.86235 0.7033984 0 0 var1 53 | 12 477 1221.32810 0.6038770 0 0 var1 54 | 13 452 1329.16407 0.6517158 0 0 var1 55 | 14 457 1437.25620 0.5665318 0 0 var1 56 | 15 415 1543.20248 0.5748227 0 0 var1 57 | > 58 | > ind=seq(1,155,2) 59 | > var1= meuse[ind,] 60 | > var2= meuse[-ind,] 61 | > g <- gstat(NULL, id = "lead", form = lead ~ 1, data=var1) 62 | > g <- gstat(g, id = "zinc", form = zinc ~ 1, data=var2) 63 | > v.cross <- variogram(g) 64 | > plot(v.cross) 65 | > 66 | > 67 | > proc.time() 68 | user system elapsed 69 | 1.528 0.076 1.612 70 | -------------------------------------------------------------------------------- /tests/vdist.R: -------------------------------------------------------------------------------- 1 | library(sp) 2 | library(gstat) 3 | 4 | data(meuse) 5 | coordinates(meuse) = ~x+y 6 | data(meuse.grid) 7 | gridded(meuse.grid) = ~x+y 8 | 9 | mg = meuse.grid 10 | gridded(mg) = FALSE 11 | mg= mg[1500,] 12 | krige(log(zinc)~1,meuse,mg,vgm(1, "Exp", 300, anis=c(0,0.01)), 13 | vdist=FALSE, maxdist=1000, nmax = 9) 14 | 15 | ## IGNORE_RDIFF_BEGIN 16 | krige(log(zinc)~1,meuse,mg,vgm(1, "Exp", 300, anis=c(0,0.01)), 17 | vdist=TRUE, maxdist=1000, nmax = 9) 18 | ## IGNORE_RDIFF_END 19 | -------------------------------------------------------------------------------- /tests/vdist.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 4.4.1 (2024-06-14) -- "Race for Your Life" 3 | Copyright (C) 2024 The R Foundation for Statistical Computing 4 | Platform: x86_64-pc-linux-gnu 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(sp) 19 | > library(gstat) 20 | > 21 | > data(meuse) 22 | > coordinates(meuse) = ~x+y 23 | > data(meuse.grid) 24 | > gridded(meuse.grid) = ~x+y 25 | > 26 | > mg = meuse.grid 27 | > gridded(mg) = FALSE 28 | > mg= mg[1500,] 29 | > krige(log(zinc)~1,meuse,mg,vgm(1, "Exp", 300, anis=c(0,0.01)), 30 | + vdist=FALSE, maxdist=1000, nmax = 9) 31 | [using ordinary kriging] 32 | coordinates var1.pred var1.var 33 | 1500 (180260, 331300) 5.024413 1.114475 34 | > 35 | > ## IGNORE_RDIFF_BEGIN 36 | > krige(log(zinc)~1,meuse,mg,vgm(1, "Exp", 300, anis=c(0,0.01)), 37 | + vdist=TRUE, maxdist=1000, nmax = 9) 38 | [using ordinary kriging] 39 | coordinates var1.pred var1.var 40 | 1500 (180260, 331300) 5.568531 1.112945 41 | > ## IGNORE_RDIFF_END 42 | > 43 | > proc.time() 44 | user system elapsed 45 | 0.593 1.446 0.532 46 | -------------------------------------------------------------------------------- /vignettes/.install_extras: -------------------------------------------------------------------------------- 1 | spatio-temporal-kriging.bib -------------------------------------------------------------------------------- /vignettes/figures/allVgmsDiffWireframe.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/figures/allVgmsDiffWireframe.png -------------------------------------------------------------------------------- /vignettes/figures/allVgmsWireframe.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/figures/allVgmsWireframe.png -------------------------------------------------------------------------------- /vignettes/figures/daily_means_PM10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/figures/daily_means_PM10.png -------------------------------------------------------------------------------- /vignettes/figures/diffs_daily_means_PM10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/figures/diffs_daily_means_PM10.png -------------------------------------------------------------------------------- /vignettes/figures/pred_daily_means_PM10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/figures/pred_daily_means_PM10.png -------------------------------------------------------------------------------- /vignettes/figures/singleStationTimeSeries.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/figures/singleStationTimeSeries.png -------------------------------------------------------------------------------- /vignettes/figures/vgmVsMetricDist.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/figures/vgmVsMetricDist.png -------------------------------------------------------------------------------- /vignettes/gstat.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/gstat.pdf -------------------------------------------------------------------------------- /vignettes/ifgi-logo_int.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/ifgi-logo_int.pdf -------------------------------------------------------------------------------- /vignettes/prs.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/prs.pdf -------------------------------------------------------------------------------- /vignettes/spatio-temporal-kriging.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/spatio-temporal-kriging.pdf -------------------------------------------------------------------------------- /vignettes/st.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-spatial/gstat/bf9410d24800e326b596edd9f8932e33856f0daf/vignettes/st.pdf --------------------------------------------------------------------------------