terra/0000755000176200001440000000000014757546132011405 5ustar liggesusersterra/tests/0000755000176200001440000000000014536376240012543 5ustar liggesusersterra/tests/tinytest.R0000644000176200001440000000012714536376240014551 0ustar liggesusers if ( requireNamespace("tinytest", quietly=TRUE) ){ tinytest::test_package("terra") } terra/MD50000644000176200001440000006204414757546132011723 0ustar liggesusers71637b00c28e55149cbef12f882c0ff1 *DESCRIPTION 4757c95e7e6b0b93c99f856788f7a096 *NAMESPACE c027c711b6b5b3f6d0495224e2f00a2c *NEWS.md d7f44345499d08d1737e4d8d1255b3f2 *R/Aclasses.R fa9197cfd153c4b5b319f2707a3f7222 *R/Agenerics.R 9b12c2d48a965372b09999bb5481d970 *R/Arith_generics.R b23faa7dfc5ab4b894d87d60af83bb1a *R/RGB.R 33fdcea8d3b95cd8a9fb60688a260869 *R/RcppExports.R 3de3105cbf1bbf08ee9784c89dbbbddd *R/SpatRasterDataset.R 80f4b6ed2917f5743f7500b0dc720d6b *R/SpatVectorCollection.R 5e5df58b70afc494698a70bd34d42268 *R/Zdeprecated.R 06715190fa2c6bd79c0c505c01ea3378 *R/aggregate.R 5b3e8c8469a823aa2d04eaca168601cb *R/animate.R 6cb58e9ecea254da819577b896ac99bf *R/app.R c3793596a26b156060f43c5d810af061 *R/approximate.R 1789f11fadb4b32d7eed963949af0379 *R/arith.R 41eecbbb53cb5ee398922900e4c851b7 *R/autocor.R ca752b4ddee117c641774b5afb52d3a4 *R/cells.R 96f499d9b758fd41c377ee7eb8712ec5 *R/clean.R 0d3b4153c53ad1294c5d9e933f277463 *R/click.R b09c318d117700588ab59125d0a28721 *R/clip.R 7cab73c1e264764fe0df8e4737654e35 *R/coerce.R a6ad768dc75900cf2086d7e5a2721d37 *R/colors.R 6b3269181e846a95fae070e45b1dcbf8 *R/connect.R 41816125231cffbd7f1136749e703484 *R/crosstab.R e469eea66bc1c9fec20cee6537d1bdb4 *R/crs.R fc6cb5db30bc67cd0f0a05683977d903 *R/dimensions.R 3da52e0ca72e8540548ccf7ced8c1baf *R/distance.R 4d99540b31df6858ab5cc970ea3654b9 *R/divide.R 0039da85e5a490127955d8407b42319e *R/draw.R b7465750d324b9bcca804257dca977a3 *R/expand.R af82491cf078752961ed7cbefe456499 *R/extent.R 68bdc0ed7f7a7fd1db3385e563e4db24 *R/extract.R 28ef0764008552c098682133220108fe *R/extract_single.R 243cf3f925befbdaf803713f4b0c5b99 *R/focal.R add8bcb355f28e78c6d7bb44653dca82 *R/focalMat.R cd79f2eec85e0dfbac38e754527c0eb9 *R/gcp.R ea5cad6f19806a81bafa89506caaaa22 *R/gdal.R f905e732fa4f7571b6c96a60f0288b38 *R/generics.R 3aed44b7ad5bbca65b5e3e546a29847a *R/geocolors.R d2be4d352fc5d434360fe71437a01860 *R/geom.R a912144edd5a89c7d5df9a06835b2ed8 *R/graticule.R 5da50bd54d43a39c6bd3dd6818eaf168 *R/hist.R b05d6fc85926ac55a5302ab45862f56f *R/ifelse.R 1a389daa4a402653f2af4e6e4eb9e428 *R/image.R 2a7bc7ae0467b6dd99985f1c0f40f76c *R/init.R e5a6a689135700622028eee5f29168d7 *R/inset.R 5516056a89de1642f4bb46f2d470c45f *R/interpolate.R 822e4fd6a34599fba94a10ed7a84f272 *R/k_means.R 79df249930fe7a94644fd28c1f929b75 *R/lapp.R 32ba058ba8058e1db337cc2f5aa2b71f *R/layerCor.R 92631634a51a42b8ab37dd311a3670eb *R/levels.R 09f0a173ec7d9248c9b2f5d23d0eba8d *R/lines.R 37a83c6db763b60ca8642fead8eb986f *R/makeVRT.R 0bb0b8d4d0fe1f5f997f7cf09449a180 *R/match.R 8b072ca7e634250163a2cfdad529ae1e *R/math.R 9ce28577c49fb5834b7ebb0b9adfc92f *R/merge.R 2caa145a80e5e837356b83391ee04f3d *R/mergeTime.R ca4f961028f6ab0b83197e1beb951664 *R/messages.R 5e65cd0320b4d60fd37005c7b5c342aa *R/names.R e594c40a3c82a04d920f1cb6b716bf57 *R/ncdf.R aac84fc82ed9e373736483d28715e392 *R/options.R 4f18aeadc9e87bdbae91649b0d94bd98 *R/panel.R 9e742b984b71d45923982e444fa62c66 *R/plot.R 90f74689ff6da4a2409da41229594bd6 *R/plotExtent.R 0704ab1745345cbaf4e88535fb2393d4 *R/plotRGB.R a79377686287e9f10f275cd0c426b7ce *R/plot_2rasters.R ffbfa9b92467b610f18614a2d5fa4fc2 *R/plot_axes.R ae3f934129a27b1b86e4c2e0f1a14560 *R/plot_cartogram.R 30271689b7289ee3792a538ae22c5416 *R/plot_legend.R 94d5e04a1e4afe9077135eb76503d5fb *R/plot_let.R 384da1bc054c8f185e90bc4a1ac840a9 *R/plot_raster.R 3988c82c521c6e7d70b5788b070df957 *R/plot_scale.R a00b3eaf44dc741939acd6bfad6f3f22 *R/plot_vector.R d41d8cd98f00b204e9800998ecf8427e *R/polygons.R 1ad20e39fc1488d7f997514e27d1dd79 *R/predict.R c9b80ddc621f7ed26b9c6cf7dcd51b12 *R/princomp.R c9adacfaee78f3e1d26bc3ec9cee089b *R/rapp.R c79afbe06cfe6e0ebc606b450436c6c7 *R/rast.R 3bec2f3f6a4ace28837c6a81dbe2c5c4 *R/rasterize.R d49fa94132ab1f7b5364a4512b087cf9 *R/rasterizeWin.R 0961701948dbf1d11df6b7548776bf2f *R/read.R d23bbd02ea2747dabac1c80c617b7bb0 *R/readsvg.R 32108a0fa3606c15f2f7ad746ea5d5c5 *R/regress.R 5bbf2002fad3612f269e63d6e60d84b3 *R/relate.R 87fb82f73868dd11ca2f5071ba1344e0 *R/replace.R 3ab5da63ea95a4156a6257bcc4e154bd *R/replace_layer.R e97fba9936ad40bae07694f04ef5b933 *R/replace_values.R 54ed50d797891bdbfa2e7647ce65d585 *R/roll.R 7abc342437102cef445231ee492d4cfc *R/rowSums.R 347ff9bbf956f39f3c9b05e1e440273f *R/sample.R 4a54212728cfc104ff13c2d79c19648f *R/select.R b819e1fcfcbb607c2878b7cb6adfd66b *R/selectHigh.R 42a133618af864d34055690ea81c1a1f *R/show.R 28eb0b982172d2400cbc8064327a8350 *R/spatDF.R 0044020faff9a42ea66cb4642947e92c *R/spatvec.R 3b99f4edd9e33f117a63c1ee3378b4f3 *R/subset.R 5e4c6b522389c534ddb659404b48bc68 *R/tags.R 087c09aa4281d86c742a2e5148d77c53 *R/tapp.R 1d79ff4e2b0945f738501f7de1fca1b2 *R/tempfiles.R 594ce8cc83c5a39b1332076d34fcf1cb *R/tiles.R 717abd4acb240ed1297e5736e6dc41b4 *R/time.R e192b1ec65e3b16bf289a65ca67746c0 *R/twoClasses.R 81acb963cb7377e1731cf11a7ad656e7 *R/update.R a6f9304937cfa40d002c176ea4ee97df *R/values.R 1f4b3759cf60946ef3127636a10e5d9b *R/vect.R 2bfc16242e9baa246ee18c876c2dcc22 *R/watershed.R 1e01e02d712240b55262cfd653270840 *R/window.R 19b7dc657be2860a0000d90c08685de9 *R/wrap.R a093b3d631787ab84bea42d8e391339e *R/write.R 8a64d6f4cbb56f114a7c19d3a12fa046 *R/xapp.R 7241e67e96b1a447717d97b19e119399 *R/xyRowColCell.R 904a380f2c8090fb4ad90d5e41698c96 *R/zonal.R 23d0f1bef55918a24b3cf2a5888b034f *R/zoom.R eb6176550a52650a82f32d0ffd8b8266 *R/zzz.R 1dda19015f0aa969acee990c150e3ac9 *build/partial.rdb 0513ced67884bcb39614d15070870521 *cleanup fc19b75c7b894ce0f46e1991370bbbf9 *configure 37fd8885d102ea5890eab19ba6d23763 *configure.ac aaead9a66071620fc36f67a7bfbc46d8 *inst/colors/legends.rds a94e0497c4ee7b653400f10409c30386 *inst/colors/palettes.rds 9f0ba0023d2db45f72e80f55a14f63cb *inst/ex/countries.rds d069a3466d5ca118b4330b322793b821 *inst/ex/elev.tif 8f96ed774ae7d7044e223b2d3b3fa3b8 *inst/ex/elev_vinschgau.tif 0d72b29353f0f26827006b4295a9c7b9 *inst/ex/logo.tif c257dbd91925dd42614dda2cf19a58a3 *inst/ex/lux.dbf c742bee3d4edfc2948a2ad08de1790a5 *inst/ex/lux.prj 4ae2847099f7574e36516738dc411a0f *inst/ex/lux.shp 5d6304a3bc11ffe01ffdda30514d15df *inst/ex/lux.shx 17cef336212cebba7255c8b6192d882f *inst/ex/meuse.rds 73eb1eb43061189bcd5bcfedbe9b7104 *inst/ex/meuse.tif 12452890a939a5a22757e2ea328bbb3b *inst/ex/rds_tst.rds 92e7d96043d934c23d2ebab93c560c77 *inst/ex/test.grd cb22d2072ca597b022e481bb86f9f989 *inst/ex/test.gri 7e139df30fc4070d1281d4d12e0ea25a *inst/tinytest/test_aggregate.R c8edb96a09580b019da6a97cdc4bfefa *inst/tinytest/test_arith.R 8feaeafa1f722c34a1c743a233c04753 *inst/tinytest/test_cats.R 26c88abde5cc4082f718d07933b7ea94 *inst/tinytest/test_classify.R d03f43d82734f6bed9399cdd2e995789 *inst/tinytest/test_crds.R b8b1169ae28677221212dabc9281cb55 *inst/tinytest/test_crop.R 131a6e2201fb9ea6bdd8d65053f2cbf8 *inst/tinytest/test_equal.R 5fcf057bdf52c231b56e76ab1ef03458 *inst/tinytest/test_extent.R f2b7c0f74fa473e7fa044e39dd33b4fb *inst/tinytest/test_extract.R 83eb1a390f2bb92eb4bbe01aa6b766b0 *inst/tinytest/test_flowAccumulation.R 094660742a88d0a2128555817154981f *inst/tinytest/test_focal.R a6040097da9aeb00d2ae773481fbab50 *inst/tinytest/test_geom.R 18ecfddfd917b4364468cbe2ce250760 *inst/tinytest/test_global.R cfeebf4bd2c785e3e94a99b52e9f5018 *inst/tinytest/test_matrix-input.R a00e19ade355713974ac0175f2becbf0 *inst/tinytest/test_merge.R f8be1984b0fe280937809e7d03120224 *inst/tinytest/test_multivariate.R 513ac5699d994e56fa629fe3ddeadb02 *inst/tinytest/test_patches.R 66a836ca5c9e527b65df28dec2a4ff42 *inst/tinytest/test_pitfinder.R d7cbdd3f9f9cc1fc2348ebaac5ea516f *inst/tinytest/test_plot.R a01557e9bb896b93da4c35142b6de28c *inst/tinytest/test_raster-vector.R f1a10f8fc4afb5adce3911c22bf06963 *inst/tinytest/test_rasterize.R b9bcb937bf5f83855c8ac5a619a46e82 *inst/tinytest/test_rds.R 2d8c1c8cf9c32b2f38ddc5d9f714e841 *inst/tinytest/test_replace.R adace6cae72c80c444a8e20a3314bfab *inst/tinytest/test_time.R fb2dbd201e5160e88ba1e7b3effe5a11 *inst/tinytest/test_vect-geom.R 66c734dcf4b0da9a4ec506c5d2cd4b54 *inst/tinytest/test_vector-subset.R 8c24b7beb04ec3a113af32799959bf43 *inst/tinytest/test_weighted-mean.R c70af37ab5349e47ebcb776dd697aee4 *inst/tinytest/test_window.R 546aa29e861d525111f4d3c0b2ce7d80 *inst/tinytest/test_wkt_grd.R 088e2ab7721082563d4439ed72a71075 *inst/tinytest/test_zonal.R a6a6d9ea4118f5c809396420826a3d35 *inst/tinytest/tinytest.R 321a8ad6e1183e23526e8c49b09f7ffa *man/NAflag.Rd a23b4344e1df236a2535f18f40c3a519 *man/NIPD.Rd a53dd4fbbf7e78fb796b631c4d33cd98 *man/RGB.Rd 6b5a6c14e696b8f2ed4de9bdb5f978b0 *man/SpatExtent-class.Rd 4dc61bfb7fe5c6f93208bff6cf8b9ae0 *man/SpatRaster-class.Rd 05350d9d6e1be8e30382586c8427c204 *man/SpatVector-class.Rd 118d132641ef7d707bf74954f7705093 *man/activeCat.Rd 8fd23006e2b5a0276d4a318fb7c856c6 *man/add.Rd 613c3405302dd65c7e031e651ceb4a82 *man/add_mtext.Rd acda543eef815af237834f05f73d8966 *man/adjacent.Rd 274a591787b147fc98a78afab74550f1 *man/aggregate.Rd 061fdc6453489ba9635945f103c1750a *man/align.Rd 76cc107de34e4b269c405398ed72a172 *man/all.equal.Rd 3a6083346d4d254394c74c5fd13fe70e *man/animate.Rd 6c81caf77e2b0d4319eedb27302c1d03 *man/app.Rd 1c90c781330d1b64a31e15c6a10505a6 *man/approximate.Rd 69ed9fbc8665a62ad9effdfb41211d2a *man/arith-generic.Rd 0705871cfef34b24c39f5797ede5ddcb *man/as.character.Rd ca4ff548bd76bd7529f52e9283065d67 *man/as.data.frame.Rd 8a3b81c94d148cb608fa64c11cf042e7 *man/as.lines.Rd a60010d647f00a02cbceada18a7e193a *man/as.list.Rd 948f3321a26266ef5321394de2fa7198 *man/as.points.Rd 17368ea9f91168df3fdd85faae008446 *man/as.polygons.Rd cbfbc0bc5e83a7d11588032c78a53050 *man/as.raster.Rd d423e2ecb6c6a2cc19798dca7572c1fb *man/atan2.Rd 83e8404f596acf01ca160f2fdbcca6a5 *man/autocor.Rd 8614a7923698984e48afdb03d575c22d *man/barplot.Rd 6042b7dd3ebb7caec03a161ab16c36ff *man/bestMatch.Rd f36c3984f0ffad80d76b64b483b8780b *man/boundaries.Rd 568fab14b3e52555d37daaf12e158e9d *man/box.Rd 199831f20e422396c648850549256fe6 *man/boxplot.Rd 2cbc8b3be2befd82d5edc8cb572578a0 *man/buffer.Rd 183820d00930f52c500991819622298d *man/c.Rd 3dead3a716ff5f508cb57ba9a41eb572 *man/cartogram.Rd 7794859ad2e9953aeb1125b6233f44f9 *man/catalyze.Rd 448f9aa1aa56c0c09a399b5ce9fa0699 *man/cellSize.Rd c7421526d1abcb0e3644d4a7ca8c342e *man/cells.Rd 51cf38969dbd92e2c18ccb3bbfe2b2d8 *man/centroids.Rd 454c1d1cc94136a3678fc855d1e76678 *man/clamp.Rd 6e2642f3a5d9d030447b548d77e839fa *man/clamp_ts.Rd f260bbe7e11a92f979bc06bb7098336c *man/classify.Rd ca0663d2cd69d8b44c69383eeadc1a9b *man/click.Rd 984291f794cefdf329cd7f16520aaff2 *man/coerce.Rd 185dc0ce9675fdf4f012aadffe31aae3 *man/collapse.Rd b99b1129faa82d48e97ece771aefaeac *man/colors.Rd 7914610933fbccfe62d7e890b39faa37 *man/combineGeoms.Rd 0a27e22180073cf675c07bbf64b6f434 *man/compare-generics.Rd 6d055f9e010575f85dc922988d906f93 *man/compareGeom.Rd 26820d945ed3742a07b34ef56b40cfaa *man/concats.Rd 83b3adfd5111096113583fea8a5e7dd0 *man/contour.Rd e5612a2268375b78b46b3bd39d0539bf *man/convhull.Rd f1197dbea22cf30a61a096321aca606a *man/costDist.Rd f9a3ae571230e63ba791370f172cdd55 *man/cover.Rd c322c89f9aa9a911234407c4a0dabaed *man/crds.Rd 6704d7ed6803d495e02223eb222e1963 *man/crop.Rd 32e284b3d6118e9180e712339788988f *man/crosstab.Rd 7d7b927ba90065e602015e9f9eb0ec79 *man/crs.Rd 7a61ae45235eefcef217ea7ed3217693 *man/datatype.Rd 0d2278667be3679be4d1bcca6cf517b1 *man/deepcopy.Rd cd87a135b0446ea63fad43a326814464 *man/densify.Rd faf1c4471cff59222f6c6d4a20463466 *man/density.Rd e4eb50a546a7182eadbce6e01b6b4b9a *man/deprecated.Rd 2a4dae82f7c9b8bd31802b5c66c089d6 *man/depth.Rd 61afe26c0de046b6fa80e480f9019da7 *man/describe.Rd 24b0b04945df9309f1cef04e010060c1 *man/diff.Rd 59c7eef11e2762a0d8c464f197b0a9ce *man/dimensions.Rd 7b07ea19288c1c099edd6676b70a176b *man/direction.Rd 6eb62722bfff62ba87275f21dfa36575 *man/disaggregate.Rd b99103ebd418b40ce044cce3678be889 *man/distance.Rd d24b9dd182be8ff46ca3f9fbdaaed995 *man/divide.Rd 8b0b99ecdc05b8d6362f3134c661a2ce *man/dots.Rd b203545f0c838dcec19e09023cdfca40 *man/draw.Rd cb6dbd29fc799ea43bb6a6f5e4b5bf6e *man/elongate.Rd 6ab38fce4d104819e61bd5b62bf66f25 *man/erase.Rd faab5ebf4398dbd41864ce719bf87af8 *man/expanse.Rd 59b4edf964c460e4857fd4e5c07f676d *man/ext.Rd 41b50a6b62704032d5c24f6f2c670e0d *man/extend.Rd df556d8bd515afba61093bbf2b2afba2 *man/extract.Rd 4fb4772021da92fde9082acfb4032e50 *man/extractAlong.Rd e96d4299dfd04abd16915e194e798949 *man/extractRange.Rd e143c9e03131bbb5bc1036f9dfbeacec *man/factors.Rd 97d6828fc02dbd2cf107273bc05defa5 *man/figures/logo.png e30e0f9d952ab6159b275cf5d0a1e98e *man/fill.Rd 5c89c58d1472a836cba05c4420e98a14 *man/fillTime.Rd cc3af891673343eeec393bdbaf362757 *man/flip.Rd f6a004bcd30726d57fde262192e6f41e *man/flowAccumulation.Rd 295e7d5a52ddd0ecc045364823277dde *man/focal.Rd e2c5e09ce90b8e2a59b971b6a77c6859 *man/focal3D.Rd e314829650b7eedee663eaf86e0c4843 *man/focalCpp.Rd 47803e42efab08728739a19d5ddf4aed *man/focalMat.Rd 93ac1004dda64196173b1e632720cd43 *man/focalPairs.Rd 66169557d93e330928a1c3f9f40f1100 *man/focalReg.Rd 9533accb9a815f4c10aa88267e4a588b *man/focalValues.Rd aef2f484b01cfef5ed788c8875af87d2 *man/forceCCW.Rd 36116899147b5b77f5f150cce362900c *man/freq.Rd 42f1051c62125b9422683af679898855 *man/gaps.Rd c6e0ac3565f04bddeca88942cd5e6d35 *man/gdal.Rd 675161335618fc80ba8ed23080d10ead *man/geometry.Rd c6c2cad8351984875ffbee1e340adfd9 *man/geomtype.Rd 39e005935207fb90b6ec91e0ead34bff *man/global.Rd 596ae9b2f7ca20058491d7b62b5867a0 *man/graticule.Rd a0877f8dde70295635f8d583ef880c94 *man/grid.Rd 5afeb76c6a866389dda4120ac20909c3 *man/gridDist.Rd 694b074b3ce6ab67aae71f7cd9e01e50 *man/halo.Rd 925193bba602f6c94b6d14c0eeebe749 *man/headtail.Rd 0b9de826e4d6987350dcd1963415628a *man/hist.Rd 74252558e170b4dc5fa1f381fda5ced4 *man/identical.Rd 6aae87cfcb10b9a1ee69727b6b5b5a85 *man/ifelse.Rd e65ea2e69d005685b88b8c7d48069241 *man/image.Rd 43c208bb26e1e75bf1d8a6714b5d1267 *man/impose.Rd 0040863c4ea2b35731080d328356b2ae *man/init.Rd d4be5ec342be8138b4f7d566f4587205 *man/inplace.Rd 2959cf1e97af288ac31143f5e433c5c8 *man/inset.Rd a710d899c2abf432feabdcaf226dd601 *man/interpIDW.Rd f3b63254fc87d7cd0b9d8e3723ef538a *man/interpNear.Rd 4b514833da02f9f1a25873a6400dee98 *man/interpolate.Rd d294ce0c182e4b313281360726c16273 *man/intersect.Rd 21ab0604cc21e837a0ceee7803fa4ef8 *man/is.bool.Rd 96fbca86ffc372143244ffbfbba1a494 *man/is.empty.Rd e042199c2ec6fb8cdbbadbea46fc16c9 *man/is.flipped.Rd 2db0c24e9ce375b6b35da508c434f2cf *man/is.lonlat.Rd 2d258edc3ac30eb8765aa7294e55ad9f *man/is.rotated.Rd d8b0e91c600b96e3b77971a8e217521a *man/is.valid.Rd 2694dfdae0c96d32e4be224ef58eef40 *man/k_means.Rd f2647dc9f2cff2fcdd6a3346cdaf23f5 *man/lapp.Rd 598933747a63404a75bc6be6734bf1fa *man/layerCor.Rd a8109a4b29b32e7a5828962aa5e07237 *man/legend.Rd d16d5b8e7f00c06b9435eaf8af4d2fdd *man/linearUnits.Rd 73a63cc128a83ef18e4fb8c3e6319ea6 *man/lines.Rd fe3af65fa878cde3aa9a1be82ca28244 *man/makeTiles.Rd f722621bda82818d8f26908770483be6 *man/makeVRT.Rd 282273552dfcbf95ac4e8fc7a065bb48 *man/map_extent.Rd 4f71d2f3e74465df2ed673dd063548c9 *man/mappal.Rd 9b73e09bebb92db5fa1de14bd519776a *man/mask.Rd 1a3c94d517fc6408dccfe2115a52ae8e *man/match.Rd 587dec10aee5fdf467bfc6e611f7d51e *man/math-generics.Rd 20cd6cee7690b02d8795d475f2f7120d *man/mem.Rd 085753ad3e4d1d7764dfa202fd1c632c *man/merge.Rd b98d26a8dd480a7284d5ff9752ef29a2 *man/mergeTime.Rd 4d95a5ee1d7967693ada6923218ab87e *man/meta.Rd 94dd46c44f6372bd78e8ad77248ac00b *man/metags.Rd ab4e5fe24aced14afac858d877d2b5bc *man/minmax.Rd 8de5bdfef13bf2c64fb8e43f3dba8f8a *man/modal.Rd b05e7a2dcddc21b7045c3fa71de99851 *man/mosaic.Rd 4e8f5ff85d378747f6af287d013c206a *man/na.omit.Rd e68f3e58dfc462d1cbeb63741ce81b35 *man/names.Rd 95a9aded1e7b26ee368ff58fa0df8699 *man/nearby.Rd 526c2587a72cb8b8745181042ae44c2d *man/normalize.longitude.Rd db47941dce499568738a2eda6903b781 *man/north.Rd fd58934e5aec292191a1a49b6d3c3d56 *man/not.na.Rd d237565e037a0718c86e9d9898f44b88 *man/nseg.Rd 60df38237628e8eac85da0ae9845d1bc *man/origin.Rd c93380632eae621f097bbef64b44beb4 *man/pairs.Rd 607c426cc96fcc3b2930039cec563645 *man/panel.Rd ad922989d79013e144d184c55df80c6a *man/patches.Rd 1d98b01c9a77080691ba899f2f5cc84e *man/perim.Rd e357456cf972f6c184aa0b44cc5bd51d *man/persp.Rd ec9c28967a754a03d4b9ba4d7125d8d8 *man/pitfinder.Rd a5f60de7a354bb50e0eb82debd8feb44 *man/plet.Rd 3f74aedeeba268763d3961c17fa3f91b *man/plot.Rd 0969099c51421506af5ff407b8316408 *man/plotRGB.Rd 11420b226613b5d74cd878f9e93a3f8b *man/plot_extent.Rd 930d41510d506976de052e3ca0f73415 *man/plot_graticule.Rd f0fa744f22aac76f46b2d8685cd0f710 *man/prcomp.Rd 2907a928ee2f2f8616cbb53d7dd5d89a *man/predict.Rd 875c96bc2e390bcdd1e3e37077087495 *man/princomp.Rd 234df1daf878bbf8310de2d362a1056c *man/project.Rd 6afc9583c42bf2bd31b998d52dde7506 *man/quantile.Rd 432cdd2dc3c1d3e0a0bce6f650dbfa9a *man/query.Rd bbe85d85c9f56816db51c00cbf721f1a *man/rangeFill.Rd 0bde183d3253871b652028c966efaa8f *man/rapp.Rd 54e65e7fe54833e865c51b00ebd92118 *man/rast.Rd 0021a3764815218015c8dd1fb9f537ac *man/rasterize.Rd 0970d39129e32c18f67da4ac61bd5ddb *man/rasterizeGeom.Rd b66a73b8867b7f9982ecdfd81e8625f6 *man/rasterizeWin.Rd 608806347d8adf840963d3ccbefff538 *man/rcl.Rd c0aca51ebb2c95ed49fb4482b401c907 *man/readwrite.Rd 50a7c5d8d96931c4a4410520dc86d7d0 *man/rectify.Rd bd8aa9eb83d0d8c77e7dbf21d935fa10 *man/regress.Rd af0e711d038d3fca486eeb07c2da9519 *man/relate.Rd e81f21854d60782f0dad55ebf451cf28 *man/rep.Rd 15c37cb56b2bb8b062686a669d9b8664 *man/replace_dollar.Rd 0d508b23dc915d99bafad9bdd5daa7b6 *man/replace_layers.Rd e4d9b292bb94d60300213788fe5a30cd *man/replace_values.Rd 2f8be6d5fa2f83e788adf8295dad781b *man/resample.Rd 278d35322fb401a3fed3a262a0c6ba60 *man/rescale.Rd d56f78dd23a20215dd72f4cf4671e2d8 *man/roll.Rd 6cf69cf2625d1ca0b9b617315ffc4b3a *man/rotate.Rd 36ed7d949f5c2ebabd816716ce0adca1 *man/rowSums.Rd 8eeaa03c92f4ca7c995a9c238039c4ff *man/same.crs.Rd 6b194bc44b821f162ff86c10b3b6afb5 *man/sample.Rd 02a8a45f1f1de184e40efc11d1db567c *man/sapp.Rd 08229374a7b2f4a5f6bbaa4f379949e8 *man/sbar.Rd 273c5344b5de00762784d54c212b65aa *man/scale.Rd 3f78b533206bec0eff1c300a73813b79 *man/scale_linear.Rd d3220149ddfbefc0ba4a5809ca311ded *man/scatter.Rd fe02d9ab735741761c8be070f452c835 *man/scoff.Rd ef386f6ecfc821437554268e1fc1b99b *man/sds.Rd d27839336a11fc40860f8aaef7d11f1d *man/segregate.Rd f3bfd4893087ddf49e19c4ff8224cc3e *man/select.Rd 489452d97aa215dbb5f649cea6dcc6aa *man/selectHigh.Rd 2dd23b1e5be856bb0ff420b880c6df78 *man/selectRange.Rd e3738b704a5f726ab70e381333b7ea4f *man/serialize.Rd 937c7948e436b535a9a54c618d60dcd5 *man/setValues.Rd 6f806895bd965b626a5c9c38f4397fef *man/shade.Rd db50cdd7e9cb2a20e1147061132a298b *man/sharedPaths.Rd 01482a352d2297423e55171eb2df26ec *man/shift.Rd 8d7c8998e764b886f5d4a98f3d69d352 *man/sieve.Rd 9d77318817e6696d84ecec29c8c097a2 *man/simplify.Rd 11e3386c36a54d84b18170161f85827d *man/sort.Rd 80141a8dbeef6a9b40bdc04c2e8b05a0 *man/sources.Rd 807af9be8bd68eb45f76fec13a578fa7 *man/spin.Rd 0bee5141a6f76aec9d7b74944eaa5d43 *man/split.Rd 9d689b5b8d63e24f077099f9ff93fc79 *man/sprc.Rd c2a9b0773125bb99f2bb7a915915c440 *man/stretch.Rd a77164321364a30a923799f0101bc36e *man/subset.Rd c8534fe735f7f538cd950af63da61b88 *man/subset_dollar.Rd 9fb79c3450e7f010d4b38fdddde63f05 *man/subset_double.Rd 614af029059cd625c03bdde5be5c2857 *man/subset_single.Rd af4940ab004733b520c115defaf83469 *man/subst.Rd bae89dbea4405a31b79263c7552c5517 *man/summarize-generics.Rd 9e9bb2ae7ac1c9b37eb18eee2f575f31 *man/summary.Rd 10b0f361feb8dff93ae8bb9e01f6119b *man/surfArea.Rd b244c8dedb350346bfac83871dd5bd25 *man/svc.Rd 0c1ba336644bd0a82809bbee5c349c0a *man/symdif.Rd 04e97d5d195dc68699874c2b4bd37938 *man/tapp.Rd 67ee33ba76c98441f209158231b6495d *man/terra-package.Rd 9d76b2b088fd55a5343a4430bfb2cbba *man/terraOptions.Rd 7a7e171b01ab272b493786beaac725ed *man/terrain.Rd 81c9107bd3a9b460d5e6d6979d5a1994 *man/text.Rd 7e5167462782680e12b963356cb03f9f *man/thresh.Rd faa42eb1d6f2bd3b92d019185d309c44 *man/time.Rd ae88830dbecb413f40f443481bb14185 *man/tmpFile.Rd d8f8fae10dec8538b0bc3ba11c5f9d98 *man/toMemory.Rd f58714e38430b02be79824bfc4d34eed *man/topology.Rd 1525964261b9fb412511f9502041cb5b *man/transpose.Rd 3cf14b93c4f4a2827706bd454aec0158 *man/trim.Rd 3dd2993f1a7e34ead75c145c2d8b9b96 *man/union.Rd 8962724a7ce4d7054b9f4eab6298fa27 *man/unique.Rd 2650f9770acd68a577abdf12225244a9 *man/units.Rd cfef00666cd46111df5e813a91fefcd9 *man/update.Rd 828b00e844ccd21d1820b9d91c7cbcba *man/values.Rd aea4e041d5597a60d6e816be3e567b12 *man/varnames.Rd 35ff519fb38777f5e453ec5d99040a94 *man/vect.Rd 760ff35a4177d540edd596c94c1e0a13 *man/vector_layers.Rd 094485ef6bba83695786032b91333998 *man/viewshed.Rd 2bb66d8ff15e7bb8edad474353f58b3d *man/voronoi.Rd 2a54e35b77cdd8d46facbc1604f3e654 *man/vrt.Rd bc605ee87b968b8040c98188be3706df *man/vrt_tiles.Rd dc482c611786ff5d4334c89adf6c855d *man/watershed.Rd bff544bda735421c8d7e3b0651551cdf *man/weighted.mean.Rd eae88e03678f2292908e2c1af0f62f77 *man/where.Rd bce7d4d8f571269f439e622baa9561e9 *man/which.Rd 7948cc222f59a33da3275297344ccf34 *man/width.Rd 3eed9594e44e8a75efb07e0a1adb3de0 *man/window.Rd dd05d05523a22f7351deb0a2aca42692 *man/wrap.Rd f895544f09351d5b020f1f5e78ebea68 *man/wrapCache.Rd 061b19dbc51cd989716bf8bb7ac19541 *man/writeCDF.Rd d7e8639d995cd288cca6ada9804e36fd *man/writeRaster.Rd 224cd1125f6f24bd4c3f8e8077b5086c *man/writeVector.Rd d2a8eb7019dad0ff2f1f28c6dd94e4db *man/xapp.Rd d9539616f11511e03e98b9480329d7dd *man/xmin.Rd b099812d99636e5471c906277c31a0d8 *man/xyCellFrom.Rd acd6392aa66b624f157cde2b35ba56df *man/zonal.Rd c0daf4b5eab6db54cb42b76e7dcc6402 *man/zoom.Rd ea9e4cdf5ff0217b94ffb7ba6663bb90 *src/Makevars.in 867989920ee5e94a1a22334827bc604d *src/Makevars.ucrt ee336a2cba1048d73e746db66c8cf0e4 *src/Makevars.win 4b35eab705c5561f987af28d368ed72b *src/NA.h 4ad9c71c26797488332b6a2e34af3f28 *src/RcppExports.cpp c974412ae34bbc3b188fae32f76c5f1e *src/RcppFunctions.cpp c18da85fae44cb0ae08d8411dd7f1090 *src/RcppModule.cpp 4c1a81c345e9bddc484310d805dfb061 *src/arith.cpp 7f3d6c5a21d4d67f49a236d4d1032613 *src/common.h 7fd83fcefcfcef5f9c9246693403a8ab *src/crs.cpp de659796a8789d05c6fbf3ef24cfbe82 *src/crs.h 1b8482f0bce855911081772c074b4ccc *src/date.h 4374586bc7f17d7544a3804e6cb8caa5 *src/distRaster.cpp f64401e8747c1fb6ce1bda8ca8b66fd6 *src/distValueRaster.cpp d1286366d27e5417053f514636869011 *src/distVector.cpp 165a71e17d9f0166a7f20f66bafb85a4 *src/distance.cpp 91af5eb8f1fd7fc778e4dbc9e299658d *src/distance.h a38f5c004a24e33aff016faf23353248 *src/extract.cpp b98245f7f34509d95955a0696e9af713 *src/file_utils.cpp ddd2a1c0d715fbd6e9aae454a475351d *src/file_utils.h ea659d68dd1d329cae534dcb8917bc32 *src/focal.cpp d3edfb952cc538d55bc27c3adaf40235 *src/gcp.cpp a14270a28abce4f3d4feb859204a95cb *src/gdal_algs.cpp 81171ea0bd83d4f4b58d1ab3bb53b3ff *src/gdal_multidimensional.cpp 9f681dfc10cf545bf43e65d6d3c40ec6 *src/gdalio.cpp 879382455567cd0cf1a1c09482557f1c *src/gdalio.h 4f277083c49bd086621abc203160e993 *src/geodesic.c 598c2f9f280f518436b2f8876df17a81 *src/geodesic.h d19b30117c31fbdd02984b5b147e5d33 *src/geos_methods.cpp 44fedf6a1a78342636e8335aa76bf831 *src/geos_spat.h aeb79f248f5aaff5de2fb72bdace2c27 *src/geosphere.cpp 3f3aa5a717765c99d893954f8f88f3bd *src/geosphere.h 931af2f8b47c60e7da1e76eb5a8e9c12 *src/math_utils.cpp c007021906d28ea503266237ab7e6bf3 *src/math_utils.h 7e5be69595d9214130a17fc1e03fc38f *src/mediancut.cpp e66941c02181837472bd165bf0abb97e *src/memory.cpp 711bd99d414fc12792dc05e6942300dc *src/movingWindow.cpp a990f9287b3a90b018277efcd5208e4e *src/ncdf.cpp ef6d96caf8010782499d4d25e7e8d981 *src/nearest.cpp a6f8ae71d4fabec722fc5bed0e7173c0 *src/patches.cpp fbbbf921bfa4cc8e2480ad631229e8ee *src/ram.cpp 24dd35fc3503bf56e551bf7e93464aff *src/ram.h 72f680717856ad8ae181033b01af4a4b *src/raster_methods.cpp fb903e29f74f918872215e185df8f6b0 *src/raster_stats.cpp 7df99edb124e766c4f31d1f0ff56d777 *src/rasterize.cpp 9848700fe92a40b539a9ec22e0f36d79 *src/read.cpp b4453328091fbd74a05797c66c5d7b7e *src/read_gdal.cpp b2668b5918f391540323f21589d5eb57 *src/read_ogr.cpp 6e8eafe468bdb7cd2971df858e54ebff *src/recycle.h fdd096dce7bf9418bf53b9f0cccd4441 *src/sample.cpp 80ba0afdf0cb574d93fe5f7ec6b8a44e *src/sort.cpp 7eae6701d6fcb5aaa3ae2923cff52dd5 *src/sort.h 04a64ff00e1049db115516c4ccb82a71 *src/spatBase.cpp 97c681a3227680a38ed0eebd8c98d05a *src/spatBase.h fbb0c120ea1864ef2401f282caf89657 *src/spatDataframe.cpp 7cbb453fa7763f3a55437b3f47f5ce91 *src/spatDataframe.h a79edef25a4f21bfa0f371d21ea3fe8c *src/spatFactor.cpp 73aad8949ac811fdb3f862bae9156dd1 *src/spatFactor.h 3357ec025b3f93f17e3b8f4ca889d412 *src/spatGraph.h 9b8887f819ce65aaecce6f73f614a26f *src/spatRaster.cpp 39237302bab1502ff42878d5e8bfda24 *src/spatRaster.h 4192e49304bcb39143bf8f2ddbdaba3f *src/spatRasterMultiple.cpp 7d4ebc2309bb120f31fb6516d3afcdc0 *src/spatRasterMultiple.h 532d90eeaf345ddbfca1cf043c00ebe1 *src/spatSources.cpp fa6011bbd96d68913be19cf3903e0a28 *src/spatTime.cpp d5b666b9ff06031f0edc40ce889e93ff *src/spatTime.h 4d4426258ac79bcc648daee3f9b563b2 *src/spatVector.cpp cd75c5e8f0f293e6e6bb547b4f40d25d *src/spatVector.h e646cc146edacd776714bc342c8ab26f *src/spatVector2.cpp 47282d3135ae24daa13302bd80c35c30 *src/spatVector2.h 44139367d4fd7090431af8392a277b41 *src/string_utils.cpp 8ed2ff99c1a429606cc725c15fb7076c *src/string_utils.h 0a19b1dc50e51f9087e3ec389495b95c *src/surfArea.cpp e652316257a89e196195bc21749e6ee3 *src/vecmath.cpp c7ba2153430978f4d1ac306aa75f7f35 *src/vecmath.h 3bd60fc636b2de507549ec4f8249fbab *src/vecmathse.cpp 445b7456d033e07766fc1a17fe0b8a2b *src/vecmathse.h 45384676e1f54eedf3cd5f94ee39533d *src/vector_methods.cpp 34796d2a5d565bf5675947e8eed9a58b *src/watershed_internal.cpp 90ea0c1db389e9259ead0e4beb6b7c17 *src/watershed_internal.h 35f2d76ce320f8d9ee555585787ed8ce *src/write.cpp a2993ec81ea596bf40a04bdcc7bd482f *src/write_gdal.cpp 03fc3ed223cf273c03117c9c16e98749 *src/write_ogr.cpp a6a6d9ea4118f5c809396420826a3d35 *tests/tinytest.R terra/R/0000755000176200001440000000000014757467211011606 5ustar liggesusersterra/R/plot_raster.R0000644000176200001440000006606214736572530014277 0ustar liggesusers hexcols <- function(out) { get_col <- function(cols, alpha) { if (isTRUE(alpha < 255)) { grDevices::rgb(t(grDevices::col2rgb(cols, alpha=TRUE)), alpha=alpha, maxColorValue=255) } else { i <- !grepl("^#", cols) cols[i] <- grDevices::rgb(t(grDevices::col2rgb(cols[i], alpha=FALSE)), maxColorValue=255) cols } } if (NCOL(out$cols) == 1) { out$cols <- get_col(out$cols, out$alpha) } else if (NCOL(out$cols) == 2) { out$cols[,2] <- get_col(out$cols[,2], out$alpha) } else if (NCOL(out$cols) == 3) { out$cols[,3] <- get_col(out$cols[,3], out$alpha) } out } .default.pal <- function() { opt.pal <- options("terra.pal")[[1]] if (is.null(opt.pal)) { map.pal("viridis", 100) } else { opt.pal } } .as.raster.rgb <- function(out, x) { if (is.null(out$rgb$scale)) { scale <- 255 if ( all(hasMinMax(x)) ) { rng <- minmax(x)[, 1:3] scale <- max(max(rng[2]), 255) } } else { scale <- out$rgb$scale } if (!is.null(out$rgb$zlim)) { if (length(out$rgb$zlim) == 2) { out$rgb$zlim <- sort(out$rgb$zlim) if (isTRUE(out$rgb$zcol)) { x <- clamp(x, out$rgb$zlim[1], out$rgb$zlim[2], values=TRUE) } else { #if (is.na(zlimcol)) { x <- clamp(x, out$rgb$zlim[1], out$rgb$zlim[2], values=FALSE) } } else if (NROW(out$rgb$zlim) == 3 & NCOL(out$rgb$zlim) == 2) { for (i in 1:3) { zmin <- min(out$rgb$zlim[i,]) zmax <- max(out$rgb$zlim[i,]) if (isTRUE(out$rgb$zcol)) { x[[i]] <- clamp(x[[i]], zmin, zmax, values=TRUE) } else { #if (is.na(zlimcol)) { x[[i]] <- clamp(x[[i]], zmin, zmax, values=FALSE) } } } else { error('zlim should be a vector of two numbers or a 3x2 matrix (one row for each color)') } } if (!is.null(out$rgb$stretch)) { if (out$rgb$stretch == "lin") { if ((!is.null(out$rgb$zlim)) && (length(out$rgb$zlim) == 2)) { x <- stretch(x, smin=out$rgb$zlim[1], smax=out$rgb$zlim[2]) } else { x <- stretch(x, minq=0.02, maxq=0.98) } } else { x <- stretch(x, histeq=TRUE, scale=255) } scale <- 255 } RGB <- values(x) RGB <- stats::na.omit(RGB) naind <- as.vector( attr(RGB, "na.action") ) if (ncol(RGB) == 4) { alpha <- RGB[,4] RGB <- RGB[,-4] } else { alpha <- out$alpha } if (!is.null(naind)) { bg <- grDevices::col2rgb(out$rgb$colNA) if (is.null(out$rgb$bgalpha)) out$rgb$bgalpha <- 255 bg <- grDevices::rgb(bg[1], bg[2], bg[3], alpha=out$rgb$bgalpha, maxColorValue=255) z <- rep( bg, times=ncell(x)) z[-naind] <- grDevices::rgb(RGB[,1], RGB[,2], RGB[,3], alpha=alpha, maxColorValue=scale) } else { z <- grDevices::rgb(RGB[,1], RGB[,2], RGB[,3], alpha=alpha, maxColorValue=scale) } out$r <- matrix(z, nrow=nrow(x), ncol=ncol(x), byrow=TRUE) out } .as.raster.continuous <- function(out, x, type) { Z <- as.matrix(x, wide=TRUE) Z[is.nan(Z) | is.infinite(Z)] <- NA Z[] <- round(Z, 12) # loss of precision # z <- stats::na.omit(round(as.vector(Z), 12)) z <- stats::na.omit(as.vector(Z)) n <- length(z) if (n == 0) { #out$values = FALSE out$range <- c(NA, NA) out$legend_draw <- FALSE return(out) } uzi <- unique(z) if (type == "depends") { if (length(uzi) < 9) { return (.as.raster.classes(out, x, Z=Z)) } } else if ((length(uzi) == 1) && is.null(out$range)) { return (.as.raster.classes(out, x, Z=Z)) } if (is.null(out$range)) { out$range <- range(z) # out$fill_range <- FALSE } else { stopifnot(length(out$range) == 2) if (out$fill_range) { out$range_filled <- c(FALSE, FALSE) if (!is.na(out$range[1])) { if (out$range[1] > min(z)) { out$range_filled[1] <- TRUE Z[ Z < out$range[1] ] <- out$range[1] } } else { out$range[1] <- min(z, na.rm=TRUE) } if (!is.na(out$range[2])) { if (out$range[2] < max(z)) { Z[ Z > out$range[2] ] <- out$range[2] out$range_filled[2] <- TRUE } } else { out$range[2] <- max(z, na.rm=TRUE) } } else { if (all(is.na(out$range))) { out$range <- range(z) } else if (is.na(out$range[1])) { out$range[1] <- min(z) } else if (is.na(out$range[2])) { out$range[2] <- max(z) } } if (!any(out$range_filled)) out$fill_range <- FALSE } breaks <- .get_breaks(z, length(out$cols), "eqint", out$range) # if (isTRUE(out$fill_range)) { # zrng <- range(z) # breaks[1] <- zrng[1] # breaks[length(breaks)] <- zrng[2] # out$frange <- zrng # } else { # out$frange <- out$range # } if (length(breaks) == 1) { Z[] <- out$cols[ceiling(length(out$cols)/2)] } else { Z[] <- out$cols[as.integer(cut(as.numeric(Z), breaks, include.lowest=TRUE, right=FALSE))] } out$r <- as.raster(Z) out$legend_type <- "continuous" if (is.null(out$levels)) { out$levels <- 5 } if (is.null(out$leg$digits)) { dif <- diff(out$range) if ((dif == 0) || (length(dif) ==0)) { out$leg$digits <- 0; } else { out$leg$digits <- max(0, -floor(log10(dif/10))) } } if (is.null(out$leg$x)) out$leg$x <- "right" out } prettyNumbs <- function(x, digits) { x <- formatC(x, digits=digits, format = "f", flag="#") x <- substr(x, 1, digits+1) gsub("\\.$", "", x) } .as.raster.classes <- function(out, x, Z=NULL, ...) { if (is.null(Z)) { Z <- as.matrix(x, wide=TRUE) Z[is.nan(Z) | is.infinite(Z)] <- NA } if (all(is.na(Z))) { #out$values = FALSE out$range <- c(NA, NA) out$legend_draw <- FALSE return(out) } fz <- as.factor(Z) if (!is.null(out$levels)) { if (is.null(out$leg$legend)) { out$leg$legend <- as.character(out$levels) } levs <- out$levels } else { levs <- as.numeric(levels(fz)) digits <- out$leg$digits if (is.null(digits)) { if (length(levs) > 1) { d <- ceiling(1 / min(diff(sort(levs)))) decimals <- round(log10(d) + 1) } else { txt <- format(levs, scientific = FALSE, digits=18) txt <- unlist(strsplit(txt, "\\.")) if (nchar(txt[1]) > 3) decimals <- 0 else if (nchar(txt[1]) > 2) decimals <- 1 else if (nchar(txt[1]) > 1) decimals <- 2 else if (txt[1] != "0") decimals <- 3 else if (length(txt) > 1) { txt <- unlist(strsplit(txt[2], "")) i <- which(txt != "0")[1] if (length(i) > 0) decimals <- i+2 else decimals <- 9; } else { decimals <- 0 } } levs <- round(levs, decimals) } out$levels <- levs if (is.null(out$leg$legend)) { if (!is.null(out$leg$digits)) { out$leg$legend <- prettyNumbs(levs, digits) } else { out$leg$legend <- levs } } } out$leg$digits <- NULL stopifnot(length(out$leg$legend) == length(out$levels)) nlevs <- length(levs) if (NCOL(out$cols) == 2) { i <- match(Z, as.numeric(levs)) Z[] <- out$cols[,2][i] i <- match(as.numeric(levs), out$cols[,1]) out$leg$fill <- out$cols[i,2] } else { ncols <- length(out$cols) if (nlevs == 1) { cols <- out$cols[length(out$cols)] } else if (nlevs < ncols) { i <- round(seq(1, ncols, length.out = nlevs)) cols <- out$cols[i] } else { cols <- rep_len(out$cols, nlevs) } out$leg$fill <- cols Z[] <- cols[as.numeric(fz)] } out$r <- as.raster(Z) out$legend_type <- "classes" if (is.null(out$leg$x)) { if (is.null(out$leg$ext)) { out$leg$x = "default" out$leg$y = NULL } else { if (length(out$leg$ext) == 4) { out$leg$x = out$leg$ext[1] out$leg$y = out$leg$ext[4] } else { out$leg$x = "default" out$leg$y = NULL } } } out } .as.raster.factor <- function(out, x, ...) { z <- round(values(x)) #z[z<1 | z>256] <- NA z[is.nan(z) | is.infinite(z)] <- NA if (all(is.na(z))) { #out$values = FALSE out$range <- c(NA, NA) out$legend_draw <- FALSE return(out) } out$levels <- sort(stats::na.omit(unique(z))) if (out$all_levels) { ilevels <- 1:nrow(out$cats) out$levels <- out$cats[,1] } else { ilevels <- match(out$levels, out$cats[[1]]) if (any(is.na(ilevels))) { warn("plot", "unknown categories in raster values") } } if (!is.null(out$coltab)) { # avoid multiple colors for the same category ilevs <- stats::na.omit(ilevels) ulevs <- unique(out$cats[ilevs,2]) if (length(ulevs) < length(ilevs)) { z <- out$cats[match(z, out$cats[,1]),2] i <- match(ulevs, out$cats[ilevels,2]) j <- out$cats[ilevs[i],] z <- j[match(z, j[,2]), 1] out$cats <- j out$levels <- sort(stats::na.omit(unique(z))) #out$coltabt = out$coltab[match(j[,1], out$coltab[,1]), ] if (out$all_levels) { ilevels <- 1:nrow(out$cats) out$levels <- out$cats[,1] } else { ilevels <- match(out$levels, out$cats[[1]]) } } if (out$all_levels) { mi <- match(out$cats[[1]], out$coltab[,1]) mi[is.na(mi)] <- 1 mc <- out$coltab[mi, ,drop=FALSE] out$leg$fill <- grDevices::rgb(mc[,2], mc[,3], mc[,4], mc[,5], maxColorValue=255) if (is.null(out$leg$legend)) out$leg$legend <- stats::na.omit(out$cats[, 2]) } else { out$levels <- out$levels[!is.na(ilevels)] m <- stats::na.omit(match(out$cats[[1]][ilevels], out$coltab[,1])) if (is.null(out$leg$legend)) out$leg$legend <- stats::na.omit(out$cats[ilevels, 2]) out$coltab <- out$coltab[m, ,drop=FALSE] } out$cols <- grDevices::rgb(out$coltab[,2], out$coltab[,3], out$coltab[,4], out$coltab[,5], maxColorValue=255) i <- match(z, out$coltab[,1]) z <- out$cols[i] } else { if (is.null(out$leg$legend)) out$leg$legend <- unique(stats::na.omit(out$cats[ilevels, 2])) levlab <- data.frame(id=out$levels, lab=out$cats[ilevels, 2], stringsAsFactors=FALSE) leglevs <- stats::na.omit(unique(levlab[,2])) if (length(leglevs) == 0) { error("plot", "something is wrong with the categories") } nlevs <- length(leglevs) ncols <- length(out$cols) #ncats <- nrow(out$cats) if (nlevs < ncols) { i <- round(seq(1, ncols, length.out = nlevs)) out$cols <- out$cols[i] } else if (nlevs > ncols) { out$cols <- rep_len(out$cols, nlevs) } out$leg$fill <- out$cols #out$cols <- out$cols[ilevels] dd <- data.frame(lab=leglevs, out$cols) m <- merge(levlab, dd) z <- m$out.cols[match(z, m$id)] } if (!out$all_levels) { out$leg$fill <- out$cols } z <- matrix(z, nrow=nrow(x), ncol=ncol(x), byrow=TRUE) out$r <- as.raster(z) out$legend_type <- "classes" if (is.null(out$leg$x)) { if (is.null(out$leg$ext)) { out$leg$x = "default" out$leg$y = NULL } else { if (length(out$leg$ext) == 4) { out$leg$x = out$leg$ext[1] out$leg$y = out$leg$ext[4] } else { out$leg$x = "default" out$leg$y = NULL } } } if (!is.null(out$legend_order)) { ord <- match(out$legend_order, out$leg$legend) out$leg$legend <- out$leg$legend[ord] out$leg$fill <- out$leg$fill[ord] } else if (isTRUE(out$legend_sort)) { ord <- order(out$leg$legend, decreasing=out$legend_sort_decreasing) out$leg$legend <- out$leg$legend[ord] out$leg$fill <- out$leg$fill[ord] } out } # to be merged with the vector variant. .generic.interval <- function(out, Z) { if (is.null(out$breaks)) { out$breaks <- 5 } if (length(out$breaks) == 1) { out$breaks <- .get_breaks(Z, out$breaks, out$breakby, out$range) } if (!is.null(out$leg$digits)) { # out$leg$legend <- substr(formatC(levs, digits=digits, format = "f", flag="#"), 1, digits+1) fz <- cut(as.numeric(Z), out$breaks, include.lowest=TRUE, right=FALSE, dig.lab=out$leg$digits) } else { fz <- cut(as.numeric(Z), out$breaks, include.lowest=TRUE, right=FALSE) } out$vcut <- as.integer(fz) levs <- levels(fz) nlevs <- length(levs) cols <- out$cols ncols <- length(cols) if (nlevs < ncols) { i <- trunc((ncols / nlevs) * 1:nlevs) cols <- cols[i] } else { cols <- rep_len(cols, nlevs) } #out$cols <- cols out$leg$fill <- cols #out$leg$levels <- levels(fz) if (!is.null(out$leg$legend)) { stopifnot(length(out$leg$legend) == nlevs) } else { levs <- gsub("]", "", gsub(")", "", gsub("\\[", "", levs))) levs <- paste(levs, collapse=",") m <- matrix(as.numeric(unlist(strsplit(levs, ","))), ncol=2, byrow=TRUE) if (!is.null(out$leg$digits)) { m <- prettyNumbs(m, out$leg$digits) } m <- apply(m, 1, function(i) paste(i, collapse=" - ")) m <- gsub("-Inf -", "<=", m) i <- grep("- Inf", m) if (length(i) == 1) { m[i] <- gsub("- Inf", "", m[i]) m[i] <- paste(">", m[i]) } out$leg$legend <- m } out$leg$digits <- NULL out } .as.raster.interval <- function(out, x, ...) { out$legend_type <- "classes" if (NCOL(out$cols) == 3) { rcl <- cbind(as.matrix(out$cols[,1:2]), 1:nrow(out$cols)) x <- classify(x, rcl, include.lowest=TRUE, others=NA) m <- apply(out$cols[,1:2], 1, function(i) paste(i, collapse=" - ")) out$leg$legend <- m out$leg$fill <- out$cols[,3] Z <- as.matrix(x, wide=TRUE) Z[is.nan(Z) | is.infinite(Z)] <- NA Z[] <- out$leg$fill[Z] } else { Z <- as.matrix(x, wide=TRUE) Z[is.nan(Z) | is.infinite(Z)] <- NA out <- .generic.interval(out, Z) Z[] <- out$leg$fill[out$vcut] } if (is.null(out$leg$x)) { # && is.null(out$leg$ext)) { out$leg$x <- "default" } out$r <- as.raster(Z) out } # leg.shrink=c(0,0), leg.main=NULL, leg.main.cex = 1, leg.digits=NULL, leg.loc=NULL, leg.ext=NULL, leg.levels=NULL, leg.labels=NULL, leg.at=NULL, .as.raster.colortable <- function(out, x, ...) { z <- round(values(x)) #z[z<0 | z>255] <- NA z[is.nan(z) | is.infinite(z)] <- NA if (all(is.na(z))) { out$values = FALSE return(out) } out$cols <- grDevices::rgb(out$coltab[,2], out$coltab[,3], out$coltab[,4], out$coltab[,5], maxColorValue=255) i <- match(z, out$coltab[,1]) z <- out$cols[i] z <- matrix(z, nrow=nrow(x), ncol=ncol(x), byrow=TRUE) out$r <- as.raster(z) out } .plotit <- function(x) { if (is.null(x$r)) { x$values = FALSE } if (x$add) { reset.clip() } else if (!x$legend_only) { old.mar <- graphics::par()$mar if (!any(is.na(x$mar))) { graphics::par(mar=x$mar) } if (x$reset) on.exit(graphics::par(mar=old.mar)) arglist <- c(list(x=x$lim[1:2], y=x$lim[3:4], type="n", xlab="", ylab="", asp=x$asp, xaxs=x$xaxs, yaxs=x$yaxs, axes=FALSE), x$dots) do.call(plot, arglist) if (!is.null(x$background)) { graphics::rect(x$lim[1], x$lim[3], x$lim[2], x$lim[4], col=x$background, border=TRUE) } } if (!x$values) { if (!x$add) try(set.clip(x$lim, x$lonlat)) return(x) } if (!x$legend_only) { graphics::rasterImage(x$r, x$ext[1], x$ext[3], x$ext[2], x$ext[4], angle = 0, interpolate = x$interpolate) if (x$axes) x <- .plot.axes(x) } if (x$legend_draw) { if (x$legend_type == "continuous") { x <- do.call(.plot.cont.legend, list(x=x)) # } else if (x$legend_type == "classes") { } else { if (x$add) { if (x$clip) { x$leg$plotlim <- unlist(get.clip()[1:4]) } else { x$leg$plotlim <- graphics::par("usr") } if (is.null(x$leg$plotlim)) { x$leg$plotlim <- x$lim } } else { if (x$clip) { x$leg$plotlim <- x$lim } else { x$leg$plotlim <- graphics::par("usr") } } x$leg$used <- do.call(.plot.class.legend, x$leg) } } if (isTRUE(x$box)) { if (x$clip) { lines(ext(x$lim)) } else { lines(ext(graphics::par("usr"))) } } if ((x$main != "") && (!x$add) && (!x$legend_only)) { pos <- 3 if (is.null(x$loc.main)) { if (isTRUE(x$clip)) { x$loc.main <- c(x$lim[1] + diff(x$lim[1:2]) / 2, x$lim[4]) } else { usr <- graphics::par("usr") x$loc.main <- c(usr[1] + diff(usr[1:2]) / 2, usr[4]) } } else if (inherits(x$loc.main, "character")) { xyp <- .txt.loc(x) x$loc.main <- xyp[1:2] pos <- xyp[3] } if (isTRUE(x$halo.main)) { .halo(x$loc.main[1], x$loc.main[2], x$main, pos=pos, offset=x$line.main, cex=x$cex.main, font=x$font.main, col=x$col.main, xpd=TRUE, hc=x$halo.main.hc, hw=x$halo.main.hw) } else { text(x$loc.main[1], x$loc.main[2], x$main, pos=pos, offset=x$line.main, cex=x$cex.main, font=x$font.main, col=x$col.main, xpd=TRUE) } } if (!x$add) { try(set.clip(x$lim, x$lonlat)) } invisible(x) } .prep.plot.data <- function(x, type, cols, mar=NULL, draw=FALSE, interpolate=FALSE, legend=TRUE, legend.only=FALSE, pax=list(), plg=list(), levels=NULL, add=FALSE, range=NULL, fill_range=FALSE, breaks=NULL, breakby="eqint", coltab=NULL, cats=NULL, xlim=NULL, ylim=NULL, ext=NULL, colNA=NA, alpha=NULL, reset=FALSE, sort=TRUE, decreasing=FALSE, grid=FALSE, las=0, all_levels=FALSE, decimals=NULL, background=NULL, xlab="", ylab="", cex.lab=0.8, line.lab=1.5, asp=NULL, yaxs="i", xaxs="i", main="", cex.main=1.2, line.main=0.5, font.main=graphics::par()$font.main, col.main = graphics::par()$col.main, loc.main=NULL, halo=FALSE, hc="white", hw=0.1, axes=TRUE, box=TRUE, cex=1, maxcell=500000, buffer=FALSE, clip=TRUE, # for rgb stretch=NULL, scale=NULL, bgalpha=NULL, zlim=NULL, zcol=NULL, overview=NULL, ...) { #cex is catch and kill out <- list() e <- out$lim <- out$ext <- as.vector(ext(x)) hadWin <- hasWin <- FALSE if (add && is.null(ext)) { ext <- unlist(get.clip())[1:4] } if ((!is.null(ext)) || (!is.null(xlim)) || (!is.null(ylim))) { if (!is.null(ext)) { ext <- ext(ext) #e <- as.vector(align(ext, x)) e <- as.vector(ext) out$lim <- out$ext <- e } if (!is.null(xlim)) { stopifnot(length(xlim) == 2) e[1:2] <- sort(xlim) } if (!is.null(ylim)) { stopifnot(length(ylim) == 2) e[3:4] <- sort(ylim) } out$lim <- e hasWin <- TRUE hadWin <- window(x) oldWin <- ext(x) w <- intersect(ext(x), ext(e)) window(x) <- out$ext <- w } if (ncell(x) > 1.1 * maxcell) { if (is.null(overview)) { if (grepl("https://", tolower(sources(x))[1])) { overview <- TRUE } else { overview <- FALSE } } if (inherits(alpha, "SpatRaster")) { if (nlyr(alpha) > 1) { alpha <- alpha[[1]] } # alpha <- spatSample(alpha, maxcell, method="regular", as.raster=TRUE, warn=FALSE) alpha <- sampleRaster(alpha, maxcell, method="regular", replace=FALSE, ext=NULL, warn=FALSE, overview=overview) } # x <- spatSample(x, maxcell, method="regular", as.raster=TRUE, warn=FALSE) x <- sampleRaster(x, maxcell, method="regular", replace=FALSE, ext=NULL, warn=FALSE, overview=overview) out$lim <- out$ext <- as.vector(ext(x)) } if (buffer) { dx <- diff(out$lim[1:2]) / 50 dy <- diff(out$lim[3:4]) / 50 out$lim[1:2] <- out$lim[1:2] + c(-dx, dx) out$lim[3:4] <- out$lim[3:4] + c(-dy, dy) } out$add <- isTRUE(add) out$axs <- as.list(pax) if (is.null(out$axs$las)) out$axs$las <- las if (is.null(out$axs$cex.lab)) out$axs$cex.lab <- cex.lab if (is.null(out$axs$line.lab)) out$axs$line.lab <- line.lab out$draw_grid <- isTRUE(grid) out$leg$digits <- decimals out$leg <- as.list(plg) out$all_levels <- isTRUE(all_levels) if (is.null(asp)) { out$lonlat <- is.lonlat(x, perhaps=TRUE, warn=FALSE) if (out$lonlat) { out$asp <- 1/cos((mean(out$ext[3:4]) * pi)/180) } else { out$asp <- 1 } } else { out$asp <- asp out$lonlat <- FALSE } out$cols <- cols if (!is.null(alpha)) { if (!inherits(alpha, "SpatRaster")) { out$alpha <- alpha[1] if ((alpha < 0) || (alpha > 1)) { warn("plot", "alpha should be between 0 and 1") out$alpha <- 255 } else { out$alpha <- out$alpha[1] * 255 } out <- hexcols(out) } } else { out$alpha <- 255 out <- hexcols(out) } out$rgb$stretch <- stretch out$rgb$scale <- scale out$rgb$bgalpha <- bgalpha out$rgb$zlim <- zlim out$rgb$zcol <- isTRUE(zcol) if (is.null(colNA) || is.na(colNA)) { out$rgb$colNA <- "white" } else { out$rgb$colNA = colNA } out$clip <- isTRUE(clip) out$dots <- list(...) out$reset <- reset out$main <- main out$halo.main <- halo out$halo.main.hc <- hc out$halo.main.hw <- hw out$loc.main <- loc.main out$cex.main <- cex.main out$font.main <- font.main out$col.main <- col.main out$line.main <- line.main out$axes <- axes out$xaxs <- xaxs out$yaxs <- yaxs out$xlab <- xlab out$ylab <- ylab out$coltab <- coltab out$cats <- cats out$breaks <- breaks out$breakby <- breakby out$interpolate <- FALSE out$background <- background out$legend_draw <- isTRUE(legend) out$legend_only <- isTRUE(legend.only) if (!is.logical(sort)) { out$legend_order <- sort out$legend_sort <- FALSE } else { out$legend_sort <- isTRUE(sort) } out$legend_sort_decreasing <- isTRUE(decreasing) out$box <- isTRUE(box) if (!is.null(out$leg$loc)) { out$leg$x <- out$leg$loc out$leg$loc <- NULL } if (!hasValues(x)) { out$values <- FALSE out$legend_draw <- FALSE #warn("plot", "SpatRaster has no cell values") } else { out$values <- TRUE if (type=="factor") { out <- .as.raster.factor(out, x) } else if (type=="rgb") { out <- .as.raster.rgb(out, x) out$interpolate <- isTRUE(interpolate) } else if (type=="colortable") { out <- .as.raster.colortable(out, x) } else if (type=="classes") { out$levels <- levels out <- .as.raster.classes(out, x) } else if (type=="interval") { out <- .as.raster.interval(out, x) } else { out$interpolate <- isTRUE(interpolate) out$range <- range out$fill_range <- fill_range out <- .as.raster.continuous(out, x, type) } if (is.null(mar)) { out$mar <- c(2, 2, 2, 2) if (out$legend_draw) { if (is.null(out$leg$ext)) { if (is.null(out$leg$x)) { out$leg$x <- "default" out$mar <- c(2, 2, 2, 4) } else if (out$legend_type == "continuous") { if (out$leg$x == "top") { out$mar <- c(2, 2, 4, 2) } else if (out$leg$x == "bottom") { out$mar <- c(4, 2, 2, 2) } else if (out$leg$x == "left") { out$mar <- c(2, 5, 2, 1) } else { out$mar <- c(2, 2, 2, 4) } } else if (out$leg$x == "default") { out$mar <- c(2, 2, 2, 4) } } } } else { out$mar <- rep_len(mar, 4) } if (!is.null(colNA)) { if (!is.na(colNA) && out$values) { out$colNA <- grDevices::rgb(t(grDevices::col2rgb(colNA)), alpha=out$alpha, maxColorValue=255) out$r[is.na(out$r)] <- out$colNA } } } if (draw) { if (inherits(alpha, "SpatRaster")) { alpha <- clamp(as.vector(alpha[[1]])*255, 0, 255) out$r <- matrix(grDevices::rgb(t(grDevices::col2rgb(out$r)), alpha=alpha, maxColorValue=255), nrow=nrow(out$r), byrow=TRUE) } out <- .plotit(out) } if (any(hasWin)) { window(x) <- NULL if (any(hadWin)) { window(x) <- oldWin } } invisible(out) } setMethod("plot", signature(x="SpatRaster", y="numeric"), function(x, y=1, col, type=NULL, mar=NULL, legend=TRUE, axes=!add, plg=list(), pax=list(), maxcell=500000, smooth=FALSE, range=NULL, fill_range=FALSE, levels=NULL, all_levels=FALSE, breaks=NULL, breakby="eqint", fun=NULL, colNA=NULL, alpha=NULL, sort=FALSE, decreasing=FALSE, grid=FALSE, ext=NULL, reset=FALSE, add=FALSE, buffer=FALSE, background=NULL, box=axes, clip=TRUE, overview=NULL, ...) { old.mar <- graphics::par()$mar on.exit(graphics::par(mar=old.mar)) y <- round(y) hasRGB <- FALSE if (has.RGB(x) && ((is.null(type) && (y[1] < 0)))) { type <- "rgb" legend <- FALSE if (is.null(mar)) { mar <- 0 axes <- FALSE } hasRGB <- TRUE y <- RGB(x) } nlx <- nlyr(x) stopifnot((min(y) > 0) & (max(y) <= nlx)) if ((!hasRGB) && (length(y) > 1)) { x <- x[[y]] if (inherits(alpha, "SpatRaster")) { if (nlyr(alpha) > 1) { alpha <- alpha[[y]] } } plot(x, col=col, type=type, mar=mar, legend=legend, axes=axes, plg=plg, pax=pax, maxcell=2*maxcell/length(y), smooth=smooth, range=range, fill_range=fill_range, levels=levels, all_levels=all_levels, breaks=breaks, breakby=breakby, fun=fun, colNA=colNA, alpha=alpha, grid=grid, sort=sort, decreasing=decreasing, ext=ext, reset=reset, add=add, buffer=buffer, background=background, box=box, clip=clip, overview=overview, ...) return(invisible()) } else { x <- x[[y]] } if (inherits(alpha, "SpatRaster")) { if (!compareGeom(x, alpha, crs=FALSE, ext=FALSE, rowcol=TRUE)) { error("plot", "geometry of alpha does not match x") } } if (is.character(legend)) { plg$x <- legend legend <- TRUE } if (missing(col)) { col <- .default.pal() #col <- rev(grDevices::terrain.colors(255)) } else if (inherits(col, "data.frame")) { if (ncol(col) == 2) { type <- "classes" } else if (ncol(col) == 3) { type <- "interval" } else { error("plot", "number of columns of a col data.frame should be 2 or 3") } breaks <- NULL } coltab <- NULL cats <- NULL if (!is.null(breaks)) { if (is.null(type)) { type <- "interval" } else { range <- range(breaks) } } else { if (is.null(type)) { if (has.colors(x)) { coltab <- coltab(x)[[1]] if (is.factor(x)) { if (activeCat(x) >= 0) { cats <- levels(x)[[1]] type <- "factor" } else { type <- "colortable" legend <- FALSE } } else { type <- "colortable" legend <- FALSE } } else if (is.factor(x)) { type <- "factor" cats <- levels(x)[[1]] } else if (is.bool(x)) { type <- "factor" levels(x) <- data.frame(id=0:1, value=c("False", "True")) cats <- cats(x)[[1]] } else { type <- "depends" } } else { type <- match.arg(type, c("continuous", "classes", "interval", "rgb")) } } if ((type == "classes") && is.null(levels) && is.factor(x)) { type <- "factor" cats <- cats(x)[[1]] if (has.colors(x)) { coltab <- coltab(x)[[1]] } } x <- .prep.plot.data(x, type=type, cols=col, mar=mar, draw=TRUE, plg=plg, pax=pax, legend=isTRUE(legend), axes=isTRUE(axes), coltab=coltab, cats=cats, interpolate=smooth, levels=levels, range=range, fill_range=fill_range, colNA=colNA, alpha=alpha, reset=reset, grid=grid, sort=sort, decreasing=decreasing, ext=ext, all_levels=all_levels, breaks=breaks, breakby=breakby, add=add, buffer=buffer, background=background, box=box, maxcell=maxcell, clip=clip, overview=overview, ...) if (!is.null(fun)) { if (!is.null(formals(fun))) { fun(y) } else { fun() } } invisible(x) } ) setMethod("plot", signature(x="SpatRaster", y="missing"), function(x, y, main, mar=NULL, nc, nr, maxnl=16, maxcell=500000, add=FALSE, ...) { if (has.RGB(x)) { if (missing(main)) main = "" p <- plot(x, -1, main=main, mar=mar, maxcell=maxcell, add=add, ...) return(invisible(p)) } nl <- max(1, min(nlyr(x), maxnl)) if (add && (nl > 1)) { nl <- 1 warn("plot", "adding the first layer of x") } if (nl==1) { if (missing(main)) main = "" out <- plot(x, 1, maxcell=maxcell, main=main[1], mar=mar, add=add, ...) return(invisible(out)) } nrnc <- .get_nrnc(nr, nc, nl) old.par <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(old.par)) if (is.null(mar)) { mar=c(1.5, 1, 2.5, 3) } graphics::par(mfrow=nrnc) maxcell= 2 * maxcell / nl if (missing("main")) { tm <- time(x) if ((!any(is.na(tm))) && (length(unique(tm)) > 1)) { main <- as.character(time(x)) } else { main <- names(x) } } else { main <- rep_len(main, nl) } for (i in 1:nl) { plot(x, i, main=main[i], mar=mar, maxcell=maxcell, add=add, ...) } } ) setMethod("plot", signature(x="SpatRaster", y="character"), function(x, y, ...) { y <- match(y, names(x)) if (any(is.na(y))) { error("plot", "y does not match the names in x") } plot(x, y, ...) } ) setMethod("plotRGB", signature(x="SpatRaster"), function(x, r=1, g=2, b=3, a=NULL, scale=NULL, mar=0, stretch=NULL, smooth=TRUE, colNA="white", alpha=NULL, bgalpha=NULL, zlim=NULL, zcol=FALSE, axes=FALSE, ...) { x <- x[[c(r, g, b, a)]] RGB(x) <- 1:nlyr(x) plot(x, -1, scale=scale, mar=mar, stretch=stretch, smooth=smooth, colNA=colNA, alpha=alpha, bgalpha=bgalpha, zlim=zlim, zcol=zcol, axes=axes, ...) } ) terra/R/show.R0000644000176200001440000004200314726700274012703 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2017 # Version 1.0 # License GPL v3 win_basename <- function(x) { if (isTRUE(grepl("Windows", utils::osVersion))) { large <- nchar(x) > 256 if (any(large)) { for (i in 1:length(large)) { if (large[i]) { r <- strsplit(x[i], "[\\/]+")[[1]] x[i] <- r[[length(r)]] } else { x[i] <- basename(x) } } } else { x <- basename(x) } x } else { basename(x) } } printDF <- function(x, n=6, first=FALSE) { n <- min(nrow(x), max(n, 0)) old <- dim(x) if (old[2] == 0) { return() } if (old[1] > 0) { x <- x[1:n, ,drop=FALSE] } if (old[2] > 12) { x <- x[, 1:10] } d <- dim(x) cls <- sapply(x, function(i){ a = class(i); a[length(a)]}) cls <- gsub("integer", "int", cls) cls <- gsub("numeric", "num", cls) cls <- gsub("character", "chr", cls) cls <- gsub("factor", "fact", cls) cls <- paste0("<", cls, ">") cls <- data.frame(rbind(class=cls), stringsAsFactors=FALSE) names(cls) <- NULL nms <- colnames(x) nc <- nchar(nms) mx <- max(15, 100/d[2]) i <- nc > (mx+2) nms[i] <- paste0(substr(nms[i], 1, (mx-1)), "~") if (d[1] > 0) { for (i in 1:ncol(x)) { if (is.character(x[[i]])) { x[[i]][is.na(x[[i]])] <- "NA" n <- nchar(x[[i]]) j <- n > (mx+2) x[[i]][j] <- paste0(substr(x[[i]][j], 1, (mx-1)), "~") } else if (is.numeric(x[[i]])) { x[[i]] <- formatC(x[[i]]) } } } x <- data.frame(lapply(x, as.character), check.names=FALSE, stringsAsFactors=FALSE) x <- rbind(x[1,,drop=FALSE], x) x[1,] <- cls if (nrow(x) < d[1]) { x <- rbind(x, "...") } if (first) { x <- data.frame("", x, check.names=FALSE, stringsAsFactors=FALSE) colnames(x)[1] <- "names :" x[1,1] <- "type :" if (d[1] > 0) { x[2,1] <- "values :" } } if (old[2] > d[2]) { name <- paste0("(and ", old[2] - d[2], " more)") x[[name]] <- "" } print(x, row.names = FALSE) } setMethod ("show" , "Rcpp_SpatDataFrame", function(object) { cat("class :" , class(object), "\n") object <- .getSpatDF(object) d <- dim(object) cat("dimensions : ", d[1], ", ", d[2], " (nrow, ncol)\n", sep="" ) n <- 6 if (d[1] > 6) { cat("values (head)\n") } else { cat("values\n") } printDF(object) } ) setMethod ("show" , "Rcpp_SpatCategories", function(object) { show(object$df) } ) setMethod ("show" , "SpatExtent", function(object) { e <- as.vector(object) e <- paste(e, collapse=", ") cat("SpatExtent :", e, "(xmin, xmax, ymin, ymax)\n") } ) setMethod ("show" , "SpatVectorCollection", function(object) { cat(" class :", class(object), "\n") cat(" length :", length(object), "\n") n <- nn <- length(object) if (n > 15) { nn <- 15 } if (n > 0) { for (i in 1:nn) { v <- object[i] if (i==1) { cat(" geometry : ", geomtype(v), " (", nrow(v) , ")\n", sep="") } else { cat(" ", geomtype(v), " (", nrow(v) , ")\n", sep="") } } if (n > nn) { cat(" ", " and ", n-nn, "more\n", sep="") } crs <- .name_or_proj4(object[1]) if (crs != "") cat(" crs (first) :", crs, "\n") nms <- names(object) if (length(nms) > 10) { nms <- c(nms[1:9], "...") } nms <- paste(nms, collapse=", ") cat(" names :", nms, "\n") } } ) setMethod ("show" , "SpatVector", function(object) { e <- as.vector(ext(object)) d <- dim(object) cat(" class :", class(object), "\n") cat(" geometry :", geomtype(object), "\n") cat(" dimensions : ", d[1], ", ", d[2], " (geometries, attributes)\n", sep="" ) cat(" extent : ", e[1], ", ", e[2], ", ", e[3], ", ", e[4], " (xmin, xmax, ymin, ymax)\n", sep="") if (object@pntr$source != "") { if (object@pntr$layer != tools::file_path_sans_ext(win_basename(object@pntr$source))) { cat(" source : ", win_basename(object@pntr$source), " (", object@pntr$layer, ")\n", sep="") } else { cat(" source : ", win_basename(object@pntr$source), "\n", sep="") } } cat(" coord. ref. :", .name_or_proj4(object), "\n") if (d[2] > 0) { nr <- min(d[1], 3) dd <- as.data.frame(object)[1:nr, , drop=FALSE] printDF(dd, 3, TRUE) } } ) setMethod ("show" , "SpatVectorProxy", function(object) { e <- as.vector(ext(object)) d <- dim(object) cat(" class : SpatVectorProxy\n") cat(" geometry :", geomtype(object), "\n") cat(" dimensions : ", d[1], ", ", d[2], " (geometries, attributes)\n", sep="" ) cat(" extent : ", e[1], ", ", e[2], ", ", e[3], ", ", e[4], " (xmin, xmax, ymin, ymax)\n", sep="") if (object@pntr$v$layer != tools::file_path_sans_ext(win_basename(object@pntr$v$source))) { cat(" source : ", win_basename(object@pntr$v$source), " (", object@pntr$v$layer, ")\n", sep="") } else { cat(" source : ", win_basename(object@pntr$v$source), "\n", sep="") } cat(" coord. ref. :", .name_or_proj4(object), "\n") dd <- get.data.frame(object) printDF(dd, 0, TRUE) } ) setMethod ("show" , "SpatRaster", function(object) { cat("class :" , class(object), "\n") d <- dim(object) cat("dimensions : ", d[1], ", ", d[2], ", ", d[3], " (nrow, ncol, nlyr)\n", sep="" ) #cat ("ncell :" , ncell(object), "\n") xyres <- res(object) cat("resolution : " , xyres[1], ", ", xyres[2], " (x, y)\n", sep="") hw <- window(object) if (any(hw)) { w <- as.vector(ext(object)) if (all(hw)) { txt <- "window : " } else { txt <- "extent (win): " } cat(txt, w[1], ", ", w[2], ", ", w[3], ", ", w[4], " (xmin, xmax, ymin, ymax)\n", sep="") #e <- as.vector(object@pntr$source[[1]]$window$full_extent$vector) #cat("full extent : " , e[1], ", ", e[2], ", ", e[3], ", ", e[4], " (xmin, xmax, ymin, ymax)\n", sep="") } else { e <- as.vector(ext(object)) cat("extent : " , e[1], ", ", e[2], ", ", e[3], ", ", e[4], " (xmin, xmax, ymin, ymax)\n", sep="") } cat("coord. ref. :" , .name_or_proj4(object), "\n") if (hasValues(object)) { mnr <- 6 ln <- names(object) nl <- d[3] if (nl > mnr) { ln <- c(ln[1:mnr], "...") } lnmx <- 60 / min(mnr, length(ln)) b <- nchar(ln) > (lnmx+2) if (isTRUE(any(b))) { mid <- floor(lnmx/2) ln[b] <- paste(substr(ln[b], 1, mid), "~", substr(ln[b], nchar(ln[b])-mid+1, nchar(ln[b])), sep="") } nsr <- nsrc(object) m <- inMemory(object) f <- sources(object) nf <- nchar(f) if (any(nf > 256)) { for (i in 1:length(nf)) { if (nf[i] > 256) { f[i] <- unlist(strsplit(f[i], "\\?"))[1] if (nchar(f[i]) > 256) { f[i] <- substr(f[i], nf[i]-255, nf[i]) } } } } hdf5 <- substr(f, 1, 5) == "HDF5:" f[!hdf5] <- win_basename(f[!hdf5]) if (any(hdf5)) { ff <- strsplit(f[hdf5], "://") ff <- sapply(ff, function(i) paste(win_basename(i), collapse="://")) ff <- gsub('\"', "", ff) f[hdf5] <- ff } #f <- gsub("\\", "/", f, fixed=TRUE) f <- gsub("\"", "", f) sources <- rep("memory", length(m)) sources[!m] <- f[!m] if (all(m)) { cat("source(s) : memory\n") } else { if (nsr > 1) { mxsrc <- 3 lbs <- .nlyrBySource(object) lbsprint <- paste0(" (", lbs, " layers)") lbsprint[lbs == 1] <- "" cat("sources :", sources[1], lbsprint[1], "\n") for (i in 2:(min(mxsrc, nsr))) { cat(" ", sources[i], lbsprint[i], "\n") } if (nsr > mxsrc) { if (nsr == (mxsrc+1)) { cat(" ", sources[mxsrc+1], lbsprint[mxsrc+1], "\n") } else { cat(" ", "... and", nsr-mxsrc, "more sources\n") } } } else { cat("source :", sources[1], "\n") } } rgbtype <- object@pntr$rgbtype if (rgbtype != "") { rdgb <- RGB(object) if (is.null(rdgb)) rdgb <- 1:3 cat(paste("colors", toupper(object@pntr$rgbtype), " :"), paste(rdgb, collapse=", "), "\n") } hasct <- object@pntr$hasColors() if (any(hasct)) { cat("color table :", paste(which(hasct), collapse=", "), "\n") } varnms <- varnames(object) fnms <- tools::file_path_sans_ext(f) if (any(fnms != varnms) && all(varnms != "")) { longnms <- longnames(object) i <- longnms != "" if (any(i)) { varnms[i] <- paste0(varnms[i], " (", longnms[i], ")") } if (nsr == 1) { cat("varname :", varnms[1], "\n") } else { cat("varnames :", varnms[1], "\n") for (i in 2:(min(nsr, 3))) { cat(" ", varnms[i], "\n") } } if (nsr > 3) { cat(" ...\n") } } uts <- units(object) hasunits <- !all(uts == "") if (nl > mnr) { uts <- c(uts[1:mnr], "...") } hMM <- hasMinMax(object) isB <- is.bool(object) if (any(hMM) || any(is.factor(object))) { #r <- minmax(object) rr <- r <- rbind(object@pntr$range_min, object@pntr$range_max) r[,!hMM] <- c(Inf, -Inf) #sc <- scoff(object) #r <- r * sc[,1] + sc[,2] r <- sapply(data.frame(r), format) minv <- r[1,] maxv <- r[2,] if (any(isB)) { minv[isB] <- ifelse(minv[isB]=="0", "FALSE", "TRUE") maxv[isB] <- ifelse(maxv[isB]=="0", "FALSE", "TRUE") } minv <- gsub("Inf", " ? ", minv) maxv <- gsub("-Inf", " ? ", maxv) minv[!hMM] <- gsub("NaN", " ? ", minv[!hMM]) maxv[!hMM] <- gsub("NaN", " ? ", maxv[!hMM]) minv[hw] <- paste0(">", minv[hw]) maxv[hw] <- paste0(maxv[hw],"<") if (nl > mnr) { minv <- c(minv[1:mnr], "...") maxv <- c(maxv[1:mnr], "...") } isf <- is.factor(object) if (any(isf)) { cats <- levels(object) for (i in which(isf)) { if (i > mnr) break levs <- cats[[i]] j <- match(rr[,i], levs[,1]) levs <- levs[j, 2] if (length(levs) > 1) { minv[i] <- levs[1] maxv[i] <- levs[2] } } } u8 <- Encoding(ln) == "UTF-8" wln <- nchar(ln) if (any(u8)) { # for Chinese: wln <- wln + u8 * wln w <- pmax(wln, nchar(minv), nchar(maxv), nchar(uts), na.rm = TRUE) m <- rbind(paste0(rep(" ", max(wln)), collapse=""), minv, maxv) if (hasunits) m <- rbind(m, uts) # a loop because "width" is not recycled by format for (i in 1:ncol(m)) { m[,i] <- format(m[,i], width=w[i], justify="right") addsp <- w[i] - nchar(ln[i]) m[1,i] <- paste0(paste0(rep(" ", addsp), collapse=""), ln[i]) } } else { w <- pmax(wln, nchar(minv), nchar(maxv), nchar(uts), na.rm = TRUE) m <- rbind(ln, minv, maxv) if (hasunits) m <- rbind(m, uts) # a loop because "width" is not recycled by format for (i in 1:ncol(m)) { m[,i] <- format(m[,i], width=w[i], justify="right") } } if (ncol(m) == 1) { if (is.factor(object)) { if (activeCat(object) > -1) { g <- cats(object)[[1]] cat("categories :", paste(colnames(g)[-1], collapse=", "), "\n") } } cat("name :", paste(m[1,], collapse=", "), "\n") cat("min value :", paste(m[2,], collapse=", "), "\n") cat("max value :", paste(m[3,], collapse=", "), "\n") } else { cat("names :", paste(m[1,], collapse=", "), "\n") cat("min values :", paste(m[2,], collapse=", "), "\n") cat("max values :", paste(m[3,], collapse=", "), "\n") } if (hasunits) cat("unit :", paste(m[4,], collapse=", "), "\n") } else { w <- pmax(nchar(ln), nchar(uts)) m <- rbind(ln, uts) for (i in 1:ncol(m)) { m[,i] <- format(m[,i], width=w[i], justify="right") } if (ncol(m) == 1) { cat("name :", paste(m[1,], collapse=", "), "\n") } else { cat("names :", paste(m[1,], collapse=", "), "\n") } if (hasunits) cat("unit :", paste(m[2,], collapse=", "), "\n") } } if (object@pntr$hasTime) { label <- "time " rtim <- range(time(object)) tims <- object@pntr$timestep if (tims == "yearmonths") { rtim <- format_ym(rtim) label <- "time (ymnts)" } else if (tims == "months") { rtim <- month.abb[rtim] label <- "time (mnts) " } else if (tims == "years") { label <- "time (years)" } else if (tims == "days") { label <- "time (days) " } else if (tims == "raw") { label <- "time (raw) " } utim <- unique(rtim) if (length(utim) > 1) { ptim <- paste0(label, ": ", paste(rtim, collapse=" to ")) } else { ptim <- paste0(label, ": ", as.character(utim)) } if (tims == "seconds") { tz <- format(utim[1], format="%Z") ptim <- paste(ptim, tz) } cat(ptim, "\n") } # else { # cat("data sources:", "no data\n") # cat("names :", paste(ln, collapse=", "), "\n") # } } ) .sources <- function(x) { #m <- inMemory(x) f <- sources(x) f <- gsub("\"", "", win_basename(f)) i <- grep(":", f) if (length(i) > 0) { for (j in i) { ff <- try(win_basename( strsplit(f[j], ':')[[1]][1]), silent=TRUE) if (!inherits(ff, "try-error")) { f[j] <- ff } } } f[f==""] <- "memory" unique(f) } setMethod("show" , "SpatRasterDataset", function(object) { cat("class :" , class(object), "\n") ns <- length(object) cat("subdatasets :", ns, "\n") if (ns == 0) return() d <- dim(object) cat("dimensions :", paste(d, collapse=", "), "(nrow, ncol)\n") nss <- nlyr(object) if (length(nss) > 10) { nss = c(as.character(nss[1:9], "...")) } cat("nlyr :", paste(nss, collapse=", "), "\n") xyres <- res(object) cat("resolution : " , xyres[1], ", ", xyres[2], " (x, y)\n", sep="") e <- as.vector(ext(object)) cat("extent : " , e[1], ", ", e[2], ", ", e[3], ", ", e[4], " (xmin, xmax, ymin, ymax)\n", sep="") cat("coord. ref. :" , .name_or_proj4(object), "\n") s <- .sources(object) if (length(s) > 6) { s <- c(s[1:6], "...") } cat("source(s) :", paste(s, collapse=", "), "\n") ln <- names(object) if (any(ln != "")) { if (length(ln) > 6) { ln <- c(ln[1:6], "...") } cat("names :", paste(ln, collapse=", "), "\n") } } ) setMethod("show" , "SpatRasterCollection", function(object) { cat("class :" , class(object), "\n") nr <- length(object) cat("length :", nr, "\n") d <- (t(dim(object))) d[] <- as.character(d) if (ncol(d) > 14) { d <- d[,1:15] d[,15] <- "..." } for (i in 1:ncol(d)) { d[,i] <- format(d[,i], width=max(nchar(d[,i])), justify="right") } cat("nrow :", paste(d[1,], collapse=", "), "\n") cat("ncol :", paste(d[2,], collapse=", "), "\n") cat("nlyr :", paste(d[3,], collapse=", "), "\n") e <- as.vector(ext(object)) cat("extent : " , e[1], ", ", e[2], ", ", e[3], ", ", e[4], " (xmin, xmax, ymin, ymax)\n", sep="") crs <- .name_or_proj4(object@pntr$x[[1]]) if (crs != "") cat("crs (first) :", crs, "\n") ln <- names(object) if (any(ln != "")) { if (length(ln) > 6) { ln = c(ln[1:6], "...") } cat("names :", paste(ln, collapse=", "), "\n") } } ) setMethod("show" , "SpatGraticule", function(object) { cat("class :" , class(object), "\n") v <- vect() v@pntr <- object@pntr cat("lon :" , stats::na.omit(v$lon), "\n") cat("lat :" , stats::na.omit(v$lat), "\n") cat("coord. ref. :", .name_or_proj4(v), "\n") e <- as.vector(ext(v)) cat("extent : ", e[1], ", ", e[2], ", ", e[3], ", ", e[4], " (xmin, xmax, ymin, ymax)\n", sep="") } ) setMethod ("head" , "SpatVector", function(x, n=6L, ...) { nn <- min(n, nrow(x)) if (nn > 0) { x <- x[1:nn, ] } else { x <- x[0,] } as.data.frame(x) } ) setMethod ("tail" , "SpatVector", function(x, n=6L, ...) { nrx <- nrow(x) nn <- min(n, nrx) if (nn > 0) { start <- nrx - nn + 1 x <- x[start:nrx, ] } else { x <- x[0,] } x <- as.data.frame(x) if (nn > 0) { rownames(x) <- start:nrx } x } ) setMethod ("head" , "SpatRaster", function(x, n=6L, ...) { utils::head(x[1:n], n=n, ...) } ) setMethod ("tail" , "SpatRaster", function(x, n=6L, ...) { nc = ncell(x) utils::tail(x[(nc-n+1):nc], n=n, ...) } ) str.SpatRaster <- function(object, ...) { cat("S4 class 'SpatRaster' [package \"terra\"]\n") } setMethod("str", signature(object="SpatRaster"), str.SpatRaster) str.SpatVector <- function(object, ...) { cat("S4 class 'SpatVector' [package \"terra\"]\n") } setMethod("str", signature(object="SpatVector"), str.SpatVector) str.SpatExtent <- function(object, ...) { cat("S4 class 'SpatExtent' [package \"terra\"]\n") } setMethod("str", signature(object="SpatExtent"), str.SpatExtent) str.SpatGraticule <- function(object, ...) { cat("S4 class 'SpatGraticule' [package \"terra\"]\n") } setMethod("str", signature(object="SpatGraticule"), str.SpatGraticule) terra/R/SpatRasterDataset.R0000644000176200001440000002226314726701411015321 0ustar liggesusers setMethod("length", signature(x="SpatRasterDataset"), function(x) { x@pntr$nsds() } ) setMethod("sds", signature(x="character"), function(x, ids=0, opts=NULL, raw=FALSE) { if (length(x) > 1) { r <- lapply(x, rast, opts=opts, raw=raw) s <- sds(r) names(s) <- tools::file_path_sans_ext(basename(x)) return(s) } x <- trimws(x[1]) if (nchar(x) == 0) { error("sds", "provide valid file name(s)") } f <- .fullFilename(x) r <- methods::new("SpatRasterDataset") ids <- round(ids)-1 if (ids[1] < 0) { useids <- FALSE } else { useids <- TRUE } if (is.null(opts)) opts <- ""[0] if (raw) opts <- c(opts, "so=false") r@pntr <- SpatRasterStack$new(f, ids, useids, opts) messages(r, "sds") } ) setMethod("sds", signature(x="missing"), function(x) { r <- methods::new("SpatRasterDataset") r@pntr <- SpatRasterStack$new() r } ) setMethod("sds", signature(x="SpatRaster"), function(x, ...) { r <- methods::new("SpatRasterDataset") r@pntr <- SpatRasterStack$new() r@pntr$add(x@pntr, varnames(x)[1], longnames(x)[1], units(x)[1], FALSE) dots <- list(...) nms <- names(dots) if (is.null(nms)) nms = "" nms <- rep_len(nms, length(dots)) for (i in seq_along(dots)) { if (inherits(dots[[i]], "SpatRaster")) { vname <- nms[i] if (vname == "") vname = varnames(dots[[i]])[1] r@pntr$add(dots[[i]]@pntr, vname, longnames(dots[[i]])[1], units(dots[[i]])[1], FALSE) } } messages(r, "sds") } ) setMethod("sds", signature(x="list"), function(x) { r <- methods::new("SpatRasterDataset") r@pntr <- SpatRasterStack$new() nms <- names(x) if (is.null(nms)) nms <- rep("", length(x)) for (i in seq_along(x)) { if (inherits(x[[i]], "SpatRaster")) { r@pntr$add(x[[i]]@pntr, nms[i], "", "", FALSE) } else if (inherits(x[[i]], "SpatRasterDataset")) { y <- as.list(x[[i]]) ynms <- names(x[[i]]) s <- sapply(y, function(j) r@pntr$add(j@pntr, ynms[j], "", "", FALSE)) } else { name <- names(x[[i]]) cls <- paste(class(x[[i]]), collapse=", ") error("sds", "list element", name, "is a: ", cls) } } messages(r, "sds") } ) setMethod("sds", signature(x="array"), function(x, crs="", extent=NULL) { dims <- dim(x) if (length(dims) <= 3) { return(sds(rast(x, crs=crs, extent=extent))) } if (length(dims) > 4) { if (length(dims) == 5) { if (dims[5] == 1) { x <- x[,,,,1] } else { error("sds,array", "cannot handle an array with 5 dimensions") } } else { error("sds,array", "cannot handle an array with more than 4 dimensions") } } r <- lapply(1:dims[4], function(i) rast(x[,,,i], crs=crs, extent=extent)) sds(r) } ) setMethod("sds", signature(x="stars"), function(x) { s <- from_stars(x) if (inherits(s, "SpatRaster")) { sds(s) } else { s } } ) setMethod("sds", signature(x="stars_proxy"), function(x) { s <- from_stars(x) if (inherits(s, "SpatRaster")) { sds(s) } else { s } } ) setMethod("c", signature(x="SpatRasterDataset"), function(x, ...) { x@pntr <- x@pntr$subset((1:x@pntr$nsds()) -1 ) # why? make a copy? dots <- list(...) nms <- names(dots) for (i in seq_along(dots)) { if (inherits(dots[[i]], "SpatRasterDataset")) { sdsnms <- names(dots[[i]]) for (j in 1:(length(dots[[i]]))) { if (!x@pntr$add(dots[[i]][[j]]@pntr, sdsnms[j], "", "", FALSE)) { messages(x, "c") } } } else if (inherits(dots[[i]], "SpatRaster")) { if (is.null(nms)) error("c", "arguments must be named") if (!x@pntr$add(dots[[i]]@pntr, nms[i], "", "", FALSE)) { messages(x, "c") } } else { error("c", "arguments must be SpatRaster or SpatRasterDataset") } } messages(x, "c") } ) setReplaceMethod("[", c("SpatRasterDataset", "numeric", "missing"), function(x, i, j, value) { if (any(!is.finite(i)) | any(i<1)) { error("`[`", "invalid index") } stopifnot(inherits(value, "SpatRaster")) i <- sort(i) for (j in i) { if (j == (length(x)+1)) { x@pntr$add(value@pntr, "", "", "", FALSE) } else { x@pntr$replace(j-1, value@pntr, FALSE) } } messages(x, "`[`") } ) setMethod("[", c("SpatRasterDataset", "numeric", "missing"), function(x, i, j, drop=TRUE) { i <- positive_indices(i, length(x), TRUE, "`[`(i)") if (drop && (length(i) == 1)) { tptr <- x@pntr$getsds(i-1) x <- rast() x@pntr <- tptr } else { x@pntr <- x@pntr$subset(i-1) } messages(x, "`[`") }) setMethod("[", c("SpatRasterDataset", "numeric", "numeric"), function(x, i, j, drop=TRUE) { i <- positive_indices(i, length(x)) j <- positive_indices(j, min(nlyr(x))) nd <- i if (drop) { out <- lapply(nd, function(k) x[k][[j]]) out <- rast(out) } else { out <- sds() nms <- x@pntr$names for (k in nd) { r <- x[k][[j]] out@pntr$add(r@pntr, nms[k], "", "", FALSE) } } messages(out, "`[`") }) setMethod("[", c("SpatRasterDataset", "numeric", "logical"), function(x, i, j, drop=TRUE) { j <- positive_indices(j, min(nlyr(x))) `[`(x, i=i, j=j, drop=drop) }) setMethod("[", c("SpatRasterDataset", "missing", "numeric"), function(x, i, j, drop=TRUE) { `[`(x, i=1:x@pntr$nsds(), j=j, drop=drop) }) setMethod("[", c("SpatRasterDataset", "missing", "logical"), function(x, i, j, drop=TRUE) { j <- positive_indices(j, min(nlyr(x))) `[`(x, i=1:x@pntr$nsds(), j=j, drop=drop) }) setMethod("[", c("SpatRasterDataset", "logical", "missing"), function(x, i, j,drop=TRUE) { i <- positive_indices(j, length(x)) x[i, drop=drop] }) setMethod("[", c("SpatRasterDataset", "character", "missing"), function(x, i, j, drop=TRUE) { i <- match(i, names(x)) if (any(is.na(i))) { error("`[`", "unknown name(s) provided") } x[i, drop=drop] }) setMethod("[[", c("SpatRasterDataset", "ANY", "ANY"), function(x, i, j, drop=TRUE) { mi <- missing(i) mj <- missing(j) if ((mi) && (mj)) { `[`(x, drop=drop) } else if (mi) { `[`(x, j=j, drop=drop) } else if (mj) { `[`(x, i=i, drop=drop) } else { `[`(x, i=i, j=j, drop=drop) } }) setMethod("$", c("SpatRasterDataset"), function(x, name) { x[name,drop=TRUE] }) setMethod("$", "SpatRasterDataset", function(x, name) { x[name] } ) setMethod("sprc", signature(x="missing"), function(x) { r <- methods::new("SpatRasterCollection") r@pntr <- SpatRasterCollection$new() r } ) setMethod("sprc", signature(x="SpatRaster"), function(x, ...) { sprc(list(x, ...)) } ) setMethod("sprc", signature(x="list"), function(x) { n <- length(x) tptr <- SpatRasterCollection$new() if (n > 0) { for (i in 1:n) { if (inherits(x[[i]], "SpatRaster")) { tptr$add(x[[i]]@pntr, "") } else if (inherits(x[[i]], "SpatRasterCollection") | inherits(x[[i]], "SpatRasterDataset")) { y <- as.list(x[[i]]) s <- sapply(y, function(j) tptr$add(j@pntr, "")) } else { name <- names(x[[i]]) cls <- paste(class(x[[i]]), collapse=", ") error("sprc", "list element", name, "is a: ", cls) } } } r <- new("SpatRasterCollection") r@pntr <- tptr if (length(r) == length(x)) names(r) <- names(x) r } ) setMethod("sprc", signature(x="character"), function(x, ids=0, opts=NULL, raw=FALSE) { if (length(x) > 1) { r <- lapply(x, rast) s <- sprc(r) names(s) <- tools::file_path_sans_ext(basename(x)) return(s) } x <- trimws(x[1]) if (nchar(x) == 0) { error("sprc", "provide valid file name(s)") } f <- .fullFilename(x) r <- methods::new("SpatRasterCollection") ids <- round(ids)-1 if (ids[1] < 0) { useids <- FALSE } else { useids <- TRUE } if (is.null(opts)) opts <- ""[0] if (raw) opts <- c(opts, "so=false") r@pntr <- SpatRasterCollection$new(f, ids, useids, opts) messages(r, "sprc") } ) setMethod("length", signature(x="SpatRasterCollection"), function(x) { x@pntr$length() } ) setMethod("[", c("SpatRasterCollection", "numeric", "missing"), function(x, i, j, ... ,drop=TRUE) { i <- positive_indices(i, length(x), TRUE, "`[`(i)") if (drop && (length(i) == 1)) { tptr <- x@pntr$x[[i]] x <- rast() x@pntr <- tptr } else { s <- x@pntr$x[i] tptr <- SpatRasterCollection$new() for (i in 1:length(s)) { tptr$add(s[[i]], "") } x@pntr <- tptr } messages(x, "`[`") }) setMethod("add<-", signature("SpatRasterCollection", "SpatRaster"), function(x, value) { x@pntr$add(value@pntr, "") messages(x, "add") } ) setMethod("add<-", signature("SpatRasterDataset", "SpatRaster"), function(x, value) { x@pntr$add(value@pntr, "") messages(x, "add") } ) setMethod("c", signature(x="SpatRasterCollection"), function(x, ..., warn=TRUE) { y <- list(...) sprc(c(as.list(x), ...)) } ) setMethod("c", signature(x="SpatRasterCollection"), function(x, ...) { x@pntr <- x@pntr$deepcopy() dots <- list(...) nms <- names(dots) for (i in seq_along(dots)) { if (inherits(dots[[i]], "SpatRasterCollection") | inherits(dots[[i]], "SpatRasterDataset")) { sdsnms <- names(dots[[i]]) for (j in 1:(length(dots[[i]]))) { x@pntr$add(dots[[i]][[j]]@pntr, sdsnms[j]) } } else if (inherits(dots[[i]], "SpatRaster")) { if (is.null(nms)) { name <- paste0("d", i) } else { name <- nms[i] } x@pntr$add(dots[[i]]@pntr, name) } else { error("c", "arguments must be SpatRaster, SpatRasterCollection, or SpatRasterDataset") } } messages(x, "c") } ) terra/R/xapp.R0000644000176200001440000000415014551065770012675 0ustar liggesusers setMethod("xapp", signature(x="SpatRaster", y="SpatRaster"), function(x, y, fun, ..., filename="", overwrite=FALSE, wopt=list()) { compareGeom(x, y, crs=FALSE, warncrs=TRUE) if (!hasValues(x)) error("xapp", "x does not have values") if (!hasValues(y)) error("xapp", "y does not have values") fun <- match.fun(fun) out <- rast(x) nc <- ncol(x) readStart(x) readStart(y) on.exit(readStop(x)) on.exit(readStop(y), add=TRUE) dots <- list(...) if (length(dots) > 0) { test <- any(sapply(dots, function(i) inherits(i, "SpatRaster"))) if (test) { error("app", "additional arguments cannot be a SpatRaster") } } teststart <- max(1, 0.5 * nc - 6) testend <- min(teststart + 12, nc) ntest <- 1 + testend - teststart vx <- readValues(x, round(0.51*nrow(x)), 1, teststart, ntest, mat=TRUE) vy <- readValues(y, round(0.51*nrow(y)), 1, teststart, ntest, mat=TRUE) test <- sapply(1:nrow(vx), function(i) fun(vx[i, ], vy[i, ], ...)) if (is.list(test)) { error("xapp", "'fun' returns a list (should be numeric or matrix)") } trans <- FALSE if (NCOL(test) > 1) { if (ncol(test) == ntest) { nlyr(out) <- nrow(test) trans <- TRUE nms <- rownames(test) } else if (nrow(test) == ntest) { nlyr(out) <- ncol(test) nms <- colnames(test) } else { error("xapp", "the number of values returned by 'fun' is not appropriate\n(it should be the product of the number of cells and and a positive integer)") } if (is.null(wopt$names)) { wopt$names <- nms } } else { if ((length(test) %% ntest) != 0) { error("xapp", "the number of values returned by 'fun' is not appropriate") } else { nlyr(out) <- length(test) / ntest } } ncops <- (nlyr(x)+nlyr(y)) / nlyr(out) ncops <- ifelse(ncops > 1, ceiling(ncops), 1) * 4 b <- writeStart(out, filename, overwrite, wopt=wopt, n=ncops, sources=sources(x)) for (i in 1:b$n) { vx <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) vy <- readValues(y, b$row[i], b$nrows[i], 1, nc, TRUE) r <- sapply(1:nrow(vx), function(i) fun(vx[i, ], vy[i, ], ...)) if (trans) { r <- t(r) } writeValues(out, r, b$row[i], b$nrows[i]) } writeStop(out) } ) terra/R/plot_let.R0000644000176200001440000005150614747312555013561 0ustar liggesusers# these methods require the dev version of leaflet checkLeafLetVersion <- function() { v <- utils::packageVersion("leaflet") if (v < "2.1.2.9000") { error("plet", "plet needs the development version of leaflet") } } popUp <- function(x) { nms <- names(x) if (length(nms) > 0) { s <- sapply(1:length(nms), function(i) paste0(nms[i], ": ", x[[i, drop=TRUE]])) if (is.null(dim(s))) { paste(s, collapse="
") } else { apply(s, 1, function(i) paste(i, collapse="
")) } } else { paste("geom", 1:nrow(x), sep="_") } } makelonlat <- function(x) { geo <- is.lonlat(x) if (is.na(geo)) { geo <- is.lonlat(x, TRUE, TRUE) if (geo) return(x) error("plet", "coordinate reference system is unknown and does not look like lon/lat") } else if (!geo) { project(x, "+proj=longlat") } else { x } } setMethod("plet", signature(x="missing"), function(x) { leaflet::leaflet() } ) #.leaflet-container { # background: #FFF; #} baselayers <- function(tiles, wrap=TRUE) { map <- leaflet::leaflet() if ((!is.null(tiles)) && (length(tiles) > 0)) { if ("Streets" %in% tiles) { map <- leaflet::addTiles(map, group="Streets", options=leaflet::tileOptions(noWrap = !wrap)) } tiles <- tiles[tiles != "Streets"] if (length(tiles) > 0) { for (i in 1:length(tiles)) { map <- leaflet::addProviderTiles(map, tiles[i], group=tiles[i], options=leaflet::tileOptions(noWrap = !wrap)) } } } map } .get_leg <- function(v, type="", dig.lab=3, cols, breaks=NULL, breakby="eqint", sort=TRUE, decreasing=FALSE, ...) { out <- list(v=v, leg=list()) if (is.null(type)) type <- "" if (type == "continuous") { type <- "interval" } else if (type == "") { if ((!is.numeric(v)) || (length(unique(v)) < 11)) { type <- "classes" } else { type <- "interval" } } else { type <- match.arg(type, c("interval", "classes")) } out$legend_type <- type out$uv <- unique(v) if (inherits(cols, "function")) { cols <- cols(100) } out$cols <- cols if (out$legend_type == "classes") { out$legend_sort <- sort[1] out$legend_sort_decreasing <- decreasing[1] out <- .vect.legend.classes(out) } else if (out$legend_type == "interval") { out$breaks <- breaks out$breakby <- breakby out$range <- range(v, na.rm=TRUE) out <- .vect.legend.interval(out, dig.lab=dig.lab) } out } setMethod("plet", signature(x="SpatVector"), function(x, y="", col, fill=0.2, main=y, cex=1, lwd=2, border="black", alpha=1, popup=TRUE, label=FALSE, split=FALSE, tiles=c("Streets", "Esri.WorldImagery", "OpenTopoMap"), wrap=TRUE, legend="bottomright", collapse=FALSE, type=NULL, breaks=NULL, breakby="eqint", sort=TRUE, decreasing=FALSE, map=NULL, ...) { #checkLeafLetVersion() y <- unique(y) if (length(y) > 1) { y = y[1] # xvc <- svc(lapply(y, function(i) x[,i])) # if (is.numeric(y)) { # names(xvc) <- names(x)[y] # } else { # names(xvc) <- y # } # plet(xvc, col=col, fill=0.2, alpha=alpha, cex=cex, lwd=lwd, border=border, popup=popup, label=label, split=split, tiles=tiles, wrap=wrap, legend=legend, collapse=collapse, map=map, ...) #type=type, breaks=breaks, breakby=breakby, sort=sort, decreasing=decreasing, } if (missing(col)) col <- function(n) grDevices::rainbow(n, start=.2) alpha <- max(0, min(1, alpha)) fill <- max(0, min(1, fill)) x <- makelonlat(x) if (is.null(map)) { tiles <- unique(as.character(tiles)) tiles <- tiles[tiles!=""] map <- baselayers(tiles, wrap) } else { tiles <- NULL } g <- geomtype(x) leg <- NULL if (y == "") { # no legend group <- x@pntr$layer if (group == "") group = g cols <- .getCols(nrow(x), col) pop <- lab <- NULL if (isTRUE(popup[1])) pop <- popUp(x) if (isTRUE(label[1])) lab <- 1:nrow(x) if (g == "polygons") { map <- leaflet::addPolygons(map, data=x, label=lab, group=group, fillColor=cols, fillOpacity=fill, opacity=alpha, popup=pop, color=border, weight=lwd, ...) } else if (g == "lines") { map <- leaflet::addPolylines(map, data=x, label=lab, group=group, color=cols, opacity=alpha, popup=pop, weight=lwd, ...) } else { map <- leaflet::addCircleMarkers(map, data=x, radius=cex, popup=pop, group=group, label=lab, opacity=alpha, color=cols, ...) } if (length(tiles) > 1) { map <- leaflet::addLayersControl(map, baseGroups = tiles, overlayGroups=group, options = leaflet::layersControlOptions(collapsed=collapse)) } else { map <- leaflet::addLayersControl(map, overlayGroups = group, options = leaflet::layersControlOptions(collapsed=collapse)) } map } else { # legend y <- y[1] if (is.numeric(y)) { y <- round(y) stopifnot((y > 0) && (y <= nlyr(x))) y <- names(x)[y] } stopifnot(y %in% names(x)) x <- x[, y] v <- values(x)[,1] if (split) { u <- unique(v) cols <- .getCols(length(u), col) for (i in seq_along(u)) { s <- x[v == u[i], ] pop <- lab <- NULL if (isTRUE(popup[1])) pop <- popUp(s) if (isTRUE(label[1])) lab <- u if (g == "polygons") { map <- leaflet::addPolygons(map, data=s, label=lab[i], group=u[i], fillColor=cols[i], fillOpacity=fill, opacity=alpha, popup=pop, col=border, ...) } else if (g == "lines") { map <- leaflet::addPolylines(map, data=s, label=lab[i], group=u[i], col=cols[i], opacity=alpha, popup=pop, ...) } else { map <- leaflet::addCircleMarkers(map, data=s, label=lab[i], group=u[i], col=cols[i], fillOpacity=fill, opacity=alpha, popup=pop, radius=cex, ...) } } if (length(tiles) > 1) { map <- leaflet::addLayersControl(map, baseGroups = tiles, overlayGroups = u, options = leaflet::layersControlOptions(collapsed=collapse)) } else { map <- leaflet::addLayersControl(map, overlayGroups = u, options = leaflet::layersControlOptions(collapsed=collapse)) } } else { # do not split #vcols <- cols[1:length(v)] leg <- .get_leg(v, type=type, dig.lab=3, cols=col, breaks=breaks, breakby=breakby, sort=sort, decreasing=decreasing, ...) pop <- lab <- NULL if (isTRUE(popup[1])) pop <- popUp(x) if (isTRUE(label[1])) lab <- v if (g == "polygons") { map <- leaflet::addPolygons(map, data=x, label=lab, group=y, fillColor=leg$main_cols, opacity=alpha, fillOpacity=fill, col = border, popup=pop, ...) } else if (g == "lines") { map <- leaflet::addPolylines(map, data=x, label=lab, group=y, col=leg$main_cols, popup=pop, opacity=alpha, ...) } else { map <- leaflet::addCircleMarkers(map, data=x, label=lab, group=y, col=leg$main_cols, radius=cex, popup=pop, fillOpacity=fill, opacity=alpha, ...) } if (length(tiles) > 1) { map <- leaflet::addLayersControl(map, baseGroups = tiles, overlayGroups=y, options = leaflet::layersControlOptions(collapsed=collapse)) } else { map <- leaflet::addLayersControl(map, overlayGroups = y, options = leaflet::layersControlOptions(collapsed=collapse)) } } if ((!is.null(legend)) && (!is.null(leg))) { if (leg$legend_type != "") { main <- gsub("\n", "
", main[1]) op = ifelse(g == "polygons", fill, 1) map <- leaflet::addLegend(map, position=legend, colors=leg$leg$fill, labels=as.character(leg$leg$legend), opacity=op, title=main) } } map } } ) setMethod("plet", signature(x="SpatVectorCollection"), function(x, col, fill=0, cex=1, lwd=2, border="black", alpha=1, popup=TRUE, label=FALSE, tiles=c("Streets", "Esri.WorldImagery", "OpenTopoMap"), wrap=TRUE, legend="bottomright", collapse=FALSE, map=NULL) { #checkLeafLetVersion() if (is.null(map)) { tiles <- unique(as.character(tiles)) tiles <- tiles[tiles!=""] map <- baselayers(tiles, wrap) } else { tiles <- NULL } nms <- names(x) nms[nchar(nms) == 0] <- "X" nms <- make.unique(nms) if (missing(col)) col <- grDevices::rainbow n <- length(x) if (is.function(col)) { cols <- col(n) } else { cols <- rep_len(col, n) } lwd <- rep_len(lwd, n) alpha <- rep_len(alpha, n) alpha <- pmax(0, pmin(1, alpha)) fill <- rep_len(fill, n) fill <- pmax(0, pmin(1, fill)) popup <- rep_len(popup, n) label <- rep_len(label, n) border <- rep_len(border, n) for (i in 1:n) { v <- x[i] v <- makelonlat(v) g <- geomtype(v) pop <- NULL lab <- NULL if (popup[i]) { pop <- popUp(v) } if (label[i]) { lab <- 1:nrow(v) } if (g == "polygons") { map <- leaflet::addPolygons(map, data=v, weight=lwd[i], fillColor=cols[i], fillOpacity=fill[i], col=border[i], opacity=alpha[i], popup=pop, label=lab, group=nms[i]) } else if (g == "lines") { map <- leaflet::addPolylines(map, data=v, weight=lwd[i], opacity=alpha[i], col=cols[i], group=nms[i], popup=pop, label=lab) } else { map <- leaflet::addCircleMarkers(map, data=v, radius=cex[i], popup=pop, label=lab, opacity=alpha[i], col=cols[i], group=nms[i]) } } if (length(tiles) > 1) { map <- leaflet::addLayersControl(map, baseGroups = tiles, overlayGroups = nms, options = leaflet::layersControlOptions(collapsed=collapse)) } else { map <- leaflet::addLayersControl(map, overlayGroups = nms, options = leaflet::layersControlOptions(collapsed=collapse)) } map } ) setMethod("polys", signature(x="leaflet"), function(x, y, col, fill=0.2, lwd=2, border="black", alpha=1, popup=TRUE, label=FALSE, ...) { if (inherits(y, "SpatVector")) { if (nrow(y) == 0) return(x) y <- makelonlat(y) if (missing(col)) col <- "black" if (geomtype(y) != "polygons") { error("polys", "SpatVector y must have polygons geometry") } leaflet::addPolygons(x, data=y, weight=lwd, fillColor=col, fillOpacity=fill, col=border, opacity=alpha, popup=popup, label=label, ...) } else if (inherits(y, "SpatVectorCollection")) { nms <- names(y) n <- length(y) nms[nchar(nms) == 0] <- "X" nms <- make.unique(nms) if (is.function(col)) { cols <- col(n) } else { cols <- rep_len(col, n) } lwd <- rep_len(lwd, n) alpha <- rep_len(alpha, n) fill <- rep_len(fill, n) border <- rep_len(border, n) popup <- rep_len(popup, n) label <- rep_len(label, n) for (i in 1:length(nms)) { x <- leaflet::addPolygons(x, data=y[i], weight=lwd[i], fillColor=cols[i], fillOpacity=fill[i], col=border[i], opacity=alpha[i], popup=popup[i], label=label[i], group=nms[i], ...) } collapse=FALSE leaflet::addLayersControl(x, overlayGroups = nms, options = leaflet::layersControlOptions(collapsed=collapse)) } else { error("plet", "y should be a SpatVector or SpatVectorCollection") } } ) setMethod("lines", signature(x="leaflet"), function(x, y, col, lwd=2, alpha=1, ...) { if (inherits(y, "SpatVector")) { if (nrow(y) == 0) return(x) y <- makelonlat(y) if (missing(col)) col <- "black" if (!(geomtype(y) %in% c("lines", "polygons"))) { error("lines", "SpatVector y must have either lines or polygons geometry") } leaflet::addPolylines(x, data=y, weight=lwd, opacity=alpha, col=col, ...) } else if (inherits(y, "SpatVectorCollection")) { nms <- names(y) n <- length(y) nms[nchar(nms) == 0] <- "X" nms <- make.unique(nms) if (is.function(col)) { cols <- col(n) } else { cols <- rep_len(col, n) } lwd <- rep_len(lwd, n) alpha <- rep_len(alpha, n) for (i in 1:length(nms)) { x <- leaflet::addPolylines(x, data=y[i], weight=lwd[i], opacity=alpha[i], col=cols[i], group=nms[i], ...) } collapse=FALSE leaflet::addLayersControl(x, overlayGroups = nms, options = leaflet::layersControlOptions(collapsed=collapse)) } else { error("plet", "y should be a SpatVector or SpatVectorCollection") } } ) setMethod("points", signature(x="leaflet"), function(x, y, col, cex=1, alpha=1, label=1:nrow(y), popup=FALSE, ...) { stopifnot(inherits(y, "SpatVector")) if (nrow(y) == 0) return(x) y <- makelonlat(y) if (missing(col)) col <- "black" if (!(geomtype(y) == "points")) { if (geomtype(y) == "polygons") { y <- centroids(y) } else { y <- as.points(y) } } if (popup) { popup=popUp(y) } else { popup <- NULL } leaflet::addCircleMarkers(x, data=y, radius=cex, popup=popup, label=label, opacity=alpha, col=col, ...) } ) make.panel <- function(x, maxcell) { nl <- nlyr(x) x <- spatSample(x, maxcell/nl, "regular", as.raster=TRUE, warn=FALSE) if (is.lonlat(x)) { asp <- 1/cos((mean(ext(x)[3:4]) * pi)/180) } else { asp <- 1 } crs(x, warn=FALSE) <- "+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0 +x_0=0.0 +y_0=0 +k=1.0 +units=m +nadgrids=@null +wktext +no_defs" ext(x) = c(0,1,0,asp) #if (!is.null(add)) { # e <- as.vector(ext(x)) # for (i in 1:length(add)) { # v <- project(v, crs(x)) # add[i] <- rescale(v, fx=1/diff(e[1:2]), fy=1/diff(e[3:4])) # } #} asp <- asp * nrow(x) / ncol(x) nc <- ceiling(2*sqrt(nl/2) * asp) nr <- ceiling(nl / nc) nc <- ceiling(nl / nr) e <- as.vector(ext(x)) r <- res(x) skiprow <- -asp - max(1, min(10, trunc(nrow(x)/20))) *r[2] skipcol <- 1 + max(1, min(10, trunc(ncol(x)/20))) *r[1] # skipcol <- 1 + max(r[1], min(10, r[1] * trunc(nrow(x)/20))) labs <- data.frame(x=0, y=0, label=names(x)) rw = cl = 0 y <- vector(mode="list", length=nl) off <- 0 #.4 / nr for (i in 1:nl) { y[[i]] <- shift(x[[i]], cl * skipcol, rw * skiprow) e <- as.vector(ext(y[[i]])) labs[i,1:2] <- c(mean(e[1:2]), e[4]-off) cl <- cl + 1 if (cl == nc) { cl <- 0 rw <- rw + 1 } } labs <- vect(labs, geom=c("x", "y"), crs=crs(x)) labs <- project(labs, "+proj=longlat") x <- merge(sprc(y)) list(x, labs) } .get_cls <- function(x, type="", dig.lab=3, cols, breaks=NULL, breakby="eqint", sort=TRUE, decreasing=FALSE, ...) { if (is.null(type) ||(type == "")) { if (is.factor(x) || is.bool(x)) { type <- "classes" } else if (is.null(breaks)) { type <- "continuous" } else { type <- "interval" } } else { type <- match.arg(type, c("continuous", "interval", "classes")) } if ((type == "interval") && (is.null(breaks))) { } if (type == "continuous") { if (inherits(cols, "function")) { cols <- cols(100) } return(list(type=type, x=x, cols=cols)) } if (type == "classes") { if (!is.factor(x)) { uv <- unique(values(x)) uv <- sort(uv) uv <- uv[!is.na(uv)] levels(x) <- data.frame(ID=uv, value=uv) } else { uv <- levels(x)[[1]][,2] } ncols <- length(uv) } else { if (is.null(breaks)) breaks <- 5 if (length(breaks) == 1) { breaks <- .get_breaks(values(x), n=breaks, breakby, r=NULL) } x <- classify(x, breaks) ncols <- length(breaks)-1 } if (inherits(cols, "function")) { cols <- cols(ncols) } else { cols <- grDevices::colorRampPalette(cols)(ncols) } return(list(type=type, x=x, cols=cols)) # out$legend_type <- type # out$uv <- unique(v) } setMethod("plet", signature(x="SpatRaster"), function(x, y=1, col, alpha=0.8, main=names(x), tiles=c("Streets", "Esri.WorldImagery", "OpenTopoMap"), wrap=TRUE, maxcell=500000, stretch=NULL, legend="bottomright", shared=FALSE, panel=FALSE, collapse=TRUE, type=NULL, breaks=NULL, breakby="eqint", map=NULL, ...) { #checkLeafLetVersion() if (is.na(crs(x)) | (grepl("^Cartesian", .name_or_proj4(x)))) { tiles <- "" e <- ext(x) rx <- diff(e[1:2]) ry <- diff(e[3:4]) m <- max(rx, ry) ext(x) <- c(0, rx/m, 0, ry/m) crs(x) <- "EPSG:3857" notmerc <- FALSE } else { notmerc <- isTRUE(crs(x, describe=TRUE)$code != "3857") } # if (!is.null(add)) { # if (inherits(add, "SpatVector")) { # add <- svc(makelonlat(add)) # } else if (inherits(add, "SpatVectorCollection")) { # for (i in 1:length(add)) { # add[i] <- makelonlat(add[i]) # } # } else { # error("plet", "add should be a SpatVector or a SpatVectorCollection") # } # } alpha <- max(0, min(1, alpha)) hasRGB <- has.RGB(x) if (hasRGB) { y <- RGB(x) legend <- NULL } # else if (!is.null(terra::coltab(x)[[1]])) { # legend <- NULL #} e <- ext(x) if (is.lonlat(x) && ((e$ymin < -85) || (e$ymax > 85))) { yr1 <- e$ymax - e$ymin e$ymin <- max(e$ymin, -85) e$ymax <- min(e$ymax, 85) yr2 <- e$ymax - e$ymin x <- spatSample(x[[y]], (yr1/yr2) * maxcell, "regular", as.raster=TRUE, warn=FALSE) x <- crop(x, e) } if (panel) { tiles <- NULL p <- make.panel(x, maxcell) #, add) x <- p[[1]] p <- p[[2]] add <- p[[3]] main <- "" } else { x <- spatSample(x[[y]], maxcell, "regular", as.raster=TRUE, warn=FALSE) } if (is.null(map)) { tiles <- unique(as.character(tiles)) tiles <- tiles[tiles!=""] if (length(tiles) > 1) { tiles <- tiles[1] #warn("plet", "only a single tileset can be used with raster data") } map <- baselayers(tiles, wrap) } else { tiles <- NULL } if (missing(col)) { col <- .default.pal() #col <- rev(grDevices::terrain.colors(255)) } main <- gsub("\n", "
", main) if (length(main) != length(y)) { main <- rep_len(main, length(x))[y] } if (hasRGB) { if (!is.null(stretch)) { if (stretch == "lin") { x <- stretch(x, minq=0.02, maxq=0.98) } else { x <- stretch(x, histeq=TRUE, scale=255) } } RGB(x) <- 1:length(y) x <- colorize(x, "col") } else { leg <- .get_cls(x, type=type, dig.lab=3, cols=col, breaks=breaks, breakby=breakby, ...) x <- leg$x col <- leg$cols } if (nlyr(x) == 1) { map <- leaflet::addRasterImage(map, x, colors=col, opacity=alpha, project=notmerc) if (!is.null(legend)) { if (leg$type == "continuous") { if (!all(hasMinMax(x))) setMinMax(x) r <- minmax(x) v <- seq(r[1], r[2], length.out=5) pal <- leaflet::colorNumeric(col, v, reverse = TRUE) map <- leaflet::addLegend(map, legend, pal=pal, values=v, opacity=1, title=main[1], labFormat = leaflet::labelFormat(transform = function(x) sort(x, decreasing = TRUE))) } else { map <- leaflet::addLegend(map, position=legend, colors=leg$cols, labels=levels(x)[[1]][,2], opacity=alpha, title=main) } } if (panel) { #map <- leaflet::addCircleMarkers(map, data=p, label=p$label, radius=1, opacity=1, col="red") map <- leaflet::addLabelOnlyMarkers(map, label=p$label, data=p, labelOptions = leaflet::labelOptions(noHide = T, textOnly = T)) } } else { nms <- make.unique(names(x)) many_legends <- one_legend <- FALSE if (!is.null(legend)) { if (!all(hasMinMax(x))) setMinMax(x) r <- minmax(x) if (shared) { rr <- range(r) pal <- leaflet::colorNumeric(col, rr, na.color="#00000000") one_legend <- TRUE } else { many_legends <- TRUE } } else { one_legend <- FALSE } for (i in 1:nlyr(x)) { if (one_legend) { map <- leaflet::addRasterImage(map, x[[i]], colors=pal, opacity=alpha, group=nms[i], project=notmerc) } else { map <- leaflet::addRasterImage(map, x[[i]], colors=col, opacity=alpha, group=nms[i], project=notmerc) if (many_legends) { v <- seq(r[1,i], r[2,i], length.out=5) pal <- leaflet::colorNumeric(col, v, reverse=TRUE) map <- leaflet::addLegend(map, position=legend, pal=pal, values=v, title=main[i], opacity=1, group=nms[i], labFormat = leaflet::labelFormat(transform = function(x) sort(x, decreasing = TRUE))) } } } map <- leaflet::addLayersControl(map, baseGroups=nms, options = leaflet::layersControlOptions(collapsed=collapse)) if (many_legends) { # show one legend at a time map <- htmlwidgets::onRender(map, "function(el, x) { var updateLegend = function () { var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1); document.querySelectorAll('.legend').forEach(a => a.hidden=true); document.querySelectorAll('.legend').forEach(l => { if (l.children[0].children[0].innerText == selectedGroup) l.hidden=false; }); }; updateLegend(); this.on('baselayerchange', e => updateLegend());}") } else if (one_legend) { v <- seq(rr[1], rr[2], length.out=5) pal <- leaflet::colorNumeric(col, v, reverse = TRUE) map <- leaflet::addLegend(map, position=legend, pal=pal, values=v, opacity=1, group=nms[i], labFormat = leaflet::labelFormat(transform = function(x) sort(x, decreasing = TRUE))) } } map } ) terra/R/tags.R0000644000176200001440000001271314732151132012654 0ustar liggesusers setMethod("meta", signature(x="SpatRaster"), function(x, layers=FALSE) { f <- function(i) { if (length(i) == 0) { matrix(ncol=2, nrow=0) } else { matrix(unlist(regmatches(i, regexpr("=", i), invert=TRUE)), ncol=2, byrow=TRUE) } } lapply(x@pntr$metadata(layers), f) } ) setMethod("metags", signature(x="SpatRaster"), function(x, layer=NULL, name=NULL) { if (!is.null(layer)) { if (is.character(layer)) layer = match(layer, names(x)) v <- x@pntr$getLyrTags(layer-1) out <- matrix(v, ncol=3, byrow=TRUE, dimnames = list(NULL, c("layer", "name", "value"))) out <- data.frame(out) out$layer <- as.numeric(out$layer) + 1 if (!is.null(name)) { out <- out[out$name == name, , drop=FALSE] } } else { v <- x@pntr$getTags() m <- matrix(v, ncol=2, byrow=TRUE, dimnames = list(NULL, c("name", "value"))) out <- m[,2] names(out) <- m[,1] if (!is.null(name)) { out <- out[name] } } out } ) setMethod("metags<-", signature(x="SpatRaster"), function(x, ..., layer=NULL, value) { if (is.null(value)) { if (!is.null(layer)) { if (is.character(layer)) layer = match(layer, names(x)) value <- matrix(x@pntr$getLyrTags(layer-1), ncol=2, byrow=TRUE) } else { value <- matrix(x@pntr$getTags(), ncol=2, byrow=TRUE) } value[,2] <- "" value[is.na(value)] <- "" } else if (NCOL(value) == 1) { if (!is.null(names(value)) && (!any(grepl("=", value)))) { value <- cbind(names(value), value) } else { value <- strsplit(value, "=") i <- sapply(value, length) == 1 if (length(i) > 0) { j <- which(i) for (i in j) value[[i]] <- c(value[[i]], "") } i <- sapply(value, length) == 2 value <- do.call(rbind, value[i]) } } else if (NCOL(value) != 2) { error("metags<-", "expecting a vector with 'name=value' or a two column matrix") } value[is.na(value[,2]), 2] <- "" value <- na.omit(value) x <- deepcopy(x) if (NROW(value) > 0) { if (!is.null(layer)) { if (is.character(layer)) layer = match(layer, names(x)) x@pntr$addLyrTags(layer-1, value[,1], value[,2]) } else { sapply(1:nrow(value), function(i) { x@pntr$addTag(value[i,1], value[i,2]) }) } } x } ) setMethod("metags", signature(x="SpatRasterDataset"), function(x, dataset=NULL, name=NULL) { if (!is.null(dataset)) { if (is.character(dataset)) layer = match(dataset, names(x)) return(metags(x[[dataset]], name=name)) } else { v <- x@pntr$getTags() m <- matrix(v, ncol=2, byrow=TRUE, dimnames = list(NULL, c("name", "value"))) out <- m[,2] names(out) <- m[,1] if (!is.null(name)) { out <- out[name] } } out } ) setMethod("metags<-", signature(x="SpatRasterDataset"), function(x, ..., dataset=NULL, value) { if (is.null(value)) { if (!is.null(dataset)) { if (is.character(dataset)) layer = match(dataset, names(x)) value <- matrix(x[[dataset]]@pntr$getTags(), ncol=2, byrow=TRUE) } else { value <- matrix(x@pntr$getTags(), ncol=2, byrow=TRUE) } value[,2] <- "" value[is.na(value)] <- "" } else if (NCOL(value) == 1) { if (!is.null(names(value)) && (!any(grepl("=", value)))) { value <- cbind(names(value), value) } else { value <- strsplit(value, "=") i <- sapply(value, length) == 1 if (length(i) > 0) { j <- which(i) for (i in j) value[[i]] <- c(value[[i]], "") } i <- sapply(value, length) == 2 value <- do.call(rbind, value[i]) } } else if (NCOL(value) != 2) { error("metags<-", "expecting a vector with 'name=value' or a two column matrix") } value[is.na(value[,2]), 2] <- "" value <- na.omit(value) x@pntr <- x@pntr$deepcopy() if (NROW(value) > 0) { if (!is.null(dataset)) { if (is.character(dataset)) layer = match(dataset, names(x)) x[[dataset]]@pntr$addTag(value[,1], value[,2]) } else { sapply(1:nrow(value), function(i) { x@pntr$addTag(value[i,1], value[i,2]) }) } } x } ) setMethod("metags", signature(x="SpatRasterCollection"), function(x, dataset=NULL, name=NULL) { if (!is.null(dataset)) { return(metags(x[[dataset]], name=name)) } else { v <- x@pntr$getTags() m <- matrix(v, ncol=2, byrow=TRUE, dimnames = list(NULL, c("name", "value"))) out <- m[,2] names(out) <- m[,1] if (!is.null(name)) { out <- out[name] } } out } ) setMethod("metags<-", signature(x="SpatRasterCollection"), function(x, ..., dataset=NULL, value) { if (is.null(value)) { if (!is.null(dataset)) { value <- matrix(x[[dataset]]@pntr$getTags(), ncol=2, byrow=TRUE) } else { value <- matrix(x@pntr$getTags(), ncol=2, byrow=TRUE) } value[,2] <- "" value[is.na(value)] <- "" } else if (NCOL(value) == 1) { if (!is.null(names(value)) && (!any(grepl("=", value)))) { value <- cbind(names(value), value) } else { value <- strsplit(value, "=") i <- sapply(value, length) == 1 if (length(i) > 0) { j <- which(i) for (i in j) value[[i]] <- c(value[[i]], "") } i <- sapply(value, length) == 2 value <- do.call(rbind, value[i]) } } else if (NCOL(value) != 2) { error("metags<-", "expecting a vector with 'name=value' or a two column matrix") } value[is.na(value[,2]), 2] <- "" value <- na.omit(value) x@pntr <- x@pntr$deepcopy() if (NROW(value) > 0) { if (!is.null(dataset)) { x[[dataset]]@pntr$addTag(value[,1], value[,2]) } else { sapply(1:nrow(value), function(i) { x@pntr$addTag(value[i,1], value[i,2]) }) } } x } ) terra/R/plot.R0000644000176200001440000002432614744355052012711 0ustar liggesusers .one.density <- function(x, maxcells=100000, plot=TRUE, ...) { d <- values(x) d <- stats::density(stats::na.omit(d)) if (plot) { plot(d, ...) return(invisible(d)) } else { return(d) } } setMethod("density", signature(x="SpatRaster"), function(x, maxcells=100000, plot=TRUE, main, ...) { x <- spatSample(x, maxcells, method="regular", as.raster=TRUE, warn=FALSE) res <- list() nl <- nlyr(x) if (missing(main)) { main=names(x) } else { main <- rep(main, length.out=nl) } if (nl==1) { res[[1]] <- .one.density(x, plot=plot, maxcells=maxcells, main=main, ...) } else { if (nl > 16) { warn("density", "only the first 16 layers are plotted") nl <- 16 x <- x[[1:16]] } nc <- ceiling(sqrt(nl)) nr <- ceiling(nl / nc) mfrow <- graphics::par("mfrow") spots <- mfrow[1] * mfrow[2] if (spots < nl) { old.par <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(old.par)) graphics::par(mfrow=c(nr, nc)) } for (i in 1:nlyr(x)) { res[[i]] <- .one.density(x[[i]], maxcells=maxcells, main=main[i], plot=plot, ...) } } if (plot) return(invisible(res)) else return(res) } ) setMethod("persp", signature(x="SpatRaster"), function(x, maxcells=100000, ...) { x <- spatSample(x, size=maxcells, method="regular", as.raster=TRUE, warn=FALSE) value <- t(as.matrix(x, wide=TRUE)[nrow(x):1,]) y <- yFromRow(x, nrow(x):1) x <- xFromCol(x, 1:ncol(x)) graphics::persp(x=x, y=y, z=value, ...) } ) .plot.filled.contour <- function(x, maxcells=100000, ...) { x <- spatSample(x[[1]], maxcells, method="regular", as.raster=TRUE, warn=FALSE) X <- xFromCol(x, 1:ncol(x)) Y <- yFromRow(x, nrow(x):1) Z <- t( matrix( values(x), ncol=ncol(x), byrow=TRUE)[nrow(x):1,] ) if (is.null(list(...)$asp)) { asp <- ifelse(is.lonlat(x, perhaps=TRUE, warn=FALSE), 1/cos((mean(as.vector(ext(x))[3:4]) * pi)/180), 1) graphics::filled.contour(x=X, y=Y, z=Z, asp=asp, ...) } else { graphics::filled.contour(x=X, y=Y, z=Z,...) } } setMethod("contour", signature(x="SpatRaster"), function(x, maxcells=100000, filled=FALSE, ...) { if (filled) { .plot.filled.contour(x, maxcells=maxcells, ...) } else { x <- spatSample(x[[1]], maxcells, method="regular", as.raster=TRUE, warn=FALSE) if (is.null(list(...)$asp)) { asp <- ifelse(is.lonlat(x, perhaps=TRUE, warn=FALSE), 1/cos((mean(as.vector(ext(x))[3:4]) * pi)/180), 1) graphics::contour(x=xFromCol(x,1:ncol(x)), y=yFromRow(x, nrow(x):1), z=t(as.matrix(x, wide=TRUE)[nrow(x):1,]), asp=asp, ...) } else { graphics::contour(x=xFromCol(x,1:ncol(x)), y=yFromRow(x, nrow(x):1), z=t(as.matrix(x, wide=TRUE)[nrow(x):1,]), ...) } } } ) setMethod("as.contour", signature(x="SpatRaster"), function(x, maxcells=100000, ...) { x <- spatSample(x[[1]], size=maxcells, method="regular", as.raster=TRUE, warn=FALSE) z <- grDevices::contourLines(x=xFromCol(x,1:ncol(x)), y=yFromRow(x, nrow(x):1), z=t(as.matrix(x, wide=TRUE)[nrow(x):1,]), ...) y <- lapply(1:length(z), function(i) cbind(z[[i]]$level, i, z[[i]]$x, z[[i]]$y)) y <- do.call(rbind, y) y[] <- as.numeric(y) u <- unique(y[,1]) y[,1] <- match(y[,1], u) colnames(y)[3:4] <- c("x", "y") vect(y, "lines", atts=data.frame(level=u), crs=crs(x)) } ) setMethod("pairs", signature(x="SpatRaster"), function(x, hist=TRUE, cor=TRUE, use="pairwise.complete.obs", maxcells=100000, ...) { if (nlyr(x) < 2) { error("x must have at least two layers") } if (nlyr(x) < 2) { error("x must have at least two layers") } panelhist <- function(x,...) { usr <- graphics::par("usr") on.exit(graphics::par(usr=usr)) graphics::par(usr = c(usr[1:2], 0, 1.5) ) h <- hist(x, plot = FALSE) breaks <- h$breaks nB <- length(breaks) y <- h$counts y <- y/max(y) graphics::rect(breaks[-nB], 0, breaks[-1], y, col="green") } panelcor <- function(x, y,...) { usr <- graphics::par("usr") on.exit(graphics::par(usr=usr)) graphics::par(usr = c(0, 1, 0, 1)) r <- abs(stats::cor(x, y, use=use)) txt <- format(c(r, 0.123456789), digits=2)[1] text(0.5, 0.5, txt, cex = max(0.5, r * 2)) } if (hist) {dp <- panelhist} else {dp <- NULL} if (cor) {up <- panelcor} else {up <- NULL} d <- spatSample(x, maxcells, method="regular", as.raster=FALSE, warn=FALSE) dots <- list(...) cex <- dots$cex main <- dots$main if (is.null(cex)) cex <- 0.5 if (is.null(main)) main <- "" graphics::pairs(d, main=main, cex=cex, upper.panel=up, diag.panel=dp) } ) .textbox <- function(x, y=NULL, labels, col="black", hc="white", hw=0.1, ... ) { xy <- grDevices::xy.coords(x, y) hw <- hw[1] n <- nchar(labels) x0 <- hw * graphics::strwidth("A") y0 <- hw * graphics::strheight("A") x1 <- n * x0 v <- vect(cbind(xy$x + c(0, x1), xy$y), crs="local") b <- buffer(v, y0) } .halo <- function(x, y=NULL, labels, col="black", hc="white", hw=0.1, ... ) { xy <- grDevices::xy.coords(x, y) hw <- hw[1] xo <- hw * graphics::strwidth("A") yo <- hw * graphics::strheight("A") n <- nchar(labels) fact <- 100 * max(1, hw*2) theta <- seq(pi/4, 2*pi, length.out=hw*fact) for (i in theta) { text( xy$x + cos(i)*xo, xy$y + sin(i)*yo, labels, col=hc, ... ) } graphics::text(xy$x, xy$y, labels, col=col, ... ) } halo <- function(x, y=NULL, labels, col="black", hc="white", hw=0.1, ... ) { .halo(x=x, y=y, labels=labels, col=col, hc=hc, hw=hw, ...) } setMethod("text", signature(x="SpatRaster"), function(x, labels, digits=0, halo=FALSE, hc="white", hw=0.1, ...) { if (missing(labels)) { labels <- 1 } if (length(labels) != ncell(x)) { labels <- labels[1] if (is.character(labels)) { i <- which(labels == names(x)) if (i == 0) { i <- 1 } } x <- x[[labels]] labels <- as.data.frame(x)[,1] p <- as.points(x, values=TRUE) } else { p <- as.points(x, values=FALSE, na.rm=FALSE) } xy <- geom(p)[, c("x", "y"), drop=FALSE] if (is.factor(labels)) { labels <- substr(as.character(labels), 1, max(1, digits)) } else if (is.numeric(labels)) { labels <- as.character(round(labels, digits=digits) ) } if (length(labels) < nrow(xy)) { labels <- rep(labels, nrow(xy)) } # if (!overlap) { # xy <- getLabelXY(xy, labels, cex) # } if (halo && (isTRUE(hw > 0))) { .halo(xy[,1], xy[,2], labels, hc=hc, hw=hw, ...) } else { text(xy[,1], xy[,2], labels, ...) } } ) setMethod("text", signature(x="SpatVector"), function(x, labels, halo=FALSE, inside=FALSE, hc="white", hw=0.1, ...) { if (missing(labels)) { labels <- 1:nrow(x) } else if (length(labels) == 1) { if (nrow(x) > 1) { labels <- as.data.frame(x)[,labels] } else { if (is.numeric(labels)) { if (labels %in% 1:ncol(x)) { labels <- x[[labels]][,1] } } else if (labels %in% names(x)) { labels <- x[[labels]][,1] } } } xy <- geom(centroids(x, inside=inside))[,c("x","y"),drop=FALSE] if (halo && (isTRUE(hw > 0))) { .halo(xy[,1], xy[,2], labels, hc=hc, hw=hw, ...) } else { text(xy[,1], xy[,2], labels, ...) } } ) setMethod("boxplot", signature(x="SpatRaster"), function(x, y=NULL, maxcell=100000, ...) { if (is.null(y)) { cn <- names(x) if ( ncell(x) > maxcell) { warn("boxplot", "taking a sample of ", maxcell, " cells") x <- spatSample(x, maxcell, method="regular", as.raster=TRUE, warn=FALSE) } names(x) <- cn boxplot(values(x), ...) } else { s <- c(x[[1]], y[[1]]) if ( ncell(x) > maxcell) { warn("boxplot", "taking a regular sample of ", maxcell, " cells") s <- spatSample(s, maxcell, method="regular", as.raster=TRUE, warn=FALSE) } s <- values(s, dataframe=TRUE) cn <- colnames(s) if (is.null(cn)) cn <- c("", "") colnames(s)[cn==""] <- c("layer1", "layer2")[cn==""] f <- try(stats::as.formula(paste(cn[1], '~', cn[2])), silent=TRUE) if (inherits(f, "try-error")) { colnames(s) <- c("layer1", "layer2") f <- layer1 ~ layer2 } boxplot(f, data=s, ...) } } ) setMethod("barplot", "SpatRaster", function(height, maxcell=1000000, digits=0, breaks=NULL, col, ...) { if (missing(col)) { col=grDevices::rainbow } height <- height[[1]] f <- is.factor(height) # x <- spatSample(height[[1]], maxcell, method="regular", as.raster=FALSE, as.df=f) x <- spatSample(height[[1]], maxcell, method="regular", as.raster=FALSE, as.df=FALSE, warn=FALSE) adj <- nrow(x) / ncell(height) if (adj < 1) { warn("barplot", "a sample of ", round(100*adj, 1), "% of the raster cells were used to estimate frequencies") } if (!f) { if (!is.null(digits)) { x <- round(x, digits) } if (!is.null(breaks)) { x <- cut(x, breaks) } } x <- table(x) / adj if (is.function(col)) { col <- col(length(x)) } barplot(x, col=col, ...) } ) shade <- function(slope, aspect, angle=45, direction=0, normalize=FALSE, filename="", overwrite=FALSE, ...) { stopifnot(inherits(slope, "SpatRaster")) opt <- spatOptions(filename, overwrite=overwrite, ...) slope@pntr <- slope@pntr$hillshade(aspect@pntr, angle, direction, normalize[1], opt) messages(slope, "shade") } map.pal <- function(name, n=50, ...) { n <- round(n) if (n < 1) { error("map.pal", "n should be >= 1") } f <- system.file("colors/palettes.rds", package="terra") v <- readRDS(f) if (missing(name)) { return(names(v)) } if (name %in% names(v)) { v <- v[[name]] if ((n > 0) && ((length(v) != n))) { grDevices::colorRampPalette(v, ...)(n) } else { v } } else if (name == "random") { if (n > 433) { warning("map.pal", "you cannot get > 433 random colors; using n=433 instead") n <- 433 } s <- sample(grDevices::colors()[grep('gr(a|e)y', grDevices::colors(), invert = TRUE)], n) rgb(t(grDevices::col2rgb(s))/255) } else { error("map.pal", paste(name, "is not a known palette")) } } map.leg <- function(name) { f <- system.file("colors/legends.rds", package="terra") v <- readRDS(f) if (name %in% names(v)) { v[[name]] } else { error("map.leg", paste(name, "is not a known legend")) } } terra/R/crosstab.R0000644000176200001440000000361014732065727013550 0ustar liggesusers# Author: Robert J. Hijmans # Date : March 2009 # Version 1.0 # License GPL v3 # revised April 2011 # adapted November 2020 setMethod("crosstab", signature(x="SpatRaster", y="missing"), function(x, digits=0, long=FALSE, useNA=FALSE) { nl <- nlyr(x) if (nl < 2) { error("crosstab", "needs at least 2 layers") } nms <- names(x) opt <- spatOptions() b <- blocks(x, 4) readStart(x) on.exit(readStop(x)) res <- NULL nc <- ncol(x) for (i in 1:b$n) { d <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) d <- lapply(1:nl, function(i) round(d[, i], digits=digits)) d <- do.call(table, c(d, useNA="ifany")) d <- as.data.frame(d) res <- rbind(res, d) } res <- res[res$Freq > 0, ,drop=FALSE] # some complexity to aggregate keeping # variables that are NA if (useNA) { for (i in 1:(ncol(res)-1)) { if (any(is.na(res[,i]))) { res[,i] <- factor(res[,i], levels=c(levels(res[,i]), NA), exclude=NULL) } } } res <- aggregate(res[, ncol(res), drop=FALSE], res[, 1:(ncol(res)-1), drop=FALSE], sum) for (i in 1:(ncol(res)-1)) { # get rid of factors res[,i] <- as.numeric(as.character(res[,i])) } if (nrow(res) == 0) { res <- data.frame(matrix(nrow=0, ncol=length(nms)+1)) } nms <- make.names(nms, unique=TRUE) colnames(res) <- c(nms, "Freq") if (! useNA ) { i <- apply(res, 1, function(x) any(is.na(x))) res <- res[!i, ,drop=FALSE] } ff <- is.factor(x) if (any(ff) && (digits >= 0)) { ff <- which(ff) v <- levels(x) for (i in ff) { j <- match(res[,i], v[[i]][,1]) res[,i] <- v[[i]][j,2] } } if (!long) { f <- eval(parse(text=paste("Freq ~ ", paste(nms , collapse="+")))) res <- stats::xtabs(f, data=res, addNA=useNA) } else { res <- res[res$Freq > 0, ,drop=FALSE] res <- res[order(res[,1], res[,2]), ] rownames(res) <- NULL colnames(res)[ncol(res)] <- "n" } return(res) } ) terra/R/rasterize.R0000644000176200001440000002276614726700274013751 0ustar liggesusers setMethod("rasterizeGeom", signature(x="SpatVector", y="SpatRaster"), function(x, y, fun="count", unit="m", filename="", ...) { opt <- spatOptions(filename, ...) y@pntr <- y@pntr$rasterizeGeom(x@pntr, unit, fun, opt) messages(y, "rasterizeGeom") } ) # now can use # r@pntr = r@pntr$rasterizePoints(v@pntr, "mean", 1:nrow(v), NA, opt) .set_names <- function(wopt, cnms, fun, nc) { if (is.null(wopt$names)) { if (is.null(cnms)) { if (nc == 1) { cnms <- fun } else { cnms <- paste0(fun, "_", 1:nc) } } else { cnms <- paste0(cnms, "_", fun) } wopt$names <- cnms } wopt } rasterize_points <- function(x, y, values, fun="last", background=NA, update=FALSE, filename="", overwrite=FALSE, wopt=list(), ...) { if (missing(fun)) fun <- "last" if (update && (!hasValues(y))) update <- FALSE nrx <- nrow(x) if (!is.data.frame(values)) { values <- as.data.frame(values) } if (nrow(values) == 1) { values <- sapply(values, function(x) rep_len(x, nrx)) if (!is.data.frame(values)) { # dropped if nrx==1 values <- as.data.frame(values) } } else if (nrow(values) != nrx) { error("rasterize", paste0("the number or rows in values is ", nrow(values), "\nThat does not match the number of points: ", nrx)) } cnms <- colnames(values) nl <- ncol(values) r <- rast(y, nlyrs=nl) levs <- list() has_levels <- FALSE for (i in 1:nl) { if (is.character(values[,i])) { f <- as.factor(values[,i]) levs[[i]] <- levels(f) values[,i] <- as.integer(f) - 1 has_levels <- TRUE } else if (is.factor(values[,i])) { f <- values[,i] levs[[i]] <- levels(f) values[,i] <- as.integer(f) - 1 has_levels <- TRUE } } if (NCOL(values) == 1 && (!has_levels)) { txtfun <- .makeTextFun(fun) if (inherits(txtfun, "character")) { if (txtfun %in% c("first", "last", "pa", "sum", "mean", "count", "min", "max", "prod")) { if (is.null(wopt$names)) { wopt$names <- txtfun } if (update) { ops <- spatOptions("", TRUE, wopt=wopt) } else { ops <- spatOptions(filename, overwrite, wopt=wopt) } narm <- isTRUE(list(...)$na.rm) r <- rast() r@pntr <- y@pntr$rasterizePointsXY(x[,1], x[,2], txtfun, values[[1]], narm, background, ops) messages(r) if (update) { r <- cover(r, y, filename=filename, overwrite=overwrite, wopt=wopt) } return(r) } } } if (inherits(fun, "character")) { if (fun == "first") { fun <- function(i, na.rm=FALSE) { if (na.rm) { i <- na.omit(i) } if (length(i) > 0) { i[i] } else { NA } } } else if (fun == "last") { fun <- function(i, na.rm=FALSE) { if (na.rm) { i <- na.omit(i) } if (length(i) > 0) { i[length(i)] } else { NA } } } else if (fun == "count") { fun <- function(i, na.rm=FALSE) { if (na.rm) { i <- na.omit(i) } length(i) } has_levels <- FALSE } } else { has_levels <- FALSE } g <- cellFromXY(y, x) i <- which(!is.na(g)) g <- g[i] if (length(g) == 0) { return(r) } values <- values[i, ,drop=FALSE] values <- aggregate(values, list(g), fun, ...) #if (!all(values %in% ) ? #has_levels <- FALSE ?? #levs <- NULL ?? # allow for multiple fields #r[a[,1]] <- as.matrix(a[,-1]) if (is.null(wopt$names)) { fun <- .makeTextFun(fun) if (inherits(fun, "character")) { wopt <- .set_names(wopt, cnms, fun, NCOL(values)) } else if (!is.null(cnms)) { wopt$names <- cnms } } values <- as.matrix(values) nl <- max(1, ncol(values)-1) r <- rast(r, nlyrs=nl) if (!update) { if (has_levels) { levels(r) <- levs } b <- writeStart(r, filename=filename, sources=sources(y), overwrite=overwrite, wopt=wopt) filename <- "" } else { b <- writeStart(r, "") } nc <- ncol(r) for (i in 1:b$n) { w <- matrix(background, nrow=b$nrows[i] * nc, ncol=nl) mincell <- cellFromRowCol(r, b$row[i], 1) maxcell <- cellFromRowCol(r, b$row[i] + b$nrows[i]-1, nc) vv <- values[values[,1] >= mincell & values[,1] <= maxcell, ,drop=FALSE] if (nrow(vv) > 0) { vv[,1] <- vv[,1] - (b$row[i] - 1) * nc w[vv[,1],] <- vv[,-1] } writeValues(r, w, b$row[i], b$nrows[i]) } r <- writeStop(r) if (update) { r <- cover(r, y, filename=filename, overwrite=overwrite, wopt=wopt) } return (r) } setMethod("rasterize", signature(x="matrix", y="SpatRaster"), function(x, y, values=1, fun, ..., background=NA, update=FALSE, by=NULL, filename="", overwrite=FALSE, wopt=list()) { if (!is.null(by)) { by <- rep_len(by, nrow(x)) values <- rep_len(values, nrow(x)) x <- lapply(split(data.frame(x), by), as.matrix) values <- split(values, by) out <- rast(lapply(1:length(x), function(i) rasterize(x[[i]], y, values[[i]], fun, background=background, update=update))) names(out) <- unique(by) if (filename != "") { out <- writeRaster(out, filename, overwrite=overwrite, wopt=wopt) } return(out) } #lonlat <- .checkXYnames(colnames(x)) if (NCOL(values) <= 1) { values <- unlist(values) if (length(values) > nrow(x)) { error("rasterize", "length(values) > nrow(x)") } values=rep_len(values, nrow(x)) } else { if (nrow(values) > nrow(x)) { error("rasterize", "nrow(values) > nrow(x)") } if (nrow(values) < nrow(x)) { i <- rep_len(1:nrow(values), nrow(x)) values <- values[i, ] } } rasterize_points(x=x, y=y, values=values, fun=fun, background=background, update=update, filename=filename, overwrite=overwrite, wopt=wopt, ...) } ) setMethod("rasterize", signature(x="SpatVector", y="SpatRaster"), function(x, y, field="", fun, ..., background=NA, touches=FALSE, update=FALSE, cover=FALSE, by=NULL, filename="", overwrite=FALSE, wopt=list()) { if (!is.null(by)) { x <- split(x, by) uby <- names(x) ##uby <- sapply(x, function(i) i[[by]][1]) out <- rast(lapply(x, function(i) rasterize(i, y, field=field, fun, background=background, touches=touches, update=update, cover=cover, ...))) names(out) <- uby if (filename != "") { out <- writeRaster(out, filename, overwrite=overwrite, wopt=wopt) } return(out) } values <- 1 if (!is.character(field)) { values <- as.numeric(field) field <- "" } else if (is.na(field[1])) { values <- as.numeric(NA) field <- "" } else if (is.null(field) || field[1] == "") { field <- "" } else if (!(field[1] %in% names(x))) { error("rasterize", paste(field, "is not a field in 'x'")) } g <- geomtype(x) if (grepl("points", g)) { nrx <- nrow(x) # also allow for multiple columns to multiple layers xy <- crds(x) if (field[1] == "") { values <- matrix(1, ncol=1, nrow=nrx) } else if (field[1] != "") { values <- x[, field, drop=TRUE] if (nrow(xy) != nrx) { # multi-points g <- geom(x) values <- values[g[,1], ,drop=FALSE] } } return( rasterize_points(x=xy, y=y, values=values, fun=fun, background=background, update=update, filename=filename, overwrite=overwrite, wopt=wopt, ...) ) } opt <- spatOptions(filename, overwrite, wopt=wopt) pols <- grepl("polygons", g) dots <- list(...) nms <- names(dots) nms <- nms[!(nms %in% c("na.rm", "fun", "sum"))] if (length(nms) > 0) { warn("rasterize", paste("unexpected additional argument(s):", paste(nms, collapse=", "))) } if (cover[1] && pols) { y@pntr <- y@pntr$rasterize(x@pntr, "", 1, background, touches[1], "", TRUE, FALSE, TRUE, opt) } else { if (missing(fun)) { if (!is.null(dots$sum)) { # backward compatibility if (isTRUE(dots$sum)) fun <- "sum" } else { fun <- "" } } if (!inherits(fun, "character")) { fun <- .makeTextFun(fun) if (!inherits(fun, "character")) { error("rasterize", "'fun' must be 'min', 'max', 'mean', 'count', or 'sum'") } } if (fun != "") { fun <- tolower(fun) if (!(fun %in% c("sum", "mean", "min", "max", "count"))) { error("rasterize", "'fun' must be 'min', 'max' 'mean', 'count', or 'sum'") } if (fun == "count") { fun <- "sum" field <- "" values <- 1 } else if (field != "") { if (fun == "min") { x <- sort(x[,field], field, TRUE) fun <- "" } else if (fun == "max") { x <- sort(x[,field], field, FALSE) fun <- "" } } } if ((field != "") && isTRUE(dots$na.rm)) { x <- x[!is.na(x[[field]]), ] } background <- as.numeric(background[1]) if (fun == "sum") { xopt = spatOptions() y@pntr <- y@pntr$rasterize(x@pntr, field, values, background, touches[1], fun, FALSE, update[1], TRUE, xopt) messages(y, "rasterize") xopt = spatOptions() yy <- rast(y) yy@pntr <- y@pntr$rasterize(x@pntr, "", values, NA, touches[1], "" , FALSE, update[1], TRUE, xopt) messages(yy, "rasterize") return(mask(y, yy, updatevalue=background, filename=filename, overwrite=overwrite, wopt=wopt)) } else if (fun == "mean") { xopt = spatOptions() y@pntr <- y@pntr$rasterize(x@pntr, field, values, background, touches[1], "sum", FALSE, update[1], TRUE, xopt) messages(y, "rasterize") xopt = spatOptions() yy <- rast(y) yy@pntr <- y@pntr$rasterize(x@pntr, "", values, NA, touches[1], "sum", FALSE, update[1], TRUE, xopt) messages(yy, "rasterize") y <- y / yy if (filename != "") { y <- writeRaster(y, filename=filename, overwrite=overwrite, wopt=wopt) } return(y) } else { y@pntr <- y@pntr$rasterize(x@pntr, field, values, background, touches[1], fun, FALSE, update[1], TRUE, opt) } } messages(y, "rasterize") } ) setMethod("rasterize", signature(x="sf", y="SpatRaster"), function(x, y, ...) { x <- vect(x) rasterize(x, y, ...) } ) terra/R/relate.R0000644000176200001440000002453614745061100013177 0ustar liggesusers setMethod("is.related", signature(x="SpatVector", y="SpatVector"), function(x, y, relation) { out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("is.related", signature(x="SpatVector", y="SpatExtent"), function(x, y, relation) { y <- as.polygons(y) out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("is.related", signature(x="SpatExtent", y="SpatVector"), function(x, y, relation) { x <- as.polygons(x) out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("is.related", signature(x="SpatVector", y="SpatRaster"), function(x, y, relation) { y <- as.polygons(y, ext=TRUE) out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("is.related", signature(x="SpatRaster", y="SpatVector"), function(x, y, relation) { x <- as.polygons(x, ext=TRUE) out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("is.related", signature(x="SpatExtent", y="SpatRaster"), function(x, y, relation) { x <- as.polygons(x) y <- as.polygons(y, ext=TRUE) out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("is.related", signature(x="SpatRaster", y="SpatExtent"), function(x, y, relation) { x <- as.polygons(x, ext=TRUE) y <- as.polygons(y) out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("is.related", signature(x="SpatRaster", y="SpatRaster"), function(x, y, relation) { x <- as.polygons(x, ext=TRUE) y <- as.polygons(y, ext=TRUE) out <- x@pntr$is_related(y@pntr, relation) x <- messages(x, "is.related") out } ) setMethod("relate", signature(x="SpatVector", y="SpatVector"), function(x, y, relation, pairs=FALSE, na.rm=TRUE) { if (pairs) { out <- x@pntr$related_between(y@pntr, relation[1], na.rm[1]) messages(x, "relate") if (length(out[[1]]) == 0) { cbind(id.x=0,id.y=0)[0,,drop=FALSE] } else { names(out) <- c("id.x", "id.y") do.call(cbind, out) + 1 } } else { out <- x@pntr$related_between(y@pntr, relation[1], TRUE) messages(x, "relate") m <- matrix(FALSE, nrow(x), nrow(y)) if (length(out[[1]]) > 0) { m[do.call(cbind, out) + 1] <- TRUE } m # out <- x@pntr$relate_between(y@pntr, relation, TRUE, TRUE) # messages(x, "relate") # out[out == 2] <- NA # matrix(as.logical(out), nrow=nrow(x), byrow=TRUE) } } ) #setMethod("which.related", signature(x="SpatVector", y="SpatVector"), # function(x, y, relation) { # out <- x@pntr$which_related(y@pntr, relation) # x <- messages(x, "which.related") # out <- do.call(cbind, out) + 1 # colnames(out) <- c("id.x", "id.y") # out # } #) setMethod("relate", signature(x="SpatVector", y="SpatExtent"), function(x, y, relation, ...) { y <- as.polygons(y) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatExtent", y="SpatVector"), function(x, y, relation, ...) { x <- as.polygons(x) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatVector", y="SpatRaster"), function(x, y, relation, ...) { y <- as.polygons(y, ext=TRUE) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatRaster", y="SpatVector"), function(x, y, relation, ...) { x <- as.polygons(x, ext=TRUE) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatExtent", y="SpatRaster"), function(x, y, relation, ...) { x <- as.polygons(x) y <- as.polygons(y, ext=TRUE) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatRaster", y="SpatExtent"), function(x, y, relation, ...) { x <- as.polygons(x, ext=TRUE) y <- as.polygons(y) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatRaster", y="SpatRaster"), function(x, y, relation, ...) { x <- as.polygons(x, ext=TRUE) y <- as.polygons(y, ext=TRUE) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatExtent", y="SpatExtent"), function(x, y, relation, ...) { x <- as.polygons(x) y <- as.polygons(y) relate(x, y, relation, ...) } ) setMethod("relate", signature(x="SpatVector", y="missing"), function(x, y, relation, pairs=FALSE, na.rm=TRUE) { if (pairs) { out <- x@pntr$related_within(relation, na.rm[1]) messages(x, "relate") if (length(out[[1]]) == 0) { cbind(id.1=0,id.2=0)[0,,drop=FALSE] } else { names(out) <- c("id.1", "id.2") do.call(cbind, out) + 1 } } else { out <- x@pntr$related_within(relation, TRUE) messages(x, "relate") out <- do.call(cbind, out) + 1 m <- matrix(FALSE, nrow(x), nrow(x)) m[out] <- TRUE m #if (symmetrical) { # as.dist(m) #} else { # m #} } #out <- x@pntr$relate_within(relation, symmetrical) #out[out == 2] <- NA #if (symmetrical) { # class(out) <- "dist" # attr(out, "Size") <- nrow(x) # attr(out, "Diag") <- FALSE # attr(out, "Upper") <- FALSE #} else { # out <- matrix(as.logical(out), nrow=nrow(x), byrow=TRUE) #} #if (pairs) { # out <- mat2wide(out, symmetrical) #} #out } ) setMethod("adjacent", signature(x="SpatRaster"), function(x, cells, directions="rook", pairs=FALSE, include=FALSE, symmetrical=FALSE) { cells <- cells - 1 if (inherits(directions, "matrix")) { directions[!is.finite(directions)] <- 0 if (isTRUE(all(directions == 0))) { error("adjacent", "directions are all FALSE") } v <- x@pntr$adjacentMat(cells, as.logical(t(directions)), dim(directions), include) } else { #if (pairs) include <- FALSE v <- x@pntr$adjacent(cells, as.character(directions)[1], include) } messages(x, "adjacent") if (pairs) { v <- cbind(from=rep(cells, each=length(v)/length(cells)), to=v) v <- v[!is.na(v[,2]), ] if (symmetrical) { #v <- unique(cbind(pmin(v[,1], v[,2]), pmax(v[,1], v[,2]))) v <- .unique_symmetric_rows(v[,1], v[,2]) } } else { v <- matrix(v, nrow=length(cells), byrow=TRUE) if (!include) rownames(v) <- cells } v + 1 } ) setMethod("adjacent", signature(x="SpatVector"), function(x, type="rook", pairs=TRUE, symmetrical=FALSE) { type <- match.arg(tolower(type), c("intersects", "touches", "queen", "rook")) stopifnot(geomtype(x) == "polygons") a <- x@pntr$relate_within(type, TRUE) x <- messages(x, "relate") a[a == 2] <- NA class(a) <- "dist" attr(a, "Size") <- nrow(x) attr(a, "Diag") <- FALSE attr(a, "Upper") <- FALSE a <- as.matrix(a) if (pairs) { mat2wide(a, symmetrical, 1) } else { a } } ) setMethod("nearby", signature(x="SpatVector"), function(x, y=NULL, distance=0, k=1, centroids=TRUE, symmetrical=TRUE, method="geo") { k <- round(k) if (distance <= 0 && k < 1) { error("nearby", "either distance or k must be a positive number") } if (!(method %in% c("geo", "haversine", "cosine"))) { error("nearby", "not a valid method. Should be one of: 'geo', 'haversine', 'cosine'") } if ((geomtype(x) == "polygons") && centroids) { x <- centroids(x) } hasy <- !is.null(y) if (hasy) { if ((geomtype(y) == "polygons") && centroids) { y <- centroids(y) } } if (distance > 0) { if (hasy) { d <- distance(x, y, method=method) d <- cbind(from_id=rep(1:nrow(d), ncol(d)), to_id=rep(1:ncol(d), each=nrow(d)), distance=as.vector(d)) } else { d <- distance(x, pairs=TRUE, symmetrical=symmetrical, method=method) } d[d[,3] <= distance, 1:2, drop=FALSE] } else { if (hasy) { k <- max(1, min(round(k), (nrow(y)-1))) } else { k <- max(1, min(round(k), (nrow(x)-1))) } # if (k > 1) { if (hasy) { d <- distance(x, y) } else { d <- as.matrix(distance(x, pairs=FALSE, method=method)) diag(d) <- NA } d <- t(apply(d, 1, function(i) order(i)[1:k])) if (k==1) d <- t(d) d <- cbind(1:length(x), d) # } else { # d <- nearest(x) # d <- values(d)[, c("from_id", "to_id")] # } colnames(d) <- c("id", paste0("k", 1:k)) d } } ) setMethod("nearest", signature(x="SpatVector"), function(x, y=NULL, pairs=FALSE, centroids=TRUE, lines=FALSE, method="geo") { if ((geomtype(x) == "polygons") && centroids) { x <- centroids(x) } within <- FALSE if (is.null(y)) { within <- TRUE y <- x } else if ((geomtype(y) == "polygons") && centroids) { y <- centroids(y) } z <- x if (!(method %in% c("geo", "haversine", "cosine"))) { error("nearest", "not a valid method. Should be one of: 'geo', 'haversine', 'cosine'") } if (within) { z@pntr <- x@pntr$near_within(method) } else { z@pntr <- x@pntr$near_between(y@pntr, pairs, method) } z <- terra:::messages(z, "nearest") if (geomtype(z) == "points") { #lonlat points if (lines) { x <- z[,c(2,5), drop=TRUE] y <- z[,c(3,6), drop=TRUE] geom <- cbind(rep(1:nrow(x), each=2), 1, as.vector(t(x)), as.vector(t(y))) zz <- vect(geom, "lines", crs=crs(z)) values(zz) <- values(z) zz$to_id = zz$to_id + 1 zz$from_id = zz$from_id + 1 return(zz) } else { z$to_id = z$to_id + 1 z$from_id = z$from_id + 1 return(z) } } else { if (lines) return(z) values(y) <- data.frame(to_id=1:nrow(y)) dis <- perim(z) zz <- as.points(z) from <- zz[seq(1, nrow(zz), 2), ] to <- zz[seq(2, nrow(zz), 2), ] values(to) <- data.frame(id=1:nrow(to)) to_int <- as.data.frame(intersect(to, y)) to_int <- to_int[!duplicated(to_int[,1]), ] to_int <- as.data.frame(merge(to, to_int, by="id", all.x=TRUE)) if (any(is.na(to_int$to_id))) { zz <- as.points(elongate(z, 1)) from2 <- zz[seq(1, nrow(zz), 2), ] to2 <- zz[seq(2, nrow(zz), 2), ] values(to2) <- data.frame(id=1:nrow(to2)) to_int2 <- as.data.frame(intersect(to2, y)) colnames(to_int2)[2] <- "to_id2" to_int <- merge(to_int, to_int2, all.x=TRUE) i <- is.na(to_int$to_id) to_int$to_id[i] <- to_int$to_id2[i] to_int <- to_int[,1:2] } to_int <- to_int[order(to_int[["id"]]), ] if (nrow(to_int) > nrow(to)) { to_int <- aggregate(to_int[, "to_id",drop=FALSE], to_int[,"id",drop=FALSE], function(x)x[1]) # } # if (nrow(to_int) < nrow(to)) { # to_int <- rep(NA, nrow(to)) } else { to_int <- to_int[,2] } from <- geom(from)[, c("x", "y"),drop=FALSE] to <- geom(to)[, c("x", "y"),drop=FALSE] d <- data.frame(1:nrow(from), from, to_int, to, dis) colnames(d) <- c("from_id", "from_x", "from_y", "to_id", "to_x", "to_y", "distance") vect(d, c("to_x", "to_y"), crs=crs(x)) } } ) terra/R/regress.R0000644000176200001440000001037714536376240013407 0ustar liggesusers# Author: Robert J. Hijmans # Date : April 2023 # Version 1.0 # License GPL v3 .reg_constX <- function(formula, X, na.rm=FALSE, nl) { formula <- eval(stats::as.formula(formula)) nas <- eval(rep(NA, nl)) d <- data.frame(x=X, y=X) mm <- eval(stats::model.matrix(formula, data=d)) if (na.rm) { ols <- function(y, ...) { m <- stats::na.omit(cbind(y, mm)) if (nrow(m) == 0) { return(nas) } stats::.lm.fit(m[,-1,drop=FALSE], m[,1])$coefficients } } else { ols <- function(y, ...) { if (any(is.na(y))) { return(nas) } stats::.lm.fit(mm, y)$coefficients } } ols } setMethod("regress", signature(y="SpatRaster", x="numeric"), function(y, x, formula=y~x, na.rm=FALSE, cores=1, filename="", overwrite=FALSE, ...) { if (any(is.na(x))) { error("regress", "y cannot have NAs") } formula <- stats::as.formula(formula) dat <- data.frame(x=x, y=1) mm <- stats::model.matrix(formula, data=dat) outnl <- ncol(mm) regfun <- .reg_constX(formula, X=x, na.rm=na.rm, nl=outnl) out <- rast(y) nlyr(out) <- outnl names(out) <- colnames(mm) nc <- ncol(y) readStart(y) on.exit(readStop(y)) doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } ncops <- nlyr(y) / nlyr(out) ncops <- ifelse(ncops > 1, ceiling(ncops), 1) * 4 b <- writeStart(out, filename, overwrite, n=ncops, sources=sources(y), ...) if (doclust) { ncores <- length(cores) #export_args(cores, ...) for (i in 1:b$n) { v <- readValues(y, b$row[i], b$nrows[i], 1, nc, TRUE) icsz <- max(min(100, ceiling(b$nrows[i] / ncores)), b$nrows[i]) r <- parallel::parRapply(cores, v, regfun, chunk.size=icsz) if (nlyr(out) > 1) { r <- matrix(r, ncol=nlyr(out), byrow=TRUE) } writeValues(out, r, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { v <- readValues(y, b$row[i], b$nrows[i], 1, nc, TRUE) r <- apply(v, 1, regfun) writeValues(out, t(r), b$row[i], b$nrows[i]) } } writeStop(out) }) .reg_mod <- function(formula, na.rm=FALSE, nl) { formula <- eval(stats::as.formula(formula)) nas <- eval(rep(NA, nl)) yi <- eval(1:nl) xi <- eval((nl+1):(nl+nl)) if (na.rm) { ols <- function(v, ...) { d <- data.frame(matrix(v, ncol=2, dimnames=list(NULL, c("y", "x")))) mm <- eval(stats::model.matrix(formula, data=d)) m <- stats::na.omit(cbind(d$y, mm)) if (nrow(m) == 0) { return(nas) } stats::.lm.fit(m[,-1,drop=FALSE], m[,1])$coefficients } } else { ols <- function(v, ...) { if (any(is.na(v))) { return(nas) } d <- data.frame(matrix(v, ncol=2, dimnames=list(NULL, c("y", "x")))) mm <- eval(stats::model.matrix(formula, data=d)) stats::.lm.fit(mm, d$y)$coefficients } } ols } setMethod("regress", signature(x="SpatRaster", y="SpatRaster"), function(y, x, formula=y~x, na.rm=FALSE, cores=1, filename="", overwrite=FALSE, ...) { if (nlyr(y) != nlyr(x)) { error("regress", "nlyr(x) != nlyr(y)") } formula <- stats::as.formula(formula) dat <- data.frame(x=1:nlyr(x), y=1) mm <- stats::model.matrix(formula, data=dat) outnl <- ncol(mm) regfun <- .reg_mod(formula, na.rm=na.rm, nl=outnl) out <- rast(y) nlyr(out) <- outnl names(out) <- colnames(mm) nc <- ncol(y) y <- c(y, x) readStart(y) on.exit(readStop(y)) doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } ncops <- nlyr(y) / nlyr(out) ncops <- ifelse(ncops > 1, ceiling(ncops), 1) * 4 b <- writeStart(out, filename, overwrite, n=ncops, sources=sources(y), ...) if (doclust) { ncores <- length(cores) #export_args(cores, ...) for (i in 1:b$n) { v <- readValues(y, b$row[i], b$nrows[i], 1, nc, TRUE) icsz <- max(min(100, ceiling(b$nrows[i] / ncores)), b$nrows[i]) r <- parallel::parRapply(cores, v, regfun, chunk.size=icsz) if (nlyr(out) > 1) { r <- matrix(r, ncol=nlyr(out), byrow=TRUE) } writeValues(out, r, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { v <- readValues(y, b$row[i], b$nrows[i], 1, nc, TRUE) r <- apply(v, 1, regfun) writeValues(out, t(r), b$row[i], b$nrows[i]) } } writeStop(out) }) terra/R/RcppExports.R0000644000176200001440000000610514756505614014223 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 proj_version <- function() { .Call(`_terra_proj_version`) } hex2rgb <- function(s) { .Call(`_terra_hex2rgb`, s) } rgb2hex <- function(x) { .Call(`_terra_rgb2hex`, x) } .sameSRS <- function(x, y) { .Call(`_terra_sameSRS`, x, y) } .SRSinfo <- function(s) { .Call(`_terra_getCRSname`, s) } .getLinearUnits <- function(s) { .Call(`_terra_getLinearUnits`, s) } .geotransform <- function(fname) { .Call(`_terra_geotransform`, fname) } .gdal_setconfig <- function(option, value) { invisible(.Call(`_terra_gdal_setconfig`, option, value)) } .gdal_getconfig <- function(option) { .Call(`_terra_gdal_getconfig`, option) } .gdalinfo <- function(filename, options, oo) { .Call(`_terra_ginfo`, filename, options, oo) } .sdinfo <- function(filename) { .Call(`_terra_sd_info`, filename) } .gdal_version <- function() { .Call(`_terra_gdal_version`) } .geos_version <- function(runtime = FALSE, capi = FALSE) { .Call(`_terra_geos_version`, runtime, capi) } .metadata <- function(filename) { .Call(`_terra_metatdata`, filename) } .sdsmetadata <- function(filename) { .Call(`_terra_sdsmetatdata`, filename) } .parsedsdsmetadata <- function(filename) { .Call(`_terra_sdsmetatdataparsed`, filename) } .gdaldrivers <- function() { .Call(`_terra_gdal_drivers`) } .set_gdal_warnings <- function(level) { invisible(.Call(`_terra_set_gdal_warnings`, level)) } .seedinit <- function(seed_val) { invisible(.Call(`_terra_seed_init`, seed_val)) } .gdalinit <- function(projpath, datapath) { invisible(.Call(`_terra_gdal_init`, projpath, datapath)) } .precRank <- function(x, y, minc, maxc, tail) { .Call(`_terra_percRank`, x, y, minc, maxc, tail) } .clearVSIcache <- function(vsi) { invisible(.Call(`_terra_clearVSIcache`, vsi)) } .setGDALCacheSizeMB <- function(x, vsi) { invisible(.Call(`_terra_setGDALCacheSizeMB`, x, vsi)) } .getGDALCacheSizeMB <- function(vsi) { .Call(`_terra_getGDALCacheSizeMB`, vsi) } .get_proj_search_paths <- function() { .Call(`_terra_get_proj_search_paths`) } .set_proj_search_paths <- function(paths) { .Call(`_terra_set_proj_search_paths`, paths) } .PROJ_network <- function(enable, url) { .Call(`_terra_PROJ_network`, enable, url) } .pearson <- function(x, y, narm) { .Call(`_terra_pearson_cor`, x, y, narm) } .weighted_pearson <- function(x, y, weights, narm = TRUE) { .Call(`_terra_weighted_pearson_cor`, x, y, weights, narm) } .unique_symmetric_rows <- function(x, y) { .Call(`_terra_uniqueSymmetricRows`, x, y) } dist2segmentPoint_geo <- function(plon, plat, lon1, lat1, lon2, lat2, ilon, ilat) { .Call(`_terra_dist2segmentPoint_geo`, plon, plat, lon1, lat1, lon2, lat2, ilon, ilat) } intermediate <- function(lon1, lat1, lon2, lat2, n, distance) { .Call(`_terra_intermediate`, lon1, lat1, lon2, lat2, n, distance) } terra/R/rast.R0000644000176200001440000003351014751032423012667 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2017 # Version 1.0 # License GPL v3 new_rast <- function(nrows=10, ncols=10, nlyrs=1, xmin=0, xmax=1, ymin=0, ymax=1, crs, extent, resolution, vals, names, time, units) { ncols <- round(ncols) if (ncols < 1) error("rast", "ncols < 1") nrows <- round(nrows) if (nrows < 1) error("rast", "nrows < 1") if (missing(extent)) { e <- c(xmin, xmax, ymin, ymax) } else { extent <- ext(extent) e <- as.vector(extent) } if ((e[1] >= e[2]) || e[3] >= e[4]) { error("rast,missing", "invalid extent") } if (missing(crs)) { if (e[1] > -360.01 & e[2] < 360.01 & e[3] > -90.01 & e[4] < 90.01) { crs <- "OGC:CRS84" } else { crs <- "" } } else { crs <- character_crs(crs, "rast") } #check_proj4_datum(crs) r <- methods::new("SpatRaster") r@pntr <- SpatRaster$new(c(nrows, ncols, nlyrs), e, crs) r <- messages(r, "rast") if (!missing(resolution)) { res(r) <- resolution } if (!missing(vals)) { if (length(vals) == 1) { if (is.na(vals[1])) { vals <- as.numeric(NA) } } if (!is.null(ncol(vals))) { nms <- colnames(vals) if (length(nms) == nlyr(r)) { names(r) <- nms } } values(r) <- vals } if (!missing(names)) { names(r) <- names } if (!missing(time)) { time(r) <- time } if (!missing(units)) { time(r) <- units } r } setMethod("rast", signature(x="missing"), function(x, nrows=180, ncols=360, nlyrs=1, xmin=-180, xmax=180, ymin=-90, ymax=90, crs, extent, resolution, vals, names, time, units) { new_rast(nrows, ncols, nlyrs, xmin, xmax, ymin, ymax, crs, extent, resolution, vals, names, time, units) } ) rast_from_image <- function(x) { # list representing an "image" if (! all(dim(x$z) == c(length(x$x), length(x$y)))) { error("rast", '"z" does not have the right dimensions') } # omitted "-1" bug fix by Barry Rowlingson resx <- ( x$x[length(x$x)] - x$x[1] ) / (length(x$x)-1) resy <- ( x$y[length(x$y)] - x$y[1] ) / (length(x$y)-1) xmn <- min(x$x) - 0.5 * resx xmx <- max(x$x) + 0.5 * resx ymn <- min(x$y) - 0.5 * resy ymx <- max(x$y) + 0.5 * resy dx <- abs(max(abs((x$x[-1] - x$x[-length(x$x)])) / resx) - 1) dy <- abs(max(abs((x$y[-1] - x$y[-length(x$y)])) / resy) - 1) if (is.na(dx) | is.na(dy)) { error("rast", "missing values in coordinates") } if (dx > 0.01 | dy > 0.01) { error("rast", "data are not on a regular grid") } # if (xmn > -360.1 & xmx < 360.1 & ymn > -90.1 & ymx < 90.1) { # crs <- "+proj=longlat +datum=WGS84" # } else { # crs <- "" # } x <- t(x$z) x <- x[nrow(x):1, ] rast(x, extent=ext(xmn, xmx, ymn, ymx), crs="") } setMethod("rast", signature(x="list"), function(x, warn=TRUE) { i <- sapply(x, function(i) inherits(i, "SpatRaster")) if (!all(i)) { if (!any(i)) { if ((length(x) == 3) && all(c("x", "y", "z") %in% names(x))) { return(rast_from_image(x)) } error("rast,list", "none of the elements of x are a SpatRaster") } else { warn("rast", sum(!i), " out of ", length(x), " elements of x are not a SpatRaster") x <- x[i] } } # start with an empty raster (alternatively use a deep copy) out <- deepcopy(x[[1]]) if (length(x) == 1) { return(out) } opt <- spatOptions() for (i in 2:length(x)) { out@pntr$addSource(x[[i]]@pntr, warn, opt) } out <- messages(out, "rast") lnms <- names(x) if (!is.null(lnms)) { if (any(lnms != "") && (length(lnms) == nlyr(out))) { rnms <- names(out) rnms[lnms != ""] <- lnms[lnms != ""] names(out) <- rnms } else if (all(lnms != "")) { nl <- sapply(x, nlyr) rnms <- sapply(1:length(nl), function(i) { if (nl[i] > 1) paste0(lnms[i], "_", 1:nl[i]) else lnms[i] }) names(out) <- unlist(rnms) } } out } ) setMethod("rast", signature(x="SpatExtent"), function(x, ...) { dots <- list(...) dots$xmin=x[1] dots$xmax=x[2] dots$ymin=x[3] dots$ymax=x[4] r <- do.call(new_rast, dots) # re-apply extent to avoid mimute differences ext(r) <- x r } ) setMethod("rast", signature(x="SpatVector"), function(x, type="", ...) { if (type == "xyz") { if (geomtype(x) != "points") { error("rast", "xyz can only be used with points") } x <- data.frame(crds(x), data.frame(x)) return(rast(x, type="xyz", ...)) } dots <- list(...) e <- ext(x) dots$xmin=e[1] dots$xmax=e[2] dots$ymin=e[3] dots$ymax=e[4] if (all(is.na(pmatch(names(dots), "crs")))) { dots$crs <- crs(x) } do.call(new_rast, dots) } ) .fullFilename <- function(x, mustExist=FALSE, vsi=FALSE) { x <- trimws(x) x <- x[x != ""] x <- enc2utf8(x) i <- substr(x, 1, 5) == "s3://" x[i] <- paste0("/vsis3/", substr(x[i], 6, nchar(x[i]))) if (all(i)) return(x) i <- substr(x, 1, 4) == "http" if (vsi) { x[i] <- paste0("/vsicurl/", x[i]) } if (all(i)) return(x) i <- grepl(":", x) if (all(i)) return(x) p <- normalizePath(x[!i], winslash = "/", mustWork = FALSE) if (mustExist) { j <- file.exists(dirname(p)) x[j] <- p[j] } else { i <- !file.exists(p) p[i] <- x[i] return(p) } #if (identical(basename(x), x)) { # x <- file.path(getwd(), x) #} #if (expand) { # x <- path.expand(x) #} return(x) } setMethod("rast", signature(x="character"), function(x, subds=0, lyrs=NULL, drivers=NULL, opts=NULL, win=NULL, snap="near", vsi=FALSE, raw=FALSE, noflip=FALSE) { f <- .fullFilename(x, vsi=vsi) if (length(f) == 0) { error("rast", "filename is empty. Provide a valid filename") } if ((length(f) == 1) && grepl("\\.rds$", tolower(f[1]))) { r <- unwrap(readRDS(x)) if (!inherits(r, "SpatRaster")) { error("rast", "the rds file does not store a SpatRaster") } return(r) } r <- methods::new("SpatRaster") #subds <- subds[1] if (is.null(opts)) opts <- ""[0] if (raw) opts <- c(opts, "so=false") if (is.null(drivers)) drivers <- ""[0] if (length(subds) == 0) subds = 0 if (is.character(subds)) { #r@pntr <- SpatRaster$new(f, -1, subds, FALSE, 0[]) r@pntr <- SpatRaster$new(f, -1, subds, FALSE, drivers, opts, 0[], noflip) } else { r@pntr <- SpatRaster$new(f, subds-1, "", FALSE, drivers, opts, 0[], noflip) } r <- messages(r, "rast") if (r@pntr$getMessage() == "ncdf extent") { # could have used opts="IGNORE_XY_AXIS_NAME_CHECKS=YES" test <- try(r <- .ncdf_extent(r, f), silent=TRUE) if (inherits(test, "try-error")) { warn("rast", "GDAL did not find an extent. Cells not equally spaced?") } } r <- messages(r, "rast") if (crs(r) == "") { if (is.lonlat(r, perhaps=TRUE, warn=FALSE)) { if (!isTRUE(all(as.vector(ext(r)) == c(0,ncol(r),0,nrow(r))))) { crs(r) <- "OGC:CRS84" } } } if (!is.null(lyrs)) { r <- r[[lyrs]] } if (!is.null(win)) { e <- ext(win) e <- align(e, r, snap=snap) window(r) <- e } r } ) multi <- function(x, subds=0, xyz=3:1, drivers=NULL, opts=NULL) { noflip <- FALSE x <- trimws(x) x <- x[x!=""] if (length(x) == 0) { error("rast,character", "provide a valid filename") } r <- methods::new("SpatRaster") f <- .fullFilename(x) if (is.null(opts)) opts <- ""[0] if (is.null(drivers)) drivers <- ""[0] if (length(subds) == 0) subds = 1 subds <- subds[1] if (is.character(subds)) { r@pntr <- SpatRaster$new(f, -1, subds, TRUE, drivers, opts, xyz-1, isTRUE(noflip[1])) } else { r@pntr <- SpatRaster$new(f, subds-1, ""[0], TRUE, drivers, opts, xyz-1, isTRUE(noflip[1])) } if (r@pntr$getMessage() == "ncdf extent") { test <- try(r <- .ncdf_extent(r), silent=TRUE) if (inherits(test, "try-error")) { warn("rast", "GDAL did not find an extent. Cells not equally spaced?") } } r <- messages(r, "rast") if (crs(r) == "") { if (is.lonlat(r, perhaps=TRUE, warn=FALSE)) { crs(r) <- "OGC:CRS84" } } r } setMethod("rast", signature(x="SpatRaster"), function(x, nlyrs=nlyr(x), names, vals, keeptime=TRUE, keepunits=FALSE, props=FALSE, tags=FALSE) { if (inherits(nlyrs, "SpatRaster")) { error("rast", "use 'c()' to combine SpatRasters") } x@pntr <- x@pntr$geometry(nlyrs, props, keeptime, keepunits, tags) x <- messages(x, "rast") if (!missing(names)) { if (length(names) == nlyr(x)) names(x) <- names } if (!missing(vals)) { values(x) <- vals } x } ) setMethod("rast", signature(x="SpatRasterDataset"), function(x) { if (length(x) == 0) { error("rast", "empty SpatRasterDataset") } else if (length(x) == 1) { x[1] } else { r <- methods::new("SpatRaster") r@pntr <- x@pntr$collapse() nms <- names(x) if (any(nms != "")) { names(r) <- paste(rep(nms, nlyr(x)), names(r), sep="_") } r } } ) setMethod("rast", signature(x="array"), function(x, crs="", extent=NULL) { dims <- dim(x) if (length(dims) < 3) { error("rast,array", "cannot handle an array with less than 3 dimensions") } if (length(dims) > 3) { if (length(dims) == 4) { if (dims[4] == 1) { x <- x[,,,1] } else { error("rast,array", "rast cannot handle an array with 4 dimensions (try 'sds')") } } else { error("rast,array", "cannot handle an array with more than 3 dimensions") } } r <- methods::new("SpatRaster") if (!is.null(extent)) { e <- as.vector(extent) } else { e <- c(0, dims[2], 0, dims[1]) } crs <- character_crs(crs, "rast") r@pntr <- SpatRaster$new(dims, e, crs) values(r) <- x messages(r, "rast") } ) setMethod("rast", signature(x="ANY"), function(x, ...) { if (inherits(x, "sf")) { out <- rast(ext(x), ...) if (is.null(list(...)$crs)) { sfi <- attr(x, "sf_column") crs(out, warn=FALSE) <- attr(x[[sfi]], "crs")$wkt } } else { out <- methods::as(x, "SpatRaster") } #g <- gc() out } ) .rastFromXYZ <- function(xyz, digits=6, crs="", extent=NULL) { ln <- colnames(xyz) ## xyz might not have colnames, or might have "" names if (is.null(ln)) ln <- rep("", ncol(xyz)) if (any(nchar(ln) < 1)) ln <- make.names(ln) if (inherits(xyz, "data.frame")) { xyz <- as.matrix(xyz) xyz <- matrix(as.numeric(xyz), ncol=ncol(xyz), nrow=nrow(xyz)) } x <- sort(unique(xyz[,1])) # x <- sort(unique(round(xyz[,1], digits+2))) if (length(x) == 1) { error("rast", "cannot create a raster geometry from a single x coordinate") } dx <- x[-1] - x[-length(x)] rx <- min(dx) for (i in 1:5) { rx <- rx / i q <- sum(round(dx / rx, digits=digits) %% 1) if ( q == 0 ) { break } } if ( q > 0 ) { error("raster,matrix(xyz)", "x cell sizes are not regular") } y <- sort(unique(xyz[,2])) # y <- sort(unique(round(xyz[,2], digits+2))) if (length(y) == 1) { error("rast", "cannot create a raster geometry from a single y coordinate") } dy <- y[-1] - y[-length(y)] ry <- min(dy) for (i in 1:5) { ry <- ry / i q <- sum(round(dy / ry, digits=digits) %% 1) if ( q == 0 ) { break } } if ( q > 0 ) { error("raster,matrix(xyz)", "y cell sizes are not regular") } minx <- min(x) - 0.5 * rx maxx <- max(x) + 0.5 * rx miny <- min(y) - 0.5 * ry maxy <- max(y) + 0.5 * ry d <- dim(xyz) r <- rast(xmin=minx, xmax=maxx, ymin=miny, ymax=maxy, crs=crs, nlyrs=d[2]-2) res(r) <- c(rx, ry) ext(r) <- round(ext(r), digits+2) cells <- cellFromXY(r, xyz[,1:2]) if (d[2] > 2) { names(r) <- ln[-c(1:2)] v <- try( matrix(NA, nrow=ncell(r), ncol= nlyr(r)) ) if (inherits(v, "try-error")) { error(paste("cannot make matrix with ", ncell(r), " rows")) } v[cells, ] <- xyz[, -c(1:2)] values(r) <- v } if (!is.null(extent)) { r <- extend(r, extent) r <- crop(r, extent) } return(r) } .rastFromXYLZ <- function(x, digits=6, crs="", extent=NULL) { if (ncol(x) != 4) { error("rast", "a 'xylz' structure must have 4 columns") } nms <- names(x) names(x)[1:3] <- c("x", "y", "l") x <- as.data.frame(x) # so that this also works for tibble #1582 w <- stats::reshape(x, timevar="l", idvar=c("x", "y"), direction="wide") w <- rast(w, type="xyz", digits=digits, crs=crs, extent=extent) names(w) <- gsub(paste0(nms[4], "."), "", names(w)) if (inherits(x[,3], "Date") || inherits(x[,3], "POSIXlt") || inherits(x[,3], "POSIXct")) { time(w) <- unique(x[,3]) names(w) <- paste0(nms[4], ".", 1:nlyr(w)) } else if (inherits(x[,3], "numeric")) { u <- unique(x[,3]) if (all(u == trunc(u))) { su <- sort(u) if ((su[1] == 1) && (su[length(su)] == length(su))) { if (!all(su == u)) { w <- w[[order(u)]] } } } } w } setMethod("rast", signature(x="matrix"), function(x, type="", crs="", digits=6, extent=NULL) { stopifnot(prod(dim(x)) > 0) if (type == "xyz") { r <- .rastFromXYZ(x, crs=crs, digits=digits, extent=extent) } else if (type == "xylz") { r <- .rastFromXYLZ(x, crs=crs, digits=digits, extent=extent) } else if (type != "") { error("rast", 'argument type should be one of "", "xyz", or "xylz"') } else { if (is.null(extent)) { r <- rast(nrows=nrow(x), ncols=ncol(x), extent=ext(c(0, ncol(x), 0, nrow(x))), crs=crs) } else { r <- rast(nrows=nrow(x), ncols=ncol(x), crs=crs, extent=extent) } values(r) <- as.vector(t(x)) } messages(r, "rast") } ) setMethod("rast", signature(x="data.frame"), function(x, type="xyz", crs="", digits=6, extent=NULL) { if (type == "xyz") { .rastFromXYZ(x, crs=crs, digits=digits, extent=extent) } else if (type == "xylz") { r <- .rastFromXYLZ(x, crs=crs, digits=digits, extent=extent) } else if (type != "") { error("rast", 'argument type should be one of "", "xyz", or "xylz"') } else { rast(as.matrix(x), type=type, crs=crs, digits=digits, extent=extent) } } ) setMethod("rast", signature(x="stars"), function(x) { x <- from_stars(x) if (inherits(x, "SpatRasterDataset")) { rast(x) } else { x } } ) setMethod("rast", signature(x="stars_proxy"), function(x) { x <- from_stars(x) if (inherits(x, "SpatRasterDataset")) { rast(x) } else { x } } ) setMethod("NAflag<-", signature(x="SpatRaster"), function(x, value) { value <- as.numeric(value) if (!(x@pntr$setNAflag(value))) { error("NAflag<-", "cannot set this value") } x } ) setMethod("NAflag", signature(x="SpatRaster"), function(x) { x@pntr$getNAflag() } ) terra/R/connect.R0000644000176200001440000000274214536376240013363 0ustar liggesusers get_groups <- function(x, y) { j <- 1 outx <- outy <- list() for (i in 1:length(x)) { if (is.na(x[i])) next gx <- stats::na.omit(x[x[i] == x] ) gy <- y[x %in% gx] nx <- ny <- 0 while(TRUE) { if (nx == length(gx)) break ny <- length(gy) nx <- length(gx) if ((ny == length(y) || (nx == length(x)))) break ux <- unique( x[y %in% gy] ) gy <- y[x %in% ux] gx <- x[y %in% gy] } x[x %in% gx] <- NA y[y %in% gy] <- NA outx[[j]] <- gx outy[[j]] <- gy j <- j + 1 } list(outx, outy) } connect_dateline <- function(x) { east <- west <- c() for (i in 1:nrow(x)) { e <- ext(x[i,]) if (xmin(e) <= -180) { west <- c(west, i) } else if (xmax(e) >= 180) { east <- c(east, i) } } if ((length(east) == 0) || (length(west) == 0)) { return(x) } xx <- shift(x[west,], 360, 0) yy <- x[east, ] #zz <- x[-c(east, west), ] px <- py <- c() hasDF <- ncol(x) > 0 for (i in 1:nrow(xx)) { for (j in 1:nrow(yy)) { if (hasDF) { if (all(as.data.frame(xx[i,]) != as.data.frame(yy[j,]))) { next } } if (is.related(xx[i,], yy[j,], "touches")) { px <- c(px, i) py <- c(py, j) } } } if ((length(px) == 0)) { return(x) } px <- west[px] py <- east[py] groups <- get_groups(px, py) xg <- groups[[1]] yg <- groups[[2]] vvv <- list() for (i in 1:length(xg)) { vvv[[i]] <- aggregate(x[unique(c(xg[[i]], yg[[i]])), ], dissolve=TRUE) } out <- x[-(unique(unlist(groups))), ] out <- c(vvv, out) do.call(rbind, out) } terra/R/plot_axes.R0000644000176200001440000000730414624312676013730 0ustar liggesusers .plot.axes <- function(x) { if (is.null(x$axs$cex.axis)) { x$axs$cex.axis = 1 } x$axs$cex.axis <- x$axs$cex.axis * 0.7 if (is.null(x$axs$mgp)) { x$axs$mgp = c(2, .25, 0) } if (is.null(x$axs$tcl)) { x$axs$tcl <- -0.25 } if ((!x$clip) & x$draw_grid) { x$axs$tck <- 1 x$axs$mgp <- c(2, .15, 0) } xlab <- ylab <- NULL if (!is.null(x$axs$labels)) { xlab <- ylab <- x$axs$labels x$axs$labels <- NULL } if (!is.null(x$axs$xlabs)) { xlab <- x$axs$xlabs x$axs$xlabs <- NULL } if (!is.null(x$axs$ylabs)) { ylab <- x$axs$ylabs x$axs$ylabs <- NULL } xat <- yat <- NULL if (!is.null(x$axs$at)) { xat <- yat <- x$axs$at } if (!is.null(x$axs$xat)) { xat <- x$axs$xat x$axs$xat <- NULL } if (!is.null(x$axs$yat)) { yat <- x$axs$yat x$axs$yat <- NULL } sides <- unique(x$axs$side) if (!is.null(sides)) sides <- round(sides) sides <- sides[sides > 0 & sides < 5] if (is.null(sides)) { x$axs$side <- sides <- 1:2 } ticks <- x$axs$tick if (is.null(ticks)) { x$axs$tick <- ticks <- sides } labs <- x$axs$lab if (is.null(labs)) { x$axs$lab <- labs <- sides } if (x$clip) { usr <- x$lim } else { usr <- graphics::par("usr") } y <- x$axs retro <- isTRUE(y$retro) if (retro && (!x$lonlat)) { warn("plot", "'retro' labels can only be used with lonlat data") retro <- FALSE } y$retro <- y$lab <- y$tick <- NULL y$line <- NA y$outer <- FALSE y$line.lab <- NULL if (is.null(y$col)) y$col <- "black" if (x$clip) { lnpts <- crds(as.points(ext(x$lim))) lnpts <- rbind(lnpts[4,], lnpts) } else { lnpts <- crds(as.points(ext(usr))) lnpts <- rbind(lnpts[4,], lnpts) } for (s in 1:4) { y$side <- s y$labels <- NULL if (s %in% c(1,3)) { ur <- usr[2] - usr[1] edg <- c(usr[1]-10*ur, usr[2]+10*ur) if (is.null(xat)) { axt <- graphics::axTicks(s) y$at <- axt[axt >= usr[1] & axt <= usr[2]] } else { y$at <- xat } if (is.null(xlab)) { y$labels <- if (retro) retro_labels(y$at, lat=FALSE) else y$at } else { y$labels <- xlab } y$pos <- ifelse(s==1, usr[3], usr[4]) if (x$clip && x$draw_grid && s == 1) { clp <- get.clip() if (!is.null(clp)) { for (i in seq_along(y$at)) { lines(rbind(c(y$at[i], clp[3]), c(y$at[i], clp[4])), col=y$col) } } } } else { ur <- usr[4] - usr[3] edg <- c(usr[3]-10*ur, usr[4]+10*ur) if (is.null(yat)) { axt <- graphics::axTicks(s) y$at <- axt[axt >= usr[3] & axt <= usr[4]] } else { y$at <- yat } if (is.null(ylab)) { y$labels <- if (retro) retro_labels(y$at, lat=TRUE) else y$at } else { y$labels <- ylab } y$pos <- ifelse(s==2, usr[1], usr[2]) if (x$clip && x$draw_grid && s == 2) { clp <- get.clip() if (!is.null(clp)) { for (i in seq_along(y$at)) { lines(rbind(c(clp[1], y$at[i]), c(clp[2], y$at[i])), col=y$col) } } } } z <- y z$lwd <- 0 if (s %in% labs) { z$lwd.ticks <- 0 do.call(graphics::axis, z) } z$labels <- FALSE if (s %in% ticks) { z$lwd <- 0 z$lwd.ticks <- y$lwd.ticks if (is.null(z$lwd.ticks)) z$lwd.ticks <- 1 do.call(graphics::axis, z) } if (s %in% sides) { lin <- lnpts[s:(s+1), ] if (is.null(y$lty)) { lty <- 1 } else { lty <- y$lty } lines(lin, y$lwd, lty=lty, col=y$col) #d <- diff(edg) * 10 #z$at <- edg + c(-d, d) #z$lwd.ticks <- 0 #z$lwd <- y$lwd #do.call(graphics::axis, z) } } if (x$xlab != "") { posx <- usr[1] + diff(usr[1:2])/2 text(posx, usr[3], x$xlab, pos=1, offset=x$axs$line.lab, cex=x$axs$cex.lab, xpd=TRUE) } if (x$ylab != "") { posy <- usr[3] + diff(usr[3:4])/2 text(usr[1], posy, x$ylab, pos=2, offset=x$axs$line.lab, srt=90, cex=x$axs$cex.lab, xpd=TRUE) } x } terra/R/geocolors.R0000644000176200001440000000060414536376240013721 0ustar liggesusers.geocolors <- function(name, ...) { if (name == "aspect") { #0% black, 50% white, 100% black pal <- grDevices::colorRampPalette(c("black", "white", "black"), ...) cols <- cbind(1:360, pal(360)) } else if (name == "aspectclr") { pal <- grDevices::colorRampPalette(c("yellow", "green", "cyan", "red", "yellow"), ...) cols <- cbind(1:360, pal(360)) cols[1,2] <- "#FFFFFF" } } terra/R/xyRowColCell.R0000644000176200001440000001304414751764240014315 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2017 # Version 1.0 # License GPL v3 point_on_border <- function(r, x, y, tolerance = sqrt(.Machine$double.eps)) { v <- h <- (x >= xmin(r)) & (x <= xmax(r)) & (y >= ymin(r)) & (y <= ymax(r)) v[v] <- ((x[v] - xmin(r)) %% res(r)[1]) < tolerance h[h] <- ((y[h] - ymin(r)) %% res(r)[2]) < tolerance h | v } setMethod("yFromRow", signature(object="SpatRaster", row="numeric"), function(object, row) { object@pntr$yFromRow(row - 1) } ) setMethod("yFromRow", signature(object="SpatRaster", row="missing"), function(object, row) { row <- seq_len(object@pntr$nrow()) object@pntr$yFromRow(row - 1) } ) setMethod(xFromCol, signature(object="SpatRaster", col="numeric"), function(object, col) { object@pntr$xFromCol(col - 1) } ) setMethod(xFromCol, signature(object="SpatRaster", col="missing"), function(object, col) { col <- seq_len(object@pntr$ncol()) object@pntr$xFromCol(col - 1) } ) setMethod(colFromX, signature(object="SpatRaster", x="numeric"), function(object, x) { cols <- object@pntr$colFromX(x) + 1 cols[cols==0] <- NA cols } ) setMethod(rowFromY, signature(object="SpatRaster", y="numeric"), function(object, y) { rows <- object@pntr$rowFromY(y) + 1 rows[rows==0] <- NA rows } ) setMethod(cellFromXY, signature(object="SpatRaster", xy="matrix"), function(object, xy) { stopifnot(ncol(xy) == 2) #.checkXYnames(colnames(xy)) object@pntr$cellFromXY(xy[,1], xy[,2], NA) + 1 } ) setMethod(cellFromXY, signature(object="SpatRaster", xy="data.frame"), function(object, xy) { stopifnot(ncol(xy) == 2) #.checkXYnames(colnames(xy)) object@pntr$cellFromXY(xy[,1], xy[,2], NA) + 1 } ) setMethod(cellFromRowCol, signature(object="SpatRaster", row="numeric", col="numeric"), function(object, row, col) { object@pntr$cellFromRowCol(row-1, col-1) + 1 } ) setMethod(cellFromRowColCombine, signature(object="SpatRaster", row="numeric", col="numeric"), function(object, row, col) { object@pntr$cellFromRowColCombine(row-1, col-1) + 1 } ) setMethod(rowColCombine, signature(object="SpatRaster", row="numeric", col="numeric"), function(object, row, col) { cell <- object@pntr$cellFromRowColCombine(row-1, col-1) rc <- object@pntr$rowColFromCell(cell) rc <- do.call(cbind, rc) rc[rc < 0] <- NA rc+1 } ) setMethod(xyFromCell, signature(object="SpatRaster", cell="numeric"), function(object, cell) { xy <- object@pntr$xyFromCell(cell-1) xy <- do.call(cbind, xy) colnames(xy) <- c("x", "y") xy } ) setMethod(yFromCell, signature(object="SpatRaster", cell="numeric"), function(object, cell) { xyFromCell(object, cell)[,2] } ) setMethod(xFromCell, signature(object="SpatRaster", cell="numeric"), function(object, cell) { xyFromCell(object, cell)[,1] } ) setMethod(rowColFromCell, signature(object="SpatRaster", cell="numeric"), function(object, cell) { rc <- object@pntr$rowColFromCell(cell-1) rc <- do.call(cbind, rc) rc[rc < 0] <- NA rc+1 } ) setMethod(rowFromCell, signature(object="SpatRaster", cell="numeric"), function(object, cell) { rowColFromCell(object, cell)[,1] } ) setMethod(colFromCell, signature(object="SpatRaster", cell="numeric"), function(object, cell) { rowColFromCell(object, cell)[,2] } ) .rep_fun <- function(v, n, N, m) { if (is.null(v)) { v } else if (n == 1) { replicate(N, v, FALSE) } else if (n == N) { as.list(v) } else if ((n == m) && all(v==(1:m))) { NULL } else { error("rcl", "if one argument is a list, the others should be a list,\n or a vector of length 1, or have the length of the list argument") } } setMethod(rcl, signature(x="SpatRaster"), function(x, row=NULL, col=NULL, lyr=NULL) { lr <- is.list(row) lc <- is.list(col) ll <- is.list(lyr) ln <- sum(lr, lc, ll) if (ln > 0) { nr <- length(row) nc <- length(col) nl <- length(lyr) N <- unique(c(nr, nc, nl)[c(lr, lc, ll)]) if (length(N) > 1) { N <- max(N) islst <- which(c(lr, lc, ll)) for (i in islst) { if (i == 1) { row <- rep_len(row, N) } else if (i == 2) { col <- rep_len(col, N) } else { lyr <- rep_len(lyr, N) } } } notlst <- which(!c(lr, lc, ll)) for (i in notlst) { if (i == 1) { row <- .rep_fun(row, nr, N, nrow(x)) } else if (i == 2) { col <- .rep_fun(col, nc, N, ncol(x)) } else { lyr <- .rep_fun(lyr, nl, N, nlyr(x)) } } out <- lapply(1:N, function(i) { rcl(x, row[[i]], col[[i]], lyr[[i]]) }) do.call(rbind, out) } else { hr <- !is.null(row) hc <- !is.null(col) hl <- !is.null(lyr) n <- sum(hr, hc, hl) if (hl) { lyr[!c(lyr %in% 1:nlyr(x))] <- NA } if (n == 0) { out <- rowColFromCell(x, 1:ncell(x)) out <- cbind(out[,1], out[,2], rep(1:nlyr(x), each=nrow(out))) colnames(out) <- c("row", "col", "lyr") return(out) } else if (hr & hc & hl) { out <- rowColCombine(x, row, col) out <- cbind(out[,1], out[,2], rep(lyr, each=nrow(out))) } else if (!hc) { out <- rowColCombine(x, row, 1:ncol(x)) if (hl) { out <- cbind(out[,1], out[,2], rep(lyr, each=nrow(out))) } else { out <- cbind(out[,1], out[,2], rep(1:nlyr(x), each=nrow(out))) } } else if (!hr) { out <- rowColCombine(x, 1:nrow(x), col) if (hl) { out <- cbind(out[,1], out[,2], rep(lyr, each=nrow(out))) } else { out <- cbind(out[,1], out[,2], rep(1:nlyr(x), each=nrow(out))) } } else if (!hl) { out <- rowColCombine(x, row, col) out <- cbind(out[,1], out[,2], rep(1:nlyr(x), each=nrow(out))) } colnames(out) <- c("row", "col", "lyr") out } } ) terra/R/selectHigh.R0000644000176200001440000000034014536376240014001 0ustar liggesusers setMethod("selectHighest", signature(x="SpatRaster"), function(x, n, low=FALSE) { x <- x[[1]] n <- min(ncell(x), max(1, n)) i <- order(values(x, mat=FALSE), decreasing=!low)[1:n] x <- rast(x) x[i] <- 1 x } ) terra/R/match.R0000644000176200001440000000270014726700274013017 0ustar liggesusers# Author: Robert J. Hijmans # License GPL v3 getCatIDs <- function(x, table, sender="%in%") { if (!is.factor(x)) { error(sender, "Can only match character values if x is categorical") } if (nlyr(x) != 1) { error(sender, "matching with character values is only supported for single layer SpatRaster") } d <- cats(x)[[1]] m <- stats::na.omit(match(table, d[,2])) d[m,1] } setMethod("match", signature(x="SpatRaster"), function(x, table, nomatch=NA, incomparables=NULL) { table <- unique(table) if (is.character(table)) { table <- getCatIDs(x, table, sender="match") if (length(table) == 0) { return(as.logical(x*0)) } } app(x, function(i) match(i, table, nomatch, incomparables)) } ) setMethod("%in%", signature(x="SpatRaster"), function(x, table) { table <- unique(table) if (is.character(table)) { table <- getCatIDs(x, table) if (length(table) == 0) { return(as.logical(x*0)) } } opt <- spatOptions("", FALSE, list()) x@pntr <- x@pntr$is_in(table, opt) messages(x, "%in%") } ) #setMethod("%in%", signature(x="SpatRaster", table="ANY"), # function(x, table) { # out <- rast(x) # readStart(x) # on.exit(readStop(x)) # nc <- ncol(out) # b <- writeStart(out, filename="", overwrite=FALSE, sources=sources(x), wopt=list()) # for (i in 1:b$n) { # v <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) # v <- v %in% table # writeValues(out, v, b$row[i], b$nrows[i]) # } # writeStop(out) # } #) terra/R/inset.R0000644000176200001440000000631514562663313013053 0ustar liggesusers# Author: Robert J. Hijmans # Date : December 2020 # Version 1.0 # License GPL v3 setMethod("inext", signature(x="SpatVector"), function(x, e, y=NULL, gap=0) { # the area used for scaling gap <- rep_len(gap, 2) e <- as.vector(e) + c(gap[1], -gap[1], gap[2], -gap[2]) stopifnot((e[2] > e[1]) && (e[4] > e[3])) ex <- ext(x) x <- shift(x, e[1] - ex[1], e[3] - ex[3]) ve <- ext(x) fx <- (e[2] - e[1]) / (ve[2] - ve[1]) fy <- (e[4] - e[3]) / (ve[4] - ve[3]) if (!is.null(y)) { y <- shift(y, e[1] - ex[1], e[3] - ex[3]) rescale(y, fx=fx, fy=fy, e[1], e[3]) } else { rescale(x, fx=fx, fy=fy, e[1], e[3]) } } ) .inset <- function(x, e, loc="", scale=0.2, background="white", perimeter=TRUE, pper, box=NULL, pbox, add=TRUE, xpd=NA, offset=0.1, ...) { usr <- unlist(get.clip()[1:4]) if (missing(e)) { e <- ext(usr) xe <- ext(x) r <- diff(xe[1:2]) / diff(xe[3:4]) n <- scale * diff(e[1:2]) e[2] <- e[1] + n e[3] <- e[4] - n / r } #offset <- 0.9 offset <- 1 - offset offset <- max(0.1, min(1, offset)) scale <- offset * min(e / ext(x)) y <- rescale(x, scale) ey <- ext(y) xy <- c(mean(ey[1:2]), mean(ey[3:4])) xybox <- c(mean(e[1:2]), mean(e[3:4])) dx <- xybox[1] - xy[1] dy <- xybox[2] - xy[2] y <- shift(y, dx, dy) if (!is.null(box)) { ex <- ext(x) box <- rescale(as.polygons(box), scale, x0=ex[1]+diff(ex[1:2])/2, y0=ex[3]+diff(ex[3:4])/2) box <- shift(box, dx, dy) } if ((loc != "") && (loc != "topleft")) { stopifnot(loc %in% c("bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right", "center")) ex <- ext(x) if (grepl("top", loc)) { dy <- usr[4] - e[4] } else if (grepl("bottom", loc)) { dy <- usr[3] - e[3] } else { dy <- (usr[3] + diff(usr[3:4])/2) - (e[3] + diff(e[3:4])/2) } if (grepl("left", loc)) { dx <- usr[1] - e[1] } else if (grepl("right", loc)) { dx <- usr[2] - e[2] } else { dx <- (usr[1] + diff(usr[1:2])/2) - (e[1] + diff(e[1:2])/2) } y <- shift(y, dx, dy) e <- shift(e, dx, dy) if (!is.null(box)) { box <- shift(box, dx, dy) } } if (add) { if (!is.na(background)) { polys(as.polygons(e), col=background, lty=0, xpd=xpd) } plot(y, ..., axes=FALSE, legend=FALSE, add=TRUE, xpd=xpd) if (isTRUE(perimeter)) { if (missing(pper) || !is.list(pper)) { pper <- list() } #pper$x <- ext(y) pper$x <- e pper$xpd <- xpd do.call(lines, pper) #lines(e, col=perimeter) } if (!is.null(box)) { if (missing(pbox) || !is.list(pbox)) { pbox <- list() } pbox$x <- box pbox$xpd <- xpd do.call(lines, pbox) } } invisible(y) } setMethod("inset", signature(x="SpatVector"), function(x, e, loc="", scale=0.2, background="white", perimeter=TRUE, box=NULL, pper, pbox, offset=0.1, add=TRUE, ...) { .inset(x, e, loc=loc, scale=scale, background=background, perimeter=perimeter, pper=pper, box=box, pbox=pbox, offset=offset, add=add, ...) } ) setMethod("inset", signature(x="SpatRaster"), function(x, e, loc="", scale=0.2, background="white", perimeter=TRUE, box=NULL, pper, pbox, offset=0.1, add=TRUE, ...) { .inset(x, e, loc=loc, scale=scale, background=background, perimeter=perimeter, pper=pper, box=box, pbox=pbox, offset=offset, add=add, ...) } ) terra/R/generics.R0000644000176200001440000007577414754707627013561 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2018 # Version 1.0 # License GPL v3 setMethod("is.rotated", signature(x="SpatRaster"), function(x) { x@pntr$is_rotated() } ) setMethod("is.flipped", signature(x="SpatRaster"), function(x) { x@pntr$is_flipped() } ) setMethod("rangeFill", signature(x="SpatRaster"), function(x, limit, circular=FALSE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$fill_range(limit, circular, opt) messages(x, "rangeFill") } ) setMethod("weighted.mean", signature(x="SpatRaster", w="numeric"), function(x, w, na.rm=FALSE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$wmean_vect(w, na.rm, opt) messages(x, "weighted.mean") } ) setMethod("weighted.mean", signature(x="SpatRaster", w="SpatRaster"), function(x, w, na.rm=FALSE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <-x@pntr$wmean_rast(w@pntr, na.rm, opt) messages(x, "weighted.mean") } ) setMethod("patches", signature(x="SpatRaster"), function(x, directions=4, values=FALSE, zeroAsNA=FALSE, allowGaps=TRUE, filename="", ...) { if (values) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$patches2(directions, opt) return(messages(x, "patches")) } if (allowGaps) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$patches(directions[1], zeroAsNA[1], opt) messages(x, "patches") } else { opt <- spatOptions() x@pntr <- x@pntr$patches(directions[1], zeroAsNA[1], opt) x <- messages(x, "patches") f <- freq(x) fr <- cbind(f[,2], 1:nrow(f)) fr <- fr[fr[,1] != fr[,2], ,drop=FALSE] if (nrow(fr) > 0) { x <- classify(x, fr, filename=filename, ...) } else if (filename != "") { x <- writeRaster(x, filename=filename, ...) } x } } ) setMethod("origin", signature(x="SpatRaster"), function(x) { x@pntr$origin } ) setMethod("origin<-", signature("SpatRaster"), function(x, value) { value <- rep(value, length.out=2) dif <- value - origin(x) res <- res(x) dif[1] <- dif[1] %% res[1] dif[2] <- dif[2] %% res[2] for (i in 1:2) { if (dif[i] < 0) { if ((dif[i] + res[i]) < abs(dif[i])) { dif[i] <- dif[i] + res[i] } } else { if (abs(dif[i] - res[i]) < dif[i]) { dif[i] <- dif[i] - res[i] } } } e <- as.vector(ext(x)) e["xmin"] <- e["xmin"] + dif[1] e["xmax"] <- e["xmax"] + dif[1] e["ymin"] <- e["ymin"] + dif[2] e["ymax"] <- e["ymax"] + dif[2] ext(x) <- e return(x) } ) setMethod("align", signature(x="SpatExtent", y="SpatRaster"), function(x, y, snap="near") { x@pntr <- y@pntr$align(x@pntr, tolower(snap)) #messages(x, "align") x } ) setMethod("align", signature(x="SpatExtent", y="numeric"), function(x, y) { x@pntr <- x@pntr$align(y, "") x } ) setMethod("intersect", signature(x="SpatRaster", y="SpatRaster"), function(x, y) { opt <- spatOptions() x@pntr <- x@pntr$intersect(y@pntr, opt) messages(x) } ) setMethod("cellSize", signature(x="SpatRaster"), function(x, mask=FALSE, lyrs=FALSE, unit="m", transform=TRUE, rcx=100, filename="", ...) { opt <- spatOptions(filename, ...) if (!lyrs) x <- x[[1]] x@pntr <- x@pntr$rst_area(mask, unit, transform, rcx, opt) messages(x, "cellSize") } ) setMethod("surfArea", signature(x="SpatRaster"), function(x, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$surface_area(opt) messages(x, "surfArea") } ) setMethod("atan2", signature(y="SpatRaster", x="SpatRaster"), function(y, x) { opt <- spatOptions(filename="", overwrite=TRUE) y@pntr <- y@pntr$atan2(x@pntr, opt) messages(y, "atan2") } ) setMethod("atan_2", signature(y="SpatRaster", x="SpatRaster"), function(y, x, filename="", ...) { opt <- spatOptions(filename=filename, ...) y@pntr <- y@pntr$atan2(x@pntr, opt) messages(y, "atan_2") } ) setMethod("boundaries", signature(x="SpatRaster"), function(x, classes=FALSE, inner=TRUE, directions=8, falseval=0, filename="", ...) { opt <- spatOptions(filename, ...) type <- ifelse(inner[1], "inner", "outer") x@pntr <- x@pntr$boundaries(classes[1], type, directions[1], falseval[1], opt) messages(x, "boundaries") } ) .collapseSources <- function(x) { x@pntr <- x@pntr$collapse_sources() messages(x, "tighten") } setMethod("deepcopy", signature("SpatRaster"), function(x) { x@pntr <- x@pntr$deepcopy() x } ) setMethod("split", signature(x="SpatRaster"), function(x, f) { stopifnot(length(f) == nlyr(x)) stopifnot(!any(is.na(f))) u <- unique(f) lapply(u, function(i) x[[f==i]]) } ) setMethod("add<-", signature("SpatRaster", "SpatRaster"), function(x, value) { if (x@pntr$same(value@pntr)) { x@pntr <- x@pntr$deepcopy() } opt <- spatOptions() x@pntr$addSource(value@pntr, FALSE, opt) messages(x, "add") } ) setMethod("tighten", signature("SpatRaster"), function(x) { x@pntr <- x@pntr$collapse_sources() messages(x, "tighten") } ) setMethod("tighten", signature("SpatRasterDataset"), function(x) { y <- new("SpatRaster") y@pntr <- x@pntr$collapse() messages(y, "tighten") } ) #setMethod("c", signature(x="SpatRaster"), # function(x, ...) { # s <- sds(list(x, ...)) # x@pntr <- s@pntr$collapse() # x <- messages(x, "c") # try( x@pntr <- x@pntr$collapse_sources() ) # messages(x, "c") # } #) #cbind.SpatVector <- function(x, y, ...) { # if (inherits(y, "SpatVector")) { # y <- y@pntr$df # } else { # stopifnot(inherits(y, "data.frame")) # y <- terra:::.makeSpatDF(y) # } # x@pntr <- x@pntr$cbind(y) # messages(x, "cbind") #} cbind.SpatVector <- function(x, y, ...) { dots <- list(y, ...) for (y in dots) { if (inherits(y, "SpatVector")) { y <- y@pntr$df } else { # stopifnot(inherits(y, "data.frame")) y <- as.data.frame(y) y <- .makeSpatDF(y) } x@pntr <- x@pntr$cbind(y) x <- messages(x, "cbind") } x } rbind.SpatVector <- function(x, y, ...) { skipped <- FALSE if (missing(y) || is.null(y)) return(x) stopifnot(inherits(y, "SpatVector")) s <- svc(x, y, ...) x@pntr <- s@pntr$append() messages(x, "rbind") # dots <- list(...) # if (is.null(dots)) { # x@pntr <- x@pntr$rbind(y@pntr, FALSE) # } else { #if (!is.null(dots)) { # for (y in dots) { # stopifnot(inherits(y, "SpatVector")) # x@pntr <- x@pntr$rbind(y@pntr, FALSE) # x <- messages(x, "rbind") # } #} #x } # this way names of named arguments are used setMethod("c", signature(x="SpatRaster"), function(x, ..., warn=TRUE) { if (missing(x)) { rast(list(...), warn=warn) } else { rast(list(x, ...), warn=warn) } } ) setMethod("rep", signature(x="SpatRaster"), function(x, ...) { i <- rep(1:nlyr(x), ...) x[[i]] } ) setMethod("clamp", signature(x="SpatRaster"), function(x, lower=-Inf, upper=Inf, values=TRUE, filename="", ...) { opt <- spatOptions(filename, ...) rlow <- inherits(lower, "SpatRaster") rupp <- inherits(upper, "SpatRaster") r <- rast() if (rlow & rupp) { x@pntr <- x@pntr$clamp_raster(lower@pntr, upper@pntr, NA, NA, values[1], opt) } else if (rlow) { if (any(is.na(upper))) error("clamp", "upper limit cannot be NA") x@pntr <- x@pntr$clamp_raster(lower@pntr, r@pntr, NA, upper, values[1], opt) } else if (rupp) { if (any(is.na(lower))) error("clamp", "lower limit cannot be NA") x@pntr <- x@pntr$clamp_raster(r@pntr, upper@pntr, lower, NA, values[1], opt) } else { if (any(is.na(lower))) error("clamp", "lower limit cannot be NA") if (any(is.na(upper))) error("clamp", "upper limit cannot be NA") x@pntr <- x@pntr$clamp_raster(r@pntr, r@pntr, lower, upper, values[1], opt) #x@pntr <- x@pntr$clamp(lower, upper, values[1], opt) } messages(x, "clamp") } ) setMethod("clamp_ts", signature(x="SpatRaster"), function(x, min=FALSE, max=TRUE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$clamp_ts(min, max, opt) messages(x, "clamp_ts") } ) setMethod("clamp", signature(x="numeric"), function(x, lower=-Inf, upper=Inf, values=TRUE, ...) { stopifnot(lower <= upper) if (values) { x[x < lower] <- lower x[x > upper] <- upper } else { x[x < lower] <- NA x[x > upper] <- NA } x } ) setMethod("classify", signature(x="SpatRaster"), function(x, rcl, include.lowest=FALSE, right=TRUE, others=NULL, brackets=TRUE, filename="", ...) { bylayer = FALSE if (is.data.frame(rcl)) { rcl <- as.matrix(rcl) } right <- ifelse(is.na(right), 2, ifelse(isTRUE(right), 1, 0)) include.lowest <- as.logical(include.lowest[1]) opt <- spatOptions(filename, ...) if (is.null(others)) { others <- FALSE othersValue <- 0 } else { othersValue <- others[1] others <- TRUE } keepcats <- FALSE x@pntr <- x@pntr$classify(as.vector(rcl), NCOL(rcl), right, include.lowest, others, othersValue, bylayer[1], brackets[1], keepcats, opt) messages(x, "classify") } ) setMethod("subst", signature(x="SpatRaster"), function(x, from, to, others=NULL, raw=FALSE, filename="", ...) { opt <- spatOptions(filename, ...) if (inherits(from, "data.frame")) { from <- as.matrix(from) } if (inherits(to, "data.frame")) { to <- as.matrix(to) } tom <- inherits(to, "matrix") frm <- inherits(from, "matrix") if (tom && frm) { error("subst", "either 'to' or 'from' can be a matrix, not both") } if (NROW(from) < NROW(to)) { error("subst", "from is shorter than to") } fromc <- inherits(from[1], "character") toc <- inherits(to[1], "character") if (raw && fromc) { error("subst", "if 'raw=TRUE', 'from' cannot have character values") } keepcats <- FALSE if (any(is.factor(x))) { if (nlyr(x) > 1) { error("subst", "you can only use 'subst' with categorical layers if x has a single layer") } if (inherits(to, "matrix")) { if (ncol(to) > 1) { warn("subst", "only the first column of 'to' is used with factors") } to <- as.vector(to[,1]) } levs <- levels(x)[[1]] if (!raw) { from <- levs[,1][match(from, levs[,2])] if (all(is.na(from))) { warn("subst", "all 'from' values are missing, returning a copy of 'x'") return(deepcopy(x)) } } i <- is.na(from) if (any(i)) { to <- rep_len(to, length(from)) from <- from[!i] to <- to[!i] } if (!raw) { toto <- levs[,1][match(to, levs[,2])] if (any(is.na(toto))) { # add new levels i <- which(is.na(toto)) m <- cbind(max(levs[,1]) + 1:length(i), to[i]) colnames(m) <- colnames(levs) levs <- rbind(levs, m) to <- levs[,1][match(to, levs[,2])] levels(x) <- levs } else { to <- toto } } keepcats <- TRUE } else { if (fromc) { error("subst", "from has character values but x is not categorical") } if (!tom) { if (toc) { to <- as.factor(to) levels(x) <- data.frame(ID=1:length(levels(to)), value=levels(to)) keepcats <- TRUE } else if (is.factor(to)) { levels(x) <- data.frame(ID=1:length(levels(to)), value=levels(to)) keepcats <- TRUE } } } if (is.null(others)) { setothers <- FALSE others <- NA } else { setothers <- TRUE others <- others[1] } if (tom) { nms <- colnames(to) if (!is.null(nms)) opt$names = nms x@pntr <- x@pntr$replaceValues(from, to, ncol(to), setothers, others, keepcats, opt) } else if (frm) { x@pntr <- x@pntr$replaceValues(as.vector(t(from)), to, -ncol(from), setothers, others, keepcats, opt) } else { x@pntr <- x@pntr$replaceValues(from, to, 0, setothers, others, keepcats, opt) } messages(x, "subst") } ) .getExt <- function(y, method="crop") { if (!inherits(y, "SpatExtent")) { e <- try(ext(y), silent=TRUE) if (inherits(e, "try-error")) { e <- try(ext(vect(y)), silent=TRUE) if (inherits(e, "try-error")) { error(method, "cannot get a SpatExtent from y") } } y <- e } y } setMethod("crop", signature(x="SpatRaster", y="ANY"), function(x, y, snap="near", mask=FALSE, touches=TRUE, extend=FALSE, filename="", ...) { opt <- spatOptions(filename, ...) if (mask) { if (inherits(y, "SpatVector")) { x@pntr <- x@pntr$crop_mask(y@pntr, snap[1], touches[1], extend[1], opt) } else if (inherits(y, "sf")) { y <- vect(y) x@pntr <- x@pntr$crop_mask(y@pntr, snap[1], touches[1], extend[1], opt) } else if (inherits(y, "SpatRaster")) { mopt <- spatOptions(filename="", ...) e <- ext(y) x@pntr <- x@pntr$crop(e@pntr, snap[1], extend[1], mopt) x <- messages(x, "crop") if (compareGeom(x, y, lyrs=FALSE, crs=FALSE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE, stopOnError=FALSE, messages=FALSE)) { return(mask(x, y, filename=filename, ...)) } else { warn("crop", "cannot mask with a raster that is not aligned to x") # should check earlier if masking will be possible to avoid writing to disk twice. if (filename != "") { x <- writeRaster(x, filename, ...) } return(x) } } else { y <- .getExt(y, method="crop") warn("crop", paste("mask=TRUE is ignored for", class(y)[1], "objects")) x@pntr <- x@pntr$crop(y@pntr, snap[1], extend[1], opt) } } else { y <- .getExt(y, method="crop") x@pntr <- x@pntr$crop(y@pntr, snap[1], extend[1], opt) } messages(x, "crop") } ) setMethod("crop", signature(x="SpatRasterDataset", y="ANY"), function(x, y, snap="near", extend=FALSE) { opt <- spatOptions() y <- .getExt(y, method="crop") x@pntr <- x@pntr$crop(y@pntr, snap[1], extend[1], opt) messages(x, "crop") } ) setMethod("crop", signature(x="SpatRasterCollection", y="ANY"), function(x, y, snap="near", extend=FALSE) { y <- .getExt(y, method="crop") opt <- spatOptions() x@pntr <- x@pntr$crop(y@pntr, snap[1], extend[1], double(), opt) messages(x, "crop") } ) setMethod("selectRange", signature(x="SpatRaster"), function(x, y, z=1, repint=0, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$selRange(y@pntr, z, repint, opt) messages(x, "selectRange") } ) setMethod("cover", signature(x="SpatRaster", y="SpatRaster"), function(x, y, values=NA, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$cover(y@pntr, values, opt) messages(x, "cover") } ) setMethod("cover", signature(x="SpatRaster", y="missing"), function(x, y, values=NA, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$cover_self(values, opt) messages(x, "cover") } ) setMethod("diff", signature(x="SpatRaster"), function(x, lag=1, filename="", ...) { n <- nlyr(x) lag <- round(lag) if ((lag < 1) | (lag >= n)) { error("diff", "lag must be > 0 and < nlyr(x)") } y <- x[[-((n-lag+1):n)]] x <- x[[-(1:lag)]] opt <- spatOptions(filename, ...) x@pntr <- x@pntr$arith_rast(y@pntr, "-", FALSE, opt) messages(x, "diff") } ) setMethod("disagg", signature(x="SpatRaster"), function(x, fact, method="near", filename="", ...) { method <- match.arg(tolower(method), c("near", "bilinear")) if (method == "bilinear") { y <- disagg(rast(x), fact) r <- resample(x, y, "bilinear", filename=filename, ...) return(r) } opt <- spatOptions(filename, ...) x@pntr <- x@pntr$disaggregate(fact, opt) messages(x, "disagg") } ) setMethod("flip", signature(x="SpatRaster"), function(x, direction="vertical", filename="", ...) { d <- match.arg(direction, c("vertical", "horizontal")) opt <- spatOptions(filename, ...) x@pntr <- x@pntr$flip(d == "vertical", opt) messages(x, "flip") } ) setMethod("mask", signature(x="SpatRaster", mask="SpatRaster"), function(x, mask, inverse=FALSE, maskvalues=NA, updatevalue=NA, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$mask_raster(mask@pntr, inverse[1], maskvalues, updatevalue[1], opt) messages(x, "mask") } ) setMethod("mask", signature(x="SpatRaster", mask="SpatVector"), function(x, mask, inverse=FALSE, updatevalue=NA, touches=TRUE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$mask_vector(mask@pntr, inverse[1], updatevalue[1], touches[1], opt) messages(x, "mask") } ) setMethod("mask", signature(x="SpatRaster", mask="SpatExtent"), function(x, mask, inverse=FALSE, updatevalue=NA, touches=TRUE, filename="", ...) { opt <- spatOptions(filename, ...) mask <- vect(mask, crs=crs(x)) x@pntr <- x@pntr$mask_vector(mask@pntr, inverse[1], updatevalue[1], touches[1], opt) messages(x, "mask") } ) setMethod("mask", signature(x="SpatRaster", mask="sf"), function(x, mask, inverse=FALSE, updatevalue=NA, touches=TRUE, filename="", ...) { mask <- vect(mask) mask(x, mask, inverse=inverse, updatevalue=updatevalue, touches=touches, filename=filename, ...) } ) setMethod("project", signature(x="SpatRaster"), function(x, y, method, mask=FALSE, align_only=FALSE, res=NULL, origin=NULL, threads=FALSE, filename="", ..., use_gdal=TRUE, by_util = FALSE) { if (missing(method)) { if (is.factor(x)[1] || isTRUE(x@pntr$rgb)) { method <- "near" } else { method <- "bilinear" } } else { method <- match.arg(tolower(method[1]), c("near", "bilinear", "cubic", "cubicspline", "lanczos", "average", "sum", "mode", "min", "q1", "median", "q3", "max", "rms")) } opt <- spatOptions(filename, threads=threads, ...) if (inherits(y, "SpatRaster")) { if (use_gdal) { if (by_util) { x@pntr <- x@pntr$warp_by_util(y@pntr, "", method, mask[1], align_only[1], FALSE, opt) } else { x@pntr <- x@pntr$warp(y@pntr, "", method, mask[1], align_only[1], FALSE, opt) } } else { if (align_only) { y <- project(rast(x), y, align_only=TRUE) } x@pntr <- x@pntr$resample(y@pntr, method, mask[1], TRUE, opt) } } else { if (!is.character(y)) { warn("project,SpatRaster", "argument y (the crs) should be a character value") y <- as.character(crs(y)) } if (!is.null(res) || !is.null(origin)) { tmp <- project(rast(x), y) if (!is.null(res)) res(tmp) <- res if (!is.null(origin)) origin(tmp) <- origin return(project(x, tmp, method=method, mask=mask, align_only=align_only, filename=filename, use_gdal=use_gdal, by_util=by_util, ...)) } if (use_gdal) { if (by_util) { x@pntr <- x@pntr$warp_by_util(SpatRaster$new(), y, method, mask, FALSE, FALSE, opt) } else { x@pntr <- x@pntr$warp(SpatRaster$new(), y, method, mask, FALSE, FALSE, opt) } } else { y <- project(rast(x), y) x@pntr <- x@pntr$resample(y@pntr, method, mask[1], TRUE, opt) } } messages(x, "project") } ) setMethod("project", signature(x="SpatVector"), function(x, y, partial=FALSE) { if (!is.character(y)) { y <- as.character(crs(y)) } x@pntr <- x@pntr$project(y, partial) messages(x, "project") } ) setMethod("project", signature(x="SpatVectorCollection"), function(x, y, partial=FALSE) { x <- lapply(x, function(v) project(v, y, partial=partial)) svc(x) } ) setMethod("project", signature(x="SpatExtent"), function(x, from, to) { if (missing(from)) error("project", "'from' cannot be missing") if (missing(to)) error("project", "'to' cannot be missing") x <- as.polygons(x, crs=from) x <- densify(x, 10000) ext(project(x, to)) } ) setMethod("project", signature(x="matrix"), function(x, from, to) { if (ncol(x) != 2) { error("project", "x must have two columns") } if (missing(from)) { error("project", "'from' cannot be missing") } if (missing(to)) { error("project", "'to' cannot be missing") } if (!is.character(from)) { from <- as.character(crs(from)) } if (!is.character(to)) { to <- as.character(crs(to)) } #v <- vect(x, type="line", crs=from) #v@pntr <- v@pntr$project(to) v <- vect() xy <- v@pntr$project_xy(x[,1], x[,2], from, to) messages(v, "project") matrix(xy, ncol=2) } ) setMethod("quantile", signature(x="SpatRaster"), function(x, probs=seq(0, 1, 0.25), na.rm=FALSE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$quantile(probs, na.rm[1], opt) messages(x, "quantile") } ) setMethod("quantile", signature(x="SpatVector"), function(x, probs=seq(0, 1, 0.25), ...) { x <- values(x) cls <- sapply(x, class) i <- cls != "character" if (!any(i)) error("quantile", "no numeric variables") x <- x[, i, drop=FALSE] apply(x, 2, function(i) quantile(i, probs=probs, ...)) } ) setMethod("rectify", signature(x="SpatRaster"), function(x, method="bilinear", aoi=NULL, snap=TRUE, filename="", ...) { opt <- spatOptions(filename, ...) if (!is.null(aoi)) { if (inherits(aoi, "SpatExtent")) { aoi <- rast(aoi) useaoi <- 1 } else if (inherits(aoi, "SpatRaster")) { aoi <- rast(aoi) useaoi <- 2 } else { error("rectify", "ext must be a SpatExtent or SpatRaster") } } else { aoi <- rast() useaoi <- 0 } snap <- as.logical(snap) x@pntr <- x@pntr$rectify(method, aoi@pntr, useaoi, snap, opt) messages(x, "rectify") } ) setMethod("resample", signature(x="SpatRaster", y="SpatRaster"), function(x, y, method, threads=FALSE, by_util=FALSE, filename="", ...) { if (missing(method)) { if (is.factor(x)[1] || isTRUE(x@pntr$rgb)) { method <- "near" } else { method <- "bilinear" } } else { method <- match.arg(tolower(method[1]), c("near", "bilinear", "cubic", "cubicspline", "lanczos", "average", "sum", "mode", "min", "q1", "median", "q3", "max", "rms")) } xcrs = crs(x) ycrs = crs(y) if ((xcrs == "") && (ycrs != "")) { crs(x) <- ycrs } if ((ycrs == "") && (xcrs != "")) { crs(y) <- xcrs } opt <- spatOptions(filename, threads=threads, ...) if (by_util) { x@pntr <- x@pntr$warp_by_util(y@pntr, "", method, FALSE, FALSE, TRUE, opt) } else { x@pntr <- x@pntr$warp(y@pntr, "", method, FALSE, FALSE, TRUE, opt) } messages(x, "resample") } ) setMethod("impose", signature(x="SpatRasterCollection"), function(x, y, filename="", ...) { stopifnot(inherits(y, "SpatRaster")) opt <- spatOptions(filename, ...) r <- rast() r@pntr <- x@pntr$morph(y@pntr, opt) messages(r, "impose") } ) setMethod("rev", signature(x="SpatRaster"), function(x) { opt <- spatOptions("", FALSE, list()) x@pntr <- x@pntr$reverse(opt) messages(x, "rev") } ) setMethod("rotate", signature(x="SpatRaster"), function(x, left=TRUE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$rotate(left, opt) messages(x, "rotate") } ) setMethod("rotate", signature(x="SpatVector"), function(x, longitude=0, split=TRUE, left=TRUE, normalize=FALSE) { if (split) { e <- ext(x) if ((longitude < e$xmin) || (longitude > e$xmax)) { if (left) { return(shift(x, -360)) } else { return(shift(x, 360)) } } e <- as.vector(floor(e) + 1) ew <- ext(c(e[1], longitude, e[3:4])) ee <- ext(c(longitude, e[2:4])) x$unique_id_for_aggregation <- 1:nrow(x) xcrs <- crs(x) crs(x) <- NULL # avoid wrapping xw <- crop(x, ew) xe <- crop(x, ee) if (left) { xe <- shift(xe, -360) } else { xw <- shift(xw, 360) } out <- rbind(xe, xw) if (nrow(out) > nrow(x)) { out <- aggregate(out, "unique_id_for_aggregation", id=F) i <- match(out$unique_id_for_aggregation, x$unique_id_for_aggregation) values(out) <- values(x)[i,,drop=FALSE] x <- out } x$unique_id_for_aggregation <- NULL crs(x) <- xcrs } else { x@pntr <- x@pntr$rotate_longitude(longitude, left) x <- messages(x, "rotate") } if (normalize) { x <- normalize.longitude(x) } x } ) setMethod("segregate", signature(x="SpatRaster"), function(x, classes=NULL, keep=FALSE, other=0, round=FALSE, digits=0, filename="", ...) { opt <- spatOptions(filename, ...) if (is.null(classes)) classes <- 1[0] x@pntr <- x@pntr$separate(classes, keep[1], other[1], round[1], digits[1], opt) messages(x, "segregate") } ) setMethod("shift", signature(x="SpatRaster"), function(x, dx=0, dy=0, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$shift(dx, dy, opt) messages(x, "shift") } ) setMethod("shift", signature(x="SpatExtent"), function(x, dx=0, dy=0) { s <- c(dx[1], dx[1], dy[1], dy[1]) ext(as.vector(x) + s) } ) setMethod("shift", signature(x="SpatVector"), function(x, dx=0, dy=0) { x@pntr <- x@pntr$shift(dx, dy) messages(x, "shift") } ) setMethod("rescale", signature(x="SpatRaster"), function(x, fx=0.5, fy=fx, x0, y0) { stopifnot(fx > 0) stopifnot(fy > 0) e <- as.vector(ext(x)) if (missing(x0)) { x0 <- mean(e[1:2]) } if (missing(y0)) { y0 <- mean(e[3:4]) } ex = x0 + fx * (e[1:2] - x0); ey = y0 + fy * (e[3:4] - y0); x@pntr <- x@pntr$deepcopy() ext(x) <- ext(c(ex, ey)) messages(x, "rescale") } ) setMethod("rescale", signature(x="SpatVector"), function(x, fx=0.5, fy=fx, x0, y0) { stopifnot(fx > 0) stopifnot(fy > 0) e <- as.vector(ext(x)) if (missing(x0)) { x0 <- mean(e[1:2]) } if (missing(y0)) { y0 <- mean(e[3:4]) } x@pntr <- x@pntr$rescale(fx, fy, x0[1], y0[1]) messages(x, "rescale") } ) setMethod("scale_linear", signature(x="SpatRaster"), function(x, min=0, max=1, filename="", ...) { opt <- spatOptions(filename=filename, ...) x@pntr <- x@pntr$scale_linear(min, max, opt) messages(x, "scale_linear") } ) setMethod("scale", signature(x="SpatRaster"), function(x, center=TRUE, scale=TRUE) { opt <- spatOptions() if (is.logical(center)) { docenter = center[1]; center = 1[0] } else { docenter = TRUE } if (is.logical(scale)) { doscale = scale[1] scale = 1[0] } else { doscale = TRUE; } x@pntr <- x@pntr$scale(center, docenter, scale, doscale, opt) messages(x, "scale") } ) setMethod("stretch", signature(x="SpatRaster"), function(x, minv=0, maxv=255, minq=0, maxq=1, smin=NA, smax=NA, histeq=FALSE, scale=1, maxcell=500000, filename="", ...) { if (histeq) { nms <- names(x) if (nlyr(x) > 1) { x <- lapply(1:nlyr(x), function(i) stretch(x[[i]], histeq=TRUE, scale=scale, maxcell=maxcell)) x <- rast(x) names(x) <- nms if (filename != "") { x <- writeRaster(x, filename=filename, ...) } return(x) } scale <- scale[1] if (scale == 1) { ecdfun <- stats::ecdf(na.omit(spatSample(x, maxcell, "regular")[,1])) } else { ecdfun <- function(y) { f <- stats::ecdf(na.omit(spatSample(x, maxcell, "regular")[,1])) f(y) * scale } } wopt <- list(...) if (is.null(wopt$names)) { wopt$names <- nms } app(x, ecdfun, filename=filename, wopt=wopt) } else { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$stretch(minv, maxv, minq, maxq, smin, smax, opt) messages(x, "stretch") } } ) setMethod("summary", signature(object="SpatRaster"), function(object, size=100000, warn=TRUE, ...) { if (!hasValues(object)) { warn("summary", "SpatRaster has no values") return(invisible()) } if (warn && (ncell(object) > size)) { warn("summary", "used a sample") } s <- spatSample(object, size, method="regular", warn=FALSE) summary(s, ...) } ) setMethod("summary", signature(object="SpatVector"), function(object, ...) { summary(as.data.frame(object), ...) } ) setMethod("t", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$transpose(opt) messages(x, "t") } ) setMethod("t", signature(x="SpatVector"), function(x) { x@pntr <- x@pntr$transpose() messages(x, "t") } ) setMethod("terrain", signature(x="SpatRaster"), function(x, v="slope", neighbors=8, unit="degrees", filename="", ...) { unit <- match.arg(unit, c("degrees", "radians")) opt <- spatOptions(filename, ...) seed <- ifelse("flowdir" %in% v, .seed(), 0) x@pntr <- x@pntr$terrain(v, neighbors[1], unit=="degrees", seed, opt) messages(x, "terrain") } ) setMethod("viewshed", signature(x="SpatRaster"), function(x, loc, observer=1.80, target=0, curvcoef=6/7, output="yes/no", filename="", ...) { opt <- spatOptions(filename, ...) z <- rast() if (length(loc) == 1) { loc <- xyFromCell(x, loc) } outops <- c("yes/no", "sea", "land") output <- match.arg(tolower(output), outops) output <- match(output, outops) z@pntr <- x@pntr$view(c(loc[1:2], observer[1], target[1]), c(1,0,2,3), curvcoef, 2, 0, output, opt) messages(z, "viewshed") } ) setMethod("sieve", signature(x="SpatRaster"), function(x, threshold, directions=8, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$sieve(threshold[1], directions[1], opt) messages(x, "sieve") } ) setMethod("trim", signature(x="SpatRaster"), function(x, padding=0, value=NA, filename="", ...) { opt <- spatOptions(filename, ...) padding <- round(padding[1]) if (padding < 0) { error("trim", "padding must be a non-negative integer") } x@pntr <- x@pntr$trim(value[1], padding, opt) messages(x, "trim") } ) setMethod("trans", signature(x="SpatRaster"), function(x, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$transpose(opt) messages(x, "trans") } ) setMethod("unique", signature(x="SpatRaster", incomparables="ANY"), function(x, incomparables=FALSE, digits=NA, na.rm=TRUE, as.raster=FALSE) { opt <- spatOptions() if (as.raster) incomparables = FALSE u <- x@pntr$unique(incomparables, digits, na.rm[1], opt) if (!as.raster) { u <- get_labels(x, u) } if (!incomparables) { #if (!length(u)) return(u) u <- do.call(data.frame, u) colnames(u) <- names(x) if (nrow(u) == 0) { if (as.raster) { return(deepcopy(x)) } else { return(NULL) } } } if ((!incomparables) && (na.rm || as.raster)) { i <- rowSums(is.na(u)) < ncol(u) u <- u[i, , drop=FALSE] } if (as.raster) { lab <- apply(get_labels(x, u), 1, function(i) paste(i, collapse="_")) if (!is.na(digits)) { x <- round(x, digits) } else { levels(x) <- NULL } uid <- 1:nrow(u) x <- subst(x, u, uid-1) set.cats(x, 1, data.frame(ID=uid-1, label=lab, u)) return(x) } u } ) setMethod("unique", signature(x="SpatVector", incomparables="ANY"), function(x, incomparables=FALSE, ...) { u <- unique(as.data.frame(x, geom="WKT"), incomparables=incomparables, ...) vect(u, geom="geometry", crs(x)) } ) setMethod("labels", signature(object="SpatRaster"), function(object, ...) { names(object) } ) setMethod("scoff", signature(x="SpatRaster"), function(x) { out <- x@pntr$getScaleOffset() names(out) <- c("scale", "offset") do.call(cbind, out) } ) setMethod("scoff<-", signature("SpatRaster"), function(x, value) { if (is.null(value)) { x@pntr <- x@pntr$deepcopy() x@pntr$setScaleOffset(1, 0) } else { if (NCOL(value) != 2) { error("scoff<-", "value must be a 2-column matrix") } x@pntr <- x@pntr$deepcopy() value[is.na(value[,1]),1] <- 1 value[is.na(value[,2]),2] <- 0 x@pntr$setScaleOffset(value[,1], value[,2]) x@pntr$setValueType(0) } messages(x, "scoff<-") } ) setMethod("sort", signature(x="SpatRaster"), function (x, decreasing=FALSE, order=FALSE, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$sort(decreasing[1], order[1], opt) messages(x, "sort") } ) setMethod("sort", signature(x="SpatVector"), function (x, v, decreasing=FALSE) { if (is.logical(v)) { tmp <- v v <- decreasing decreasing <- tmp } if (length(v) > 1) { v <- data.frame(x)[,v] i <- do.call(order, lapply(v, function(i) i)) } else { i <- order(x[[v]][[1]], decreasing=decreasing) } x[i, ] } ) setMethod("sort", signature(x="data.frame"), function (x, v, decreasing=FALSE) { if (length(v) > 1) { v <- data.frame(x)[, v] i <- do.call(order, lapply(v, function(i) i)) } else { i <- order(x[[v]], decreasing=decreasing) } x[i, ] } ) terra/R/vect.R0000644000176200001440000002774514726700274012704 0ustar liggesusers #setMethod("row.names", signature(x="SpatVector"), # function(x) { # 1:nrow(x) # } #) setMethod("emptyGeoms", signature(x="SpatVector"), function(x) { x@pntr$nullGeoms() + 1 } ) setMethod("as.vector", signature(x="SpatVector"), function(x, mode="any") { if (nrow(x) > 0) { lapply(1:nrow(x), function(i) x[i,]) } else { x } } ) setMethod("vect", signature(x="missing"), function(x) { p <- methods::new("SpatVector") p@pntr <- SpatVector$new() messages(p, "vect") return(p) } ) setMethod("vect", signature(x="SpatExtent"), function(x, crs="") { as.polygons(x, crs=crs) } ) setMethod("vect", signature(x="SpatVectorCollection"), function(x) { vect(as.list(x)) } ) setMethod("vect", signature(x="SpatGraticule"), function(x) { v <- vect() v@pntr <- x@pntr v } ) setMethod("vect", signature(x="character"), function(x, layer="", query="", extent=NULL, filter=NULL, crs="", proxy=FALSE, what="", opts=NULL) { what <- trimws(tolower(what)) if (what != "") what <- match.arg(trimws(tolower(what)), c("geoms", "attributes")) s <- substr(x[1], 1, 5) if (s %in% c("POINT", "MULTI", "LINES", "POLYG", "EMPTY")) { p <- methods::new("SpatVector") # if (all(grepl("\\(", x) & grepl("\\)", x))) { p@pntr <- SpatVector$new(gsub("\n", "", x)) messages(p, "vect") crs(p, warn=FALSE) <- crs return(p) } x <- x[1] nx <- try(normalizePath(x, mustWork=TRUE), silent=TRUE) if (!inherits(nx, "try-error")) { # skip html x <- nx if (grepl("\\.rds$", tolower(x))) { v <- unwrap(readRDS(x)) if (!inherits(v, "SpatVector")) { error("vect", "the rds file does not store a SpatVector") } return(v) } } else if ((substr(x, 1, 4) == "http") & (grepl("\\.shp$", x) | grepl("\\.gpkg$", x))) { x <- paste0("/vsicurl/", x[1]) } p <- methods::new("SpatVector") p@pntr <- SpatVector$new() proxy <- isTRUE(proxy) if ((what=="attributes") && proxy) { error("vect", "you cannot use 'what==attributes' when proxy=TRUE") } #if (proxy) query <- "" if (is.null(filter)) { filter <- SpatVector$new() } else { if (!inherits(filter, "SpatVector")) { error("vect", "'filter' must be a SpatVector") } if (proxy) { error("vect", "you cannot use 'filter' when proxy=TRUE") } filter <- filter@pntr } if (is.null(extent)) { extent <- double() } else { extent <- as.vector(ext(extent)) } if (is.null(opts)) opts <- ""[0] p@pntr$read(x, layer, query, extent, filter, proxy, what, opts) if (isTRUE(crs != "")) { crs(p, warn=FALSE) <- crs } if (proxy) { messages(p, "vect") pp <- methods::new("SpatVectorProxy") pp@pntr <- SpatVectorProxy$new() pp@pntr$v <- p@pntr return(pp) } p <- messages(p, "vect") if (what == "attributes") { p <- values(p) } p } ) setMethod("vect", signature(x="Spatial"), function(x, ...) { methods::as(x, "SpatVector") } ) setMethod("vect", signature(x="sf"), function(x) { methods::as(x, "SpatVector") } ) setMethod("vect", signature(x="sfc"), function(x) { methods::as(x, "SpatVector") } ) setMethod("vect", signature(x="XY"), #sfg function(x) { methods::as(x, "SpatVector") } ) .checkXYnames <- function(x, warn=FALSE) { if (is.null(x)) return(TRUE) if (length(x) != 2) { error("vect", "coordinate matrix should have 2 columns") } z <- tolower(x[1:2]) x <- substr(z, 1, 3) y <- substr(x, 1, 1) if ((y[1] == "x") && (y[2] == "y")) return(FALSE) if ((x[1] == "eas") && (x[2] == "nor")) return(FALSE) if ((x[1] == "lon") && (x[2] == "lat")) return(TRUE) if (grepl("lon", z[1]) && grepl("lat", z[2])) return(TRUE) if ((x[1] == "lat") && (x[2] == "lon")) { stop("vect", "longitude/latitude in the wrong order") } else if ((y[1] == "y") && (y[2] == "x")) { stop("vect", "x/y in the wrong order") } else if ((x[1] == "nor") && (x[2] == "eas")) { stop("vect", "easting/northing in the wrong order") } else if (warn) { warn("coordinate names not recognized. Expecting lon/lat, x/y, or easting/northing") } return(FALSE) } setMethod("vect", signature(x="matrix"), function(x, type="points", atts=NULL, crs="") { type <- tolower(type) type <- match.arg(tolower(type), c("points", "lines", "polygons")) stopifnot(NCOL(x) > 1) crs <- character_crs(crs, "vect") p <- methods::new("SpatVector") p@pntr <- SpatVector$new() crs(p, warn=FALSE) <- crs nr <- nrow(x) if (nr == 0) { return(p) } nc <- ncol(x) if (nc == 2) { lonlat <- .checkXYnames(colnames(x)) if (type == "points") { p@pntr$setPointsXY(as.double(x[,1]), as.double(x[,2])) } else { p@pntr$setGeometry(type, rep(1, nr), rep(1, nr), x[,1], x[,2], rep(FALSE, nr)) } if (lonlat && isTRUE(crs=="")) crs <- "+proj=longlat" } else if (nc == 3) { p@pntr$setGeometry(type, x[,1], rep(1, nr), x[,2], x[,3], rep(FALSE, nr)) } else if (nc == 4) { p@pntr$setGeometry(type, x[,1], x[,2], x[,3], x[,4], rep(FALSE, nr)) } else if (nc == 5) { p@pntr$setGeometry(type, x[,1], x[,2], x[,3], x[,4], x[,5]) } else { error("vect", "not an appropriate matrix (too many columns)") } if (!is.null(atts)) { if ((nrow(atts) == nrow(p)) & (ncol(atts) > 0)) { values(p) <- atts } } messages(p, "vect") } ) setMethod("$", "SpatVector", function(x, name) { if (!(name %in% names(x))) { return(NULL) #error("$", paste(name, "is not a variable name in x")) } s <- .subset_cols(x, name, drop=TRUE) s[,1,drop=TRUE] }) setMethod("[[", c("SpatVector", "numeric", "missing"), function(x, i, j,drop=FALSE) { s <- .subset_cols(x, i, drop=TRUE) s[,,drop=drop] }) setMethod("[[", c("SpatVector", "character", "missing"), function(x, i, j, drop=FALSE) { if (!(any(i %in% names(x)))) { return(NULL) } s <- .subset_cols(x, i, drop=TRUE) s[,,drop=drop] }) setReplaceMethod("[", c("SpatVector", "ANY", "ANY"), function(x, i, j, value) { v <- values(x) v[i,j] <- value if (nrow(v) != nrow(x)) { error("[<-", "this would create an invalid SpatVector") } values(x) <- v x } ) setReplaceMethod("[", c("SpatVector", "ANY", "missing"), function(x, i, j, value) { v <- values(x) if (inherits(value, "SpatVector")) { value <- values(value) } v[i,] <- value if (nrow(v) != nrow(x)) { error("[<-", "this would create an invalid SpatVector") } values(x) <- v x } ) setReplaceMethod("[", c("SpatVector", "missing", "ANY"), function(x, i, j, value) { v <- values(x) if (inherits(value, "SpatVector")) { value <- values(value) } v[,j] <- value if (nrow(v) != nrow(x)) { error("[<-", "this would create an invalid SpatVector") } values(x) <- v x } ) setReplaceMethod("[[", c("SpatVector", "character"), function(x, i, value) { x@pntr <- x@pntr$deepcopy() if (is.null(value)) { for (name in i) { if (name %in% names(x)) { x@pntr$remove_column(name) } } return(x); } if (inherits(value, "data.frame")) { if (ncol(value) > 1) { warn("`[[<-`", "only using the first column") } value <- value[,1] } else if (inherits(value, "list")) { value <- unlist(value) } if (NCOL(value) > 1) { warn("[[<-,SpatVector", "only using the first column") value <- value[,1] } name <- i[1] value <- rep(value, length.out=nrow(x)) if (name %in% names(x)) { d <- values(x) if (all(is.na(value))) { #[] to keep type if NA is used d[[name]][] <- value } else { d[[name]] <- value } values(x) <- d } else { if (inherits(value, "factor")) { v <- .makeSpatFactor(value) ok <- x@pntr$add_column_factor(v, name) } else if (inherits(value, "character")) { ok <- x@pntr$add_column_string(enc2utf8(value), name) } else if (inherits(value, "integer")) { # min long (should query what it is on the system?) value[is.na(value)] <- -2147483648 ok <- x@pntr$add_column_long(value, name) } else if (inherits(value, "logical")) { v <- as.integer(value) v[is.na(v)] <- 2 ok <- x@pntr$add_column_bool(v, name) } else if (inherits(value, "numeric")) { ok <- x@pntr$add_column_double(value, name) } else if (inherits(value, "Date")) { ok <- x@pntr$add_column_time(as.numeric(as.POSIXlt(value)), name, "days", "") } else if (inherits(value, "POSIXt")) { tz <- if (length(value) > 0) { attr(value[1], "tzone") } else { "" } if (is.null(tz)) tz <- "" ok <- x@pntr$add_column_time(as.numeric(value), name, "seconds", tz) } else { v <- try(as.character(value)) if (!inherits(v, "try-error")) { ok <- x@pntr$add_column_string(enc2utf8(v), name) } else { ok <- FALSE } } if (!ok) { error("[[<-,SpatVector", "cannot add these values") } } x } ) setReplaceMethod("[[", c("SpatVector", "numeric"), function(x, i, value) { stopifnot(i > 0 && i <= ncol(x)) vn <- names(x)[i] x[[vn]] <- value x } ) setMethod("$<-", "SpatVector", function(x, name, value) { x[[name]] <- value x } ) setMethod("vect", signature(x="data.frame"), function(x, geom=c("lon", "lat"), crs="", keepgeom=FALSE) { if (!all(geom %in% names(x))) { error("vect", "the variable name(s) in argument `geom` are not in `x`") } crs <- character_crs(crs, "vect") if (length(geom) == 2) { geom <- match(geom[1:2], names(x)) if (inherits(x[,geom[1]], "integer")) { x[,geom[1]] = as.numeric(x[,geom[1]]) } if (inherits(x[,geom[2]], "integer")) { x[,geom[2]] = as.numeric(x[,geom[2]]) } p <- methods::new("SpatVector") p@pntr <- SpatVector$new() x <- .makeSpatDF(x) p@pntr$setPointsDF(x, geom-1, crs, keepgeom) return(messages(p, "vect")) } else if (length(geom) == 1) { v <- vect(unlist(x[,geom]), crs=crs) if (!keepgeom) { x[[geom]] <- NULL } } else { error("vect", "the length of 'geom' must be 1 or 2") } values(v) <- x v } ) setMethod("vect", signature(x="list"), function(x, type="points", crs="") { x <- lapply(x, function(i) { if (inherits(i, "SpatVector")) return(i) vect(i, type=type) }) x <- svc(x) v <- methods::new("SpatVector") v@pntr <- x@pntr$append() if (crs != "") { crs(v) <- crs } messages(v, "vect") } ) setMethod("query", signature(x="SpatVectorProxy"), function(x, start=1, n=nrow(x), vars=NULL, where=NULL, extent=NULL, filter=NULL, sql=NULL, what="") { f <- x@pntr$v$source slayer <- x@pntr$v$layer #1058 layer <- paste0("\"", slayer, "\"") e <- x@pntr$v$read_extent if (is.null(extent)) { if (length(e) == 4) { extent = ext(e); } } else { if (length(e) == 4) { extent = intersect(ext(e), extent); if (is.null(extent)) { error("query", "extent does not intersect with x") } } } if (is.null(vars)) { vars <- "*" } else { vars <- stats::na.omit(unique(vars)) nms <- names(x) if (!all(vars %in% nms)) { error("query", "not all vars are variable names") } else if (length(vars) < length(nms)) { vars <- paste(vars, collapse=", ") } } if (!is.null(sql)) { qy <- as.character(sql) } else { qy <- "" if (!is.null(where)) { qy <- paste("SELECT", vars, "FROM", layer, "WHERE", where[1]) } else { qy <- paste("SELECT", vars, "FROM", layer) } nr <- nrow(x) start <- start-1 if (start > 0) { if (n >= (nr-start)) { qy <- paste(qy, "OFFSET", start) } else { n <- min(n, nr-start) qy <- paste(qy, layer, "LIMIT", n, "OFFSET", start) } } else if (n < nr) { n <- min(n, nr) qy <- paste(qy, "LIMIT", n) } } if (qy != "") { if (x@pntr$v$read_query != "") { error("query", "A query was used to create 'x'; you can only subset it with extent or filter") } } else { layer <- slayer } p <- vect(f, layer, query=qy, extent=extent, filter=filter, crs="", FALSE, what=what) if (what == "attributes") { p <- values(p) } p } ) vector_layers <- function(filename, delete="", return_error=FALSE) { p <- SpatVector$new() if (any(delete != "")) { delete <- trimws(delete) ok <- p$delete_layers(filename, delete, return_error[1]) messages(p, "vector_layers") invisible(ok) } else { out <- p$layer_names(filename) messages(p, "vector_layers") out } } terra/R/write.R0000644000176200001440000001164214746206355013065 0ustar liggesusers setMethod("blocks", signature(x="SpatRaster"), function(x, n=4) { opt <- spatOptions("", FALSE, ncopies=n) b <- x@pntr$getBlockSizeR(opt) b$row <- b$row + 1 b } ) setMethod("writeStart", signature(x="SpatRaster", filename="character"), function(x, filename="", overwrite=FALSE, n=4, sources="", ...) { filename <- path.expand(trimws(filename[1])) filename <- enc2utf8(filename) opt <- spatOptions(filename, overwrite, ncopies=n, ...) ok <- x@pntr$writeStart(opt, unique(sources)) messages(x, "writeStart") b <- x@pntr$getBlockSizeWrite() b$row <- b$row + 1 b } ) setMethod("writeStop", signature(x="SpatRaster"), function(x) { success <- x@pntr$writeStop() messages(x, "writeStop") f <- sources(x) if (f != "") { x <- rast(f) } return(x) } ) setMethod("writeValues", signature(x="SpatRaster", v="vector"), function(x, v, start, nrows) { success <- x@pntr$writeValues(v, start-1, nrows) messages(x, "writeValues") invisible(success) } ) setMethod("writeRaster", signature(x="SpatRaster", filename="character"), function(x, filename="", overwrite=FALSE, ...) { filename <- trimws(filename) stopifnot(filename != "") filename <- enc2utf8(filename) ftp <- list(...)$filetype[1] fext <- tools::file_ext(filename) if (any(fext %in% c("nc", "cdf")) && (is.null(ftp) || isTRUE(ftp=="netCDF"))) { warn("writeRaster", "consider writeCDF to write ncdf files") } #else if ((length(fext)==1) && (any(fext == "rds")) && ((is.null(ftp)) || isTRUE(ftp=="RDS"))) { # if ((!overwrite) && file.exists(filename)) { # error("writeRaster", "Use 'overwrite=TRUE' to overwrite an existing file") # } # return(saveRDS(x, filename)) #} opt <- spatOptions(filename, overwrite, ...) x@pntr <- x@pntr$writeRaster(opt) x <- messages(x, "writeRaster") invisible(rast(filename)) } ) get_filetype <- function(filename) { fn <- tolower(filename) ext <- tools::file_ext(fn) ext2 <- gsub("^[^.]*\\.(.*).*$", "\\1", fn) if ((ext == "shp") || (ext == "shz") || (ext == "zip" && ext2 == "shp.zip")) { "ESRI Shapefile" } else if ((ext == "") || (ext == "gpkg") || (ext == "zip" && ext2 == "gpkg.zip")) { "GPKG" } else if (ext == "gdb") { "OpenFileGDB" } else if (ext == "gml") { "GML" } else if ((ext == "json") || (ext == "geojson")) { "GeoJSON" } else if (ext == "cdf") { "netCDF" } else if (ext == "svg") { "SVG" } else if (ext == "kml") { "KML" } else if (ext == "vct") { "Idrisi" } else if (ext == "rds") { "rds" } else if (ext == "tab") { "MapInfo File" } else { error("writeVector", "cannot guess filetype from filename") } } setMethod("writeVector", signature(x="SpatVector", filename="character"), function(x, filename, filetype=NULL, layer=NULL, insert=FALSE, overwrite=FALSE, options="ENCODING=UTF-8") { filename <- path.expand(trimws(filename[1])) filename <- enc2utf8(filename) if (filename == "") { error("writeVector", "provide a filename") } if (is.null(filetype)) { filetype <- get_filetype(filename) if (filetype == "rds") { return(saveRDS(x, filename)) } } if (is.null(layer)) layer <- tools::file_path_sans_ext(basename(filename)) layer <- trimws(layer) if (is.null(options)) { options <- ""[0] } if (filetype == "ESRI Shapefile") { nms <- names(x) i <- nchar(nms) > 10 if (any(i)) { nms[i] <- substr(nms[i], 1, 10) testnms <- make.unique(nms, sep="") if (!all(testnms == nms)) { i <- which(i) newnms <- substr(nms[i], 1, 9) newnms <- make.unique(newnms, sep="") j <- which(nchar(newnms) == 9) newnms[j] <- paste0(newnms[j], "0") nms[i] <- newnms } x@pntr <- x@pntr$deepcopy() names(x) <- nms } } success <- x@pntr$write(filename, layer, filetype, insert[1], overwrite[1], options) messages(x, "writeVector") invisible(TRUE) } ) # setMethod("writeVector", signature(x="SpatVectorProxy", filename="character"), # function(x, filename, filetype=NULL, layer=NULL, insert=FALSE, overwrite=FALSE, options="ENCODING=UTF-8") { # filename <- trimws(filename) # filename <- enc2utf8(filename) # if (filename == "") { # error("writeVector", "provide a filename") # } # if (is.null(filetype)) { # filetype <- get_filetype(filename) # } # if (is.null(layer)) layer <- tools::file_path_sans_ext(basename(filename)) # layer <- trimws(layer) # if (is.null(options)) { options <- ""[0] } # if (filetype == "ESRI Shapefile") { # nms <- names(x) # i <- nchar(nms) > 10 # if (any(i)) { # nms[i] <- substr(nms[i], 1, 10) # testnms <- make.unique(nms, sep="") # if (!all(testnms == nms)) { # i <- which(i) # newnms <- substr(nms[i], 1, 9) # newnms <- make.unique(newnms, sep="") # j <- which(nchar(newnms) == 9) # newnms[j] <- paste0(newnms[j], "0") # nms[i] <- newnms # } # x@pntr <- x@pntr$deepcopy() # names(x) <- nms # } # } # success <- x@pntr$write_proxy(filename, layer, filetype, insert[1], FALSE, overwrite[1], options) # messages(x, "writeVector") # invisible(TRUE) # } # ) terra/R/coerce.R0000644000176200001440000004262514747272543013203 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2018 # Version 1.0 # License GPL v3 ## from stars #stars:::st_as_raster is used #setAs("stars", "SpatRaster") is provided by stars via st_as_raster from_stars <- function(from) { isProxy <- inherits(from, "stars_proxy") natts <- length(from) #from[i] recursion does not work with proxy if (!isProxy && (natts > 1)) { # not sure what attributes represent ra <- list() for (i in 1:natts) { ra[[i]] <- from_stars(from[i]) } if (all(sapply(ra, function(i) inherits(i, "SpatRaster")))) { nl <- sapply(ra, nlyr) ra <- rast(ra) nms <- names(ra) names(ra) <- paste(rep(names(from), nl), nms, sep="_") } else if (all(sapply(ra, function(i) inherits(i, "SpatRasterDataset")))) { ra <- do.call(c, ra) } else { ra <- lapply(ra, function(i) if (!inherits(i, "SpatRasterDataset")) {sds(i)} else {i}) ra <- do.call(c, ra) } return(ra) } dims <- attr(from, "dimensions") dd <- dim(from) # x, y hasBands <- "band" %in% names(dd) hasTime <- "time" %in% names(dd) timev <- NULL if (hasTime) { tim <- dims$time$offset tseq <- dims$time$from:dims$time$to if (dims$time$refsys == "Date") { timev <- as.Date(tim) + tseq } else { # for now timev <- tseq } } # no time or variables if (length(dd) - hasBands == 2) { return( methods::as(from, "SpatRaster")) } # time, perhaps bands or variables if (length(dd) - (hasTime + hasBands) == 2) { r <- methods::as(from, "SpatRaster") if (hasBands) { timev <- rep(timev, each=dd["band"]) } time(r) <- timev return(r) } if (isProxy) { # currently not setting time dim here if (natts > 1) { ff <- sapply(from, function(i) from[i][[1]]) s <- sds(ff) names(s) <- names(from) } else { f <- from[[1]] s <- sds(f) nms <- names(dd)[3+hasBands] if (!is.na(nms)) { names(s) <- paste(nms, 1:length(s), sep="-") } } return(s) } xmin <- dims$x$offset nc <- dims$x$to xmax <- xmin + nc * dims$x$delta ymax <- dims$y$offset nr <- dims$y$to ymin <- ymax + nr * dims$y$delta from <- from[[1]] rr <- list() if (hasTime && hasBands) { for (i in 1:dd[5]) { x <- from[,,,,i] r <- rast(ncols=nc, nrows=nr, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, crs=dims$x$refsys$wkt, nlyr=dd["band"] * dd["time"]) time(r) <- rep(timev, each=dd["band"]) bandnames <- rep(paste("band", 1:dd["band"], sep="-"), length(timev)) names(r) <- paste(bandnames, rep(timev, each=dd["band"]), sep="_") r <- setValues(r, as.vector(x)) rr[[i]] <- r } } else { #if (hasTime || hasBands) { for (i in 1:dd[4]) { x <- from[,,,i] r <- rast(ncols=nc, nrows=nr, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, crs=dims$x$refsys$wkt, nlyr=dim(x)[3], time=timev) if (hasBands) { names(r) <- paste("band", 1:dd["band"], sep="-") } else { names(r) <- timev } rr[[i]] <- setValues(r, x) } } s <- sds(rr) names(s) <- paste(names(dd)[4], 1:length(s), sep="-") s } setAs("stars", "SpatRasterDataset", function(from) { from_stars(from) } ) setAs("ggmap", "SpatRaster", function(from) { b <- attr(from, "bb") e <- ext(b$ll.lon, b$ur.lon, b$ll.lat, b$ur.lat) r <- rast(nrows=nrow(from), ncols=ncol(from), ext=e, nlyr=3, crs="epsg:4326", names=c("red", "green", "blue")) values(r) <- t(grDevices::col2rgb(from)) RGB(r) <- 1:3 r } ) as.list.SpatRaster <- function(x, geom=NULL, ...) { if (!is.null(geom)) { e <- as.vector(ext(x)) d <- crs(x, describe=TRUE) if (!(is.na(d$authority) || is.na(d$code))) { crs <- paste0(d$authority, ":", d$code) } else { crs <- gsub("\n[ ]+", "", crs(x)) } list( ncols=ncol(x), nrows=nrow(x), nlyrs=nlyr(x), xmin=e[1], xmax=e[2], ymin=e[3], ymax=e[4], xres=xres(x), yres=yres(x), nms = paste(names(x), collapse="', '"), units = paste(units(x), collapse="', '"), time = paste(time(x), collapse="', '"), crs=crs ) } else { lapply(1:nlyr(x), function(i) x[[i]]) } } setMethod("as.list", signature(x="SpatRaster"), as.list.SpatRaster) as.list.SpatRasterCollection <- function(x, ...) { out <- lapply(1:length(x), function(i) x[i]) names(out) <- names(x) out } setMethod("as.list", signature(x="SpatRasterCollection"), as.list.SpatRasterCollection) as.list.SpatRasterDataset <- function(x, ...) { out <- lapply(1:length(x), function(i) x[i]) names(out) <- names(x) out } setMethod("as.list", signature(x="SpatRasterDataset"), as.list.SpatRasterDataset) as.list.SpatVectorCollection <- function(x, ...) { out <- lapply(1:length(x), function(i) x[i]) names(out) <- names(x) out } setMethod("as.list", signature(x="SpatVectorCollection"), as.list.SpatVectorCollection) # create a "grDevices::raster" (small r) object for use with the rasterImage function # NOT a raster::Raster* object setMethod("as.raster", signature(x="SpatRaster"), function(x, maxcell=500000, col) { if (missing(col)) { #col <- rev(grDevices::terrain.colors(255)) col <- .default.pal() } x <- spatSample(x, maxcell, method="regular", as.raster=TRUE, warn=FALSE) x <- as.matrix(x, wide=TRUE) r <- range(x, na.rm=TRUE) x <- (x - r[1])/ (r[2] - r[1]) x <- round(x * (length(col)-1) + 1) x[] <- col[x] as.raster(x) } ) .as.image <- function(x, maxcells=10000) { x <- spatSample(x, size=maxcells, method="regular", as.raster=TRUE, warn=FALSE) X <- xFromCol(x, 1:ncol(x)) Y <- yFromRow(x, nrow(x):1) Z <- t(as.matrix(x, wide=TRUE)[nrow(x):1,]) list(x=X, y=Y, z=Z) } get_labels <- function(x, p, dissolve=FALSE) { ff <- is.factor(x) if (dissolve) { ff <- ff[[1]] } if (any(ff)) { ff <- which(ff) cgs <- levels(x) for (f in ff) { cg <- cgs[[f]] i <- match(unlist(p[[f]]), cg[,1]) p[[f]] <- cg[i, 2] } } p } setMethod("as.polygons", signature(x="SpatRaster"), function(x, round=TRUE, aggregate=TRUE, values=TRUE, na.rm=TRUE, na.all=FALSE, extent=FALSE, digits=0, ...) { if (isFALSE(list(...)$dissolve)) { aggregate <- FALSE } p <- methods::new("SpatVector") if (extent) { p@pntr <- x@pntr$dense_extent(FALSE, FALSE) x <- messages(x, "as.polygons") } else { opt <- spatOptions() p@pntr <- x@pntr$as_polygons(round[1], aggregate[1], values[1], na.rm[1], na.all[1], digits, opt) x <- messages(x, "as.polygons") if (values) { p <- get_labels(x, p, aggregate[1]) } } messages(p, "as.polygons") } ) setMethod("as.lines", signature(x="SpatRaster"), function(x) { p <- methods::new("SpatVector") opt <- spatOptions() p@pntr <- x@pntr$as_lines(opt) messages(p, "as.lines") } ) setMethod("as.polygons", signature(x="SpatExtent"), function(x, crs="") { p <- methods::new("SpatVector") crs <- character_crs(crs, "as.polygons") p@pntr <- SpatVector$new(x@pntr, crs) messages(p, "as.polygons") } ) setMethod("as.lines", signature(x="SpatExtent"), function(x, crs="") { crs <- character_crs(crs, "as.lines") as.lines(as.polygons(x, crs)) } ) setMethod("as.points", signature(x="SpatExtent"), function(x, crs="") { #vect(do.call(cbind, x@pntr$as.points()), "points", crs=crs) as.points(as.polygons(x, crs)) } ) setMethod("as.lines", signature(x="SpatVector"), function(x) { x@pntr <- x@pntr$as_lines() messages(x, "as.lines") } ) setMethod("as.lines", signature(x="matrix"), function(x, crs="") { p <- vect() if (ncol(x) == 2) { nr <- nrow(x) p@pntr$setGeometry("lines", rep(1, nr), rep(1, nr), x[,1], x[,2], rep(FALSE, nr)) crs(p) <- crs } else if (ncol(x) == 4) { p@pntr$setLinesStartEnd(x, crs(crs)) } else { error("expecting a two or four column matrix", "as.lines") } messages(p, "vect") } ) setMethod("as.polygons", signature(x="SpatVector"), function(x, extent=FALSE) { if (extent) { as.polygons(ext(x), crs=crs(x)) } else { x@pntr <- x@pntr$polygonize() messages(x, "as.polygons") } } ) setMethod("as.points", signature(x="SpatVector"), function(x, multi=FALSE, skiplast=TRUE) { opt <- spatOptions() x@pntr <- x@pntr$as_points(multi, skiplast) messages(x, "as.points") } ) setMethod("as.points", signature(x="SpatRaster"), function(x, values=TRUE, na.rm=TRUE, na.all=FALSE) { p <- methods::new("SpatVector") opt <- spatOptions() p@pntr <- x@pntr$as_points(values, na.rm, na.all, opt) x <- messages(x, "as.points") if (values) { p <- get_labels(x, p, FALSE) } messages(p, "as.points") } ) # mode argument is ignored as mode=mode gave an error on R-devel setMethod("as.vector", signature(x="SpatExtent"), function(x, mode="any") { v <- x@pntr$vector names(v) <- c("xmin", "xmax", "ymin", "ymax") if (mode == "list") { v <- as.list(v) } v } ) setMethod("as.character", signature(x="SpatExtent"), function(x) { e <- as.vector(x) paste0("ext(", paste(e, collapse=", "), ")") } ) setMethod("as.vector", signature(x="SpatRaster"), function(x, mode="any") { values(x, FALSE) } ) as.matrix.SpatRaster <- function(x, wide=FALSE, ...) { if (!hasValues(x)) { error("as.matrix", "SpatRaster has no cell values") } # wide <- isTRUE(list(...)$wide) if (wide) { if (nlyr(x) > 1) { m <- values(x, mat=TRUE) m <- lapply(1:ncol(m), function(i) { matrix(m[,i], nrow=nrow(x), byrow=TRUE) }) m <- do.call(cbind, m) } else { m <- matrix(values(x, mat=FALSE),nrow=nrow(x),byrow=TRUE) } } else { m <- values(x, mat=TRUE) } m } setMethod("as.matrix", signature(x="SpatRaster"), as.matrix.SpatRaster) as.matrix.SpatExtent <- function(x, ...) { v <- matrix(as.vector(x), ncol=2, byrow=TRUE) colnames(v) <- c("min", "max") v } setMethod("as.matrix", signature(x="SpatExtent"), as.matrix.SpatExtent) as.data.frame.SpatRaster <- function(x, row.names=NULL, optional=FALSE, xy=FALSE, cells=FALSE, time=FALSE,na.rm=NA, wide=TRUE, ...) { d <- NULL if (xy) { d <- xyFromCell(x, 1:ncell(x)) } if (cells) { d <- cbind(cell=1:ncell(x), d) } if (is.null(d)) { d <- values(x, dataframe=TRUE, ... ) } else { d <- data.frame(d) d <- cbind(d, values(x, dataframe=TRUE), ...) } if (is.na(na.rm)) { cols <- (1 + cells + xy * 2):ncol(d) i <- rowSums(is.na(d[,cols,drop=FALSE])) < length(cols) d <- d[i,,drop=FALSE] } else if (isTRUE(na.rm)) { d <- stats::na.omit(d) attr(d, "na.action") <- NULL } if (!wide) { nr <- nrow(d) if (!(xy || cells)) { d <- data.frame(layer=rep(names(x), each=nr), values=as.vector(as.matrix(d))) } else { idv <- NULL if (xy) idv <- c("x", "y", idv) if (cells) idv <- c("cell", idv) add <- d[idv] rownames(add) <- NULL for (i in 1:length(idv)) { d[[idv[i]]] <- NULL } d <- data.frame(add, layer=rep(names(x), each=nr), values=as.vector(as.matrix(d))) nms <- names(x) # d <- stats::reshape(d, direction="long", idvar=idv, varying=nms, v.names="values") # d$time <- nms[d$time] # names(d)[names(d) == "time"] <- "layer" } rownames(d) <- NULL if (time) { # d$time <- NULL # vals <- d$values # d$values <- NULL d$time <- rep(time(x), each=nr) # d$values <- vals } } else if (time && has.time(x)) { tm <- as.character(time(x)) nc <- ncol(d) colnames(d)[(1+nc-length(tm)):nc] <- tm } d } setMethod("as.data.frame", signature(x="SpatRaster"), as.data.frame.SpatRaster) setAs("SpatRaster", "data.frame", function(from) { as.data.frame(from) } ) setAs("SpatVector", "data.frame", function(from) { as.data.frame(from) } ) setMethod("as.array", signature(x="SpatRaster"), function(x) { dm <- dim(x) x <- values(x, TRUE) a <- array(NA, dm) for (i in 1:dm[3]) { a[,,i] <- matrix(x[,i], nrow=dm[1], byrow=TRUE) } a } ) setMethod("as.array", signature(x="SpatRasterDataset"), function(x) { n <- length(x) if (n < 2) return(as.array(x[1])) dm <- sapply(x, dim) udm <- apply(dm, 1, function(i)length(unique)) if (!all(udm) == 1) { error("as.array", "cannot make an array from rasters with different dimensions") } a <- array(NA, c(dm[,1], n)) dimnames(a) <- list(NULL, NULL, NULL, names(x)) for (i in 1:n) { a[,,,i] <- as.array(x[i]) } a } ) # to sf from SpatVector # available in sf #.v2sf <- function(from) { # txt <- 'sf::st_as_sf(as.data.frame(from, geom=TRUE), wkt="geometry", crs=from@pntr$get_crs("wkt"))' # eval(parse(text = txt)) #} # sf bbox .ext_from_sf <- function(from) { sfi <- attr(from, "sf_column") geom <- from[[sfi]] e <- attr(geom, "bbox") ext(e[c(1,3,2,4)]) } .from_sf <- function(from, geom, sfi) { crs <- attr(geom, "crs")$wkt if (is.na(crs)) crs <- "" #geom <- st_as_text(geom) #v <- vect(geom, crs=crs) v <- vect() v@pntr <- v@pntr$from_hex(sf::rawToHex(sf::st_as_binary(geom)), crs) v <- messages(v, "SpatVector from sf") if (ncol(from) > 1) { from[[sfi]] <- NULL values(v) <- as.data.frame(from) } v } .svc_from_sf <- function(from) { sfi <- attr(from, "sf_column") geom <- from[[sfi]] crs <- attr(geom, "crs")$wkt if (is.na(crs)) crs <- "" #geom <- st_as_text(geom) #v <- vect(geom, crs=crs) v <- svc() v@pntr <- v@pntr$from_hex_col(sf::rawToHex(sf::st_as_binary(geom)), crs) #if (ncol(from) > 1) { # from[[sfi]] <- NULL # values(v) <- as.data.frame(from) #} v } setAs("sf", "SpatRaster", function(from) { e <- ext(from) rast(e) } ) setAs("sf", "SpatVector", function(from) { sfi <- attr(from, "sf_column") if (is.null("sfi")) { error("as,sf", "the object has no sf_column") } geom <- from[[sfi]] if (inherits(geom, "list")) { error("as,sf", "the geometry column is not valid (perhaps first load the sf package)") } v <- try(.from_sf(from, geom, sfi), silent=FALSE) if (inherits(v, "try-error")) { error("as,sf", "coercion failed. You can try coercing via a Spatial* (sp) class") } v } ) .from_sfc <- function(from) { v <- vect() v@pntr <- v@pntr$from_hex(sf::rawToHex(sf::st_as_binary(from)), "") crs(v, warn=FALSE) <- attr(from, "crs")$wkt v } setAs("sfc", "SpatVector", function(from) { v <- try(.from_sfc(from), silent=TRUE) if (inherits(v, "try-error")) { error("as,sfc", "coercion failed. You can try coercing via a Spatial* (sp) class") } v } ) setAs("sfg", "SpatVector", function(from) { v <- try(.from_sfc(from), silent=TRUE) if (inherits(v, "try-error")) { error("as,sfg", "coercion failed. You can try coercing via a Spatial* (sp) class") } v } ) setAs("XY", "SpatVector", function(from) { v <- try(.from_sfc(from), silent=TRUE) if (inherits(v, "try-error")) { error("as,sfc", "coercion failed. You can try coercing via a Spatial* (sp) class") } v } ) setAs("im", "SpatRaster", function(from) { r <- rast(nrows=from$dim[1], ncols=from$dim[2], xmin=from$xrange[1], xmax=from$xrange[2], ymin=from$yrange[1], ymax=from$yrange[2], crs="") values(r) <- from$v units(r) <- from$units$singular if (from$units$multiplier != 1) { r <- r * from$units$multiplier } flip(r, direction="vertical") } ) setAs("SpatVector", "Spatial", function(from) { hasmethod <- suppressWarnings("geom,data.frame-method" %in% utils::methods("geom")) if (!hasmethod) { error("coerce", "first run 'library(raster)' to coerce a SpatVector to a Spatial object" ) } g <- geom(from, df=TRUE) geom(g, values(from), geomtype(from), as.character(crs(from, proj=TRUE))) } ) geom_SpatialPolygons <- function(x) { nobs <- length(x@polygons) objlist <- vector(mode = "list", length = nobs) for (i in 1:nobs) { nsubobs <- length(x@polygons[[i]]@Polygons) ps <- list() last <- 0 for (j in 1:nsubobs) { if (!x@polygons[[i]]@Polygons[[j]]@hole) { last <- last + 1 hole <- 0 } else { hole <- max(1, last) } ps[[j]] <- cbind(j, x@polygons[[i]]@Polygons[[j]]@coords, hole) } objlist[[i]] <- cbind(i, do.call(rbind, ps)) } do.call(rbind, objlist) } geom_SpatialLines <- function(x) { nobs <- length(x@lines) objlist <- vector(mode = "list", length = nobs) for (i in 1:nobs) { nsubobj <- length(x@lines[[i]]@Lines) ps <- lapply(1:nsubobj, function(j) cbind(j, x@lines[[i]]@Lines[[j]]@coords)) objlist[[i]] <- cbind(i, do.call(rbind, ps)) } do.call(rbind, objlist) } setAs("Spatial", "SpatVector", function(from) { if (inherits(from, "SpatialPolygons")) { g <- geom_SpatialPolygons(from) vtype <- "polygons" } else if (inherits(from, "SpatialLines")) { g <- geom_SpatialLines(from) vtype <- "lines" } else if (inherits(from, "SpatialPoints")) { g <- from@coords[,1:2,drop=FALSE] vtype <- "points" } else { error("coerce", "cannot coerce this object to a SpatVector") } #the below can change the proj-string when going back to sp #crs <- attr(from@proj4string, "comment") #if (is.null(crs)) crs <- from@proj4string@projargs if (methods::.hasSlot(from, "data")) { vect(g, vtype, from@data, crs=crs) } else { vect(g, vtype, crs=crs) } } ) setAs("SpatialGrid", "SpatRaster", function(from){ prj <- attr(from@proj4string, "comment") if (is.null(prj)) prj <- from@proj4string@projargs b <- rast(ext=as.vector(t(from@bbox)), nrow=from@grid@cells.dim[2], ncol=from@grid@cells.dim[1], crs=prj) if (inherits(from, "SpatialGridDataFrame")) { cls <- sapply(from@data, function(i) class(i)[1]) if (all(cls == "numeric")) { nlyr(b) <- ncol(from@data) b <- setValues(b, as.matrix(from@data)) } else { x <- vector(mode="list", length=ncol(from@data)) for (i in 1:ncol(from@data)) { x[[i]] <- setValues(b, from@data[,i]) } b <- rast(x) } names(b) <- colnames(from@data) } else { dim(b) <- c(from@grid@cells.dim[2], from@grid@cells.dim[1]) } b } ) setAs("SpatialPixels", "SpatRaster", function(from){ if (methods::.hasSlot(from, "data")) { as(as(from, "SpatialGridDataFrame"), "SpatRaster") } else { as(as(from, "SpatialGrid"), "SpatRaster") } } ) terra/R/expand.R0000644000176200001440000000257614726700274013215 0ustar liggesusers setMethod("extend", signature(x="SpatExtent"), function(x, y) { if (length(y) == 1) { y <- rep(y, 4) } else if (length(y) == 2) { y <- rep(y, each=2) } else if (! length(y) == 4 ) { error("extend", 'argument "y" should be a vector of 1, 2, or 4 elements') } y <- abs(y) e <- as.vector(x) e[1] <- e[1] - y[1] e[2] <- e[2] + y[2] e[3] <- e[3] - y[3] e[4] <- e[4] + y[4] ext(e) } ) setMethod("extend", signature(x="SpatRaster"), function(x, y, snap="near", fill=NA, filename="", overwrite=FALSE, ...) { if (!inherits(y, "SpatExtent")) { if (is.vector(y)) { stopifnot(all(y >= 0)) rs <- res(x) e <- as.vector(ext(x)) if (length(y) <= 2) { y <- rep_len(round(y), 2) adj <- rev(y) * rs e[1] <- e[1] - adj[1] e[2] <- e[2] + adj[1] e[3] <- e[3] - adj[2] e[4] <- e[4] + adj[2] } else if (length(y) == 4) { e[1] <- e[1] - y[1] * rs[1] e[2] <- e[2] + y[2] * rs[1] e[3] <- e[3] - y[3] * rs[2] e[4] <- e[4] + y[4] * rs[2] } else { error("extend", "if 'y' is a vector it should have 1, 2, or 4 numbers") } y <- ext(e) } else { test <- try ( y <- ext(y), silent=TRUE ) if (inherits(test, "try-error")) { error("extend", "cannot get a SpatExtent object from argument y") } } } opt <- spatOptions(filename, overwrite, ...) x@pntr <- x@pntr$expand(y@pntr, snap[1], fill[1], opt) messages(x, "extend") } ) terra/R/spatvec.R0000644000176200001440000001237614731656575013414 0ustar liggesusers setMethod("geomtype", signature(x="SpatVector"), function(x){ x@pntr$type() } ) setMethod("geomtype", signature(x="SpatVectorProxy"), function(x){ x@pntr$v$type() } ) setMethod("datatype", signature(x="SpatVector"), function(x){ x@pntr$df$get_datatypes() } ) setMethod("is.lines", signature(x="SpatVector"), function(x) { geomtype(x) == "lines" } ) setMethod("is.polygons", signature(x="SpatVector"), function(x) { geomtype(x) == "polygons" } ) setMethod("is.points", signature(x="SpatVector"), function(x) { grepl("points", geomtype(x)) } ) setMethod("geomtype", signature(x="Spatial"), function(x){ type <- sub("spatial", "", as.vector(tolower(class(x)[1]))) type <- sub("dataframe", "", type) if (type %in% c("grid", "pixels")) type <- "raster" type } ) setMethod("geom", signature(x="SpatVector"), function(x, wkt=FALSE, hex=FALSE, wkb=FALSE, df=FALSE, list=FALSE, xnm="x", ynm="y"){ if (hex) { x@pntr$hex() } else if (wkt) { x@pntr$getGeometryWKT() # or via geos with # x@pntr$wkt() } else if (list) { x@pntr$get_geometryList(xnm, ynm) } else if (wkb) { x@pntr$wkb_raw() } else { g <- x@pntr$get_geometry() g <- do.call(cbind, g) colnames(g) <- c("geom", "part", "x", "y", "hole")[1:ncol(g)] if (df) { data.frame(g) } else { g } } } ) setMethod("crds", signature(x="SpatVector"), function(x, df=FALSE, list=FALSE){ if (list) { gt <- geomtype(x) if (gt == "lines") { x@pntr$linesNA() } else if (gt == "polygons") { x@pntr$polygonsList() } else { x@pntr$coordinates() } } else { g <- x@pntr$coordinates() g <- do.call(cbind, g) colnames(g) <- c("x", "y") if (df) { data.frame(g) } else { g } } } ) setMethod("crds", signature(x="SpatRaster"), function(x, df=FALSE, na.rm=TRUE, na.all=FALSE){ # crds( as.points(x, values=(hasValues(x) || (na.rm)), na.rm=na.rm, na.all=na.all), df=df) opt <- spatOptions() out <- x@pntr$crds(na.rm, na.all, opt) messages(x) if (df) { out <- data.frame(out) } else { out <- do.call(cbind, out) } colnames(out) <- c("x", "y") out } ) setMethod("dim", signature(x="SpatVector"), function(x){ c(nrow(x), ncol(x)) } ) setMethod("dim", signature(x="SpatVectorProxy"), function(x){ c(x@pntr$v$geom_count, x@pntr$v$ncol()) } ) as.data.frame.SpatVector <- function(x, row.names=NULL, optional=FALSE, geom=NULL, ...) { d <- .getSpatDF(x@pntr$df, ...) # fix empty names colnames(d)[1:ncol(x)] <- x@pntr$names if (!is.null(geom)) { geom <- match.arg(toupper(geom), c("WKT", "HEX", "XY")) if (geom == "XY") { if (!grepl("points", geomtype(x))) { error("as.data.frame", 'geom="XY" is only valid for point geometries') } if (nrow(d) > 0) { d <- cbind(d, crds(x)) } else { d <- data.frame(crds(x), ...) } } else { g <- geom(x, wkt=geom=="WKT", hex=geom=="HEX") if (nrow(d) > 0) { d$geometry <- g } else { d <- data.frame(geometry=g, stringsAsFactors=FALSE, ...) } } } d } setMethod("as.data.frame", signature(x="SpatVector"), as.data.frame.SpatVector) get.data.frame <- function(x) { v <- vect() v@pntr <- x@pntr$v d <- as.data.frame(v) d[0,,drop=FALSE] } as.list.SpatVector <- function(x, geom=NULL, ...) { as.list(as.data.frame(x, geom=geom)) } setMethod("as.list", signature(x="SpatVector"), as.list.SpatVector) setMethod ("expanse", "SpatVector", function(x, unit="m", transform=TRUE) { a <- x@pntr$area(unit, transform, double()); x <- messages(x, "expanse"); return(abs(a)) } ) setMethod("perim", signature(x="SpatVector"), function(x) { p <- x@pntr$length(); x <- messages(x, "perim"); p } ) setMethod("nseg", signature(x="SpatVector"), function(x) { p <- x@pntr$nsegments(); x <- messages(x, "nseg"); p } ) setMethod("length", signature(x="SpatVector"), function(x) { x@pntr$size() } ) setMethod("fillHoles", signature(x="SpatVector"), function(x, inverse=FALSE) { if (inverse) { x@pntr <- x@pntr$get_holes() } else { x@pntr <- x@pntr$remove_holes() } messages(x, "fillHoles") } ) #setMethod("eliminate", signature(x="SpatVector"), # function(x, y) { # x@pntr <- x@pntr$eliminate(y@pntr) # messages(x) # } #) setMethod("centroids", signature(x="SpatVector"), function(x, inside=FALSE) { if (inside) { x@pntr <- x@pntr$point_on_surface(TRUE) } else { x@pntr <- x@pntr$centroid(TRUE) } messages(x, "centroids") } ) setMethod("densify", signature(x="SpatVector"), function(x, interval, equalize=TRUE, flat=FALSE) { x@pntr <- x@pntr$densify(interval, equalize, flat) messages(x, "densify") } ) setMethod("normalize.longitude", signature(x="SpatVector"), function(x) { if (nrow(x) == 0) return(deepcopy(x)) nc <- ncol(x) fname <- "uuu-_123_uqq_-agg_-id123" x[[fname]] <- 1:nrow(x) d <- values(x) out <- x[,fname] out@pntr <- out@pntr$normalize_longitude() out <- messages(out) a <- aggregate(out, fname, count=FALSE) if (nc > 0) { a <- merge(a, d, by=fname) } a[[fname]] <- NULL a } ) terra/R/values.R0000644000176200001440000003412014746055732013227 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2018 # Version 0.9 # License GPL v3 setMethod("hasValues", signature(x="SpatRaster"), function(x) { x@pntr$hasValues } ) .makeDataFrame <- function(x, v, ...) { v <- data.frame(v, check.names=FALSE, ...) # factors=TRUE, # if (factors) { ff <- is.factor(x) if (any(ff)) { fs <- which(ff) cgs <- levels(x) for (f in fs) { cg <- cgs[[f]] i <- match(v[,f], cg[,1]) if (!inherits(cg[[2]], "numeric")) { v[[f]] <- factor(cg[i, 2], levels=unique(cg[[2]])) } else { v[[f]] <- cg[i, 2] } } } bb <- is.bool(x) if (any(bb)) { for (b in which(bb)) { v[[b]] = as.logical(v[[b]]) } } ii <- (is.int(x) & (!ff) & (substr(datatype(x, TRUE), 1, 4) != "INT8")) if (any(ii)) { for (i in which(ii)) { v[[i]] = as.integer(v[[i]]) } } dd <- !(bb | ii | ff) if (any(dd)) { d <- which(dd) v[,d] <- replace(v[,d], is.na(v[,d]), NA) } v } setMethod("readValues", signature(x="SpatRaster"), function(x, row=1, nrows=nrow(x), col=1, ncols=ncol(x), mat=FALSE, dataframe=FALSE, ...) { stopifnot(row > 0 && nrows > 0) stopifnot(col > 0 && ncols > 0) v <- x@pntr$readValues(row-1, nrows, col-1, ncols) messages(x, "readValues") if (dataframe) { v <- matrix(v, ncol = nlyr(x)) colnames(v) <- names(x) return(.makeDataFrame(x, v, ...) ) } else if (mat) { if (all(is.int(x))) { v <- matrix(as.integer(v), ncol = nlyr(x)) } else if (all(is.bool(x))) { v <- matrix(as.logical(v), ncol = nlyr(x)) } else { v <- matrix(v, ncol = nlyr(x)) } colnames(v) <- names(x) } else if (all(is.int(x))) { v <- as.integer(v) } else if (all(is.bool(x))) { v <- as.logical(v) } v } ) setMethod("readValues", signature(x="SpatRasterDataset"), function(x, row=1, nrows=nrow(x), col=1, ncols=ncol(x), mat=FALSE, dataframe=FALSE, ...) { lapply(1:length(x), function(i) readValues(x[i], row, nrows, 1, ncols, mat=mat, dataframe=dataframe, ...)) } ) setMethod("values", signature(x="SpatRaster"), function(x, mat=TRUE, dataframe=FALSE, row=1, nrows=nrow(x), col=1, ncols=ncol(x), na.rm=FALSE, ...) { readStart(x) on.exit(readStop(x)) v <- readValues(x, row, nrows, col, ncols, mat=mat, dataframe=dataframe, ...) messages(x, "values") if (na.rm) { if (!is.null(dim(v))) { v[stats::complete.cases(v), , drop=FALSE] } else { v[!is.na(v)] } } else { v } } ) setMethod("values<-", signature("SpatRaster", "ANY"), function(x, value) { setValues(x, value, keepnames=TRUE) } ) setMethod("focalValues", signature("SpatRaster"), function(x, w=3, row=1, nrows=nrow(x), fill=NA) { if (is.matrix(w)) { #m <- as.vector(t(w)) w <- dim(w) } else { w <- rep_len(w, 2) } readStart(x) on.exit(readStop(x)) opt <- spatOptions() m <- matrix(x@pntr$focalValues(w, fill, max(0, row-1), nrows, opt), ncol=prod(w), byrow=TRUE) messages(x, "focalValues") m } ) mtrans <- function(mm, nc) { v <- NULL n <- ncol(mm) / nc for (i in 1:n) { j <- 1:nc + (i-1)*nc v <- c(v, as.vector(t(mm[, j]))) } v } setMethod("setValues", signature("SpatRaster"), function(x, values, keeptime=TRUE, keepunits=TRUE, keepnames=FALSE, props=FALSE) { y <- rast(x, keeptime=keeptime, keepunits=keepunits, props=props) if (is.data.frame(values)) { # needs improvement to deal with mixed data types values <- as.matrix(values) } if (is.matrix(values)) { nl <- nlyr(x) d <- dim(values) if (!all(d == c(ncell(x), nl))) { ncx <- ncol(x) if ((d[1] == nrow(x)) && ((d[2] %% nl*ncx) == 0)) { # raster-shaped matrix if (ncx < d[2]) { values <- mtrans(values, ncx) } else { values <- as.vector(t(values)) } } else if ((d[2] == nl) && (d[1] < ncell(x))) { if (d[1] > 1) warn("setValues", "values were recycled") values <- as.vector(apply(values, 2, function(i) rep_len(i, ncell(x)))) } else { error("setValues","dimensions of the matrix do not match the SpatRaster") } } if (!keepnames) { nms <- colnames(values) if (!is.null(nms)) names(y) <- nms } } else if (is.array(values)) { stopifnot(length(dim(values)) == 3) values <- as.vector(aperm(values, c(2,1,3))) } make_factor <- FALSE set_coltab <- FALSE if (is.character(values)) { if (all(substr(stats::na.omit(values), 1, 1) == "#")) { fv <- as.factor(values) if (length(levels(fv)) <= 256) { values <- as.integer(fv) #-1 fv <- levels(fv) set_coltab <- TRUE } else { fv <- NULL values <- t(grDevices::col2rgb(values)) y <- rast(y, nlyr=3, names=c("red", "green", "blue")) RGB(y) <- 1:3 } } else { values <- as.factor(values) levs <- levels(values) values <- as.integer(values) # -1 not needed anymore? make_factor <- TRUE } } else if (is.factor(values)) { levs <- levels(values) values <- as.integer(values)# - 1 make_factor <- TRUE } if (!(is.numeric(values) || is.integer(values) || is.logical(values))) { error("setValues", "values must be numeric, integer, logical, factor or character") } lv <- length(values) nc <- ncell(y) nl <- nlyr(y) opt <- spatOptions() if (lv == 1) { y@pntr$setValues(values, opt) } else { if (lv > (nc * nl)) { warn("setValues", "values is larger than the size of cells") values <- values[1:(nc*nl)] } else if (lv < (nc * nl)) { warn("setValues", "values were recycled") values <- rep(values, length.out=nc*nl) } y@pntr$setValues(values, opt) } y <- messages(y, "setValues") if (make_factor) { for (i in 1:nlyr(y)) { levs <- data.frame(value=1:length(levs), label=levs) set.cats(y, i, levs) } names(y) <- names(x) } if (set_coltab) { coltab(y) <- fv } else if (is.logical(values)) { if (!all(is.na(values))) y@pntr$setValueType(3) } else if (is.integer(values)) { y@pntr$setValueType(1) } y } ) setMethod("inMemory", signature(x="SpatRaster"), function(x, bylayer=FALSE) { r <- x@pntr$inMemory if (bylayer) { nl <- .nlyrBySource(x) r <- rep(r, nl) } r } ) #..hasValues <- function(x) { x@pntr$hasValues} #..inMemory <- function(x) { x@pntr$inMemory } #..filenames <- function(x) { x@pntr$filenames } subsetSource <- function(x, i) { x@pntr <- x@pntr$subsetSource(i-1) messages(x) } setMethod("sources", signature(x="SpatRaster"), function(x, nlyr=FALSE, bands=FALSE) { src <- x@pntr$filenames() Encoding(src) <- "UTF-8" if (bands) { nls <- x@pntr$nlyrBySource() d <- data.frame(sid=rep(1:length(src), nls), source=rep(src, nls), bands=x@pntr$getBands()+1, stringsAsFactors=FALSE) if (nlyr) { d$nlyr <- rep(nls, nls) } d } else if (nlyr) { data.frame(source=src, nlyr=x@pntr$nlyrBySource(), stringsAsFactors=FALSE) } else { src } } ) setMethod("sources", signature(x="SpatRasterCollection"), function(x, nlyr=FALSE, bands=FALSE) { if (nlyr | bands) { x <- lapply(x, function(i) sources(i, nlyr, bands)) x <- lapply(1:length(x), function(i) cbind(cid=i, x[[i]])) do.call(rbind, x) } else { sapply(x, sources) } } ) setMethod("sources", signature(x="SpatRasterDataset"), function(x, nlyr=FALSE, bands=FALSE) { if (nlyr | bands) { x <- lapply(x, function(i) sources(i, nlyr, bands)) x <- lapply(1:length(x), function(i) cbind(cid=i, x[[i]])) do.call(rbind, x) } else { x@pntr$filenames() } } ) setMethod("sources", signature(x="SpatVector"), function(x) { if (x@pntr$source != "") { if (x@pntr$layer != tools::file_path_sans_ext(basename(x@pntr$source))) { paste0(x@pntr$source, "::", x@pntr$layer) } else { x@pntr$source } } else { "" } } ) setMethod("sources", signature(x="SpatVectorProxy"), function(x) { if (x@pntr$v$layer != tools::file_path_sans_ext(basename(x@pntr$v$source))) { paste0(x@pntr$v$source, "::", x@pntr$v$layer) } else { x@pntr$v$source } } ) setMethod("hasMinMax", signature(x="SpatRaster"), function(x) { x@pntr$hasRange } ) setMethod("minmax", signature(x="SpatRaster"), function(x, compute=FALSE) { have <- x@pntr$hasRange if (!all(have)) { if (compute) { opt <- spatOptions() x@pntr$setRange(opt, FALSE) } else { warn("minmax", "min and max values not available for all layers. See 'setMinMax' or 'global'") } } r <- rbind(x@pntr$range_min, x@pntr$range_max) if (!compute) { r[,!have] <- c(Inf, -Inf) } colnames(r) <- names(x) rownames(r) <- c("min", "max") r } ) setMethod("setMinMax", signature(x="SpatRaster"), function(x, force=FALSE) { opt <- spatOptions() if (force) { x@pntr$setRange(opt, TRUE) } else if (!all(hasMinMax(x))) { x@pntr$setRange(opt, FALSE) } x <- messages(x, "setMinMax") } ) setMethod("compareGeom", signature(x="SpatRaster", y="SpatRaster"), function(x, y, ..., lyrs=FALSE, crs=TRUE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE, stopOnError=TRUE, messages=FALSE) { opt <- spatOptions("") out <- x@pntr$compare_geom(y@pntr, lyrs, crs, opt$tolerance, warncrs, ext, rowcol, res) if (stopOnError) { messages(x, "compareGeom") } else { m <- NULL if (x@pntr$has_warning()) { m <- x@pntr$getWarnings() } if (x@pntr$has_error()) { m <- c(m, x@pntr$getError()) } if (!is.null(m) && messages) { message(paste(m, collapse="\n")) } } dots <- list(...) if (length(dots) > 0) { for (i in 1:length(dots)) { if (!inherits(dots[[i]], "SpatRaster")) { error("compareGeom", "all additional arguments must be a SpatRaster") } out <- out & compareGeom(x, dots[[i]], lyrs=lyrs, crs=crs, warncrs=warncrs, ext=ext, rowcol=rowcol, res=res, stopOnError=stopOnError, messages=messages) } } out } ) setMethod("compareGeom", signature(x="SpatRaster", y="list"), function(x, y, ..., lyrs=FALSE, crs=TRUE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE, stopOnError=TRUE, messages=FALSE) { dots <- list(...) if (length(dots) > 0) { y <- c(y, dots) } isr <- sapply(y, inherits, "SpatRaster") if (!all(isr)) { y <- y[isr] if (length(y) == 0) error("compareGeom", "none of the elements of y is a SpatRaster") n <- sum(!isr) if (n > 1) { warn("compareGeom", paste(n, "elements of y are not a SpatRaster")) } else { warn("compareGeom", paste("1 element of y is not a SpatRaster")) } } out <- sapply(y, compareGeom, y=x, lyrs=lyrs, crs=crs, warncrs=warncrs, ext=ext, rowcol=rowcol, res=res, stopOnError=stopOnError, messages=messages) if (!all(isr)) { res <- rep(NA, length(isr)) res[isr] <- out return(res) } all(out) } ) setMethod("compareGeom", signature(x="SpatRasterCollection", y="missing"), function(x, y, ..., lyrs=FALSE, crs=TRUE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE, stopOnError=FALSE, messages=FALSE) { x <- as.list(x) dots <- list(...) if (length(dots) > 0) { error("compareGeom", "when x is a SpatRasterCollection, additional arguments are ignored") } if (length(x) == 1) return(TRUE) out <- sapply(x[-1], compareGeom, y=x[1], lyrs=lyrs, crs=crs, warncrs=warncrs, ext=ext, rowcol=rowcol, res=res, stopOnError=stopOnError, messages=messages) out } ) setMethod("compareGeom", signature(x="SpatRaster", y="SpatRasterCollection"), function(x, y, ..., lyrs=FALSE, crs=TRUE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE, stopOnError=FALSE, messages=FALSE) { dots <- list(...) if (length(dots) > 0) { error("compareGeom", "when y is a SpatRasterCollection, additional arguments are ignored") } out <- sapply(as.list(y), compareGeom, y=x, lyrs=lyrs, crs=crs, warncrs=warncrs, ext=ext, rowcol=rowcol, res=res, stopOnError=stopOnError, messages=messages) all(out) } ) setMethod("compareGeom", signature(x="SpatVector", y="SpatVector"), function(x, y, tolerance=0) { out <- x@pntr$equals_between(y@pntr, tolerance) x <- messages(x, "compareGeom") out[out == 2] <- NA matrix(as.logical(out), nrow=nrow(x), byrow=TRUE) } ) setMethod("compareGeom", signature(x="SpatVector", y="missing"), function(x, y, tolerance=0) { symmetrical=FALSE # this is inefficient out <- x@pntr$equals_within(symmetrical, tolerance) x <- messages(x, "compareGeom") out[out == 2] <- NA out <- matrix(as.logical(out), nrow=nrow(x), byrow=TRUE) out } ) setMethod("all.equal", signature(target="SpatRaster", current="SpatRaster"), function(target, current, maxcell=100000, ...) { a <- base::all.equal(rast(target), rast(current)) maxcell <- round(maxcell) if (isTRUE(a) && maxcell > 0) { hvT <- hasValues(target) hvC <- hasValues(current) if (hvT && hvC) { if (maxcell < ncell(target)) { warn(paste("all.equal", "taking a sample of ", maxcell, "cells")) s1 <- spatSample(current, maxcell, "regular") s2 <- spatSample(target, maxcell, "regular") } else { s1 <- values(current) s2 <- values(target) } a <- all.equal(s1, s2, ...) } else if (hvT || hvC) { if (hvT) { a <- "target has cell values, current does not" } else { a <- "current has cell values, target does not" } } } a } ) setMethod("identical", signature(x="SpatRaster", y="SpatRaster"), function(x, y) { a <- isTRUE(all.equal(x, y, maxcell=0)) if (a && hasValues(x)) { v <- unique(unlist(unique(x - y) )) a <- identical(v, 0) } a } ) setMethod("values", signature("SpatVector"), function(x, ...) { as.data.frame(x, ...) } ) setMethod("values<-", signature("SpatVector", "data.frame"), function(x, value) { x@pntr <- x@pntr$deepcopy() if (ncol(value) == 0) { x@pntr$remove_df() return(x) } value <- .makeSpatDF(value) x@pntr$set_df(value) messages(x) } ) setMethod("values<-", signature("SpatVector", "matrix"), function(x, value) { `values<-`(x, data.frame(value)) } ) setMethod("values<-", signature("SpatVector", "ANY"), function(x, value) { if (!is.vector(value)) { error("values<-", "the values must be a data.frame, matrix or vector") } value <- rep(value, length.out=nrow(x)) value <- data.frame(value=value) `values<-`(x, data.frame(value)) } ) setMethod("values<-", signature("SpatVector", "NULL"), function(x, value) { x@pntr <- x@pntr$deepcopy() x@pntr$remove_df() x } ) setMethod("setValues", signature("SpatVector"), function(x, values) { x@pntr <- x@pntr$deepcopy() `values<-`(x, values) } ) terra/R/options.R0000644000176200001440000001230414753274500013415 0ustar liggesusers .terra_environment <- new.env(parent=emptyenv()) .create_options <- function() { opt <- methods::new("SpatOptions") opt@pntr <- SpatOptions$new() # check=T does not exist in ancient R tmpdir <- try(tempdir(check = TRUE), silent=TRUE) opt@pntr$tempdir <- normalizePath(tempdir(), winslash="/") .terra_environment$options <- opt .terra_environment$devs <- NULL .terra_environment$RStudio_warned <- FALSE x <- options("terra_default")[[1]] if (!is.null(x)) { do.call(terraOptions, x) } } .option_names <- function() { c("progress", "progressbar", "tempdir", "memfrac", "memmax", "memmin", "datatype", "filetype", "filenames", "overwrite", "todisk", "names", "verbose", "NAflag", "statistics", "steps", "ncopies", "tolerance", "tmpfile", "threads", "scale", "offset") #, "append") } .setOptions <- function(x, wopt) { nms <- names(wopt) g <- which(nms == "gdal") if (length(g) > 0) { gopt <- unlist(wopt[g]) wopt <- wopt[-g] nms <- nms[-g] i <- grep("=", gopt) gopt <- gopt[i] gopt <- gsub(" ", "", gopt) x$gdal_options <- gopt } s <- nms %in% .option_names() if (any(!s)) { bad <- paste(nms[!s], collapse=",") error("write", "unknown option(s): ", bad) } if (any(s)) { nms <- nms[s] wopt <- wopt[s] i <- which(nms == "names") if (length(i) > 0) { namevs <- trimws(unlist(strsplit(as.character(wopt[[i]]), ","))) x[["names"]] <- namevs wopt <- wopt[-i] nms <- nms[-i] } if ("tempdir" %in% nms) { i <- which(nms == "tempdir") if (!dir.exists(wopt[[i]])) { warn("options", "you cannot set the tempdir to a path that does not exist") wopt <- wopt[-i] nms <- nms[-i] } } for (i in seq_along(nms)) { x[[nms[i]]] <- wopt[[i]] } } if (x$has_warning()) { warn("options", paste(x$getWarnings(), collapse="\n")) } if (x$has_error()) { error("options", x$getError()) } x } defaultOptions <- function() { ## work around onLoad problem if (is.null(.terra_environment$options)) .create_options() .terra_environment$options@pntr$deepcopy() } spatOptions <- function(filename="", overwrite=FALSE, ..., wopt=NULL) { wopt <- c(list(...), wopt) ## work around onLoad problem if (is.null(.terra_environment$options)) .create_options() opt <- .terra_environment$options@pntr$deepcopy() opt$tmpfile <- paste0(gsub("^file", "", basename(tempfile())), "_", Sys.getpid()) filename <- .fullFilename(filename, mustExist=TRUE) if (!is.null(unlist(wopt))) { wopt$filenames <- filename wopt$overwrite <- overwrite[1] opt <- .setOptions(opt, wopt) } else { opt$filenames <- filename opt$overwrite <- overwrite[1] } #messages(opt) #opt$todisk <- TRUE opt } #..getOptions <- function() { # spatOptions("", TRUE, list()) #} #..showOptions <- function(opt) { # cat("Options for package 'terra'\n") # cat("memfrac :" , opt$memfrac, "\n") # cat("tempdir :" , opt$tempdir, "\n") # cat("datatype :" , opt$def_datatype, "\n") # cat("filetype :" , opt$def_filetype, "\n") # cat("progress :" , opt$progress, "\n") # cat("verbose :" , opt$verbose, "\n") # if (opt$todisk) { # cat("todisk :" , opt$todisk, "\n") # } #} .getOptions <- function() { opt <- spatOptions() nms <- names(opt) nms <- nms[!grepl("^\\.", nms)] nms <- nms[!(nms %in% c("initialize", "messages", "getClass", "finalize", "datatype_set", "tmpfile", "statistics", "gdal_options", "scale", "offset", "threads", "filenames", "NAflag"))] defnms <- grepl("^def_", nms) nms <- nms[!defnms] out <- sapply(nms, function(n) eval(parse(text=paste0("opt$", n)))) out$memmin <- 8 * out$memmin / (1024^3) if (out$memmax > 0) { out$memmax <- 8 * out$memmax / (1024^3) } out } .showOptions <- function(opt, print=TRUE) { out <- .getOptions() if (!print) return(out) nms <- c("memfrac", "tempdir", "datatype", "progress", "todisk", "verbose", "tolerance", "memmin", "memmax") p <- out[names(out) %in% nms] if (p$memmax <= 0) p$memmax <- NULL nms <- names(p) for (i in seq_along(nms)) { cat(paste0(substr(paste(nms[i], " "), 1, 10), ": ", p[i], "\n")) } invisible(out) } .default_option_names <- function() { c("datatype", "filetype") #, "verbose") } terraOptions <- function(..., print=TRUE) { dots <- list(...) if (is.null(.terra_environment$options)) .create_options() opt <- .terra_environment$options@pntr nms <- names(dots) if (length(dots) == 0) { return(.showOptions(opt, print=print)) } ok <- nms %in% .option_names() if (any(!ok)) { bad <- paste(nms[!ok], collapse=", ") warn("terraOptions<-", paste("unknown option(s):", bad)) dots <- dots[ok] nms <- nms[ok] if (length(dots) == 0) return(invisible()) } if ("tempdir" %in% nms) { i <- which(nms == "tempdir") dots[i] <- path.expand(trimws(dots[i])) if (!dir.exists(dots[[i]])) { warn("options", "you cannot set the tempdir to a path that does not exist") dots <- dots[-i] nms <- nms[-i] if (length(dots) == 0) return(invisible()) } } d <- nms %in% .default_option_names() dnms <- paste0("def_", nms) for (i in 1:length(nms)) { if (d[i]) { opt[[ dnms[i] ]] <- dots[[ i ]] } else { opt[[ nms[i] ]] <- dots[[ i ]] } } if ("memfrac" %in% nms) { if (dots$memfrac > 0.9) { warn("terraOptions", "memfrac > 0.9") } } .terra_environment$options@pntr <- opt } terra/R/Arith_generics.R0000644000176200001440000004246514726700273014664 0ustar liggesusers# Author: Robert J. Hijmans # Date : September 2018 # Version 1.0 # License GPL v3 setMethod("Arith", signature(e1="SpatExtent", e2="numeric"), function(e1, e2){ oper <- as.vector(.Generic)[1] if (oper == "%%") { e1@pntr <- e1@pntr$align(e2[1], "") } else if (oper == "+") { e2 <- rep_len(e2, 4) e2[c(1,3)] <- -e2[c(1,3)] e1 <- ext(as.vector(e1) + e2) } else if (oper == "-") { e2 <- rep_len(e2, 4) e2[c(1,3)] <- -e2[c(1,3)] e1 <- ext(as.vector(e1) - e2) } else if (oper == "*") { e2 <- abs(rep_len(e2, 4)) e1 <- as.vector(e1) dx <- (e1[2] - e1[1]) dy <- (e1[4] - e1[3]) mx <- e1[1] + dx/2 my <- e1[3] + dy/2 e1[1] <- mx - (dx/2)*e2[1] e1[2] <- mx + (dx/2)*e2[2] e1[3] <- my - (dy/2)*e2[3] e1[4] <- my + (dy/2)*e2[4] e1 <- ext(e1) } else if (oper == "/") { e2 <- abs(rep_len(e2, 4)) e1 <- as.vector(e1) dx <- (e1[2] - e1[1]) dy <- (e1[4] - e1[3]) mx <- e1[1] + dx/2 my <- e1[3] + dy/2 e1[1] <- mx - dx/(2*e2[1]) e1[2] <- mx + dx/(2*e2[2]) e1[3] <- my - dy/(2*e2[3]) e1[4] <- my + dy/(2*e2[4]) e1 <- ext(e1) } else { error(oper, "only +, -, *, / and %% are supported") } if (!is.valid(e1)) { error(oper, "this would create an invalid extent") } e1 } ) setMethod("Arith", signature(e1="numeric", e2="SpatExtent"), function(e1, e2) { oper <- as.vector(.Generic)[1] if (oper == "%%") { error("%%", "only 'Spatextent %% numeric' (in that order) is supported") } else if (oper == "+") { return(e2 + e1) } else if (oper == "-") { error("-", "only 'Spatextent - numeric' (in that order) is supported") } else if (oper == "*") { return(e2 * e1) } else if (oper == "/") { error("/", "only 'Spatextent / numeric' (in that order) is supported") } else { error(oper, "only +, -, *, / and %% are supported") } if (!is.valid(e1)) { error(oper, "this would create an invalid extent") } e1 } ) setMethod("Arith", signature(e1="SpatExtent", e2="SpatExtent"), function(e1, e2){ oper <- as.vector(.Generic)[1] if (oper == "+") { e1@pntr <- e1@pntr$deepcopy() e1@pntr$union(e2@pntr) } else if (oper == "*") { e1@pntr <- e1@pntr$intersect(e2@pntr) } else if (oper == "/") { d <- c(diff(e1[1:2]) / diff(e2[1:2]), diff(e1[3:4]) / diff(e2[3:4])) names(d) <- c("x", "y") return(d) } else { error(oper, "only +, *, and / are supported for SpatExtent") } if (!is.valid(e1)) { error(oper, "this would create an invalid extent") } e1 } ) setMethod("Arith", signature(e1="SpatVector", e2="SpatVector"), function(e1, e2){ oper <- as.vector(.Generic)[1] if (geomtype(e1) != geomtype(e2)) { error(oper, "geometry types do not match") } if (oper == "+") { e1 <- union(e1, e2) } else if (oper == "*") { e1 <- intersect(e1, e2) } else if (oper == "-") { e1 <- erase(e1, e2) } else { error(oper, "only operators +, *, and - are supported for SpatVector") } messages(e1, oper) } ) setMethod("Arith", signature(e1="SpatRaster", e2="SpatRaster"), function(e1, e2){ opt <- spatOptions() oper <- as.vector(.Generic)[1] e1@pntr <- e1@pntr$arith_rast(e2@pntr, oper, FALSE, opt) messages(e1, oper) } ) setMethod("Arith", signature(e1="SpatRaster", e2="numeric"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e1@pntr <- e1@pntr$arith_numb(e2, oper, FALSE, FALSE, opt) messages(e1, oper) } ) setMethod("Arith", signature(e1="SpatRaster", e2="logical"), function(e1, e2){ methods::callGeneric(e1, as.integer(e2)) } ) setMethod("Arith", signature(e1="SpatRaster", e2="missing"), function(e1, e2){ methods::callGeneric(0, e1) } ) setMethod("Arith", signature(e1="numeric", e2="SpatRaster"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e2@pntr <- e2@pntr$arith_numb(e1, oper, TRUE, FALSE, opt) messages(e2, oper) } ) setMethod("Arith", signature(e1="logical", e2="SpatRaster"), function(e1, e2){ methods::callGeneric(as.integer(e1), e2) } ) setMethod("Arith", signature(e1="SpatRaster", e2="matrix"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e1@pntr <- e1@pntr$arith_m(as.vector(e2), oper, dim(e2)[1:2], FALSE, opt) messages(e1, oper) } ) setMethod("Arith", signature(e1="matrix", e2="SpatRaster"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e1@pntr <- e1@pntr$arith_m(as.vector(e2), oper, dim(e2)[1:2], TRUE, opt) messages(e1, oper) } ) setMethod("Compare", signature(e1="SpatRaster", e2="SpatRaster"), function(e1, e2){ opt <- spatOptions() oper <- as.vector(.Generic)[1] e1@pntr <- e1@pntr$arith_rast(e2@pntr, oper, FALSE, opt) messages(e1, oper) } ) setMethod("Compare", signature(e1="SpatRaster", e2="numeric"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e1@pntr <- e1@pntr$arith_numb(e2, oper, FALSE, FALSE, opt) messages(e1, oper) } ) setMethod("Compare", signature(e1="numeric", e2="SpatRaster"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e2@pntr <- e2@pntr$arith_numb(e1, oper, TRUE, FALSE, opt) messages(e2, oper) } ) setMethod("Compare", signature(e1="SpatRaster", e2="matrix"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e1@pntr <- e1@pntr$arith_m(as.vector(e2), oper, dim(e2)[1:2], FALSE, opt) messages(e1, oper) } ) setMethod("Compare", signature(e1="matrix", e2="SpatRaster"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e1@pntr <- e1@pntr$arith_m(as.vector(e2), oper, dim(e2)[1:2], TRUE, opt) messages(e1, oper) } ) getFactTable <- function(x, table, sender="%in%") { if (!is.factor(x)) { error(sender, "Can only match character values if x is categorical") } if (nlyr(x) != 1) { error(sender, "matching with character values is only supported for single layer SpatRaster") } d <- levels(x)[[1]] m <- stats::na.omit(match(table, d[,2])) if (length(m) == 0) { return(as.logical(x*0)) } d[m,1] } setMethod("Compare", signature(e1="SpatRaster", e2="character"), function(e1, e2){ oper <- as.vector(.Generic)[1] e2 <- getCatIDs(e1, e2, "==") if (oper != "==") { error(oper, "only '==' is supported with categorical comparisons") } if (length(e2) == 0) { return(as.logical(e1*0)) } if (length(e2) != 1) { error(oper, "comparisons only supported for single values (see %in% and match)") } opt <- spatOptions() e1@pntr <- e1@pntr$arith_numb(e2, oper, TRUE, FALSE, opt) messages(e1, oper) } ) setMethod("Logic", signature(e1="SpatRaster", e2="SpatRaster"), function(e1, e2){ oper <- as.vector(.Generic)[1] opt <- spatOptions() e1@pntr <- e1@pntr$logic_rast(e2@pntr, oper, opt) messages(e1, oper) } ) setMethod("Logic", signature(e1="SpatRaster", e2="numeric"), function(e1, e2){ opt <- spatOptions() oper <- as.vector(.Generic)[1] e2 <- as.logical(e2) e1@pntr <- e1@pntr$logic_numb(e2, oper, opt) messages(e1, oper) } ) setMethod("Logic", signature(e1="numeric", e2="SpatRaster"), function(e1, e2){ opt <- spatOptions() oper <- as.vector(.Generic)[1] e1 <- as.logical(e1) e2@pntr <- e2@pntr$logic_numb(e1, oper, opt) messages(e2, oper) } ) setMethod("Logic", signature(e1="SpatRaster", e2="logical"), function(e1, e2){ opt <- spatOptions() oper <- as.vector(.Generic)[1] e1@pntr <- e1@pntr$logic_numb(e2, oper, opt) messages(e1, oper) } ) setMethod("Logic", signature(e1="logical", e2="SpatRaster"), function(e1, e2){ opt <- spatOptions() oper <- as.vector(.Generic)[1] e2@pntr <- e2@pntr$logic_numb(e1, oper, opt) messages(e2, oper) } ) setMethod("!", signature(x="SpatRaster"), function(x) { x == 0 } ) setMethod("not.na", signature(x="SpatRaster"), function(x, falseNA=FALSE, filename="", ...) { opt <- spatOptions(filename=filename, ...) x@pntr <- x@pntr$not_na(falseNA, opt) messages(x, "not.na") } ) setMethod("isTRUE", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$is_true(FALSE, opt) messages(x, "isTRUE") } ) setMethod("isFALSE", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$is_false(FALSE, opt) messages(x, "isFALSE") } ) setMethod("as.logical", signature(x="SpatRaster"), function(x) { isTRUE(x) } ) setMethod("is.bool", signature(x="SpatRaster"), function(x) { x@pntr$valueType(FALSE) == 3 } ) setMethod("is.int", signature(x="SpatRaster"), function(x) { x@pntr$valueType(FALSE) == 1 } ) setMethod("as.bool", signature(x="SpatRaster"), function(x, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$is_true(FALSE, opt) messages(x, "as.boolean") } ) setMethod("as.int", signature(x="SpatRaster"), function(x, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$math("trunc", opt) messages(x, "as.int") } ) setMethod("as.integer", signature(x="SpatRaster"), function(x, filename="", ...) { as.int(x, filename, x) } ) setMethod("is.na", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$isnan(FALSE, opt) messages(x, "is.na") } ) setMethod("countNA", signature(x="SpatRaster"), function(x, n=0) { opt <- spatOptions() n <- round(n) if (n == 1) { x@pntr <- x@pntr$anynan(FALSE, opt) } else { x@pntr <- x@pntr$countnan(n, opt) } messages(x, "countNA") } ) setMethod("anyNA", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$anynan(FALSE, opt) messages(x, "anyNA") } ) setMethod("noNA", signature(x="SpatRaster"), function(x, falseNA=FALSE) { opt <- spatOptions() x@pntr <- x@pntr$nonan(falseNA, opt) messages(x, "noNA") } ) setMethod("allNA", signature(x="SpatRaster"), function(x, falseNA=FALSE) { opt <- spatOptions() x@pntr <- x@pntr$allnan(falseNA, opt) messages(x, "allNA") } ) setMethod("is.nan", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$isnan(FALSE, opt) messages(x, "is.nan") } ) setMethod("is.finite", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$isfinite(FALSE, opt) messages(x, "is.finite") } ) setMethod("is.infinite", signature(x="SpatRaster"), function(x) { opt <- spatOptions() x@pntr <- x@pntr$isinfinite(FALSE, opt) messages(x, "is.infinite") } ) .summarize <- function(x, ..., fun, na.rm=FALSE, filename="", overwrite=FALSE, wopt=list(), par=FALSE) { dots <- list(...) add <- NULL cls <- FALSE if (length(dots) > 0) { cls <- sapply(dots, function(i) inherits(i, "SpatRaster")) if (!all(cls)) { add <- dots[!cls] if (!is.null(names(add))) { error(fun, "additional arguments cannot be names (except for `filename`, `overwrite` and `wopt`)") } i <- sapply(add, function(x) class(x) %in% c("logical", "integer", "numeric")) add <- unlist(add[i], use.names = FALSE) if (any(!i)) { error(fun, "invalid argument(s)") } } } if (any(cls) | par) { x <- sds(c(list(x), dots[cls])) } opt <- spatOptions(filename, overwrite, wopt=wopt) r <- rast() if (is.null(add)) { r@pntr <- x@pntr$summary(fun, na.rm, opt) } else { r@pntr <- x@pntr$summary_numb(fun, add, na.rm, opt) } messages(r, fun) r } setMethod("which.max", "SpatRaster", function(x) { opt <- spatOptions() x@pntr <- x@pntr$summary("which.max", TRUE, opt) messages(x, "which.max") } ) setMethod("which.min", "SpatRaster", function(x) { opt <- spatOptions() x@pntr <- x@pntr$summary("which.min", TRUE, opt) messages(x, "which.min") } ) setMethod("which.lyr", "SpatRaster", function(x) { opt <- spatOptions() x@pntr <- x@pntr$summary("which", TRUE, opt) messages(x, "which.lyr") } ) wherefun <- function(out, list, values) { if (list) { if (values) { lapply(out, function(i) { m <- matrix(i, ncol=2) m[,1] <- m[,1] + 1 colnames(m) <- c("cell", "value") m }) } else { lapply(out, function(i) {i + 1}) } } else { if (values) { out <- lapply(1:length(out), function(i) { m <- matrix(out[[i]], ncol=2) m[,1] <- m[,1] + 1 cbind(i, m) }) out <- do.call(rbind, out) colnames(out) <- c("layer", "cell", "value") } else { out <- lapply(1:length(out), function(i) {cbind(i, out[[i]] + 1)}) out <- do.call(rbind, out) colnames(out) <- c("layer", "cell") } out } } setMethod("where.max", "SpatRaster", function(x, values=TRUE, list=FALSE) { opt <- spatOptions() out <- x@pntr$where("max", values, opt) x <- messages(x, "where.max") wherefun(out, list, values) } ) setMethod("where.min", "SpatRaster", function(x, values=TRUE, list=FALSE) { opt <- spatOptions() out <- x@pntr$where("min", values, opt) x <- messages(x, "where.min") wherefun(out, list, values) } ) setMethod("Summary", signature(x="SpatRaster"), function(x, ..., na.rm=FALSE){ fun <- as.character(sys.call()[[1L]]) .summarize(x, ..., fun=fun, na.rm=na.rm) } ) setMethod("Summary", signature(x="SpatVector"), function(x, ..., na.rm=FALSE){ apply(values(x), 2, sys.call()[[1L]], ...) } ) setMethod("Summary", signature(x="SpatExtent"), function(x, ..., na.rm=FALSE){ e <- as.vector(x) x <- e[1:2] y <- e[3:4] fun <- as.character(sys.call()[[1L]]) if (fun == "range") { r <- c(diff(x), diff(y)) names(r) <- c("x", "y") r } else { c(callGeneric(x), callGeneric(y)) } } ) setMethod("mean", signature(x="SpatExtent"), function(x, ..., trim=NA, na.rm=FALSE){ if (!is.na(trim)) { warn("mean", "argument 'trim' is ignored") } e <- as.vector(x) c(mean(e[1:2]), mean(e[3:4])) } ) setMethod("mean", signature(x="SpatRaster"), function(x, ..., trim=NA, na.rm=FALSE){ if (!is.na(trim)) { warn("mean", "argument 'trim' is ignored") } .summarize(x, ..., fun="mean", na.rm=na.rm) } ) setMethod("mean", signature(x="SpatVector"), function(x, ..., trim=NA, na.rm=FALSE){ if (!is.na(trim)) { warn("mean", "argument 'trim' is ignored") } if (!is.null(list(...))) { warn("mean", "additional arguments are ignored") } colMeans(values(x)) } ) setMethod("median", signature(x="SpatRaster"), function(x, na.rm=FALSE, ...){ if (!is.logical(na.rm)) { error("median", "na.rm (the second argument) must be a logical value") } .summarize(x, ..., fun="median", na.rm=na.rm) } ) setMethod("median", signature(x="SpatVector"), function(x, na.rm=FALSE){ apply(values(x), 2, median, na.rm=na.rm) } ) setMethod("Compare", signature(e1="SpatExtent", e2="SpatExtent"), function(e1, e2){ oper <- as.vector(.Generic)[1] if (!(oper %in% c("==", "!=", ">", "<", ">=", "<="))) { error(oper, "is not implemented for SpatExtent") } return( e1@pntr$compare(e2@pntr, oper, 0.000001) ) } ) setMethod("stdev", signature(x="SpatRaster"), function(x, ..., pop=TRUE, na.rm=FALSE){ if (pop) { .summarize(x, ..., fun="std", na.rm=na.rm) } else { .summarize(x, ..., fun="sd", na.rm=na.rm) } } ) setMethod("modal", signature("SpatRaster"), function(x, ..., ties="first", na.rm=FALSE, filename="", overwrite=FALSE, wopt=list()) { opt <- spatOptions(filename, overwrite, wopt=wopt) dots <- list(...) add <- NULL if (length(dots) > 0) { cls <- sapply(dots, function(i) inherits(i, "SpatRaster")) if (any(cls)) { y <- c(dots[cls], x) x <- do.call(c, y) } if (!all(cls)) { dots <- dots[!cls] i <- sapply(dots, function(x) class(x) %in% c("logical", "integer", "numeric")) add <- unlist(dots[i], use.names = FALSE) } } if (is.null(add)) { add <- c(.5)[0] } x@pntr <- x@pntr$modal(add, ties[1], na.rm[1], opt) messages(x, "modal") } ) setMethod("compare", signature(x="SpatRaster"), function(x, y, oper, falseNA=FALSE, filename="", overwrite=FALSE, ...){ if (!is.character(oper)) { error("compare", "oper must be a character value") } oper = oper[1] ops <- c("==", "!=", ">", "<", ">=", "<=") if (!(oper %in% ops)) { error("compare", "oper must be a one of", ops) } opt <- spatOptions(filename, overwrite, ...) if (inherits(y, "SpatRaster")) { x@pntr <- x@pntr$arith_rast(y@pntr, oper, falseNA[1], opt) } else { x@pntr <- x@pntr$arith_numb(y, oper, FALSE, falseNA[1], opt) } messages(x, oper) } ) setMethod("logic", signature(x="SpatRaster"), function(x, oper, falseNA=FALSE, filename="", overwrite=FALSE, ...){ if (!is.character(oper)) { error("logic", "oper must be a character value") } oper = oper[1] ops <- c("!", "is.na", "allNA", "noNA", "is.infinite", "is.finite", "iSTRUE", "isFALSE") if (!(oper %in% ops)) { error("compare", "oper must be a one of", ops) } opt <- spatOptions(filename, overwrite, ...) falseNA <- as.logical(falseNA[1]) if (oper == "is.infinite") { x@pntr <- x@pntr$isinfinite(falseNA, opt) } else if (oper == "is.finite") { x@pntr <- x@pntr$isfinite(falseNA, opt) } else if (oper == "is.na") { x@pntr <- x@pntr$isnan(falseNA, opt) } else if (oper == "isTRUE") { x@pntr <- x@pntr$is_true(falseNA, opt) } else if (oper == "isFALSE") { x@pntr <- x@pntr$is_false(falseNA, opt) } else if (oper == "allNA") { x@pntr <- x@pntr$allnan(falseNA, opt) } else if (oper == "noNA") { x@pntr <- x@pntr$nonan(falseNA, opt) } else if (oper == "anyNA") { x@pntr <- x@pntr$anynan(falseNA, opt) } else if (oper == "anyNA") { x@pntr <- x@pntr$anynan(falseNA, opt) } else if (oper == "!") { x@pntr <- x@pntr$arith_numb(0, "==", FALSE, falseNA[1], opt) } else { error("logic", "??") } messages(x, "logic") } ) terra/R/plot_cartogram.R0000644000176200001440000000116614536376240014746 0ustar liggesusers setMethod("cartogram", signature(x="SpatVector"), function(x, var, type) { if (geomtype(x) != "polygons") { error("cartogram", "x must be polygons") } type <- match.arg(tolower(type), "nc") stopifnot(var %in% names(x)) v <- as.numeric(as.vector(x[[var, drop=TRUE]])) if (!any(!is.na(v))) stop(paste("no numeric values in", var)) if (any(v <= 0)) stop(paste("non-positive values in", var)) x <- x[!is.na(v)] v <- v[!is.na(v)] f <- v / max(v) cxy <- crds(centroids(x, inside=TRUE)) r <- lapply(1:length(v), function(i) { rescale(x[i,], f[i], x0=cxy[i,1], y0=cxy[i,2]) }) do.call(rbind, r) } ) terra/R/plot_vector.R0000644000176200001440000004622114752530025014263 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2019 # Version 1.0 # License GPL v3 setMethod("dots", signature(x="SpatVector"), function(x, field, size, ...) { reset.clip() n <- length(x) if (n < 1) return(NULL) #method <- match.arg(tolower(method), c("regular", "random")) if (is.character(field)) { stopifnot(field %in% names(x)) } else { stopifnot(field > 0 && field <= ncol(x)) } stopifnot(is.numeric(x[[field,drop=TRUE]])) field <- x[[field,drop=TRUE]] size <- size[1] stopifnot(size > 0) d <- round(field / size) d[d < 1 | is.na(d)] <- 0 i <- d > 0; if (sum(i) == 0) { error("dots", "'size' is too small") } s <- spatSample(x[i], d[i], method="random") if (.Device != "null device") { try(points(s, ...), silent=TRUE) } invisible(s) } ) .plotLines <- function(x, out, lty=1, lwd=1, ...) { n <- nrow(x) if (n == 0) return(out) # cols <- out$cols # if (is.null(cols)) cols = rep("black", n) # g <- lapply(x@pntr$linesList(), function(i) { names(i)=c("x", "y"); i } ) # g <- geom(x, df=TRUE) # g <- split(g, g[,1]) # g <- lapply(g, function(x) split(x[,3:4], x[,2])) # n <- length(g) g <- x@pntr$linesList() lty <- rep_len(lty, n) lwd <- rep_len(lwd, n) for (i in 1:n) { if (!is.null(g[[i]])) { names(g[[i]]) = c("x", "y") graphics::plot.xy(g[[i]], type="l", lty=lty[i], col=out$main_cols[i], lwd=lwd[i], ...) } } # for (i in 1:n) { # for (j in 1:length(g[[i]])) { # lines(g[[i]][[j]], col=out$main_cols[i], lwd=lwd[i], lty=lty[i], ...) # } # } out$leg$lwd <- lwd out$leg$lty <- lty out } .plotPolygons <- function(x, out, lty=1, lwd=1, density=NULL, angle=45, ...) { n <- nrow(x) if (n == 0) return(out) if ((length(out$main_cols) == 0) && (length(out$leg$border) <= 1) && (length(lty) <= 1) && (length(lwd) <= 1) && (is.null(density))) { if (is.null(out$leg$border)) out$leg$border <- "black" lines(x, col=out$leg$border, lty=lty, lwd=lwd, ...) return(out) } # cols <- .getCols(length(x), col, alpha) # out <- list(main_cols=cols) if (!is.null(out$leg$border)) { out$leg$border <- rep_len(out$leg$border, n) } else { out$leg$border <- NA } if (!is.null(density)) { out$leg$density <- rep_len(density, n) out$leg$angle <- rep_len(angle, n) } if (!is.null(lty)) out$leg$lty <- rep_len(lty, n) if (!is.null(lwd)) out$leg$lwd <- rep_len(lwd, n) if (!is.null(out$main_cols)) { out$main_cols <- rep_len(out$main_cols, n) } # g <- geom(x, df=TRUE) # g <- split(g, g[,1]) # g <- lapply(g, function(y) split(y[,3:5], y[,2])) # w <- getOption("warn") # on.exit(options("warn" = w)) # for (i in 1:length(g)) { # gg <- g[[i]] # for (j in 1:length(gg)) { # a <- gg[[j]] # if (any(is.na(a))) next # if (any(a[,3] > 0)) { # a <- split(a[,1:2,drop=FALSE], a[,3]) # a <- lapply(a, function(i) rbind(i, NA)) # a <- do.call(rbind, a ) # a <- a[-nrow(a), ] # # g[[i]][[1]] <- a # } g <- x@pntr$polygonsList() if (is.null(out$leg$density)) { for (i in seq_along(g)) { for (j in seq_along(g[[i]])) { if (any(is.na(g[[i]][[j]]))) next graphics::polypath(g[[i]][[j]][[1]], g[[i]][[j]][[2]], col=out$main_cols[i], rule = "evenodd", border=out$leg$border[i], lwd=out$leg$lwd[i], lty=out$leg$lty[i], ...) } } } else { for (i in 1:length(g)) { for (j in seq_along(g[[i]])) { if (any(is.na(g[[i]][[j]]))) next graphics::polygon(g[[i]][[j]][[1]], g[[i]][[j]][[2]], col=out$main_cols[i], density=out$leg$density[i], angle=out$leg$angle[i], border=NA, lwd=out$leg$lwd[i], lty=out$leg$lty[i], ...) graphics::polypath(g[[i]][[j]][[1]], g[[i]][[j]][[2]], col=NA, rule="evenodd", border=out$leg$border[i], lwd=out$leg$lwd[i], lty=out$leg$lty[i], ...) } } } invisible(out) } .vplot <- function(x, out, xlab="", ylab="", pch=16, lty=1, lwd=1, ...) { if (out$leg$geomtype == "points") { points(x, col=out$main_cols, cex=out$cex, pch=pch, ...) if (is.null(out$leg$pch)) out$leg$pch <- pch if (is.null(out$leg$pt.cex)) out$leg$pt.cex = out$cex } else if (out$leg$geomtype == "polygons") { out <- .plotPolygons(x, out, density=out$leg$density, angle=out$leg$angle, lty=lty, lwd=lwd, ...) } else { # out <- .plotLines(x, out, ...) lines(x, col=out$main_cols, lty=lty, lwd=lwd, ...) if (is.null(out$leg$lwd)) out$leg$lwd = lwd if (is.null(out$leg$lty)) out$leg$lty = lty } out } .getCols <- function(n, cols, alpha=NULL) { if (is.null(cols)) { return(cols) } if (inherits(cols, "function")) { cols <- cols(n) } else { ncols <- length(cols) if (ncols > n) { steps <- ncols/n i <- round(seq(1, ncols, steps)) cols <- cols[i] } else if (ncols < n) { cols <- rep_len(cols, n) } } if (!is.null(alpha)) { if (alpha[1] < 1 && alpha[1] >= 0) { cols <- grDevices::rgb(t(grDevices::col2rgb(cols)), alpha=alpha[1]*255, maxColorValue=255) } } cols } .vect.legend.none <- function(out) { #if (out$leg$geomtype == "points") { # out$main_cols <- .getCols(out$ngeom, out$cols, 1) #} else { # out$cols <- .getCols(out$ngeom, out$cols) #} out$main_cols <- out$cols out } .vect.legend.classes <- function(out) { if (isTRUE(out$legend_sort)) { out$uv <- sort(out$uv, decreasing=out$legend_sort_decreasing) } else { out$uv <- out$uv[!is.na(out$uv)] } ucols <- .getCols(length(out$uv), out$cols, out$alpha) i <- match(out$v, out$uv) out$cols <- ucols out$main_cols <- ucols[i] if (!is.null(out$colNA)) { out$main_cols[is.na(out$main_cols)] <- out$colNA } out$levels <- out$uv out$leg$legend <- out$uv nlevs <- length(out$uv) cols <- out$cols ncols <- length(cols) if (nlevs < ncols) { i <- trunc((ncols / nlevs) * 1:nlevs) cols <- cols[i] } else { cols <- rep_len(cols, nlevs) } out$leg$fill <- cols out$legend_type <- "classes" if (is.null(out$leg$x)) { # && is.null(out$leg$ext)) { out$leg$x <- "default" } out } .vect.legend.continuous <- function(out) { z <- stats::na.omit(out$v) n <- length(z) if (n == 0) error("plot", "no values") if (!is.numeric(out$v)) { out$v <- as.integer(as.factor(out$v)) z <- stats::na.omit(out$v) n <- length(z) } #out$range <- range(z) interval <- (out$range[2]-out$range[1])/(length(out$cols)-1) breaks <- out$range[1] + interval * (0:(length(out$cols)-1)) out$legend_type <- "continuous" if (is.null(out$levels)) { out$levels <- 5 } if (is.null(out$leg$digits)) { dif <- diff(out$range) if (dif == 0) { out$leg$digits <- 0; } else { out$leg$digits <- max(0, -floor(log10(dif/10))) } } if (is.null(out$leg$loc)) out$leg$loc <- "right" brks <- seq(out$range[1], out$range[2], length.out = length(out$cols)) grps <- cut(out$v, breaks = brks, include.lowest = TRUE) out$main_cols <- out$cols[grps] out } .vect.legend.interval <- function(out, dig.lab=3, ...) { nmx <- length(out$uv) if (!is.numeric(out$v)) { out$v <- as.integer(as.factor(out$v)) } if (is.null(out$breaks)) { out$breaks <- min(5, nmx) } if (length(out$breaks) == 1) { out$breaks <- .get_breaks(out$v, out$breaks, out$breakby, out$range) } fz <- cut(out$v, out$breaks, include.lowest=TRUE, right=FALSE, dig.lab=dig.lab) out$vcut <- as.integer(fz) levs <- levels(fz) nlevs <- length(levs) # cols <- out$cols # ncols <- length(cols) # if (nlevs < ncols) { # i <- trunc((ncols / nlevs) * 1:nlevs) # cols <- cols[i] # } else { # cols <- rep_len(cols, nlevs) # } if (out$legend_type == "classes" && nlevs > length(out$cols)) { # more classes than colors: cycle from beginning cols_idx <- rep_len(out$cols, nlevs) } else { # else sample the colors cols_idx <- trunc(seq(1, length(out$cols), length.out = nlevs)) } out$leg$fill <- out$cols <- out$cols[cols_idx] out$legend_type <- "classes" if (!is.null(out$leg$legend)) { if (length(out$leg$legend) != nlevs) { warn("plot", "legend does not match number of levels") out$leg$legend <- rep_len(out$leg$legend, nlevs) } } else { levs <- gsub("]", "", gsub(")", "", gsub("\\[", "", levs))) levs <- paste(levs, collapse=",") m <- matrix(as.numeric(unlist(strsplit(levs, ","))), ncol=2, byrow=TRUE) m <- apply(m, 1, function(i) paste(i, collapse=" - ")) out$leg$legend <- m } if (is.null(out$leg$x)) { # && is.null(out$leg$ext)) { out$leg$x <- "default" } out$main_cols <- out$cols[out$vcut] if (!is.null(out$colNA)) { out$main_cols[is.na(out$main_cols)] <- out$colNA } out } .plot.vect.map <- function(x, out, ...) { if ((!out$add) & (!out$legend_only)) { if (!any(is.na(out$mar))) { graphics::par(mar=out$mar) } plot(out$lim[1:2], out$lim[3:4], type="n", xlab="", ylab="", asp=out$asp, xaxs="i", yaxs="i", axes=FALSE, main="") if (!is.null(out$background)) { graphics::rect(out$lim[1], out$lim[3], out$lim[2], out$lim[4], col=out$background, border=TRUE) } } if (isTRUE(out$blank)) return(out) nuq <- length(out$uv) if (out$legend_type == "none") { out <- .vect.legend.none(out) } else if (out$legend_type == "classes") { out <- .vect.legend.classes(out) } else if (out$legend_type == "interval") { if (nuq < 2) { out <- .vect.legend.classes(out, ...) } else { out <- .vect.legend.interval(out, dig.lab=out$dig.lab) } } else if (out$legend_type == "depends") { if (!is.null(out$breaks)) { out <- .vect.legend.interval(out, dig.lab=out$dig.lab) } else if (nuq < 11) { out <- .vect.legend.classes(out) } else if (!is.numeric(out$uv)) { #if (nuq < 21) out <- .vect.legend.classes(out) } else { out <- .vect.legend.interval(out, dig.lab=out$dig.lab) } } else { if (nuq == 1) { out <- .vect.legend.classes(out) } else { out <- .vect.legend.continuous(out) out$leg$density <- NULL } } if (!out$legend_only) { if (!out$add) { try(set.clip(out$lim, out$lonlat)) } out <- .vplot(x, out, ...) } if (out$axes) { out <- .plot.axes(out) } if (out$legend_draw) { if (out$legend_type == "continuous") { out$legpars <- do.call(.plot.cont.legend, list(x=out)) } else { if (out$add) { if (out$clip) { out$leg$plotlim <- unlist(get.clip()[1:4]) } else { out$leg$plotlim <- graphics::par("usr") } if (is.null(out$leg$plotlim)) { out$leg$plotlim <- out$lim } } else { if (out$clip) { out$leg$plotlim <- out$lim } else { out$leg$plotlim <- graphics::par("usr") } } out$legpars <- do.call(.plot.class.legend, out$leg) } } if (isTRUE(out$box)) { if (out$clip) { lines(ext(out$lim)) } else { lines(ext(graphics::par("usr"))) } } if (out$main != "") { posx <- out$lim[1] + diff(out$lim[1:2])/2 text(posx, out$lim[4], out$main, pos=3, offset=out$line.main, cex=out$cex.main, font=out$font.main, col=out$col.main, xpd=TRUE) } if (!out$add) { try(set.clip(out$lim, out$lonlat)) } out } .prep.vect.data <- function(x, y, type=NULL, cols=NULL, mar=NULL, legend=TRUE, legend.only=FALSE, levels=NULL, add=FALSE, range=NULL, fill_range=FALSE, breaks=NULL, breakby="eqint", xlim=NULL, ylim=NULL, colNA=NA, alpha=NULL, axes=TRUE, buffer=TRUE, background=NULL, pax=list(), plg=list(), ext=NULL, grid=FALSE, las=0, sort=TRUE, decreasing=FALSE, values=NULL, box=TRUE, xlab="", ylab="", cex.lab=0.8, line.lab=1.5, yaxs="i", xaxs="i", main="", cex.main=1.2, line.main=0.5, font.main=graphics::par()$font.main, col.main = graphics::par()$col.main, density=NULL, angle=45, border="black", dig.lab=3, cex=1, clip=TRUE, leg_i=1, asp=NULL, xpd=NULL, ...) { out <- list() out$blank <- FALSE if ((y == "") && (is.null(values))) { if (is.null(type)) type <- "none" if (type == "n") { out$blank <- TRUE } type <- "none" plg <- list() } e <- as.vector(ext(x)) if (any(is.na(e))) { error("plot", "SpatVector has no valid geometries") } if (e[1] == e[2]) { e[1] = e[1] - 0.5 e[2] = e[2] + 0.5 } if (e[3] == e[4]) { e[3] = e[3] - 0.5 e[4] = e[4] + 0.5 } out$lim <- out$ext <- e if ((!is.null(ext)) || (!is.null(xlim)) || (!is.null(ylim))) { if (!is.null(ext)) { ext <- ext(ext) if (!is.null(xlim) | !is.null(ylim)) { x <- crop(x, ext) } else { x <- x[ext, ] } out$ext <- as.vector(ext(x)) out$lim <- as.vector(ext) } if (!is.null(xlim)) { stopifnot(length(xlim) == 2) out$lim[1:2] <- sort(xlim) } if (!is.null(ylim)) { stopifnot(length(ylim) == 2) out$lim[3:4] <- sort(ylim) } } else if ((!add) && is.null(xpd)) { xpd <- TRUE } out$ngeom <- nrow(x) out$clip <- isTRUE(clip) if (buffer) { dx <- diff(out$lim[1:2]) / 50 dy <- diff(out$lim[3:4]) / 50 out$lim[1:2] <- out$lim[1:2] + c(-dx, dx) out$lim[3:4] <- out$lim[3:4] + c(-dy, dy) } out$main <- main if ((!is.expression(main)) && (is.null(out$main) || any(is.na(out$main)))) out$main <- "" out$cex.main <- cex.main out$font.main <- font.main out$col.main <- col.main out$line.main <- line.main out$dig.lab <- dig.lab out$box <- isTRUE(box) out$add <- isTRUE(add) out$axes <- isTRUE(axes) out$xlab <- xlab out$ylab <- ylab out$axs <- as.list(pax) out$cex <- cex if (is.null(out$axs$las)) out$axs$las <- las if (is.null(out$axs$cex.lab)) out$axs$cex.lab <- cex.lab if (is.null(out$axs$line.lab)) out$axs$line.lab <- line.lab out$draw_grid <- isTRUE(grid) out$leg <- as.list(plg) out$leg$geomtype <- geomtype(x) out$leg$density <- density out$leg$angle <- angle out$leg$border <- border if (is.null(asp)) { out$lonlat <- is.lonlat(x, perhaps=TRUE, warn=FALSE) if (out$lonlat) { out$asp <- 1/cos((mean(out$ext[3:4]) * pi)/180) } else { out$asp <- 1 } } else { out$asp <- asp out$lonlat <- FALSE } out$breaks <- breaks out$breakby <- breakby out$background <- background if (is.null(values)) { v <- unlist(x[, y, drop=TRUE], use.names=FALSE) } else { if (inherits(values, "data.frame")) { if (ncol(values) == 2) { xname = names(values)[1] if (xname %in% names(x)) { i <- match(x[[xname,drop=TRUE]], values[[1]]) v <- values[[2]][i] } else { error("plot", paste(xname, "is not a name in x")) } } else { values <- values[[1]] } } else { v <- as.vector(values) } v <- rep_len(v, nrow(x)) } if (is.factor(v)) v <- as.character(v) if (is.numeric(v)) { v[!is.finite(v)] <- NA } if (!is.null(range)) { range <- sort(range) v[v < range[1]] <- NA v[v > range[2]] <- NA if (all(is.na(v))) { v <- NULL y <- "" type = "none" } else { out$range <- range } out$range_set <- TRUE } else { if (!is.null(v)) { out$range <- range(v, na.rm=TRUE) } out$range_set <- FALSE } out$fill_range <- fill_range out$v <- v if (!is.logical(sort)) { out$uv <- unique(sort) out$legend_sort <- FALSE } else { out$uv <- unique(out$v) if (is.factor(out$v)) { out$uv <- levels(out$v)[levels(out$v) %in% out$uv] } out$legend_sort <- isTRUE(sort) out$legend_sort_decreasing <- isTRUE(decreasing) } if (is.null(type)) { type <- "depends" } else { type <- match.arg(type, c("continuous", "classes", "interval", "depends", "none")) } out$levels <- levels if (type=="none") { legend <- FALSE legend_only <- FALSE } out$legend_type <- type if (is.null(cols)) { if (type == "none") { if (out$leg$geomtype %in% c("lines", "points")) { cols <- "black" } } else { cols <- .default.pal() # cols <- rev(grDevices::rainbow(100, start=.1, end=0.9)) } } if (!is.null(alpha)) { alpha <- clamp(alpha[1], 0, 1) cols <- grDevices::rgb(t(grDevices::col2rgb(cols)), alpha=alpha*255, maxColorValue=255) } else { alpha <- 1 } out$alpha <- alpha out$cols <- cols out$legend_draw <- isTRUE(legend) out$legend_only <- isTRUE(legend.only) out$leg$leg_i <- leg_i if (is.null(mar)) { if (out$legend_draw) { mar=c(3.1, 3.1, 2.1, 7.1) } else { mar=c(3.1, 3.1, 2.1, 2.1) } } out$mar <- rep_len(mar, 4) out$skipNA <- TRUE if (!is.null(colNA)) { if (!is.na(colNA)) { out$colNA <- grDevices::rgb(t(grDevices::col2rgb(colNA)), alpha=alpha*255, maxColorValue=255) out$r[is.na(out$r)] <- out$colNA out$skipNA <- FALSE } else { out$colNA <- NULL } } .plot.vect.map(x, out, xpd=xpd, ...) } setMethod("plot", signature(x="SpatVector", y="character"), function(x, y, col=NULL, type=NULL, mar=NULL, add=FALSE, legend=TRUE, axes=!add, main, buffer=TRUE, background=NULL, grid=FALSE, ext=NULL, sort=TRUE, decreasing=FALSE, plg=list(), pax=list(), nr, nc, colNA=NA, alpha=NULL, box=axes, clip=TRUE, ...) { old.mar <- graphics::par()$mar on.exit(graphics::par(mar=old.mar)) if (nrow(x) == 0) { error("plot", "SpatVector has zero geometries") } if (add) reset.clip() y <- trimws(y) if (any(is.na(match(y, c("", names(x)))))) { i <- is.na(match(y, names(x))) error("plot", paste(paste(y[i], collapse=",")), " is not a name in x") } nrnc <- c(1,1) if (length(y) > 1) { nrnc <- .get_nrnc(nr, nc, length(y)) old.par <- graphics::par(no.readonly =TRUE) on.exit(graphics::par(old.par)) graphics::par(mfrow=nrnc) } if (is.character(legend)) { plg$x <- legend legend <- TRUE } for (i in 1:length(y)) { if (length(y) > 1) { if (missing("main")) { main <- y } else { main <- rep_len(main, length(y)) } newrow <- (nrnc[2] == 1) | ((i %% nrnc[2]) == 1) lastrow <- i > (prod(nrnc) - nrnc[2]) if (lastrow) { if (newrow) { pax$side <- 1:2 } else { pax$side <- 1 } } else if (newrow) { pax$side <- 2 } else { pax$side <- 0 } } else if (missing("main")) { main <- "" } if (missing(col)) col <- NULL out <- .prep.vect.data(x, y[i], type=type, cols=col, mar=mar, plg=plg, pax=pax, legend=isTRUE(legend), add=add, axes=axes, main=main[i], buffer=buffer, background=background, grid=grid, ext=ext, sort=sort, decreasing=decreasing, colNA=colNA, alpha=alpha, box=box, clip=clip, leg_i=i, ...) } invisible(out) } ) setMethod("plot", signature(x="SpatVector", y="numeric"), function(x, y, ...) { y <- round(y) if (any(y > ncol(x))) { error("plot", paste("x only has", ncol(x), " columns")) } y[y<0] <- 0 y <- c("", names(x))[y+1] out <- plot(x, y, ...) invisible(out) } ) #setMethod("plot", signature(x="SpatVector", y="data.frame"), # function(x, y, values=NULL, ...) { # out <- plot(x, "", values=y, ...) # invisible(out) # } #) setMethod("plot", signature(x="SpatVector", y="missing"), function(x, y, values=NULL, ...) { invisible( plot(x, "", values=values, ...) ) } ) setMethod("plot", signature(x="SpatVectorProxy", y="missing"), function(x, y, ...) { plot(ext(x), ...) } ) setMethod("plot", signature(x="SpatVectorCollection", y="missing"), function(x, y, main, mar=NULL, nc, nr, maxnl=16, ...) { nl <- max(1, min(length(x), maxnl)) if (nl==1) { if (missing(main)) main = "" out <- plot(x[1], main=main[1], mar=mar, ...) return(invisible(out)) } nrnc <- .get_nrnc(nr, nc, nl) old.par <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(old.par)) if (is.null(mar)) { mar=c(1.5, 1, 2.5, 3) } graphics::par(mfrow=nrnc) if (missing("main")) { main <- names(x) } else { main <- rep_len(main, nl) } for (i in 1:nl) { plot(x[i], main=main[i], mar=mar, ...) } } ) setMethod("plot", signature(x="SpatVectorCollection", y="numeric"), function(x, y, main, mar=NULL, ext=NULL, ...) { y <- round(y) if ((y > 0) && (y <= length(x))) { if (is.null(ext)) ext <- ext(x) plot(x[y], main=main, mar=mar, ext=ext, ...) } else { error("plot", "y should be between 1 and length(x)") } } ) terra/R/update.R0000644000176200001440000000037214735567526013223 0ustar liggesusers setMethod("update", signature(object="SpatRaster"), function(object, crs=FALSE, extent=FALSE) { opt <- spatOptions() names <- FALSE ok <- object@pntr$update_meta(names, crs, extent, opt) messages(object, "update") invisible(object) } ) terra/R/rasterizeWin.R0000644000176200001440000002510214726700274014412 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2022 # Version 1.0 # License GPL v3 check_ngb_pars <- function(algo, pars, fill, caller="rasterizeWin") { #p <- c("Power", "Smoothing", "Radius", "Radius1", "Radius2", "Angle", "nMaxPoints", "nMinPoints") n <- tolower(names(pars)) if (length(n) == 0) error(caller, "parameters are not named") if (algo %in% c("min", "max", "range", "mean", "count", "distto", "distbetween")) { pex <- c("Radius1", "Radius2", "Angle", "MinPoints") } else if (algo == "invdistpow") { pex <- c("Power", "Smoothing", "Radius1", "Radius2", "Angle", "MaxPoints", "MinPoints") } else if (algo == "invdistpownear") { pex <- c("Power", "Smoothing", "Radius", "MaxPoints", "MinPoints") } else if (algo == "nearest") { pex <- c("Radius1", "Radius2", "Angle") } else if (algo == "linear") { pex <- c("Radius") } else { error(caller, "invalid algorithm name") } if (length(n) != length(pex)) error(caller, paste("expected 4 parameters for", algo, "got", length(n))) if (!all(n %in% tolower(pex)))error(caller, paste("parameters needed for", algo, ":\n ", paste(pex, collapse=","))) c(pars[match(n, tolower(pex))], fill) } get_z <- function(y, field, caller="rasterizeWin") { if (inherits(field, "character")) { if (length(field) == 0) { error(caller, "field name missing") } if (!all(field %in% names(y))) { f <- paste(field[!(field %in% names(y))], collapse=", ") error(caller, paste(f, " is not a name in y")) } z <- y[, field, drop=TRUE] #if (any(!sapply(z, is.numeric))) { # error(caller, paste("fields must be numeric")) #} } else { #if (!is.numeric(field)) { # error(caller, paste(field, "is not numeric")) #} z <- data.frame(field=rep_len(field, nrow(y))) } z } get_rad <- function(r, caller="rasterizeWin") { if (length(r) == 1) { c(r, r, 0) } else if (length(r) == 2) { c(r, 0) } else if (length(r) == 3) { r[3] = r[3] %% 360 if (r[3] < 0) r[3] = r[3] + 360; r } else { error(caller, "radius argument should have length 1, 2, or 3") } } rastWinR <- function(x, y, win, pars, fun, nl, cvars, filename, wopt, ...) { out <- rast(x, nlyr=nl) rb <- rast(out) e <- ext(out) hy <- yres(out)/2 opt <- spatOptions() b <- writeStart(out, filename, n=12, sources="", wopt=wopt) if ((ncol(y) == 3) && (is.numeric(y[,3]))) { for (i in 1:b$n) { e$ymax <- yFromRow(out, b$row[i]) + hy e$ymin <- yFromRow(out, b$row[i] + b$nrows[i] - 1) - hy rbe <- crop(rb, e) if (win == "rectangle") { p <- rbe@pntr$winrect(y[,1], y[,2], y[,3], pars, opt) } else { p <- rbe@pntr$wincircle(y[,1], y[,2], y[,3], pars, opt) } if ((pars[4] > 1) && (length(p[[1]]) > 0)) { a <- aggregate(p[[1]], p[1], length) a <- a[a[,2] >= pars[4], 1] a <- p[[1]] %in% a p[[1]] <- p[[1]][a] p[[2]] <- p[[2]][a] } if (length(p[[1]]) > 0) { p <- aggregate(p[2], p[1], fun, ...) v <- matrix(pars[5], ncell(rbe), nl) v[p[,1]+1, ] <- p[,-1] writeValues(out, v, b$row[i], b$nrows[i]) } else { writeValues(out, rep(pars[5], ncell(rbe) * nl), b$row[i], b$nrows[i]) } } } else { id <- 1:nrow(y) for (i in 1:b$n) { e$ymax <- yFromRow(out, b$row[i]) + hy e$ymin <- yFromRow(out, b$row[i] + b$nrows[i] - 1) - hy rbe <- crop(rb, e) if (win == "rectangle") { p <- rbe@pntr$winrect(y[,1], y[,2], id, pars, opt) } else { p <- rbe@pntr$wincircle(y[,1], y[,2], id, pars, opt) } if ((pars[4] > 1) && (length(p[[1]]) > 0)) { a <- aggregate(p[[1]], p[1], length) a <- a[a[,2] >= pars[4], 1] a <- p[[1]] %in% a p[[1]] <- p[[1]][a] p[[2]] <- p[[2]][a] } if (length(p[[1]]) > 0) { py <- y[p[[2]],3:ncol(y)] v <- matrix(pars[5], ncell(rbe), nl) if (cvars) { #u <- unique(p[[1]]) #if (usedots) { # p <- sapply(u, function(i) fun(py[p[[1]]==i, ,drop=FALSE], ...)) #} else { # p <- sapply(u, function(i) fun(py[p[[1]]==i, ,drop=FALSE])) #} p <- split(py, p[[1]]) p <- sapply(p, fun, ...) if (!is.null(dim(p))) { p <- t(as.matrix(p)) u <- rownames(p) } else { u <- names(p) } u <- as.numeric(u) v[u+1, ] <- p } else { p <- aggregate(py, p[1], fun, ...) v[p[,1]+1, ] <- as.matrix(p[,-1]) } writeValues(out, v, b$row[i], b$nrows[i]) } else { writeValues(out, rep(pars[5], ncell(rbe) * nl), b$row[i], b$nrows[i]) } } } writeStop(out) } rastBufR <- function(x, y, win, pars, fun, nl, cvars, filename, wopt, ...) { w <- pars[1] z <- y[,-c(1:2), drop=FALSE] y <- vect(y[,1:2,drop=FALSE], geom=c("x", "y")) out <- rast(x, nlyr=1) rb <- rast(out) if (!is.lonlat(x)) { ngb <- max(round(w/yres(x)), round(w/xres(x))) if (ngb <= 5) { m <- matrix(1, 2*round(w/yres(x))+1, 2*round(w/xres(x))+1) rb <- rasterize(y, rb) rb <- focal(rb, m, "sum", na.rm=TRUE) } } out <- rast(x, nlyr=nl) ncs <- ncol(out) e <- ext(out) hy <- yres(out)/2 off <- 0 b <- writeStart(out, filename, n=12, sources="", wopt=wopt) for (i in 1:b$n) { e$ymax <- yFromRow(out, b$row[i]) + hy e$ymin <- yFromRow(out, b$row[i] + b$nrows[i] - 1) - hy rbe <- crop(rb, e) buf <- as.polygons(rbe, dissolve=FALSE) buf <- buffer(buf, w) r <- relate(buf, y, "intersects", pairs=TRUE) if ((pars[4] > 1) && (nrow(r) > 0)) { a <- aggregate(r[,1], list(r[,1]), length) a <- a[a[,2] >= pars[4], 1] r <- r[r[,1] %in% a, ] } if (nrow(r) > 0) { v <- matrix(pars[5], ncell(rbe), nl) if ((ncol(z) == 1) || (!cvars)) { f <- aggregate(z[r[,2],,drop=FALSE], list(r[,1]), fun, ...) v[f[,1], ] <- f[,-1] writeValues(out, v, b$row[i], b$nrows[i]) } else { #u <- unique(r[,1]) #p <- z[r[,2], ,drop=FALSE] #if (usedots) { # p <- sapply(u, function(i) fun(p[r[,1]==i, ,drop=FALSE], ...)) #} else { # p <- sapply(u, function(i) fun(p[r[,1]==i, ,drop=FALSE])) #} #if (!is.null(dim(p))) p <- t(p) #v[u, ] <- as.matrix(p) py <- z[r[,2], ,drop=FALSE] s <- split(py, r[,1]) p <- sapply(s, fun, ...) if (!is.null(dim(p))) { p <- t(as.matrix(p)) u <- as.numeric(rownames(p)) } else { u <- as.numeric(names(p)) } v[u, ] <- p writeValues(out, v, b$row[i], b$nrows[i]) } } else { writeValues(out, rep(pars[5], ncell(rbe) * nl), b$row[i], b$nrows[i]) } } writeStop(out) } setMethod("rasterizeWin", signature(x="data.frame", y="SpatRaster"), function(x, y, win="circle", pars, fun, ..., cvars=FALSE, minPoints=1, fill=NA, filename="", wopt=list()) { pars <- c(get_rad(pars), minPoints[1], fill[1]) if (ncol(x) < 3) { error("rasterizeNGB", "expecting a matrix with at least three columns") } win <- match.arg(tolower(win), c("circle", "ellipse", "rectangle", "buffer")) # usedots <- length(list(...)) > 0 if (ncol(x) == 3) cvars = FALSE if (inherits(fun, "character")) { if (fun[1] == "count") { fun <- length pars[5] = 0 } nl <- ncol(x)-2 } else { if (cvars) { i <- min(10, nrow(x)) v <- x[1:i, -c(1:2)] test <- sapply(list(v), fun, ...) nl <- length(test) } else { test <- sapply(list(1:5), fun, ...) nl <- length(test) * (ncol(x)-2) } } if (win == "buffer") { rastBufR(y, x, win, pars=pars, fun=fun, nl=nl, cvars=cvars, filename=filename, wopt=wopt, ...) } else { if (win == "circle") { pars[2] = pars[1] pars[3] = 0; } algo <- .makeTextFun(fun) #algos <- c("min", "max", "range", "mean", "count", "distto", "distbetween") algos <- c("distto", "distbetween") builtin <- FALSE if (inherits(algo, "character") && (algo %in% algos)) { if (win == "rectangle") { error("rasterizeWin", paste(fun, "not yet available for 'win=rectangle'")) } else { opt <- spatOptions(filename, wopt=wopt) x@pntr <- x@pntr$rasterizeWindow(x[,1], x[,2], x[,3], algo, pars, opt) return(messages(x, "rasterizeWin")) } } rastWinR(x=y, y=x, win=win, pars=pars, fun=fun, nl=nl, cvars=cvars, filename=filename, wopt=wopt, ...) } } ) setMethod("rasterizeWin", signature(x="SpatVector", y="SpatRaster"), function(x, y, field, win="circle", pars, fun, ..., cvars=FALSE, minPoints=1, fill=NA, filename="", wopt=list()) { if (geomtype(x) != "points") { error("rasterizeWin", "SpatVector y must have a point geometry") } x <- cbind(crds(x), get_z(x, field, "rasterizeWin")) rasterizeWin(x, y, win=win, pars=pars, fun=fun, minPoints=minPoints, fill=fill, cvars=cvars, filename=filename, wopt=wopt, ...) } ) setMethod("interpNear", signature(x="SpatRaster", y="matrix"), function(x, y, radius, interpolate=FALSE, fill=NA, filename="", ...) { if (ncol(y) != 3) { error("interpNear", "expecting a matrix with three columns") } if (!is.numeric(y)) { error("interpNear", "values must be numeric") } if (interpolate) { algo <- "linear" pars <- c(radius[1], fill) } else { algo <- "nearest" pars <- c(get_rad(radius, "interpNear"), fill) } opt <- spatOptions(filename, ...) x@pntr <- x@pntr$rasterizeWindow(y[,1], y[,2], y[,3], algo, pars, opt) messages(x, "interpNear") } ) setMethod("interpNear", signature(x="SpatRaster", y="SpatVector"), function(x, y, field, radius, interpolate=FALSE, fill=NA, filename="", ...) { if (geomtype(y) != "points") { error("interpNear", "SpatVector y must have a point geometry") } y <- cbind(crds(y), get_z(y, field, "interpNear")) y <- as.matrix(y) interpNear(x, y, radius=radius, interpolate=interpolate, fill=fill, filename=filename, ...) } ) setMethod("interpIDW", signature(x="SpatRaster", y="matrix"), function(x, y, radius, power=2, smooth=0, maxPoints=Inf, minPoints=1, near=TRUE, fill=NA, filename="", ...) { if (ncol(y) != 3) { error("interpIDW", "expecting a matrix with three columns") } if (!is.numeric(y)) { error("interpIDW", "values must be numeric") } if (near) { algo <- "invdistpownear" pars <- c(power, smooth, radius[1], maxPoints, minPoints, fill) } else { algo <- "invdistpow" pars <- c(power, smooth, get_rad(radius, "interpIDW"), maxPoints, minPoints, fill) } opt <- spatOptions(filename, ...) x@pntr <- x@pntr$rasterizeWindow(y[,1], y[,2], y[,3], algo, pars, opt) messages(x, "interpIDW") } ) setMethod("interpIDW", signature(x="SpatRaster", y="SpatVector"), function(x, y, field, radius, power=2, smooth=0, maxPoints=Inf, minPoints=1, near=TRUE, fill=NA, filename="", ...) { if (geomtype(y) != "points") { error("interpIDW", "SpatVector y must have a point geometry") } y <- cbind(crds(y), get_z(y, field, "interpIDW")) y <- as.matrix(y) interpIDW(x, y, radius, power=power, smooth=smooth, maxPoints=maxPoints, minPoints=minPoints, near=near, fill=fill, filename=filename, ...) } ) terra/R/mergeTime.R0000644000176200001440000000474314536376240013653 0ustar liggesusers if (!isGeneric("fillTime")) {setGeneric("fillTime", function(x, ...) standardGeneric("fillTime"))} setMethod("fillTime", signature(x="SpatRaster"), function(x, filename="", ...) { tm <- time(x) if (any(is.na(tm))) { error("fillTime", "NA in time values") } if (any(table(tm)>1)) { error("fillTime", "duplicate time values") } if (is.unsorted(tm)) { warn("mergeTimelines", "sorting layers") ord <- order(tm) x <- x[[ ord ]] tm <- tm[ord] } d <- data.frame(time=seq(min(tm), max(tm), min(diff(tm)))) d <- merge(d, data.frame(time=tm, tm=tm), by=1, all.x=TRUE) b <- (!is.na(d[,2])) + 0 b <- cumsum(b) * b if (any(b==0)) { mx <- max(b) b[b==0] <- mx+1 r <- init(rast(x, nlyr=1), NA) x <- c(x, r) x <- x[[b]] } time(x) <- d[,1] if (filename != "") { writeRaster(x, ...) } else { x } } ) if (!isGeneric("mergeTime")) {setGeneric("mergeTime", function(x, ...) standardGeneric("mergeTime"))} setMethod("mergeTime", signature(x="SpatRasterDataset"), function(x, fun="mean", filename="", ...) { tim <- lapply(1:length(x), function(i) time(x[i])) if (any(sapply(tim, function(i) any(is.na(i))))) { error("mergeTime", "NA in time values") } if (any(sapply(tim, function(i) any(table(i)>1)))) { error("mergeTime", "duplicate time values") } us <- sapply(tim, is.unsorted) if (any(us)) { warn("mergeTime", paste("sorting layers of SpatRaster:", paste(us, collapse=", "))) us <- which(us) for (i in us) { ord <- order(tim[[i]]) x[i] <- x[i][[ ord ]] tim[[i]] <- tim[[i]][ord] } } z <- data.frame(time=sort(unique(do.call(c, tim)))) for (i in 1:length(tim)) { d <- data.frame(tim[[i]],tim[[i]]) names(d) <- c("time", paste0("x", i)) z <- merge(z, d, by=1, all.x=TRUE) } b <- (!is.na(z)) + 0 y <- apply(b, 1, function(i) paste(i, collapse="")) r <- rep(1, length(y)) for (i in 2:length(y)) { if (y[i] == y[i-1]) { r[i] <- r[i-1] } else { r[i] <- r[i-1] + 1 } } u <- unique(r) out <- list() d <- apply(b, 2, cumsum) * b for (i in u) { zz <- z[r==i, ,drop=FALSE] dd <- d[r==i, -1, drop=FALSE] tim <- zz[,1] s <- which(colSums(is.na(zz[,-1])) == 0) if (length(s) == 1) { out[[i]] <- x[s][[ dd[,s] ]] } else { ss <- x[s] for (j in 1:length(s)) { ss[j] = ss[j][[ dd[, s[j]] ]] } out[[i]] <- app(ss, fun) time(out[[i]]) <- tim } } out <- rast(out) if (filename != "") { out <- writeRaster(out, ...) } out } ) terra/R/roll.R0000644000176200001440000000335214726700274012677 0ustar liggesusers# Author: Robert Hijmans # November 2009 # License GPL3 movingFun <- function(x, n, fun=mean, type="around", circular=FALSE, na.rm=FALSE, ...) { n <- round(abs(n)) if (n == 0) { stop("n == 0") } x = as.vector(x) lng <- length(x) if (type == "around") { hn <- floor(n/2) if (circular) { x <- c(x[(lng-hn+1):lng], x, x[1:hn]) } else { x <- c(rep(NA, hn), x, rep(NA, hn)) } } else if (type == "to") { if (circular) { x <- c(x[(lng-n+2):lng], x) } else { x <- c(rep(NA, n-1), x) } } else if (type == "from") { if (circular) { x <- c(x, x[1:n]) } else { x <- c(x, rep(NA, n)) } } else { stop('unknown type; should be "around", "to", or "from"') } m <- matrix(ncol=n, nrow=lng) for (i in 1:n) { m[,i] <- x[i:(lng+i-1)] } if (na.rm) { apply(m, MARGIN=1, FUN=fun, na.rm=na.rm, ...) } else { apply(m, MARGIN=1, FUN=fun, ...) } } .roll <- function(x, n) { # by Josh O'Brien x[(seq_along(x) - (n+1)) %% length(x) + 1] } setMethod("roll", signature(x="numeric"), function(x, n, fun=mean, type="around", circular=FALSE, na.rm=FALSE, ...) { movingFun(x, n, fun, type=type, circular=circular, na.rm=na.rm, ...) } ) setMethod("roll", signature(x="SpatRaster"), function(x, n, fun="mean", type="around", circular=FALSE, na.rm=FALSE, filename="", ..., wopt=list()) { txtfun <- .makeTextFun(match.fun(fun)) if (inherits(txtfun, "character")) { if (txtfun %in% .cpp_funs) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$roll(n, txtfun, type, circular, na.rm, opt) return (messages(x, "roll") ) } } else { f <- function(i) { movingFun(i, n, fun, type=type, circular=circular, na.rm=na.rm, ...) } app(x, f, filename=filename, ..., wopt=wopt) } } ) terra/R/wrap.R0000644000176200001440000003032114743554311012672 0ustar liggesusers setClass("Packed", contains="VIRTUAL") setMethod("show", signature(object="Packed"), function(object) { print(paste("This is a", class(object), "object. Use 'terra::unwrap()' to unpack it")) } ) setClass("PackedSpatExtent", contains="Packed", representation ( extent = "numeric" ), prototype ( extent = numeric() ) ) setClass("PackedSpatVector", contains="Packed", representation ( type = "character", crs = "character", coordinates = "matrix", index = "matrix", attributes = "data.frame" ), prototype ( type= "", crs = "" ) ) setClass("PackedSpatRaster", contains="Packed", representation ( definition = "character", values = "matrix", attributes = "list" ), prototype ( attributes = list() ) ) setClass("PackedSpatRasterDC", contains="Packed", representation ( type = "character", rasters = "list" ), prototype ( rasters = list() ) ) setMethod("wrap", signature(x="SpatVector"), function(x) { vd <- methods::new("PackedSpatVector") vd@type <- geomtype(x) vd@crs <- as.character(crs(x)) #stopifnot(vd@type %in% c("points", "lines", "polygons")) g <- geom(x) vd@coordinates <- g[, c("x", "y"), drop=FALSE] j <- c(1, 2, grep("hole", colnames(g))) g <- g[ , j, drop=FALSE] i <- which(!duplicated(g)) vd@index <- cbind(g[i, ,drop=FALSE], start=i) vd@attributes <- as.data.frame(x) vd } ) setMethod("unwrap", signature(x="PackedSpatVector"), function(x) { p <- methods::new("SpatVector") p@pntr <- SpatVector$new() if (!is.na(x@crs)) { crs(p, warn=FALSE) <- x@crs } if (nrow(x@coordinates) == 0) { return(p) } n <- ncol(x@index) reps <- diff(c(x@index[,n], nrow(x@coordinates)+1)) i <- rep(1:nrow(x@index), reps) if (n == 2) { p@pntr$setGeometry(x@type, x@index[i,1], x@index[i,2], x@coordinates[,1], x@coordinates[,2], rep(0, nrow(x@coordinates))) } else { p@pntr$setGeometry(x@type, x@index[i,1], x@index[i,2], x@coordinates[,1], x@coordinates[,2], x@index[i,3]) } if (nrow(x@attributes) > 0) { values(p) <- x@attributes } messages(p, "pack") } ) setMethod("vect", signature(x="PackedSpatVector"), function(x) { unwrap(x) } ) setMethod("as.character", signature(x="SpatRaster"), function(x) { e <- as.vector(ext(x)) d <- crs(x, describe=TRUE) if (!(is.na(d$authority) || is.na(d$code))) { crs <- paste0(", crs='", d$authority, ":", d$code, "'") } else { d <- crs(x) crs <- ifelse(d=="", ", crs=''", paste0(", crs='", d, "'")) crs <- gsub("\n[ ]+", "", crs) } nms <- paste0(", names=c('", paste(names(x), collapse="', '"), "')") paste0("rast(", "ncols=", ncol(x), ", nrows=", nrow(x), ", nlyrs=", nlyr(x), ", xmin=",e[1], ", xmax=",e[2], ", ymin=",e[3], ", ymax=",e[4], nms, crs, ")" ) } ) #eval(parse(text=as.character(s))) writeSources <- function(x, fsource, ftarget, overwrite, ...) { fex <- file.exists(ftarget) if (isFALSE(overwrite) && (any(fex))) { error("wrap", "file(s) exist(s) and 'overwrite=FALSE'") } mem <- fsource == "" for (i in 1:length(mem)) { r <- subsetSource(x, i) if (mem[i]) { writeRaster(r, ftarget[i], overwrite=TRUE, ...) } else { ff <- r@pntr$getAllFiles(); if (length(ff) > 1) { target_noex <- tools::file_path_sans_ext(basename(ftarget[i])) source_noex <- tools::file_path_sans_ext(basename(fsource[i])) fftarget <- file.path(dirname(ftarget[i]), gsub(source_noex, target_noex, basename(ff))) file.copy(ff, fftarget) } else { file.copy(fsource[i], ftarget[i]) } } } } finalizeWrap <- function(x, r, mem) { if (any(is.factor(x))) { r@attributes$levels <- cats(x) r@attributes$levindex <- activeCat(x, 0) } if (any(has.colors(x))) { r@attributes$colors <- coltab(x) } v <- time(x) if (any(!is.na(v))) { r@attributes$time <- v r@attributes$tinfo <- timeInfo(x) } v <- units(x) if (all(v != "")) { r@attributes$units <- v } v <- depth(x) if (!all(v == 0)) { r@attributes$depth <- v } v <- varnames(x) if (!all(v == "")) { if (mem) { v <- unique(v) if (length(v) == 1) { r@attributes$varnames <- v } } else { r@attributes$varnames <- v } } v <- longnames(x) if (!all(v == "")) { if (mem) { v <- unique(v) if (length(v) == 1) { r@attributes$longnames <- v } } else { r@attributes$longnames <- v } } r } setMethod("wrapCache", signature(x="SpatRaster"), function(x, filename=NULL, path=NULL, overwrite=FALSE, ...) { r <- methods::new("PackedSpatRaster") r@definition <- as.character(x) xs <- sources(x, TRUE, TRUE) s <- xs$source if (!is.null(filename)) { if ((length(filename) != 1) && (nrow(xs) != length(filename))) { error("wrap", "length(files) does not match the number of sources") } if (any(filename == "")) { error("wrap", "filenames cannot be empty") } filename <- file.path(normalizePath(dirname(filename), mustWork=TRUE), basename(filename)) if (length(filename) == 1) { if (is.logical(overwrite)) { writeRaster(x, filename, overwrite=overwrite, ...) } else if (!file.exists(filename)) { writeRaster(x, filename, overwrite=FALSE, ...) } } else { writeSources(x, s, filename, overwrite, ...) } xs$source <- filename } else if (!is.null(path)) { path <- normalizePath(path, mustWork=TRUE) fnames <- file.path(path, basename(s)) i <- s == "" if (any(i)) { fnames[i] <- file.path(path, paste0(basename(tempfile()), "_", 1:sum(i), ".tif")) } writeSources(x, s, fnames, overwrite) xs$source <- fnames } else { error("wrapCache", "both path and files are NULL") } r@attributes$sources <- xs finalizeWrap(x, r, FALSE) } ) setMethod("wrap", signature(x="SpatExtent"), function(x) { r <- methods::new("PackedSpatExtent") r@extent <- as.vector(x) r } ) setMethod("unwrap", signature(x="PackedSpatExtent"), function(x) { ext(x@extent) } ) setMethod("wrap", signature(x="SpatRaster"), function(x, proxy=FALSE) { r <- methods::new("PackedSpatRaster") r@definition <- as.character(x) opt <- spatOptions(ncopies=2) can <- (!proxy) && x@pntr$canProcessInMemory(opt) s <- sources(x) mem <- (can || all(s == "")) if (mem) { r@values <- values(x) } else if (all(s != "")) { xs <- sources(x, TRUE, TRUE) r@attributes$sources <- xs } else { fname <- paste0(tempfile(), ".tif") if (!is.null(path)) { path <- normalizePath(path, mustWork=TRUE) fname <- file.path(path, basename(fname)) } x <- writeRaster(x, fname) r@attributes$filename <- fname } finalizeWrap(x, r, mem) } ) setMethod("unwrap", signature(x="PackedSpatRaster"), function(x) { r <- eval(parse(text=x@definition)) if (!is.null(x@attributes$filename)) { # single file, all layers rr <- rast(x@attributes$filename) ext(rr) <- ext(r) crs(rr, warn=FALSE) <- crs(r) names(rr) <- names(r) r <- rr } else if (!is.null(x@attributes$sources)) { s <- x@attributes$sources u <- unique(s$sid) rr <- lapply(1:length(u), function(i) { ss <- s[s$sid == i, ] r <- rast(ss[1,2]) r[[ss[,3]]] }) rr <- rast(rr) ext(rr) <- ext(r) crs(rr, warn=FALSE) <- crs(r) names(rr) <- names(r) r <- rr } else { values(r) <- x@values } if (length(x@attributes) > 0) { nms <- names(x@attributes) if ("time" %in% nms) { tinfo <- x@attributes$tinfo if (!is.null(tinfo)) { time(r, tinfo$step) <- x@attributes$time } else { time(r) <- x@attributes$time } } if (any(nms %in% c("levels", "units", "depth"))) { time(r) <- x@attributes$time units(r) <- x@attributes$units depth(r) <- x@attributes$depth if (!is.null(x@attributes$levels)) { lyrnms <- names(r) if (is.null(x@attributes$levindex)) x@attributes$levindex <- 1 set.cats(r, layer=0, x@attributes$levels, active=x@attributes$levindex) names(r) <- lyrnms } } if (any(nms=="colors")) { for (i in seq_along(x@attributes$colors)) { if (!is.null(x@attributes$colors[[i]])) { d <- terra:::.makeSpatDF(x@attributes$colors[[i]]) if (!r@pntr$setColors(i-1, d)) messages("cols<-", r) } } } if (!is.null(x@attributes$varnames)) { varnames(r) <- x@attributes$varnames } if (!is.null(x@attributes$longnames)) { longnames(r) <- x@attributes$longnames } } r } ) setMethod("wrap", signature(x="SpatRasterDataset"), function(x, proxy=FALSE) { r <- methods::new("PackedSpatRasterDC") r@type <- "SpatRasterDataset" r@rasters <- lapply(x, wrap) r } ) setMethod("wrap", signature(x="SpatRasterCollection"), function(x, proxy=FALSE) { r <- methods::new("PackedSpatRasterDC") r@type <- "SpatRasterCollection" r@rasters <- lapply(x, wrap) r } ) setMethod("unwrap", signature(x="PackedSpatRasterDC"), function(x) { type <- x@type x <- lapply(x@rasters, unwrap) if (type == "SpatRasterCollection") { sprc(x) } else { sds(x) } } ) setMethod("rast", signature(x="PackedSpatRaster"), function(x) { unwrap(x) } ) setMethod("unwrap", signature(x="ANY"), function(x) { x } ) setMethod("serialize", signature(object="SpatExtent"), function(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) { serialize(wrap(object), connection=connection, ascii = ascii, xdr = xdr, version = version, refhook = refhook) } ) setMethod("saveRDS", signature(object="SpatExtent"), function(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) { saveRDS(wrap(object), file=file, ascii = ascii, version = version, compress=compress, refhook = refhook) } ) setMethod("serialize", signature(object="SpatVector"), function(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) { object = wrap(object) serialize(object, connection=connection, ascii = ascii, xdr = xdr, version = version, refhook = refhook) } ) setMethod("saveRDS", signature(object="SpatVector"), function(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) { object = wrap(object) saveRDS(object, file=file, ascii = ascii, version = version, compress=compress, refhook = refhook) } ) setMethod("serialize", signature(object="SpatRaster"), function(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) { object <- wrap(object, proxy=TRUE) serialize(object, connection=connection, ascii = ascii, xdr = xdr, version = version, refhook = refhook) } ) setMethod("serialize", signature(object="SpatRasterDataset"), function(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) { object <- wrap(object, proxy=TRUE) serialize(object, connection=connection, ascii = ascii, xdr = xdr, version = version, refhook = refhook) } ) setMethod("serialize", signature(object="SpatRasterCollection"), function(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) { object <- wrap(object, proxy=TRUE) serialize(object, connection=connection, ascii = ascii, xdr = xdr, version = version, refhook = refhook) } ) setMethod("unserialize", signature(connection="ANY"), function(connection, refhook = NULL) { x <- base::unserialize(connection, refhook) unwrap(x) } ) setMethod("saveRDS", signature(object="SpatRaster"), function(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) { object <- wrap(object) saveRDS(object, file=file, ascii = ascii, version = version, compress=compress, refhook = refhook) } ) setMethod("saveRDS", signature(object="SpatRasterDataset"), function(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) { object <- wrap(object) saveRDS(object, file=file, ascii = ascii, version = version, compress=compress, refhook = refhook) } ) setMethod("saveRDS", signature(object="SpatRasterCollection"), function(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) { object <- wrap(object) saveRDS(object, file=file, ascii = ascii, version = version, compress=compress, refhook = refhook) } ) setMethod("readRDS", signature(file="character"), function (file = "", refhook = NULL) { x <- base::readRDS(file=file, refhook=refhook) unwrap(x) } ) #setMethod("wrap", signature(x="Spatial"), # function(x) { # pv <- .packVector(x) # if (methods::.hasSlot(x, "data")) { # pv@attributes <- x@data # } # pv # } #) terra/R/aggregate.R0000644000176200001440000002160314746554435013664 0ustar liggesusers# Author: Robert J. Hijmans # Date : December 2017 # Version 1.0 # License GPL v3 .makeTextFun <- function(fun) { if (!inherits(fun, "character")) { fun <- match.fun(fun) if (is.primitive(fun)) { test <- try(deparse(fun)[[1]], silent=TRUE) test <- gsub('.Primitive\\(\"', "", test) test <- gsub('\")', "", test) if (test %in% c("sum", "min", "max", "prod", "any", "all")) return(test); } else { depf <- deparse(fun) test1 <- isTRUE(try( depf[2] == 'UseMethod(\"mean\")', silent=TRUE)) test2 <- isTRUE(try( fun@generic == "mean", silent=TRUE)) if (test1 | test2) return("mean") test1 <- isTRUE(try( depf[2] == 'UseMethod(\"median\")', silent=TRUE)) test2 <- isTRUE(try( fun@generic == "median", silent=TRUE)) if (test1 | test2) return("median") test1 <- isTRUE(try( depf[1] == "function (x, na.rm = FALSE) ", silent=TRUE)) test2 <- isTRUE(try( depf[2] == "sqrt(var(if (is.vector(x) || is.factor(x)) x else as.double(x), ", silent=TRUE)) test3 <- isTRUE(try( depf[3] == " na.rm = na.rm))", silent=TRUE)) if (test1 && test2 && test3) return("sd") if (isTRUE(try( fun@generic == "which.min", silent=TRUE))) return("which.min") if (isTRUE(try( fun@generic == "which.max", silent=TRUE))) return("which.max") if (isTRUE(all(depf[1] == deparse(base::which)[1]))) return("which") if (isTRUE(all(depf[1] == deparse(base::table)[1]))) return("table") } } return(fun) } setMethod("aggregate", signature(x="SpatRaster"), function(x, fact=2, fun="mean", ..., cores=1, filename="", overwrite=FALSE, wopt=list()) { if (hasValues(x)) { fun <- .makeTextFun(fun) toc <- FALSE if (inherits(fun, "character")) { if (fun %in% c("sum", "mean", "min", "max", "median", "modal","prod", "which.min", "which.max", "any", "all", "sd", "std", "sdpop", "table")) { fun[fun == "sdpop"] <- "std" toc <- TRUE } else { fun <- match.fun(fun) } } else { fun <- match.fun(fun) } } else { toc = TRUE fun = "mean" } if (toc) { # fun="mean", expand=TRUE, na.rm=TRUE, filename="" narm <- isTRUE(list(...)$na.rm) opt <- spatOptions(filename, overwrite, wopt=wopt) x@pntr <- x@pntr$aggregate(fact, fun, narm, opt) return (messages(x, "aggregate")) } else { out <- rast(x) nl <- nlyr(out) opt <- spatOptions() out@pntr <- out@pntr$aggregate(fact, "sum", TRUE, opt) out <- messages(out, "aggregate") dims <- x@pntr$get_aggregate_dims(fact) vtest <- values(x, dataframe=TRUE, row=1, nrows=dims[1], col=1, ncols=dims[2]) vtest <- as.list(vtest) test <- sapply(vtest, fun, ...) dm <- dim(test) do_transpose = FALSE if (!is.null(dm)) { do_transpose = TRUE } if (inherits(test, "list")) { error("aggregate", "fun returns a list") } fun_ret <- 1 if (length(test) > nl) { if ((length(test) %% nl) == 0) { fun_ret <- length(test) / nl nlyr(out) <- nlyr(x) * fun_ret } else { error("aggregate", "cannot use this function") } } b <- blocks(x, 4) nr <- max(1, floor(b$nrows[1] / fact[1])) * fact[1] nrs <- rep(nr, floor(nrow(x)/nr)) d <- nrow(x) - sum(nrs) if (d > 0) nrs <- c(nrs, d) b$row <- c(0, cumsum(nrs))[1:length(nrs)] + 1 b$nrows <- nrs b$n <- length(nrs) outnr <- ceiling(b$nrows / fact[1]); outrows <- c(0, cumsum(outnr))[1:length(outnr)] + 1 nc <- ncol(x) if (inherits(cores, "cluster")) { doPar <- TRUE } else if (cores > 1) { doPar <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores)) export_args(cores, ..., caller="aggregate") } else { doPar <- FALSE } mpl <- prod(dims[5:6]) * fun_ret readStart(x) on.exit(readStop(x)) ignore <- writeStart(out, filename, overwrite, sources=sources(x), wopt=wopt) if (doPar) { for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, nc) v <- x@pntr$get_aggregates(v, b$nrows[i], dims) v <- parallel::parSapply(cores, v, fun, ...) if (length(v) != outnr[i] * mpl) { error("aggregate", "this function does not return the correct number of values") } if (do_transpose) { v <- t(v) } writeValues(out, v, outrows[i], outnr[i]) } } else { for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, nc) v <- x@pntr$get_aggregates(v, b$nrows[i], dims) v <- sapply(v, fun, ...) if (length(v) != outnr[i] * mpl) { error("aggregate", "this function does not return the correct number of values") } if (do_transpose) { v <- t(v) } writeValues(out, v, outrows[i], outnr[i]) } } out <- writeStop(out) messages(out, "aggregate") } } ) .agg_uf <- function(i) { u <- unique(i) if (length(u) == 1) { u } else { NA } } aggregate_attributes <- function(d, by, fun=NULL, count=TRUE, ...) { i <- sapply(d, is.numeric) i[colnames(d) %in% by] <- FALSE j <- 1:length(by) da <- db <- NULL if (!is.null(fun)) { if (any(i)) { if (is.character(fun)) { f <- match.fun(fun) da <- aggregate(d[, i,drop=FALSE], d[, by, drop=FALSE], f, ...) names(da)[-j] <- paste0(fun, "_", names(da)[-j]) } else { da <- aggregate(d[, i,drop=FALSE], d[, by, drop=FALSE], fun, ...) names(da)[-j] <- paste0("agg_", names(da)[-j]) } } else { da <- unique(d[, by, drop=FALSE]) } } else { i[] <- FALSE } i[colnames(d) %in% by] <- TRUE if (any(!i)) { db <- aggregate(d[, !i,drop=FALSE], d[, by, drop=FALSE], .agg_uf) #db <- db[, colSums(is.na(db)) < nrow(db), drop=FALSE] if (NCOL(da)>1) { da <- merge(da, db, by=by) } else { da <- db } } if (count) { dn <- aggregate(d[, by[1],drop=FALSE], d[, by, drop=FALSE], length) colnames(dn)[ncol(dn)] = "agg_n" if (NCOL(da) > 1) { if (nrow(dn) > 0) { dn <- merge(da, dn, by=by) } else { dn <- da dn$agg_n <- 1 } } dn } else { da } } setMethod("aggregate", signature(x="SpatVector"), function(x, by=NULL, dissolve=TRUE, fun="mean", count=TRUE, ...) { if (inherits(by, "SpatVector")) { error("use 'zonal' to aggregate a SpatVector with a SpatVector") } if (is.null(by)) { x$aggregate_by_variable = 1; x@pntr <- x@pntr$aggregate("aggregate_by_variable", dissolve) x$aggregate_by_variable = NULL; } else { if (is.character(by)) { by <- unique(by) iby <- match(by, names(x)) if (any(is.na(iby))) { bad <- paste(by[is.na(iby)], collapse=", ") error("aggregate", "invalid name(s) in by: ", bad) } } else if (is.numeric(by)) { by <- unique(by) iby <- round(by) if (any((iby < 1) | (iby > ncol(x)))) { bad <- iby[(iby < 1) | (iby > ncol(x))] error("aggregate", "invalid column number in by: ", bad) } } else { error("aggregate", "by should be character or numeric") } d <- values(x) mvars <- FALSE if (length(iby) > 1) { cvar <- apply(d[, iby], 1, function(i) paste(i, collapse="_")) by <- basename(tempfile()) values(x) <- NULL x[[by]] <- cvar mvars <- TRUE } else { by <- names(x)[iby] } x@pntr <- x@pntr$aggregate(by, dissolve) messages(x) if (mvars) { d[[by]] <- cvar a <- aggregate_attributes(d, c(by, names(d)[iby]), fun=fun, count=count, ...) } else { a <- aggregate_attributes(d, names(d)[iby], fun=fun, count=count, ...) } if (any(is.na(d[[by]]))) { # because NaN and NA are dropped i <- nrow(a)+(1:2) a[i,] <- c(NA, NaN) } i <- match(x[[by,drop=TRUE]], a[[by]]) i <- i[!is.na(i)] if (mvars) { a[[by]] <- NULL } values(x) <- a[i,,drop=FALSE] } x } ) # setMethod("aggregate", signature(x="SpatVector"), # function(x, by=NULL, dissolve=TRUE, fun="mean", ...) { # gt <- geomtype(x) # if (length(by) > 1) { # error("aggregate", "this method can only aggregate by one variable") # } # x <- methods::as(x, "Spatial") # if (is.numeric(by[1])) { # i <- round(by) # if ((i > 0) & (i <= ncol(x))) { # by <- names(x)[i] # } else { # error("aggregate", "invalid column number supplied: ", by) # } # } # r <- aggregate(x, by=by, dissolve=dissolve, ...) # if (!missing(fun) && !missing(by)) { # if (.hasSlot(x, "data")) { # d <- x@data # i <- sapply(d, is.numeric) # i[colnames(d) %in% by] <- FALSE # j <- 1:length(by) # if (any(i)) { # if (is.character(fun)) { # f <- match.fun(fun) # da <- aggregate(d[, i,drop=FALSE], d[, by, drop=FALSE], f) # names(da)[-j] <- paste0(fun, "_", names(da)[-j]) # } else { # da <- aggregate(d[, i,drop=FALSE], d[, by, drop=FALSE], fun) # names(da)[-j] <- paste0("agg_", names(da)[-j]) # } # r <- merge(r, da, by) # } # i[colnames(d) %in% by] <- TRUE # if (any(!i)) { # db <- aggregate(d[, !i,drop=FALSE], d[, by, drop=FALSE], .agg_uf) # db <- db[, colSums(is.na(db)) < nrow(db), drop=FALSE] # if (ncol(db) > 1) { # r <- merge(r, db, by) # } # } # dn <- aggregate(d[, by,drop=FALSE], d[, by, drop=FALSE], length) # colnames(dn)[2] = "agg_n" # r <- merge(r, dn, by) # } # } # vect(r) # } # ) terra/R/extract_single.R0000644000176200001440000001470014735320520014731 0ustar liggesusers make_extract_index <- function(v, vmx, name="i") { caller <- paste0("`[`(", name, ")") if (inherits(v, "SpatRaster")) { error(caller, paste("index", name, "cannot be a SpatRaster")) } if (inherits(v, "SpatVector")) { error(caller, paste("index", name, "cannot be a SpatVector")) } if (inherits(v, "SpatExtent")) { error(caller, paste("index", name, "cannot be a SpatExtent")) } if (!is.numeric(v)) { if (inherits(v, "data.frame")) { if (ncol(v) == 1) { v <- v[,1,drop=TRUE] } else if ((name == "i") && (ncol(v) == 2)) { v <- cellFromRowCol(x, v[,1], v[,2]) } else { error(caller, paste("index", name, "has", ncol(v), "columns")) } } else if (inherits(v, "matrix")) { if (ncol(v) == 1) { v <- v[,1] } else { error(caller, paste("index", name, "is not numeric and has", ncol(v), "columns")) } } if (!is.vector(v)) { error(caller, paste("the type of index", name, "is unexpected:", class(v)[1])) } if (is.factor(v) || is.character(v)) { error(caller, paste("the type of index", name, "cannot be a factor or character")) } if (is.logical(v)) { v <- which(v) } if (!is.numeric(v)) { error(caller, paste("the type of index", name, "is unexpected:", class(v)[1])) } } if (inherits(v, "matrix")) { if (ncol(v) == 1) { v <- v[,1] } else { error(caller, paste("index", name, "has unexpected dimensions:", paste(dim(v), collapse=", "))) } } positive_indices(v, vmx, FALSE, caller=caller) } .extract_spatraster <- function(x, i, drop) { if (!hasValues(i)) { error("`[`", "the index SpatRaster must have values") } if (nlyr(i) > 1) { error("`[`", "the index SpatRaster can only have one layer") } if (!compareGeom(x, i, crs=FALSE, stopOnError=FALSE)) { if (!drop) { return(crop(x, i)) } i <- cells(x, ext(i)) return (x[i, drop=drop]) } if (drop) { i <- which(values(i)==1) values(x)[i, ,drop=FALSE] } else { if (is.bool(i)) { mask(x, i, maskvalues=FALSE) } else { mask(x, i) } } } .extract_spatextent <- function(x, i, drop) { x <- crop(x, i) if (drop) { values(x) } else { x } } .extract_spatvector <- function(x, i, drop) { if (drop) { extract(x, i, data.frame=TRUE)[ , -1, drop=FALSE] } else { crop(x, i, mask=TRUE) } } .extract_row <- function(x, i, drop=TRUE) { if (!drop) { e <- ext_from_rc(x, min(i), max(i), 1, ncol(x)) return(crop(x, e)) } i <- cellFromRowColCombine(x, i, 1:ncol(x)) .extract_cell(x, i, drop=TRUE) } .extract_col <- function(x, j, drop=TRUE) { if (!drop) { e <- ext_from_rc(x, 1, nrow(x), min(j), max(j)) return(crop(x, e)) } i <- cellFromRowColCombine(x, 1:nrow(x), j) .extract_cell(x, i, drop=TRUE) } .extract_rowcol <- function(x, i, j, drop=TRUE) { if (!drop) { e <- ext_from_rc(x, min(i), max(i), min(j), max(j)) return(crop(x, e)) } i <- cellFromRowColCombine(x, i, j) .extract_cell(x, i, drop=TRUE) } .extract_cell <- function(x, i, drop=TRUE, raw=FALSE) { if (!drop) { rc <- rowColFromCell(x, i) e <- ext_from_rc(x, min(rc[,1]), max(rc[,1]), min(rc[,2]), max(rc[,2])) y <- crop(x, e) y[-cellFromXY(y, xyFromCell(x, i))] <- NA y } else { e <- x@pntr$extractCell(i-1) x <- messages(x, "extract") e <- do.call(cbind, e) colnames(e) <- names(x) if (raw) { return(e) } .makeDataFrame(x, e) } } .extract_cell_layer <- function(x, i, lyrs, drop) { if (drop) { e <- x@pntr$extractCell(i-1) messages(x, "extract") e <- do.call(cbind, e) colnames(e) <- names(x) e <- .makeDataFrame(x, e) e[cbind(1:length(i), lyrs)] } else { rc <- rowColFromCell(x, i) e <- ext_from_rc(x, min(rc[,1]), max(rc[,1]), min(rc[,2]), max(rc[,2])) x <- x[unique(lyrs)] crop(x, e) } } setMethod("[", c("SpatRaster", "ANY", "ANY", "ANY"), function(x, i, j, k, drop=TRUE) { m <- c(missing(i), missing(j), missing(k)) if (!m[3]) { if (is.logical(k) && length(k) == 1) { drop <- k m[3] <- TRUE } } s <- rep(FALSE, 3) if (!m[1]) s[1] <- is.list(i) if (!m[2]) s[2] <- is.list(j) if (!m[3]) s[3] <- is.list(k) if (any(s)) { if (m[1]) i <- NULL if (m[2]) j <- NULL if (m[3]) k <- NULL m <- c(FALSE, TRUE, TRUE) i <- rcl(x, row=i, col=j, lyr=k) } if ((!m[1]) && (inherits(i, "matrix"))) { if (ncol(i) == 1) { i <- i[,1] } else if (ncol(i) == 2) { i <- cellFromRowCol(x, i[,1], i[,2]) m[2:3] <- TRUE } else if (ncol(i) == 3) { k <- i[,3] i <- cellFromRowCol(x, i[,1], i[,2]) uk <- unique(k) if (length(uk) == 1) { x <- x[[uk]] m[2:3] <- TRUE } else { return(.extract_cell_layer(x, i, k, drop)) } } else { error("`[<-`", paste("index i has", ncol(i), "columns")) } } if (!m[3]) { if (is.logical(k) && length(k) == 1) { drop <- k m[3] <- TRUE } else { if (inherits(k, "character")) { k <- match(k, names(x)) if (any(is.na(k))) { error("`[`(k)", "invalid layer name(s)") } } else { k <- make_extract_index(k, nlyr(x), "k") } x <- x[[k]] } } if ((!m[1]) && (inherits(i, "character"))) { # partial matching of layer names i <- grep(i, names(x)) x <- subset(x, i, NSE=FALSE) if (m[2]) return(x) m[1] <- TRUE } if (m[1] && m[2]) { if (drop) { return(values(x, mat=TRUE)) } else { return(deepcopy(x)) } } if (!m[1]) { # i not missing if (inherits(i, "SpatRaster")) { return(.extract_spatraster(x, i, drop)) } if (inherits(i, "SpatVector")) { return(.extract_spatextent(x, i, drop)) } if (inherits(i, "SpatVector")) { return(.extract_spatextent(x, i, drop)) } theCall <- sys.call(-1) narg <- length(theCall)-length(match.call(call=theCall)) if ((narg==0) && m[2]) { # cell i <- make_extract_index(i, ncell(x), "i") return(.extract_cell(x, i, drop=drop)) } else if (m[2]) { # row i <- make_extract_index(i, nrow(x), "i") return(.extract_row(x, i, drop=drop)) } else { #row,col i <- make_extract_index(i, nrow(x), "i") j <- make_extract_index(j, ncol(x), "j") return(.extract_rowcol(x, i, j, drop=drop)) } } else { #if (!m[2]) { #col j <- make_extract_index(j, ncol(x), "j") return(.extract_col(x, j, drop=drop)) } } ) setMethod("[", c("SpatVector", "SpatVector", "missing"), function(x, i, j) { #r <- !relate(x, i, "disjoint") #r <- which(apply(r, 1, any)) r <- is.related(x, i, "intersects") x[r, ] }) setMethod("[", c("SpatVector", "SpatExtent", "missing"), function(x, i, j) { x[as.polygons(i)] }) terra/R/image.R0000644000176200001440000000151714536376240013013 0ustar liggesusers# Author: Robert J. Hijmans # Date : April 2019 # Version 1.0 # License GPL v3 .plot_image <- function(x, y=1, xlab="", ylab="", asp=NULL, ...) { X <- xFromCol(x, 1:ncol(x)) Y <- yFromRow(x, nrow(x):1) value <- matrix(as.vector(x), nrow=nrow(x), byrow=TRUE) value <- t(value[nrow(value):1, ,drop=FALSE]) if (is.null(asp)) { asp <- ifelse(is.lonlat(x, perhaps=TRUE, warn=FALSE), 1/cos((mean(as.vector(ext(x))[3:4]) * pi)/180), 1) graphics::image(x=X, y=Y, z=value, asp=asp, xlab=xlab, ylab=ylab, ...) } else { graphics::image(x=X, y=Y, z=value, xlab=xlab, ylab=ylab, ...) } } setMethod("image", signature(x="SpatRaster"), function(x, y=1, maxcell=500000, ...) { y <- as.integer(y[1]) stopifnot(y > 0 && y <= nlyr(x)) x <- spatSample(x[[y]], maxcell, method="regular", as.raster=TRUE, warn=FALSE) .plot_image(x, ...) } ) terra/R/Aclasses.R0000644000176200001440000000462514726700402013462 0ustar liggesusers# Author: Robert J. Hijmans, r.hijmans@gmail.com # Date : November 2017 # Version 0 # License GPL v3 setClass("SpatRaster", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatRaster")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatRasterDataset", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatRasterStack")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatRasterCollection", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatRasterCollection")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatVector", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatVector")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatVectorProxy", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatVectorProxy")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatVectorCollection", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatVectorCollection")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatExtent", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatExtent")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatOptions", representation ( pntr = "C++Object" ), prototype ( pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatOptions")){ return(TRUE) } else { return(FALSE) } } ) setClass("SpatGraticule", representation ( pntr = "C++Object", box = "C++Object" ), prototype ( pntr = NULL, pntr = NULL ), validity = function(object) { if (is.null(object@pntr) || is(object@pntr, "Rcpp_SpatVector")){ return(TRUE) } else { return(FALSE) } } ) terra/R/graticule.R0000644000176200001440000001167414726700274013714 0ustar liggesusers# Author: Robert J. Hijmans, r.hijmans@gmail.com # Date : November 2022 # Version 1 # License GPL v3 graticule <- function(lon=30, lat=30, crs="") { if (crs == "") { crs <- "+proj=longlat" } if (length(lon) == 1) { lon <- seq(-180, 180, lon) } else { lon <- sort(lon) } if (length(lat) == 1) { lat <- seq(-90, 90, lat) } else { lat <- sort(lat) } interval <- 100 #should depend on extent y <- cbind(rep(1:length(lon), each=2), rep(lon, each=2), range(lat)) vy <- vect(y, "lines", crs="+proj=longlat") vy <- densify(vy, interval*1000, TRUE) values(vy) <- data.frame(h=FALSE, lon=lon) rlon <- range(lon) rlon <- c(rlon[1], rlon[1] + (rlon[2]-rlon[1])/2, rlon[2]) x <- cbind(rep(1:length(lat), each=3), rlon, rep(lat, each=3)) vx <- vect(x, "lines", crs="local") vx <- densify(vx, interval/110, TRUE) values(vx) <- data.frame(h=TRUE, lat=lat) crs(vx, warn=FALSE) <- "+proj=longlat" v <- rbind(vy, vx) e <- as.polygons(ext(v), crs=crs(v)) e <- densify(e, interval*1000, TRUE) if (!is.lonlat(crs, FALSE, FALSE)) { v <- project(v, crs) e <- project(e, crs) } g <- new("SpatGraticule") g@pntr <- v@pntr g@box <- e@pntr g } #setMethod("project", signature(x="SpatGraticule"), # function(x, y) { # v <- vect(x) # v <- project(v, y) # x@pntr <- v@pntr # v@pntr <- x@box # v <- project(v, y) # x@box <- v@pntr # x # } #) setMethod("crop", signature(x="SpatGraticule"), function(x, y) { v <- vect(x) v <- crop(v, y) x@pntr <- v@pntr v@pntr <- x@box v <- crop(v, y) x@box <- v@pntr x } ) setMethod("erase", signature(x="SpatGraticule", y="SpatVector"), function(x, y) { v <- vect(x) y <- project(y, v) v <- erase(v, y) x@pntr <- v@pntr v@pntr <- x@box v <- erase(v, y) x@box <- v@pntr x } ) grat_labels <- function(x, retro, atlon, atlat, labloc, cex, col, offlon, offlat, vfont=NULL, font=NULL, ...) { v <- vect(x) left <- right <- top <- bottom <- FALSE labloc <- rep_len(labloc, 2) if (!is.na(labloc[1])) { if (labloc[1] == 1) { bottom <- TRUE } else if (labloc[1] == 2) { top <- TRUE } else { bottom <- TRUE top <- TRUE } } if (!is.na(labloc[2])) { if (labloc[2] == 1) { left <- TRUE } else if (labloc[2] == 2) { right <- TRUE } else { left <- TRUE right <- TRUE } } if (left || right) { s <- sign(offlat)+2 x <- v[v$h, ] g <- geom(x) if (retro) { labs <- retro_labels(x$lat, lat=TRUE) } else { labs <- paste0(x$lat,"\u00B0") } if (!is.null(atlat)) { atlat <- round(stats::na.omit(atlat)) atlat <- atlat[(atlat > 0) & (atlat <= length(labs))] labs <- labs[atlat] } if (left) { a <- vect(g[match(unique(g[,1]), g[,1]), 3:4]) if (!is.null(atlat)) { a <- a[atlat, ] } pos <- c(4,0,2)[s] if (pos == 0) pos <- NULL text(a, labels=labs, pos=pos, offset=abs(offlat), cex=cex, halo=TRUE, xpd=TRUE, col=col) } if (right) { g <- g[nrow(g):1, ] a <- vect(g[match(unique(g[,1]), g[,1]), 3:4]) if (!is.null(atlat)) { a <- a[atlat, ] labs <- rev(labs) } pos <- c(2,0,4)[s] if (pos == 0) pos <- NULL text(a, labels=labs, pos=pos, offset=abs(offlat), cex=cex, halo=TRUE, xpd=TRUE, col=col) } } if (top || bottom) { s <- sign(offlon)+2 x <- v[!v$h, ] g <- geom(x) if (retro) { labs <- retro_labels(x$lon, lat=FALSE) } else { labs <- paste0(x$lon,"\u00B0") } if (!is.null(atlon)) { atlon <- round(stats::na.omit(atlon)) atlon <- atlon[(atlon > 0) & (atlon <= length(labs))] labs <- labs[atlon] } if (bottom) { a <- vect(g[match(unique(g[,1]), g[,1]), 3:4]) if (!is.null(atlon)) { a <- a[atlon, ] } pos <- c(3,0,1)[s] if (pos == 0) pos <- NULL text(a, labels=labs, pos=pos, offset=abs(offlon), cex=cex, halo=TRUE, xpd=TRUE, col=col) } if (top) { g <- g[nrow(g):1, ] a <- vect(g[match(unique(g[,1]), g[,1]), 3:4]) if (!is.null(atlon)) { a <- a[atlon, ] labs <- rev(labs) } pos <- c(1,0,3)[s] if (pos == 0) pos <- NULL text(a, labels=labs, pos=pos, offset=abs(offlon), cex=cex, halo=TRUE, xpd=TRUE, col=col) } } } setMethod("plot", signature(x="SpatGraticule", y="missing"), function(x, y, background=NULL, col="black", mar=NULL, labels=TRUE, retro=FALSE, lab.loc=c(1,1), lab.lon=NULL, lab.lat=NULL, lab.cex=.65, lab.col="black", off.lat=0.25, off.lon=0.25, box=FALSE, box.col="black", add=FALSE, ...) { b <- vect() b@pntr <- x@box if (!is.null(mar)) mar <- rep_len(mar, 4) if (!is.null(background)) { plot(b, col=background, border=NA, axes=FALSE, mar=mar, add=add) } else { if (!add) { plot(ext(b), border=NA, axes=FALSE, mar=mar) } } lines(x, col=col, ...) if (box) { lwd <- list(...)$lwd if (is.null(lwd)) lwd=1; lines(b, lty=1, col=box.col, lwd=lwd) } if (labels) grat_labels(x, isTRUE(retro[1]), lab.lon, lab.lat, lab.loc, lab.cex[1], lab.col[1], off.lon, off.lat, ...) } ) setMethod("lines", signature(x="SpatGraticule"), function(x, ...) { lines(vect(x), ...) } ) terra/R/princomp.R0000644000176200001440000000227514645307434013562 0ustar liggesusers setMethod("princomp", signature(x="SpatRaster"), function(x, cor=FALSE, fix_sign=TRUE, use="pairwise.complete.obs", maxcell=Inf) { if (!hasValues(x)) { error("princomp", "x has no values") } if (nlyr(x) < 2) { error("princomp", "The number of layers of x must be > 1") } xcov <- layerCor(x, fun="cov", use=use, asSample=FALSE, maxcell=maxcell) if (any(is.na(xcov[["covariance"]]))) { error("princomp", "the covariance matrix has missing values") } model <- princomp(covmat=xcov$covariance, cor=cor, fix_sign=fix_sign) model$center <- diag(xcov$mean) n <- diag(xcov$n) if (cor) { ## scale as population sd S <- diag(xcov$covariance) model$scale <- sqrt(S) } model$n.obs <- stats::as.dist(xcov$n) model } ) setMethod("prcomp", signature(x="SpatRaster"), function(x, retx = TRUE, center = TRUE, scale. = FALSE, tol = NULL, rank. = NULL, maxcell=Inf) { d <- na.omit(spatSample(x, maxcell, "regular")) p <- prcomp(d, retx=retx, center=center, scale.=scale., tol=tol, rank.=rank.) nms <- names(p$center) nms <- nms[!(nms %in% names(x))] if (length(nms) > 0) { warn("prcomp", "names were changed to make them valid. See 'valid.names'") } p } ) terra/R/clip.R0000644000176200001440000000150014624317253012645 0ustar liggesusers set.clip <- function(clp, geo) { # remove non-existing ones x <- grDevices::dev.list() x <- paste(names(x), x, sep="_") e <- .terra_environment$devs e <- e[e[,1] %in% x, ] graphics::clip(clp[1], clp[2], clp[3], clp[4]) d <- grDevices::dev.cur() d <- data.frame(dev=paste(names(d), d[[1]], sep="_"), rbind(clp), geo=geo, row.names="") # remove one with the same name/number e <- e[!(e[,1] %in% d[1]), ] e <- rbind(e, d) .terra_environment$devs <- e } get.clip <- function() { d <- grDevices::dev.cur() dev <- paste(names(d), d[[1]], sep="_") e <- .terra_environment$devs i <- match(dev, e[,1])[1] if (is.na(i)) { NULL } else { e[i[1],-1] } } reset.clip <- function() { g <- get.clip() if (!is.null(g)) { graphics::clip(g[[1]], g[[2]], g[[3]], g[[4]]) } } map_extent <- function() { get.clip() } terra/R/zzz.R0000644000176200001440000000312114736322043012551 0ustar liggesusers ## from htmltools for future use with knitr ## method = c(package, genname, class). #registerMethods <- function(methods) { # lapply(methods, function(method) { # pkg <- method[[1]] # generic <- method[[2]] # class <- method[[3]] # func <- get(paste(generic, class, sep=".")) # if (pkg %in% loadedNamespaces()) { # registerS3method(generic, class, func, envir = asNamespace(pkg)) # } # setHook( # packageEvent(pkg, "onLoad"), # function(...) { # registerS3method(generic, class, func, envir = asNamespace(pkg)) # } # ) # } # ) #} .gdinit <- function() { path = "" sf <- system.file("", package="terra") if (file.exists(file.path(sf, "proj/nad.lst"))) { path <- system.file("proj", package="terra") } .gdalinit(path, file.path(sf, "gdal")) if (libVersion("gdal") == "3.6.0") { message("Using GDAL version 3.6.0 which was retracted because it cannot write large GPKG files") } } loadModule("spat", TRUE) .onLoad <- function(libname, pkgname) { .gdinit() #registerMethods(list(c(package, genname, class))) } .onAttach <- function(libname, pkgname) { packageStartupMessage("terra ", utils::packageVersion("terra")) .create_options() if (length(grep(.geos_version(FALSE, TRUE), .geos_version(TRUE))) != 1) { packageStartupMessage("WARNING: different compile-time and run-time versions of GEOS") packageStartupMessage("Compiled with:", .geos_version(FALSE, TRUE)) packageStartupMessage(" Running with:", .geos_version(TRUE, TRUE)) packageStartupMessage("\nYou should reinstall package 'terra'\n") } # terraOptions(todisk=TRUE, steps=2) # terraOptions(memfrac=0) } terra/R/extract.R0000644000176200001440000003421314750564600013377 0ustar liggesusers# Author: Robert J. Hijmans # Date : November 2018 # Version 1.0 # License GPL v3 .big_number_warning <- function() { # this warning should be given by C warn("big number", "cell numbers larger than ", 2^.Machine$double.digits, " are approximate") } ext_from_rc <- function(x, r1, r2, c1, c2){ e <- as.vector(ext(x)) r <- res(x) c1 <- min(max(c1, 1), ncol(x)) c2 <- min(max(c2, 1), ncol(x)) if (c1 > c2) { tmp <- c1 c1 <- c2 c2 <- tmp } r1 <- min(max(r1, 1), nrow(x)) r2 <- min(max(r2, 1), nrow(x)) if (r1 > r2) { tmp <- r1 r1 <- r2 r2 <- tmp } xn <- xFromCol(x, c1) - 0.5 * r[1] xx <- xFromCol(x, c2) + 0.5 * r[1] yx <- yFromRow(x, r1) + 0.5 * r[2] yn <- yFromRow(x, r2) - 0.5 * r[2] ext(c(sort(c(xn, xx))), sort(c(yn, yx))) } getLyrNrs <- function(layer, nms, n) { nl <- length(nms) if (is.numeric(layer)) { layer <- round(layer) if (min(layer, na.rm=TRUE) < 1 || max(layer, na.rm=TRUE) > nl) { error("extract", "layer should be between 1 and nlyr(x)") } } else { layer <- match(layer, nms) } if (any(is.na(layer))) { # error("extract", "names in argument 'layer' do not match names(x)") } rep_len(layer, n) } extractCells <- function(x, y, raw=FALSE) { e <- x@pntr$extractCell(y-1) e <- do.call(cbind, e) colnames(e) <- names(x) if (!raw) { e <- .makeDataFrame(x, e) } e } use_layer <- function(e, y, layer, nl) { if (is.null(layer)) { return(e) } layer <- getLyrNrs(layer, colnames(e)[-1], nrow(y)) idx <- cbind(1:nrow(e), layer[e[,1]] + 1) ee <- data.frame(e[,1,drop=FALSE], colnames(e)[idx[,2]], value=e[idx]) colnames(ee)[2] <- "layer" if (ncol(e) > (nl+1)) { cbind(ee, e[,(nl+1):ncol(e), drop=FALSE]) } else { ee } } extract_table <- function(x, y, ID=FALSE, weights=FALSE, exact=FALSE, touches=FALSE, small=TRUE, na.rm=FALSE) { if (weights && exact) { exact = FALSE } opt <- spatOptions() if (weights | exact) { wtable <- function(p, na.rm=FALSE) { n <- length(p) w <- p[[n]] p[[n]] <- NULL do.call( rbind, lapply(1:length(p), function(i) { x <- p[[i]] j <- is.na(x) if (na.rm) { x <- x[!j] w <- w[!j] } else if (any(j)) { w[] <- NA } data.frame(layer=i, aggregate(w, list(x), sum, na.rm=FALSE)) }) ) } e <- x@pntr$extractVector(y@pntr, touches[1], small[1], "simple", FALSE, FALSE, isTRUE(weights[1]), isTRUE(exact[1]), opt) x <- messages(x, "extract") e <- lapply(e, wtable, na.rm=na.rm) e <- lapply(1:length(e), function(i) cbind(ID=i, e[[i]])) e <- do.call(rbind, e) colnames(e)[3:4] <- c("group", "value") out <- vector("list", nlyr(x)) for (i in 1:nlyr(x)) { ee <- e[e[,2] == i, ] ee <- replace_with_label(x[[i]], ee, 3) ee <- stats::reshape(ee, idvar=c("ID", "layer"), timevar="group", direction="wide") colnames(ee) <- gsub("value.", "", colnames(ee)) ee$layer <- NULL if (!ID) { ee$ID <- NULL } if (na.rm) { ee[is.na(ee)] <- 0 } out[[i]] <- ee } if (nlyr(x) == 1) return(out[[1]]) else return(out) } else { e <- x@pntr$extractVectorFlat(y@pntr, "", FALSE, touches[1], small[1], "", FALSE, FALSE, FALSE, FALSE, opt) x <- messages(x, "extract") e <- data.frame(matrix(e, ncol=nlyr(x)+1, byrow=TRUE)) colnames(e) <- c("ID", names(x)) id <- e[,1,drop=FALSE] e <- cbind(id, .makeDataFrame(x, e[,-1,drop=FALSE])) cn <- colnames(e) out <- vector("list", ncol(e)-1) for (i in 2:ncol(e)) { fixname <- TRUE if (!is.factor(e[,i])) { fixname <- FALSE e[,i] <- as.factor(e[,i]) } tb <- table(e[,1], e[,i]) tb <- cbind(ID = rownames(tb), as.data.frame.matrix(tb)) if (fixname) colnames(tb) <- gsub(cn[i], "", colnames(tb)) if (!ID) { tb$ID <- NULL } tb$layer <- NULL out[[i-1]] <- tb } if (ncol(e) == 2) return(out[[1]]) else return(out) } } extract_fun <- function(x, y, fun, ID=TRUE, weights=FALSE, exact=FALSE, touches=FALSE, small=TRUE, layer=NULL, bind=FALSE, na.rm=FALSE) { nl <- nlyr(x) nf <- length(fun) if ((nf > 1) & (!is.null(layer))) { error("extract", "you cannot use argument 'layer' when using multiple functions") } opt <- spatOptions() e <- x@pntr$extractVectorFlat(y@pntr, fun, na.rm, touches[1], small[1], "", FALSE, FALSE, weights, exact, opt) x <- messages(x, "extract") e <- data.frame(matrix(e, ncol=nl*nf, byrow=TRUE)) if (nf == 1) { colnames(e) <- names(x) } else { colnames(e) <- apply(cbind(rep(fun, each=nl), names(x)), 1, function(i) paste(i, collapse="_")) } if (!is.null(layer)) { e <- cbind(ID=1:nrow(e), e) e <- use_layer(e, y, layer, nlyr(x)) if (!ID || bind) { e$ID <- NULL } ID <- FALSE } if (bind) { if (nrow(e) == nrow(y)) { e <- data.frame(e) e <- cbind(y, e) } else { #? can this occur? warn("extract", "cannot return a SpatVector because the number of records extracted does not match he number of rows in y (perhaps you need to use a summarizing function") } } else if (ID) { e <- cbind(ID=1:nrow(e), e) } e } do_fun <- function(e, fun, ...) { fun <- match.fun(fun) e <- aggregate(e[,-1,drop=FALSE], e[,1,drop=FALSE], fun, ...) m <- sapply(e, NCOL) if (any(m > 1)) { cn <- names(e) e <- do.call(cbind, as.list(e)) i <- rep(1, length(cn)) i[m>1] <- m[m>1] cn <- rep(cn, i) cn <- make.names(cn, TRUE) if (length(cn) == ncol(e)) { colnames(e) <- cn } } e } setMethod("extract", signature(x="SpatRaster", y="SpatVector"), function(x, y, fun=NULL, method="simple", cells=FALSE, xy=FALSE, ID=TRUE, weights=FALSE, exact=FALSE, touches=is.lines(y), small=TRUE, layer=NULL, bind=FALSE, raw=FALSE, search_radius=0, ...) { geo <- geomtype(y) if (!is.null(layer)) { if (length(layer) != nrow(y)) { error("extract", "length(layer) != nrow(y)") } } if (geo == "points") { if (search_radius > 0) { pts <- crds(y) e <- x@pntr$extractBuffer(pts[,1], pts[,2], search_radius) messages(x, "extract") e <- do.call(cbind, e) colnames(e) <- c(names(x)[1], "distance", "cell") e[,3] <- e[,3] + 1 if (xy) { e <- cbind(xyFromCell(x, e[,3]), e) } if (!raw) { e <- cbind(.makeDataFrame(x, e[,1,drop=FALSE]), e[,2:3]) } if (bind) { e <- data.frame(e) e <- cbind(y, e) } else if (ID) { e <- cbind(ID=1:nrow(e), e) } return(e) } else if (weights || exact) { method <- "bilinear" weights <- FALSE exact <- FALSE } # method <- match.arg(tolower(method), c("simple", "bilinear")) } else if (!is.null(fun)) { # nothing to summarize for points txtfun <- .makeTextFun(fun) if (inherits(txtfun, "character")) { if (any(txtfun == "table")) { if (length(fun) > 1) { warn("extract", "'table' cannot be combined with other functions") } if (!is.null(layer)) { warn("extract", "argument 'layer' is ignored when 'fun=table'") } e <- extract_table(x, y, ID=ID, weights=weights, exact=exact, touches=touches, small=small, ...) } else { e <- extract_fun(x, y, txtfun, ID=ID, weights=weights, exact=exact, touches=touches, small=small, bind=bind, layer=layer, ...) } return(e) } else if (weights || exact) { error("extract", "if 'weights' or 'exact' is TRUE, you can only use functions mean, sum, min, max and table") } xy <- cells <- FALSE raw <- TRUE } opt <- spatOptions() e <- x@pntr$extractVectorFlat(y@pntr, "", FALSE, touches[1], small[1], method, isTRUE(cells[1]), isTRUE(xy[1]), isTRUE(weights[1]), isTRUE(exact[1]), opt) x <- messages(x, "extract") cn <- c("ID", names(x)) nc <- nl <- nlyr(x) if (cells) { cn <- c(cn, "cell") nc <- nc + 1 } if (xy) { cn <- c(cn, "x", "y") nc <- nc + 2 } if (weights) { cn <- c(cn, "weight") nc <- nc + 1 } else if (exact) { cn <- c(cn, "fraction") nc <- nc + 1 } if (geo == "points") { ## this was? should be fixed upstream if (nc == nl) { e <- matrix(e, ncol=nc) } else { e <- matrix(e, ncol=nc, byrow=TRUE) } e <- cbind(1:nrow(e), e) if (nrow(e) > nrow(y)) { #multipoint g <- geom(y) e[,1] <- g[,1] } } else { e <- matrix(e, ncol=nc+1, byrow=TRUE) } colnames(e) <- cn if (!is.null(fun)) { e <- as.data.frame(e) e <- do_fun(e, fun, ...) } if (cells) { cncell <- cn =="cell" e[, cncell] <- e[, cncell] + 1 } if (!raw) { if (method != "simple") { e <- as.data.frame(e) } else { id <- data.frame(e[,1,drop=FALSE]) e <- cbind(id, .makeDataFrame(x, e[,-1,drop=FALSE])) } } e <- use_layer(e, y, layer, nl) if (bind) { if (nrow(e) == nrow(y)) { e <- data.frame(e) e <- cbind(y, e[,-1,drop=FALSE]) } else { warn("extract", "cannot return a SpatVector because the number of records extracted does not match the number of rows in y (perhaps you need to use a summarizing function") } } else if (!ID) { e <- e[,-1,drop=FALSE] } e }) setMethod("extract", signature(x="SpatRaster", y="sf"), function(x, y, fun=NULL, method="simple", cells=FALSE, xy=FALSE, ID=TRUE, weights=FALSE, exact=FALSE, touches=is.lines(y), layer=NULL, bind=FALSE, ...) { y <- vect(y) extract(x, y, fun=fun, method=method, cells=cells, xy=xy, ID=ID, weights=weights, exact=exact, touches=touches, layer=layer, bind=bind, ...) } ) setMethod("extract", signature(x="SpatRaster", y="data.frame"), function(x, y, ...) { if (ncol(y) != 2) { error("extract", "extract expects a 2 column data.frame of x and y coordinates") } v <- vect(y, colnames(y)) extract(x, v, ...) }) setMethod("extract", signature(x="SpatRaster", y="numeric"), function(x, y, xy=FALSE, raw=FALSE) { y <- round(y) # y[(y < 1) | (y > ncell(x))] <- NA v <- .extract_cell(x, y, drop=TRUE, raw=raw) if (xy) { v <- cbind(xyFromCell(x, y), v) } v }) setMethod("extract", signature(x="SpatRaster", y="matrix"), function(x, y, cells=FALSE, method="simple") { .checkXYnames(colnames(y)) method <- match.arg(tolower(method), c("simple", "bilinear")) if (method != "simple") { y <- vect(y) return(extract(x, y, method=method, ID=FALSE)) } y <- cellFromXY(x, y) if (cells) { cbind(cell=y, extract(x, y)) } else { extract(x, y) } }) setMethod("extract", signature(x="SpatRaster", y="SpatExtent"), function(x, y, cells=FALSE, xy=FALSE) { y <- cells(x, y) v <- extract(x, y, xy=xy) if (cells) { v <- cbind(cell=y, v) } v } ) setMethod("extract", c("SpatVector", "SpatVector"), function(x, y) { e <- relate(y, x, "coveredby", pairs=TRUE, na.rm=FALSE) if (ncol(x) > 0) { d <- as.data.frame(x) e <- data.frame(id.y=e[,1], d[e[,2], ,drop=FALSE]) rownames(e) <- NULL } else { colnames(e) <- c("id.y", "id.x") } e }) setMethod("extract", signature(x="SpatVector", y="matrix"), function(x, y) { stopifnot(ncol(y) == 2) .checkXYnames(colnames(y)) y <- vect(y) extract(x, y) }) setMethod("extract", signature(x="SpatVector", y="data.frame"), function(x, y) { extract(x, as.matrix(y)) }) setMethod("extract", signature(x="SpatRasterCollection", y="ANY"), function(x, y, ...) { lapply(x, function(r) extract(r, y, ...)) } ) setMethod("extract", signature(x="SpatRasterDataset", y="ANY"), function(x, y, ...) { lapply(x, function(r) extract(r, y, ...)) } ) extractAlong <- function(x, y, ID=TRUE, cells=FALSE, xy=FALSE, online=FALSE, bilinear=TRUE) { stopifnot(inherits(x, "SpatRaster")) if (inherits(y, "sf")) { y <- vect(y) } else { stopifnot(inherits(y, "SpatVector")) } stopifnot(geomtype(y) == "lines") spbb <- as.matrix(ext(y)) rsbb <- as.matrix(ext(x)) addres <- 2 * max(res(x)) nlns <- nrow(y) res <- vector(mode = "list", length = nlns) if (spbb[1,1] > rsbb[1,2] | spbb[1,2] < rsbb[1,1] | spbb[2,1] > rsbb[2,2] | spbb[2,2] < rsbb[2,1]) { res <- data.frame(matrix(ncol=nlyr(x)+4, nrow=0)) colnames(res) <- c("ID", "cell", "x", "y", names(x)) if (!cells) res$cell <- NULL if (!xy) { res$x <- NULL res$y <- NULL } if (!ID) res$ID <- NULL return(res) } rr <- rast(x) g <- data.frame(geom(y)) for (i in 1:nlns) { yp <- g[g$geom == i, ] nparts <- max(yp$part) vv <- NULL for (j in 1:nparts) { pp <- as.matrix(yp[yp$part==j, c("x", "y"), ]) for (k in 1:(nrow(pp)-1)) { ppp <- pp[k:(k+1), ] spbb <- t(ppp) if (! (spbb[1,1] > rsbb[1,2] | spbb[1,2] < rsbb[1,1] | spbb[2,1] > rsbb[2,2] | spbb[2,2] < rsbb[2,1]) ) { lns <- vect(ppp, "lines") rc <- crop(rr, ext(lns) + addres) rc <- rasterize(lns, rc, touches=TRUE) cxy <- crds(rc) v <- cbind(row=rowFromY(rr, cxy[,2]), col=colFromX(rr, cxy[,1])) #up or down? updown <- c(1,-1)[(ppp[1,2] < ppp[2,2]) + 1] rightleft <- c(-1,1)[(ppp[1,1] < ppp[2,1]) + 1] v <- v[order(updown*v[,1], rightleft*v[,2]), ] vv <- rbind(vv, v) } } } if (!is.null(vv)) { cell <- cellFromRowCol(rr, vv[,1], vv[,2]) res[[i]] <- data.frame(i, cell) } } res <- do.call(rbind, res) if (is.null(res)) { if (xy) { res <- data.frame(matrix(ncol=nlyr(x)+4, nrow=0)) colnames(res) <- c("ID", "cell", "x", "y", names(x)) } else { res <- data.frame(matrix(ncol=nlyr(x)+2, nrow=0)) colnames(res) <- c("ID", "cell", names(x)) } } else { colnames(res) <- c("ID", "cell") if (xy) { xycrd <- xyFromCell(x, res$cell) method <- "simple" if (online) { pts <- vect(xycrd, crs="local") crs(y) <- "local" n <- nearest(pts, y) xycrd <- crds(n) if (bilinear) method <- "bilinear" res <- data.frame(res, xycrd, extract(x, xycrd, method=method)) } else { res <- data.frame(res, xycrd, extract(x, res$cell)) } } else { res <- data.frame(res, extract(x, res$cell)) } } if (!cells) res$cell <- NULL if (!ID) res$ID <- NULL res } setMethod("extractRange", signature(x="SpatRaster", y="ANY"), function(x, y, first, last, lyr_fun=NULL, geom_fun=NULL, ID=FALSE, na.rm=TRUE, ...) { first <- getLyrNrs(first, names(x), NROW(y)) + 1 last <- getLyrNrs(last, names(x), NROW(y)) + 1 if (inherits(y, "SpatVector")) { e <- extract(x, y, geom_fun, ID=TRUE, na.rm=na.rm, ...) if (nrow(e) != nrow(y)) { error("extractRange", "geom_fun must return a single value for each geometry/layer") } } else { e <- data.frame(ID=1:NROW(y), extract(x, y, ...)) } a <- lapply(1:nrow(e), function(i) e[i, c(first[i]:last[i])]) if (!is.null(lyr_fun)) { a <- sapply(a, lyr_fun, na.rm=na.rm) } if (ID) { if (is.list(a)) { names(a) <- 1:NROW(y) } else { a <- data.frame(ID=1:nrow(a), value=a) } } a } ) terra/R/distance.R0000644000176200001440000002125014752176377013530 0ustar liggesusers# Author: Robert J. Hijmans # Date : July 2019 # Version 1.0 # License GPL v3 setMethod("buffer", signature(x="SpatRaster"), function(x, width, background=0, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$buffer(width, background, opt) messages(x, "buffer") } ) #setMethod("nearest", signature(x="SpatRaster"), # function(x, target=NA, exclude=NULL, unit="m", method="haversine", filename="", ...) { # # if (!(method %in% c("geo", "haversine", "cosine"))) { # error("nearest", "not a valid method. Should be one of: 'geo', 'haversine', 'cosine'") # } # opt <- spatOptions(filename, ...) # target <- as.numeric(target[1]) # keepNA <- FALSE # if (!is.null(exclude)) { # exclude <- as.numeric(exclude[1]) # if ((is.na(exclude) && is.na(target)) || isTRUE(exclude == target)) { # error("nearest", "'target' and 'exclude' must be different") # } # if (is.na(exclude)) { # keepNA <- TRUE # } # } else { # exclude <- NA # } # x@pntr <- x@pntr$nearest(target, exclude, keepNA, tolower(unit), TRUE, method, opt) # messages(x, "nearest") # } # #) setMethod("distance", signature(x="SpatRaster", y="missing"), function(x, y, target=NA, exclude=NULL, unit="m", method="haversine", maxdist=NA, values=FALSE, filename="", ...) { method <- match.arg(tolower(method), c("cosine", "haversine", "geo")) opt <- spatOptions(filename, ...) target <- as.numeric(target[1]) keepNA <- FALSE if (!is.null(exclude)) { exclude <- as.numeric(exclude[1]) if ((is.na(exclude) && is.na(target)) || isTRUE(exclude == target)) { error("distance", "'target' and 'exclude' must be different") } if (is.na(exclude)) { keepNA <- TRUE } } else { exclude <- NA } x@pntr <- x@pntr$rastDistance(target, exclude, keepNA, tolower(unit), TRUE, method, isTRUE(values), maxdist, opt) messages(x, "distance") } ) setMethod("costDist", signature(x="SpatRaster"), function(x, target=0, scale=1, maxiter=50, filename="", ...) { opt <- spatOptions(filename, ...) maxiter <- max(maxiter[1], 2) x@pntr <- x@pntr$costDistance(target[1], scale[1], maxiter, FALSE, opt) messages(x, "costDist") } ) setMethod("gridDist", signature(x="SpatRaster"), function(x, target=0, scale=1, maxiter=50, filename="", ...) { opt <- spatOptions(filename, ...) if (is.na(target)) { x@pntr <- x@pntr$gridDistance(scale[1] , opt) } else { maxiter <- max(maxiter[1], 2) x@pntr <- x@pntr$costDistance(target[1], scale[1], maxiter, TRUE, opt) } messages(x, "gridDist") } ) setMethod("distance", signature(x="SpatRaster", y="SpatVector"), function(x, y, unit="m", rasterize=FALSE, method="cosine", filename="", ...) { opt <- spatOptions(filename, ...) unit <- as.character(unit[1]) method <- match.arg(tolower(method), c("cosine", "haversine", "geo")) x@pntr <- x@pntr$vectDistance(y@pntr, rasterize, unit, method, opt) # if (rasterize) { # x@pntr <- x@pntr$vectDistanceRasterize(y@pntr, NA, NA, unit, method, opt) # } else { # x@pntr <- x@pntr$vectDistanceDirect(y@pntr, unit, method, opt) # } messages(x, "distance") } ) setMethod("distance", signature(x="SpatRaster", y="sf"), function(x, y, unit="m", rasterize=FALSE, method="cosine", filename="", ...) { distance(x, vect(y), unit=unit, rasterize=rasterize, method=method, filename=filename, ...) } ) mat2wide <- function(m, sym=TRUE, keep=NULL) { if (inherits(m, "dist")) { # sym must be true in this case nr <- attr(m, "Size") x <- rep(1:(nr-1), (nr-1):1) y <- unlist(sapply(2:nr, function(i) i:nr)) cbind(x,y, as.vector(m)) } else { bool <- is.logical(m) if (sym) { m[lower.tri(m)] <- NA } m <- cbind(from=rep(1:nrow(m), each=ncol(m)), to=rep(1:ncol(m), nrow(m)), value=as.vector(t(m))) m <- m[!is.na(m[,3]), , drop=FALSE] if (!is.null(keep)) { m <- m[m[,3] == keep, 1:2, drop=FALSE] } m } } setMethod("distance", signature(x="SpatVector", y="ANY"), function(x, y, sequential=FALSE, pairs=FALSE, symmetrical=TRUE, unit="m", method="geo") { if (!missing(y)) { error("distance", "If 'x' is a SpatVector, 'y' should be a SpatVector or missing") } method <- match.arg(tolower(method), c("cosine", "haversine", "geo")) if (sequential) { return( x@pntr$distance_self(sequential, unit, method)) } unit <- as.character(unit[1]) d <- x@pntr$distance_self(sequential, unit, method) messages(x, "distance") class(d) <- "dist" attr(d, "Size") <- nrow(x) attr(d, "Diag") <- FALSE attr(d, "Upper") <- FALSE attr(d, "method") <- "spatial" if (pairs) { d <- as.matrix(d) diag(d) <- NA d <- mat2wide(d, symmetrical) } d } ) setMethod("distance", signature(x="SpatVector", y="SpatVector"), function(x, y, pairwise=FALSE, unit="m", method = "cosine") { unit <- as.character(unit[1]) d <- x@pntr$distance_other(y@pntr, pairwise, unit, method) messages(x, "distance") if (!pairwise) { d <- matrix(d, nrow=nrow(x), ncol=nrow(y), byrow=TRUE) } d } ) test.for.lonlat <- function(xy) { x <- range(xy[,1], na.rm=TRUE) y <- range(xy[,2], na.rm=TRUE) x[1] >= -180 && x[2] <= 180 && y[1] > -90 && y[2] < 90 } setMethod("distance", signature(x="matrix", y="matrix"), function(x, y, lonlat, pairwise=FALSE, unit="m", method="geo") { if (missing(lonlat)) { lonlat <- test.for.lonlat(x) & test.for.lonlat(y) warn("distance", paste0("lonlat not set. Assuming lonlat=", lonlat)) } stopifnot(ncol(x) == 2) stopifnot(ncol(y) == 2) v <- vect() stopifnot(unit %in% c("m", "km")) m <- ifelse(unit == "m", 1, 0.001) d <- v@pntr$point_distance(x[,1], x[,2], y[,1], y[,2], pairwise[1], m, lonlat, method=method) messages(v) if (pairwise) { d } else { matrix(d, nrow=nrow(x), ncol=nrow(y), byrow=TRUE) } } ) setMethod("distance", signature(x="data.frame", y="data.frame"), function(x, y, lonlat, pairwise=FALSE, unit="m", method="geo") { distance(as.matrix(x), as.matrix(y), lonlat, pairwise=pairwise, unit=unit, method=method) } ) setMethod("distance", signature(x="matrix", y="missing"), function(x, y, lonlat=NULL, sequential=FALSE, pairs=FALSE, symmetrical=TRUE, unit="m", method="geo") { if (missing(lonlat)) { lonlat <- test.for.lonlat(x) & test.for.lonlat(y) warn("distance", paste0("lonlat not set. Assuming lonlat=", lonlat)) } crs <- ifelse(isTRUE(lonlat), "+proj=longlat +datum=WGS84", "+proj=utm +zone=1 +datum=WGS84") x <- vect(x, crs=crs) distance(x, sequential=sequential, pairs=pairs, symmetrical=symmetrical, unit=unit, method=method) } ) setMethod("distance", signature(x="data.frame", y="missing"), function(x, y, lonlat=NULL, sequential=FALSE, pairs=FALSE, symmetrical=TRUE, unit="m", method="geo") { distance(as.matrix(x), lonlat=lonlat, sequential=sequential, pairs=pairs, symmetrical=symmetrical, unit=unit, method=method) } ) setMethod("direction", signature(x="SpatRaster"), function(x, from=FALSE, degrees=FALSE, method="cosine", filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$rastDirection(from[1], degrees[1], NA, NA, method, opt) messages(x, "direction") } ) match_abs <- function(x, y, ...) { d <- colMeans(abs(y - x), ...) which.min(d)[1] } match_sqr <- function(x, y, ...) { d <- colMeans((y - x)^2, ...) which.min(d)[1] } setMethod("bestMatch", signature(x="SpatRaster", y="matrix"), function(x, y, labels=NULL, fun="squared", ..., filename="", overwrite=FALSE, wopt=list()) { if (!(all(colnames(y) %in% names(x)) && (all(names(x) %in% colnames(y))))) { error("bestMatch", "names of x and y must match") } if (inherits(fun, "character")) { fun <- match.arg(tolower(fun), c("abs", "squared")) if (fun == "abs") { f <- match_abs } else { f <- match_sqr } out <- app(x, f, y=t(y), ...) } else { out <- app(x, fun, y=t(y), ...) } if (!is.null(labels)) { levels(out) <- data.frame(ID=1:nrow(y), label=labels) } if (filename!="") { out <- writeRaster(out, filename, wopt=wopt) } out } ) setMethod("bestMatch", signature(x="SpatRaster", y="SpatVector"), function(x, y, labels=NULL, fun="squared", ..., filename="", overwrite=FALSE, wopt=list()) { y <- as.matrix(extract(x, y, fun="mean", ..., na.rm=TRUE, ID=FALSE)) bestMatch(x, y, labels=labels, fun=fun, filename=filename, ...) } ) setMethod("bestMatch", signature(x="SpatRaster", y="data.frame"), function(x, y, labels=NULL, fun="squared", ..., filename="", overwrite=FALSE, wopt=list()) { if (!(all(names(y) %in% names(x)) && (all(names(x) %in% names(y))))) { error("bestMatch", "names of x and y must match") } # y <- y[, names(x), drop=FALSE] i <- unique(sapply(y, class)) if (any(i != "numeric")) { error("bestMatch", "all values in y must be numeric") } y <- as.matrix(y) bestMatch(x, y, labels=labels, fun=fun, filename=filename, ...) } ) terra/R/twoClasses.R0000644000176200001440000000426714746604252014065 0ustar liggesusers# Author: Robert J. Hijmans # Date : January 2025 # Version 1.0 # License GPL v3 otsu <- function(values, counts) { #based on https://stackoverflow.com/questions/51116495/auto-thresholding-on-r-raster-object by Eric n <- length(values) w1 <- cumsum(counts) w2 <- w1[n] + counts - w1 cv <- counts * values m1 <- cumsum(cv) m2 <- m1[n] + cv - m1 varian <- w1 * w2 * (m2/w2 - m1/w1)^2 mxi <- which(varian == max(varian, na.rm = TRUE)) (values[mxi[1]] + values[mxi[length(mxi)]])/2 } setMethod("thresh", signature(x="SpatRaster"), function(x, method="otsu", maxcell=1000000, combine=FALSE, as.raster=TRUE, filename="", ...) { method <- match.arg(tolower(method), c("mean", "median", "otsu")) nl <- nlyr(x) if (combine) { if (method == "otsu") { rng <- minmax(x, compute=TRUE) breaks <- seq(rng[1], rng[2], length.out=257) h <- classify(x, breaks, include.lowest=TRUE, right=FALSE) f <- freq(h) f <- aggregate(f[,3,drop=FALSE], f[,2,drop=FALSE], sum) breaks <- breaks + ((breaks[2] - breaks[1]) / 2) f$value <- breaks[f$value+1] th <- otsu(f$value, f$count) } else if (method == "mean") { r <- spatSample(x, maxcell, "regular", as.df=FALSE) th <- mean(r, na.rm=TRUE) } else if (method == "median") { r <- spatSample(x, maxcell, "regular", as.df=FALSE) th <- median(r, na.rm=TRUE) } } else { if (method == "otsu") { th <- rep(NA, nl) rng <- minmax(x, compute=TRUE) for (i in 1:nl) { breaks <- seq(rng[1,i], rng[2, i], length.out=257) h <- classify(x, breaks, include.lowest=TRUE, right=FALSE) f <- freq(h) breaks <- breaks + ((breaks[2] - breaks[1]) / 2) f[,2] <- breaks[f[,2]+1] j <- f[,1] == i th[i] <- otsu(f[j,2], f[j,3]) } } else if (method == "mean") { th <- global(x, "mean", na.rm=TRUE)[,1] } else if (method == "median") { r <- spatSample(x, maxcell, "regular", as.df=FALSE) th <- apply(r, 2, median, na.rm=TRUE) } } if (!as.raster) { if (combine) { th <- as.vector(th) } else { names(th) <- names(x) } return(th) } opt <- spatOptions(filename, ...) x@pntr <- x@pntr$arith_numb(th, ">", FALSE, FALSE, opt) messages(x, "thresh") } ) terra/R/read.R0000644000176200001440000000267114726700274012645 0ustar liggesusers# Author: Robert J. Hijmans # Date : December 2017 # Version 1.0 # License GPL v3 setMethod("readStart", signature(x="SpatRaster"), function(x) { success <- x@pntr$readStart() messages(x, "readStart") if (!success) error("readStart,SpatRaster", "cannot open file for reading") invisible(success) } ) setMethod("readStart", signature(x="SpatRasterDataset"), function(x) { success <- x@pntr$readStart() messages(x, "readStart") if (!success) error("readStart,SpatRasterDataset", "cannot open file for reading") invisible(success) } ) #setMethod("readStart", signature(x="SpatRasterDataset"), # function(x, ...) { # nsd <- length(x) # for (i in 1:nsd) { # y <- x[i] # success <- readStart(y) # x[i] <- y # } # messages(x, "readStart") # invisible(success) # } #) setMethod("readStop", signature(x="SpatRaster"), function(x) { success <- x@pntr$readStop() messages(x, "readStop") invisible(success) } ) setMethod("readStop", signature(x="SpatRasterDataset"), function(x) { success <- x@pntr$readStop() messages(x, "readStop") invisible(success) } ) setMethod("toMemory", signature(x="SpatRaster"), function(x) { x@pntr <- x@pntr$deepcopy() x@pntr$readAll() messages(x, "toMemory") } ) setMethod("toMemory", signature(x="SpatRasterDataset"), function(x) { x@pntr <- x@pntr$deepcopy() x@pntr$readAll() messages(x, "toMemory") } ) terra/R/layerCor.R0000644000176200001440000001257214726700274013513 0ustar liggesusers# Robert Hijmans # Date : Nov 2021 # Version 1.0 # Licence GPL v3 # Computation of the weighted covariance and (optionally) weighted means of bands in an Raster. # based on code for "raster" by Jonathan Greenberg and Robert Hijmans # partly based on code by Mort Canty setMethod("layerCor", signature(x="SpatRaster"), function(x, fun, w, asSample=TRUE, use="everything", maxcell=Inf, ...) { ops <- c("everything", "complete.obs", "pairwise.complete.obs", "masked.complete") # backwards compatibility na.rm <- list(...)$na.rm if (isTRUE(na.rm) && (use == "everything")) { use <- "pairwise.complete.obs" } use <- match.arg(use, ops) if (use != "everything") { na.rm <- TRUE } else { na.rm <- FALSE } stopifnot(is.logical(asSample) & !is.na(asSample)) nl <- nlyr(x) if (nl < 2) { error("layerCor", "x must have at least 2 layers") } if (inherits(fun, "character")) { fun <- tolower(fun) if (!(fun %in% c("cov", "weighted.cov", "pearson", "cor"))) { error("layerCor", "character function names must be one of: 'cor', 'cov', or 'weighted.cov'") } # backwards compatibility if (fun == "pearson") fun = "cor" if (fun == "weighted.cov") { if (missing(w)) { error("layerCor", "to compute weighted covariance a weights layer should be provided") } stopifnot( nlyr(w) == 1 ) x <- c(w, x) } } else { FUN <- fun fun <- "" } if (maxcell < ncell(x)) { x <- spatSample(x, size=maxcell, "regular", as.raster=TRUE) } n <- ncell(x) # for "cor" masking is done in cpp code if ((use == "complete.obs") && (fun != "cor")) { x <- mask(x, anyNA(x), maskvalue=TRUE) } if (fun == "weighted.cov") { w <- x[[1]] x <- x[[-1]] means <- mat <- matrix(NA, nrow=nl, ncol=nl) colnames(means) <- rownames(means) <- colnames(mat) <- rownames(mat) <- names(x) sqrtw <- sqrt(w) for(i in 1:nl) { for(j in i:nl) { s <- c(x[[c(i,j)]]) if (use == "pairwise.complete.obs") { s <- mask(c(s, w), anyNA(s), maskvalue=TRUE) ww <- s[[3]] s <- s[[1:2]] sumw <- unlist(global(ww, fun="sum", na.rm=TRUE) ) avg <- unlist(global(s * ww, fun="sum", na.rm=TRUE)) / sumw } else { sumw <- unlist(global(w, fun="sum", na.rm=na.rm) ) avg <- unlist(global(s * w, fun="sum", na.rm=na.rm)) / sumw } sumw <- sumw - asSample s <- prod( (s - avg) * sqrtw ) v <- unlist(global(s, fun="sum", na.rm=na.rm)) / sumw mat[j,i] <- mat[i,j] <- v means[i,j] <- avg[1] means[j,i] <- avg[2] } } return( list(weighted_covariance=mat, weighted_mean=means) ) } else if (fun == "cov") { means <- mat <- nn <- matrix(NA, nrow=nl, ncol=nl) colnames(means) <- rownames(means) <- colnames(mat) <- rownames(mat) <- names(x) n_ij <- n for(i in 1:nl) { for(j in i:nl) { s <- x[[c(i,j)]] if (use == "pairwise.complete.obs") { m <- anyNA(s) s <- mask(s, m, maskvalue=TRUE) n_ij <- n - global(m, fun="sum")$sum } avg <- unlist(global(s, fun="mean", na.rm=na.rm) ) r <- prod(s - avg) v <- unlist(global(r, fun="sum", na.rm=na.rm)) / (n_ij - asSample) mat[j,i] <- mat[i,j] <- v means[i,j] <- avg[1] means[j,i] <- avg[2] nn[i,j] <- nn[j,i] <- n_ij } } return( list(covariance=mat, mean=means, n=nn) ) } else if (fun == "cor") { if (isTRUE(list(...)$old)) { old_pearson(x, asSample=asSample, na.rm=na.rm, nl=nl, n=n, mat=mat) } else { opt <- spatOptions() m <- x@pntr$layerCor("cor", use, asSample, opt) x <- messages(x) m <- lapply(m, function(i) { matrix(i, nrow=nl, byrow=TRUE, dimnames=list(names(x), names(x))) }) names(m) <- c("correlation", "mean", "n") return(m) } } else { v <- spatSample(x, size=maxcell, "regular", na.rm=na.rm, warn=FALSE) if (use %in% c("complete.obs", "complete.masked")) { v <- na.omit(v) } mat <- matrix(NA, nrow=nl, ncol=nl) for(i in 1:nl) { for(j in i:nl) { if (use == "pairwise.complete.obs") { vij <- na.omit(v[,c(i,j)]) mat[j,i] <- mat[i,j] <- FUN(vij[,1], vij[,2], ...) } else { mat[j,i] <- mat[i,j] <- FUN(v[,i], v[,j], ...) } } } mat } } ) old_pearson <- function(x, asSample, na.rm, nl, n, mat) { if (na.rm) { means <- matrix(NA, nrow=2, ncol=nlyr(x)) for(i in 1:(nl-1)) { for(j in (i+1):nl) { m <- anyNA(x[[c(i,j)]]) a <- mask(x[[i]], m, maskvalue=TRUE) b <- mask(x[[j]], m, maskvalue=TRUE) xx <- c(a, b) mns <- unlist(global(xx, fun="mean", na.rm=na.rm) ) means[2,i] <- mns[1] means[1,j] <- mns[2] sds <- unlist(global(xx, fun="sd", na.rm=na.rm) ) r <- prod(xx - mns) nas <- unlist(global(is.na(r), fun="sum")) v <- unlist(global(r, fun="sum", na.rm=na.rm)) v <- v / ((n - nas - asSample) * sds[1] * sds[2]) mat[j,i] <- mat[i,j] <- v } } colnames(means) <- names(x) } else { means <- unlist(global(x, fun="mean", na.rm=na.rm) ) sds <- unlist(global(x, fun="sd", na.rm=na.rm) ) x <- (x - means) for(i in 1:(nl-1)) { for(j in i:nl) { r <- x[[i]] * x[[j]] v <- unlist(global(r, fun="sum", na.rm=na.rm)) v <- v / ((n - asSample) * sds[i] * sds[j]) mat[j,i] <- mat[i,j] <- v } } means <- matrix(means, nrow=1) colnames(means) <- names(x) } diag(mat) <- 1 covar <- list(mat, means) names(covar) <- c("pearson", "mean") return(covar) } terra/R/RGB.R0000644000176200001440000001227414726700274012344 0ustar liggesusers# Author: Robert J. Hijmans # Date : April 2010 # Version 0.9 # License GPL v3 setMethod ("has.RGB" , "SpatRaster", function(x, strict=TRUE) { if (strict) { x@pntr$rgbtype == "rgb" } else { x@pntr$rgbtype != "" } } ) setMethod("set.RGB", signature(x="SpatRaster"), function(x, value=1:3, type="rgb") { if (is.null(value[1]) || is.na(value[1]) || any(value < 1)) { x@pntr$removeRGB() } else { if (inherits(value, "character")) { i <- match(value, names(x)) j <- !is.na(i) value[j] <- i[j] value <- as.integer(value) } if (!all(value %in% 1:nlyr(x))) { error("set.RGB", "value(s) are not value layer numbers") } if (length(value) == 3) { x@pntr$setRGB(value[1]-1, value[2]-1, value[3]-1, -99, type) } else if (length(value) == 4) { x@pntr$setRGB(value[1]-1, value[2]-1, value[3]-1, value[4]-1, type) } else { error("set.RGB", "value must have length 3 or 4") } } x <- messages(x, "set.RGB") invisible(TRUE) } ) setMethod("RGB<-", signature(x="SpatRaster"), function(x, ..., type="rgb", value) { x@pntr <- x@pntr$deepcopy() set.RGB(x, value, type) x } ) setMethod("RGB", signature(x="SpatRaster"), function(x, value=NULL, type="rgb") { if (!is.null(value)) { RGB(x, type=type) <- value return(x) } else { if (x@pntr$rgb) { x@pntr$getRGB() + 1 } else { return(NULL) } } } ) #### RGB2col make_cut <- function(x) { j <- length(x) out <- vector("list", 2*j) for (i in 1:j) { rgb <- x[[i]] if (NROW(rgb) <= 1) { out[[i]] <- rgb j <- j - 1 next } rng <- apply(rgb[,-1], 2, function(i) diff(range(i))) if (max(rng) == 0) { out[[i]] <- rgb j <- j - 1 next } p <- which.max(rng) + 1 m <- median(rgb[,p]) out[[i]] <- rgb[rgb[,p] >= m, ,drop=FALSE] out[[i+j]] <- rgb[rgb[,p] < m, ,drop=FALSE] } i <- sapply(out, is.null) out <- out[!i] i <- sapply(out, nrow) > 0 out[i] } median_cut <- function(v) { v <- list(v) n <- 0 while ((length(v) < 129) & (length(v) > n)) { n <- length(v) v <- make_cut(v) } s <- sapply(v, function(i) max(apply(i[,-1,drop=FALSE], 2, function(j) diff(range(j))))) n <- 256 - length(v) ss <- rev(sort(s)) ss <- max(2, min(ss[1:n])) i <- which(s > ss) if (length(i) > 0) { vv <- make_cut(v[i]) v <- c(v[-i], vv) } v <- lapply(1:length(v), function(i) cbind(group=i, v[[i]])) do.call(rbind, v) } rgb2col <- function(x, value, stretch=NULL, grays=FALSE, NAzero=FALSE, filename="", overwrite=FALSE, ...) { idx <- RGB(x) if (is.null(idx)) { if (missing(value)) { error("colorize", "x does not have an RGB attribute and the value argument is missing") } else { idx <- value } } n <- length(idx) stopifnot((n == 3) | (n == 4)) if ((min(idx) < 1) | (max(idx) > nlyr(x))) { error("colorize", "invalid value (RGB indices)") } x <- x[[idx]] if (!is.null(stretch)) { if (stretch == "lin") { x <- stretch(x, minq=0.02, maxq=0.98) } else { x <- stretch(x, histeq=TRUE, scale=255) } } if (n == 4) x[[4]] <- x[[4]] * 255 if (NAzero) { x <- classify(x, cbind(NA, 0)) } if (grays) { opt <- spatOptions(filename, overwrite, ...) x@pntr <- x@pntr$rgb2col(0, 1, 2, opt) return(messages(x, "colorize")) } v <- cbind(id=1:ncell(x), values(x)) v <- median_cut(stats::na.omit(v)) a <- aggregate(v[,-c(1:2)], list(v[,1]), median) # if (n==3) { # a$cols <- grDevices::rgb(a[,2], a[,3], a[,4], maxColorValue=255) # } else { # a$cols <- grDevices::rgb(a[,2], a[,3], a[,4], a[,5], maxColorValue=255) # } m <- merge(v[,1:2], a, by=1) m[,1] <- m[,1] - 1 r <- rast(x, 1) r[m$id] <- m$group coltab(r) <- unique(m[,-2]) if (filename != "") { r <- writeRaster(r, filename, overwrite, ...) } r } terra_col2rgb <- function(x, alpha=FALSE, filename="", overwrite=FALSE, ...) { if (nlyr(x) > 1) { x <- x[[1]] warn("colorize", "only the first layer of 'x' is considered") } ct <- coltab(x)[[1]] if (is.null(ct)) { error("colorize", "x has no color table") } ct <- unique(as.matrix(ct)) nms <- c("red", "green", "blue", "alpha") rgbidx <- 1:4 if (!alpha) { ct <- ct[,1:4] nms <- nms[1:3] rgbidx <- rgbidx[1:3] } wopt=list(...) if (is.null(wopt$names)) { wopt$names <- nms } out <- subst(x, from=ct[,1], to=ct[,-1], raw=TRUE, filename=filename, overwrite=overwrite, wopt=wopt) set.RGB(out, rgbidx) out } setMethod("colorize", signature(x="SpatRaster"), function(x, to="hsv", alpha=FALSE, stretch=NULL, grays=FALSE, NAzero=FALSE, filename="", overwrite=FALSE, ...) { to <- tolower(to) if (to %in% c("hsi", "hsl", "hsv")) { opt <- spatOptions(filename, overwrite, ...) x@pntr <- x@pntr$rgb2hsx(to, opt) } else if (to == "rgb") { if (nlyr(x) == 1) { return(terra_col2rgb(x, alpha=alpha, filename=filename, overwrite=overwrite, ...)) } else { opt <- spatOptions(filename, overwrite, ...) x@pntr <- x@pntr$hsx2rgb(opt) } } else if (to == "hsl") { opt <- spatOptions(filename, overwrite, ...) x@pntr <- x@pntr$hsx2rgb(to, opt) } else if (to == "col") { return(rgb2col(x, stretch=stretch, grays=grays, NAzero=NAzero, filename=filename, overwrite=overwrite, ...)) } else { error("colorize", "'to' is not valid. Should be 'rgb', 'col', 'hsi', 'hsl', or 'hsv'") } messages(x) } ) terra/R/math.R0000644000176200001440000000562514726700274012665 0ustar liggesusers# Author: Robert J. Hijmans # Date : September 2018 # Version 1.0 # License GPL v3 #to do #"gamma", "lgamma", "digamma", "trigamma") setMethod("log", signature(x="SpatRaster"), function(x, base=exp(1)){ opt <- spatOptions() if (base == exp(1)) { x@pntr <- x@pntr$math("log", opt) } else if (base == 2) { x@pntr <- x@pntr$math("log2", opt) } else if (base == 10) { x@pntr <- x@pntr$math("log10", opt) } else { x <- app(x, function(i) log(i, base)) } x } ) #? "gamma", "lgamma", "digamma", "trigamma" setMethod("Math", signature(x="SpatRaster"), function(x){ oper <- as.vector(.Generic)[1] opt <- spatOptions() if (substr(oper, 1, 3) == "cum") { x@pntr <- x@pntr$cum(substr(oper, 4, 10), FALSE, opt) } else if (oper %in% c("acos", "acosh", "asin", "asinh", "atan", "atanh", "cos", "cosh", "cospi", "sin", "sinh", "sinpi", "tan", "tanh", "tanpi")) { x@pntr <- x@pntr$trig(oper, opt) } else { x@pntr <- x@pntr$math(oper, opt) } messages(x, oper) } ) setMethod("math", signature(x="SpatRaster"), function(x, fun, digits=0, filename="", overwrite=FALSE, ...){ if (!is.character(fun)) { error("math", "fun must be a character value") } fun = fun[1] opt <- spatOptions(filename, overwrite, ...) if (substr(fun, 1, 3) == "cum") { x@pntr <- x@pntr$cum(substr(fun, 4, 10), FALSE, "", FALSE) } else if (fun %in% c("acos", "acosh", "asin", "asinh", "atan", "atanh", "cos", "cosh", "cospi", "sin", "sinh", "sinpi", "tan", "tanh", "tanpi")) { x@pntr <- x@pntr$trig(fun, opt) } else if (fun %in% c("abs", "sign", "sqrt", "ceiling", "floor", "trunc", "log", "log10", "log2")) { x@pntr <- x@pntr$math(fun, opt) } else if (fun %in% c("round", "signif")) { x@pntr <- x@pntr$math2(fun, digits, opt) } else { error("math", "unknown function") } messages(x, fun) } ) setMethod("Math2", signature(x="SpatRaster"), function(x, digits=0){ opt <- spatOptions() oper <- as.vector(.Generic)[1] x@pntr <- x@pntr$math2(oper, digits, opt) messages(x, oper) } ) setMethod("Math", signature(x="SpatExtent"), function(x){ oper <- as.vector(.Generic)[1] if (oper == "floor") { x@pntr <- x@pntr$floor() } else if (oper == "ceiling") { x@pntr <- x@pntr$ceil() } else { error(oper, "not implemented for SpatExtent") } if (!is.valid(x)) { error(oper, "invalid extent") } return(x) } ) setMethod("Math2", signature(x="SpatExtent"), function(x, digits=0){ oper <- as.vector(.Generic)[1] if (oper == "round") { x@pntr <- x@pntr$round(digits) if (!is.valid(x)) { error(oper, "invalid extent") } return(x) } else { error(oper, "not implemented for SpatExtent") } } ) setMethod("Math2", signature(x="SpatVector"), function(x, digits=4){ oper <- as.vector(.Generic)[1] if (oper == "round") { x@pntr <- x@pntr$round(digits) return(x) } else { error(oper, "not implemented for SpatVector") } } ) terra/R/cells.R0000644000176200001440000000420414734622000013013 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2020 # Version 1.0 # License GPL v3 setMethod("cells", signature(x="SpatRaster", y="missing"), function(x, y) { if (hasValues(x)) { opt <- spatOptions() x@pntr$cells_notna_novalues(opt) + 1 } else { # is this useful? 1:ncell(x) } } ) setMethod("cells", signature(x="SpatRaster", y="numeric"), function(x, y, pairs=FALSE) { opt <- spatOptions() v <- x@pntr$is_in_cells(y, pairs, opt) x <- messages(x, "cells") if (pairs) { v <- lapply(v, function(i) { m <- matrix(i, ncol=2) m[,1] <- m[,1] + 1 colnames(m) <- c("cell", "value") m }) } else { v <- lapply(v, function(i) i+1) } names(v) <- names(x) v } ) setMethod("cells", signature("SpatRaster", "SpatVector"), function(x, y, method="simple", weights=FALSE, exact=FALSE, touches=is.lines(y), small=TRUE) { method = match.arg(tolower(method), c("simple", "bilinear")) opt <- spatOptions() d <- x@pntr$vectCells(y@pntr, touches[1], small[1], method[1], weights[1], exact[1], opt) if (geomtype(y) == "points") { d <- matrix(d, nrow=nrow(y), byrow=TRUE) d <- cbind(1:nrow(y), d) if (method == "bilinear") { colnames(d) <- c("ID", "c1", "c2", "c3", "c4", "w1", "w2", "w3", "w4") d[,2:5] <- d[,2:5] + 1 } else { colnames(d) <- c("ID", "cell") d[,2] <- d[,2] + 1 } return (d) } cn <- c("ID", "cell") if (weights[1] || exact[1]) { d <- matrix(d, ncol=3) cn <- c(cn, "weights") } else { d <- matrix(d, ncol=2) } d[,1:2] <- d[,1:2] + 1 colnames(d) <- cn d } ) #setMethod("cells", signature("SpatRaster", "SpatExtent"), # function(x, y, ...) { # p <- as.polygons(y, crs=crs(x)) # cells(x, p)[,2] # } #) #setMethod("cells", signature("SpatRaster", "SpatExtent"), # function(x, y, ...) { # e <- align(y, x) # s <- res(x)/2 # e <- as.vector(y) + c(s[1], -s[1], s[2], -s[2]) # r <- rowFromY(x, e[4:3])-1 # c <- colFromX(x, e[1:2]) # cc <- c[1]:c[2] # rr <- (r[1]:r[2]) * ncol(x) # rep(rr, each=length(cc)) + cc # } #) setMethod("cells", signature("SpatRaster", "SpatExtent"), function(x, y) { opt <- spatOptions() x@pntr$extCells(y@pntr) + 1 } ) terra/R/rowSums.R0000644000176200001440000000413614732065717013412 0ustar liggesusers#Author: Robert J. Hijmans #Date : April 2015 #Version 1.0 #Licence GPL v3 setMethod("rowSums", signature(x="SpatRaster"), function(x, na.rm = FALSE, dims = 1L, ...) { nl <- nlyr(x) nc <- ncol(x) readStart(x) on.exit(readStop(x)) b <- blocks(x, n=4) s <- vector("list", b$n) for (i in 1:b$n) { v <- readValues(x, row=b$row[i], nrows=b$nrows[i]) s[[i]] <- .colSums(v, nc, b$nrows[i]*nl, na.rm=na.rm) } s <- t(matrix(unlist(s), nrow=nl, byrow=TRUE)) colnames(s) <- names(x) s } ) setMethod("colSums", signature(x="SpatRaster"), function(x, na.rm = FALSE, dims = 1L, ...) { nl <- nlyr(x) nc <- ncol(x) readStart(x) on.exit(readStop(x)) b <- blocks(x, n=4) s <- matrix(nrow=b$n, ncol=nc*nl) for (i in 1:b$n) { v <- readValues(x, row=b$row[i], nrows=b$nrows[i], mat=TRUE) for (j in 1:nl) { k <- (j-1) * nc + 1 k <- k:(k+nc-1) s[i, k] <- .colSums(matrix(v[,j], nrow=b$nrows[i], byrow=TRUE), b$nrows[i], nc, na.rm=na.rm) } } s <- matrix(.colSums(s, nrow(s), ncol(s), na.rm=na.rm), ncol=nl) colnames(s) <- names(x) return(s) } ) setMethod("rowMeans", signature(x="SpatRaster"), function(x, na.rm = FALSE, dims = 1L, ...) { nl <- nlyr(x) nc <- ncol(x) readStart(x) on.exit(readStop(x)) b <- blocks(x, n=4) s <- vector("list", b$n) for (i in 1:b$n) { v <- readValues(x, row=b$row[i], nrows=b$nrows[i]) s[[i]] <- .colMeans(v, nc, b$nrows[i]*nl, na.rm=na.rm) } s <- t(matrix(unlist(s), nrow=nl, byrow=TRUE)) colnames(s) <- names(x) s } ) setMethod("colMeans", signature(x="SpatRaster"), function(x, na.rm = FALSE, dims = 1L, ...) { nl <- nlyr(x) nc <- ncol(x) readStart(x) on.exit(readStop(x)) b <- blocks(x, n=4) s <- matrix(nrow=b$n, ncol=nc*nl) for (i in 1:b$n) { v <- readValues(x, row=b$row[i], nrows=b$nrows[i], mat=TRUE) for (j in 1:nl) { k <- (j-1) * nc + 1 k <- k:(k+nc-1) s[i, k] <- .colMeans(matrix(v[,j], nrow=b$nrows[i], byrow=TRUE), b$nrows[i], nc, na.rm=na.rm) } } s <- matrix(.colSums(s, nrow(s), ncol(s), na.rm=na.rm), ncol=nl) colnames(s) <- names(x) return(s) } ) terra/R/levels.R0000644000176200001440000002546014740020227013212 0ustar liggesusers setMethod("droplevels", signature(x="SpatRaster"), function(x, level=NULL, layer=1) { if (is.null(level)) { x@pntr <- x@pntr$droplevels() messages(x) } else { if (is.character(layer)) { layer <- match(layer, names(x)) if (any(is.na(layer))) { error("droplevels", "invalid layer") } } x[[layer]][x[[layer]] %in% level] <- NA x@pntr <- x@pntr$droplevels() messages(x) } } ) setMethod("is.factor", signature(x="SpatRaster"), function(x) { x@pntr$hasCategories() } ) setMethod("as.factor", signature(x="SpatRaster"), function(x) { x@pntr = x@pntr$makeCategorical(-1, spatOptions()) messages(x) #if (!hasValues(x)) { # error("as.factor", "x has no values") #} #x <- round(x) #u <- unique(x, TRUE) #for (i in 1:nlyr(x)) { # set.cats(x, i, data.frame(ID=u[[i]], label=u[[i]], stringsAsFactors=FALSE)) #} #x } ) setMethod("levels", signature(x="SpatRaster"), function(x) { x <- x@pntr$getCategories() lapply(x, function(i) { d <- .getSpatDF(i$df) if (ncol(d) == 0) return("") d[, c(1, max(1, i$index+1))] }) } ) setMethod("levels<-", signature(x="SpatRaster"), function(x, value) { x@pntr <- x@pntr$deepcopy() if (is.null(value)) { x@pntr$removeCategories(-1) return(messages(x, "levels<-")) } else if (inherits(value, "list")) { for (i in 1:length(value)) { set.cats(x, i, value[[i]]) } } else { set.cats(x, 1, value) } x } ) combineLevels <- function(x, assign=TRUE) { if (nlyr(x) == 1) return(x) nms <- names(x) lv <- levels(x) lv <- lv[sapply(lv, is.data.frame)] un <- unique(sapply(lv, names)) if (length(un) > 2) { lv <- lapply(lv, function(i) { colnames(i) <- colnames(lv[[1]]); i}) } lv <- try(do.call(rbind, lv), silent=TRUE) if (inherits(lv, "try-error")) { # should not happen anymore error("panel", "cannot use combine categories") } lv <- unique(lv) if (length(unique(lv[,1])) < nrow(lv)) { error("panel", "cannot combine conflicting categories") } lv <- lv[order(lv[,1]), ] if (assign) { x <- categories(x, 0, lv) names(x) <- nms x } else { lv } } setMethod ("set.cats" , "SpatRaster", function(x, layer=1, value, active=1) { if (missing(value)) { error("set.cats", "value cannot be missing") #return(invisible(x@pntr$setCatIndex(layer-1, index))) } if (is.character(layer)) { layer <- match(layer, names(x)) if (any(is.na(layer))) { error("set.cats", "invalid layer") } } layer <- round(layer) if (length(layer) > 1) { if (!is.list(value)) { error("set.cats", "value should be a list") } if (length(layer) != length(value)) { error("set.cats", "length(value) != length(value)") } index <- rep_len(active, nlyr(x)) for (i in 1:length(layer)) { ok <- set.cats(x, layer[i], value[[i]], index[i]) x <- messages(x, "set.cats") } return(invisible(ok)) } if (layer < 1) { if (layer != 0) { error("set.cats", "layer must be >= 0") } if (nlyr(x) == 1) { layer <- 1 } else { if (is.data.frame(value)) { value <- replicate(nlyr(x), value, simplify=FALSE) } else { if (!is.list(value)) { error("set.cats", "value should be a list") } if (length(value) != nlyr(x)) { error("set.cats", "length(value) != nlyr(x)") } } index <- rep_len(active, nlyr(x)) for (i in 1:length(value)) { if (!is.null(value[[i]])) { ok <- set.cats(x, i, value[[i]], index[i]) x <- messages(x, "set.cats") } } return(invisible(ok)) } } layer <- layer[1] if (is.character(layer)) { i <- match(layer, names(x))[1] if (length(i) == 0) { error("set.cats", layer, " is not in names(x)") } layer <- i } else { stopifnot(layer > 0 && layer <= nlyr(x)) } if (inherits(value, "list")) { value <- value[[1]] } if (is.null(value)) { x@pntr$removeCategories(layer-1) messages(x, "set.cats") return(invisible(TRUE)) } setname <- FALSE if (!is.data.frame(value)) { if (is.vector(value) || is.factor(value)) { if ((length(value) == 1) && value[1] == "") { return(invisible("")) } warn("set.cats", "setting categories like this is deprecated; use a two-column data.frame instead") value <- data.frame(value=0:(length(value)-1), category=value, stringsAsFactors=FALSE) } else { error("set.cats", "value should be a data.frame") } } else { setname <- TRUE if (ncol(value) == 1) { error("set.cats", "value should have at least two columns") } else { if (!is.numeric(value[[1]])) { error("set.cats", "the first column of 'value' must be numeric") } value[,1] <- round(value[[1]]) if (length(unique(value[[1]])) != nrow(value)) { error("set.cats", "duplicate values (IDs) supplied") } } } value[[1]] <- as.integer(value[[1]]) for (i in seq_along(value)) { if (is.factor(value[[i]])) { value[[i]] <- as.character(value[[i]]) } } index <- max(1, min(ncol(value), active)) if (setname) { nms <- names(x) cn <- colnames(value)[index+1] if (!(tolower(cn) %in% c("histogram", "count", "red", "green", "blue", "alpha", "opacity", "r", "g", "b", "a"))) { nms[layer] <- cn if (! x@pntr$setNames(nms, FALSE)) { error("names<-", "cannot set name") } } } if (any(is.na(value[[1]]))) { error("set.cats", "you cannot associate a category with NA") } if (any(table(value[[1]]) > 1)) { error("set.cats", "you cannot have duplicate IDs") } value <- .makeSpatDF(value) ok <- x@pntr$setCategories(layer-1, value, index) x <- messages(x, "set.cats") invisible(ok) } ) setMethod ("categories" , "SpatRaster", function(x, layer=1, value, active=1, ...) { #... to accept but ignore old argument "index" x@pntr <- x@pntr$deepcopy() set.cats(x, layer, value, active) x } ) setMethod ("activeCat" , "SpatRaster", function(x, layer=1) { layer <- layer[1] if (is.character(layer)) { layer = which(layer == names(x))[1] if (is.na(layer)) { error("activeCat", "invalid layer name") } } if (layer < 1) { sapply(1:nlyr(x), function(i) x@pntr$getCatIndex(i-1)) } else { if (!is.factor(x)[layer]) { return(NA) } x@pntr$getCatIndex(layer-1) } } ) setMethod("activeCat<-" , "SpatRaster", function(x, layer=1, value) { if (missing(value)) { value <- layer[1] layer <- 1 } else { layer <- layer[1] } if ((layer < 1) | (layer > nlyr(x))) { error("activeCat", "invalid layer") } if (!is.factor(x)[layer]) { error("activeCat", "layer is not categorical") } if (is.character(value)) { g <- cats(x)[[layer]] value <- which(value == names(g))[1] - 1 if (is.na(value)) { error("activeCat", "invalid category name") } } x <- deepcopy(x) if (!x@pntr$setCatIndex(layer-1, value)) { error("activeCat", "invalid category index") } x } ) setMethod("cats" , "SpatRaster", function(x, layer) { if (!missing(layer)) { x <- subset(x, layer, NSE=FALSE) } cats <- x@pntr$getCategories() lapply(1:nlyr(x), function(i) { if (cats[[i]]$df$nrow == 0) { return(NULL) } .getSpatDF(cats[[i]]$df) }) } ) # superseded by levels(x)[[layer]] ..active_cats <- function(x, layer) { ff <- is.factor(x) if (!any(ff)) { return (lapply(ff, function(i) NULL)) } cats <- x@pntr$getCategories() x <- lapply(1:length(cats), function(i) { if (cats[[i]]$df$nrow == 0) return(NULL) r <- .getSpatDF(cats[[i]]$df) a <- activeCat(x, i) if (a < 0) return(NULL) r[, c(1, a+1)] }) if (!missing(layer)) { x[[layer]] } else { x } } setMethod ("as.numeric", "SpatRaster", function(x, index=NULL, filename="", ...) { if (!any(is.factor(x))) { x <- deepcopy(x) x@pntr$setValueType(0) return(x) } if (nlyr(x) > 1) { x <- lapply(1:nlyr(x), function(i) as.numeric(x[[i]], index=index)) x <- rast(x) if (filename != "") { x <- writeRaster(x, filename, ...) } return(x) } g <- cats(x)[[1]] if (!is.null(index)) { if (is.character(index)) { index <- match(index, colnames(g)) if (is.na(index)) { error("as.numeric", "index is not category name") } if (index == 1) { levels(x) <- NULL x@pntr$setValueType(0) if (filename != "") { x <- writeRaster(x, filename, ...) } return(x) } } else { index <- round(index[1]) if (!((index >= 1) & (index < ncol(g)))) { error("as.numeric", "index out of range") } index <- index + 1 } } else { index <- activeCat(x, 1) if (index <= 1) { levels(x) <- NULL x@pntr$setValueType(0) if (filename != "") { x <- writeRaster(x, filename, ...) } return(x) } } from <- g[,1] to <- g[,index] if (!is.numeric(to)) { suppressWarnings(toto <- as.numeric(to)) if (sum(is.na(toto) > sum(is.na(to)))) { to <- as.integer(as.factor(to)) } else { to <- toto } } m <- cbind(from, to) m <- m[!is.na(m[,1]), ,drop=FALSE] classify(x, m, names=names(g)[index], filename, ...) } ) catLayer <- function(x, index, ...) { stopifnot(nlyr(x) == 1) if (!is.factor(x)) return(x) g <- cats(x)[[1]] if (!is.null(index)) { if (!((index > 1) & (index <= ncol(g)))) { error("as.numeric", "invalid index") } } else { index <- set.cats(x, 1) } from <- g[,1] toc <- g[,index] addFact <- FALSE if (!is.numeric(toc)) { addFact <- TRUE ton <- as.integer(as.factor(toc)) } else { ton <- toc } m <- cbind(from, ton) m <- m[!is.na(m[,1]), ,drop=FALSE] x <- classify(x, m, names=names(g)[index], ...) if (addFact) { fact <- unique(data.frame(ton, toc)) names(fact) <- c("ID", names(g)[index]) fact <- fact[order(fact[,1]), ] set.cats(x, 1, fact) } x } setMethod("catalyze", "SpatRaster", function(x, filename="", ...) { g <- cats(x) out <- list() for (i in 1:nlyr(x)) { y <- x[[i]] gg <- g[[i]] if (nrow(gg) > 0) { for (j in 2:ncol(gg)) { z <- as.numeric(y, index=j-1) out <- c(out, z) } } else { out <- c(out, y) } } out <- rast(out) if (filename!="") { out <- writeRaster(out, filename, ...) } out } ) setMethod("concats", "SpatRaster", function(x, y, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr = x@pntr$combineCats(y@pntr, opt) messages(x, "concats") } ) setMethod("addCats", "SpatRaster", function(x, value, merge=FALSE, layer=1) { if (!(is.factor(x)[layer])) { error("addCat", "the layer has no categories to add to") } cts <- cats(x)[[layer]] nact <- ncol(cts) if (merge) { if (ncol(value) < 2) { error("addCat", "'value' must have at least two columns when using 'merge=TRUE'") } cts <- merge(cts, value, by=1, all.x=TRUE) cts <- cts[order(cts[,1]), ] } else { if (nrow(cts) != nrow(value)) { error("addCat", "the number of categories does not match") } cts <- cbind(cts, value) } categories(x, layer=layer, cts, active=nact) } ) terra/R/spatDF.R0000644000176200001440000000473014536376240013112 0ustar liggesusers .makeSpatDF <- function(d) { x <- methods::new("Rcpp_SpatDataFrame") nms <- colnames(d) for (i in 1:ncol(d)) { if (inherits(d[[i]], "character")) { s <- d[[i]] s[is.na(s)] <- "____NA_+" x$add_column_string(enc2utf8(s), nms[i]) } else if (inherits(d[[i]], "integer")) { v <- d[[i]] # min long (should query what it is on the system?) v[is.na(v)] <- -2147483648 x$add_column_long(v, nms[i]) } else if (inherits(d[[i]], "logical")) { v <- as.integer(d[[i]]) v[is.na(v)] <- 2 x$add_column_bool(v, nms[i]) } else if (inherits(d[[i]], "numeric")) { x$add_column_double(d[[i]], nms[i]) } else if (inherits(d[[i]], "Date")) { x$add_column_time(as.numeric(as.POSIXlt(d[[i]])), nms[i], "days", "") } else if (inherits(d[[i]], "factor")) { f <- .makeSpatFactor(d[[i]]) x$add_column_factor(f, nms[i]) } else if (inherits(d[[i]], "POSIXt")) { tz <- if (nrow(d) > 0) { attr(d[[i]][1], "tzone") } else { "" } if (is.null(tz)) tz <- "" x$add_column_time(as.numeric(d[[i]]), nms[i], "seconds", tz) } else { v <- try(as.character(d[[i]])) if (!inherits(v, "try-error")) { x$add_column_string(enc2utf8(v), nms[i]) } } } x } .getSpatDF <- function(x, check.names = FALSE, stringsAsFactors=FALSE, ...) { d <- x$values() f <- sapply(d, class) == "Rcpp_SpatFactor" if (any(f)) { f <- which(f) for (i in f) { d[[i]] <- .getSpatFactor(d[[i]]) } } d <- data.frame(d, check.names=check.names, stringsAsFactors=stringsAsFactors, ...) if (ncol(d) == 0) return(d) s <- which(sapply(d, function(i) inherits(i, "character"))) for (i in s) { d[[i]][d[[i]]=="NA"] <- NA Encoding(d[[i]]) <- "UTF-8" } #ints <- which(x$itype == 1) #for (i in ints) d[[i]] <- suppressWarnings(as.integer(d[[i]])) #bools <- which(x$itype == 3) #for (i in bools) d[[i]] <- suppressWarnings(as.logical(d[[i]])) times <- x$itype == 4 if (any(times)) { steps <- x$get_timesteps() zones <- x$get_timezones() for (i in which(times)) { d[[i]] <- strptime("1970-01-01", "%Y-%m-%d", tz = "UTC") + d[[i]] if (!(zones[i] %in% c("", "UTC"))) { attr(d[[i]], "tzone") = zones[i] } if (steps[i] == "days") { d[[i]] <- as.Date(d[[i]]) } } } d } .makeSpatFactor <- function(x) { i <- as.integer(x) i[is.na(i)] <- 0 SpatFactor$new(i, levels(x), is.ordered(x)) } .getSpatFactor <- function(x) { i <- x$values i[i==0] <- NA if (isTRUE(x$ordered)) { ordered(x$labels[i], x$labels) } else { factor(x$labels[i], x$labels) } } terra/R/readsvg.R0000644000176200001440000000351314536376240013362 0ustar liggesusers transform <- function(xy, m) { newX = m[1] * xy[,1] + m[3] * xy[,2] + m[5] newY = m[2] * xy[,1] + m[4] * xy[,2] + m[6] cbind(newX, newY) } oneline <- function(x, id) { x <- trimws(gsub('^m', "", x)) ss <- trimws(unlist(strsplit(x, "m "))) out <- list() for (j in 1:length(ss)) { v <- unlist(utils::read.table(text=ss[j], sep=" ")) vv <- as.numeric(unlist(strsplit(v, ","))) vv <- matrix(vv, ncol=2, byrow=TRUE) if (j > 1) { vv[1,] <- vv[1,] + a[1,] } a <- apply(vv, 2, cumsum) out[[j]] <- a } out <- lapply(1:length(out), function(p) cbind(id=id, part=p, out[[p]], hole=0)) out <- do.call(rbind, out) out[,4] <- -out[,4] #out[,3:4] <- transform(out[,3:4], m) out } oneline2 <- function(x, id) { x <- trimws(gsub('^M', "", x)) ss <- trimws(unlist(strsplit(x, "ZM"))) out <- list() for (j in 1:length(ss)) { v <- unlist(strsplit(ss[j], "L")) v <- unlist(strsplit(v, "C")) v <- unlist(strsplit(v, " ")) v <- gsub("Z", "", v) vv <- as.numeric(unlist(strsplit(v, ","))) vv <- matrix(vv, ncol=2, byrow=TRUE) out[[j]] <- vv } out <- lapply(1:length(out), function(p) cbind(id=id, part=p, out[[p]], hole=0)) do.call(rbind, out) #out[,3:4] <- transform(out[,3:4], m) } readSVG <- function(f) { doc <- XML::htmlParse(f) p <- XML::xpathSApply(doc, "//path", XML::xmlGetAttr, "d") s <- list() for (i in 1:length(p)) { s[[i]] <- oneline2(p[i], i) } ss <- do.call(rbind, s) v <- vect(ss, type="polygons") a <- XML::xpathSApply(doc, "//path", XML::xmlAttrs) a <- unique(unlist(sapply(a, names))) a <- a[-grep(":", a)] a <- a[a != "d"] if (length(a) > 0) { att <- list() for (i in 1:length(a)) { z <- XML::xpathSApply(doc, "//path", XML::xmlGetAttr, a[i]) att[[i]] <- sapply(z, function(i) if (is.null(i)) NA else i, USE.NAMES = FALSE) } names(att) <- a values(v) <- data.frame(att) } v } terra/R/divide.R0000644000176200001440000001444214752017430013167 0ustar liggesusers# Author: Robert Hijmans # December 2024 # License GPL3 getv <- function(x, a) { cumsum(values(aggregate(x, a, sum, na.rm=TRUE)) / 1000) } splitNS3 <- function(x) { v <- getv(x, c(1, ncol(x))) m1 <- which.min(abs(v - max(v)/3)) m2 <- which.min(abs(v - max(v) * 2/3)) list(n=x[1:m1, ,drop=FALSE], m=x[(m1+1):m2, ,drop=FALSE], s=x[(m2+1):nrow(x), ,drop=FALSE]) } splitNS <- function(x) { v <- getv(x, c(1, ncol(x))) m <- which.min(abs(v - max(v)/2)) list(n=x[1:m, ,drop=FALSE], s=x[(m+1):nrow(x), ,drop=FALSE]) } splitWE3 <- function(x) { v <- getv(x, c(nrow(x), 1)) m1 <- which.min(abs(v - max(v)/3)) m2 <- which.min(abs(v - max(v) * 2/3)) list(w=x[, 1:m1, drop=FALSE], m=x[, (m1+1):m2, drop=FALSE], e=x[, (m2+1):ncol(x), drop=FALSE]) } splitWE <- function(x) { v <- getv(x, c(nrow(x), 1)) m <- which.min(abs(v - max(v)/2)) list(w=x[, 1:m, drop=FALSE], e=x[, (m+1):ncol(x), drop=FALSE]) } setMethod("divide", signature(x="SpatRaster"), function(x, n=2, start="ns", as.raster=FALSE, na.rm=TRUE) { # if (!is.null(border)) stopifnot(inherits(border, "SpatVector")) if (nlyr(x) > 1) { warn("divide", "only the first layer is used") x <- x[[1]] } n <- round(n) if (length(n) > 1) { if (!all(n %in% c(-2,-1,1,2))) { error("divide", "if (length(n) > 1), values can only be -3, -2 for WE and 2, 3 for NS") } } else { if (!isTRUE(n > 0)) { error("divide", "n must be > 0") } start <- match.arg(tolower(start), c("ns", "ew")) north <- start == "ns" } if (!hasValues(x)) { out <- x if (length(n) > 1) { nrow(out) <- sum(abs(n[n<0]) + 1) ncol(out) <- sum(abs(n[n<0]) + 1) } else { if (north) { rows <- ceiling(n / 2) cols <- n - rows } else { cols <- ceiling(n / 2) rows <- n - cols } nrow(out) <- rows * 2 ncol(out) <- cols * 2 } out <- as.polygons(out) } else { out <- list(classify(trim(x), cbind(NA, 0))) if (length(n) > 1) { for (i in 1:length(n)) { if (n[i] == 1) { out <- unlist(lapply(out, function(i) splitNS(i))) } else if (n[i] == -1) { out <- unlist(lapply(out, function(i) splitWE(i))) } else if (n[i] == 2) { out <- unlist(lapply(out, function(i) splitNS3(i))) } else { # if (n[i] == -2) { out <- unlist(lapply(out, function(i) splitWE3(i))) } } } else { for (i in 1:n) { if (north) { out <- unlist(lapply(out, function(s) splitNS(s))) } else { out <- unlist(lapply(out, function(s) splitWE(s))) } north <- !north } } out <- vect(lapply(out, function(i) as.polygons(ext(i)))) crs(out) <- crs(out) } out$zones <- 1:nrow(out) if (isTRUE(as.raster) || is.na(as.raster)) { r <- rasterize(out, x, "zones") if (na.rm) { r <- mask(r, x) } if (is.na(as.raster)) { return(list(r=r, v=out)) } else { return(r) } } else if (na.rm) { border <- as.polygons(not.na(x, TRUE)) out <- crop(out, border) } out } ) check_frac <- function(f) { if (is.null(f)) return(f) if ((any(f <= 0)) || (any(f >= 1))) { stop("f values must be > 0 and < 1") } if (length(f) == 1) { f <- seq(f, 1, f) f[length(f)] <- 1 } else { if (length(unique(f)) < length(f)) { stop("f values must be unique") } ord <- order(f) if (!all(ord == 1:length(ord))) { stop("f values must be in ascending order") } if (!isTRUE(all.equal(sum(f), 1, tolerance=0.0001))) { stop("f values must sum to 1") } } f } strip_polygon <- function(x, vertical, horizontal) { ## based on a function by Barry Rowlinson totalArea <- expanse(x, transform=FALSE, unit="km") e <- ext(x) ex <- data.frame(t(as.vector(e + 1))) e <- data.frame(t(as.vector(e))) if (!is.null(vertical)) { edges <- sapply(vertical, function(fraction){ target <- totalArea * fraction target_fun <- function(xm){ expanse(crop(x, ext(ex$xmin, xm, ex$ymin, ex$ymax)), transform=FALSE, unit="km") - target } stats::uniroot(target_fun, lower=e$xmin+0.0000001, upper=e$xmax)$root }) xbnds <- matrix(c(ex$xmin, rep(edges,rep(2,length(edges))), ex$xmax), ncol=2, byrow=TRUE) xbnds <- cbind(xbnds, ex$ymin, ex$ymax) xbnds <- do.call(rbind, apply(xbnds, 1, function(i) as.polygons(ext(i)))) xbnds$vid <- 1:nrow(xbnds) } if (!is.null(horizontal)) { edges <- sapply(horizontal, function(fraction){ target <- totalArea * fraction target_fun <- function(ym){ expanse(crop(x, ext(ex$xmin, ex$xmax, ex$ymin, ym)), transform=FALSE, unit="km") - target } stats::uniroot(target_fun, lower=e$ymin+0.0000001, upper=e$ymax)$root }) ybnds <- matrix(c(ex$ymin, rep(edges,rep(2,length(edges))), ex$ymax), ncol=2, byrow=TRUE) ybnds <- cbind(ex$xmin, ex$xmax, ybnds) ybnds <- do.call(rbind, apply(ybnds, 1, function(i) as.polygons(ext(i)))) ybnds$hid <- 1:nrow(ybnds) if (!is.null(vertical)) { bnds <- union(xbnds, ybnds) } else { bnds <- ybnds } } intersect(x, bnds) } divide_polygon <- function(x, n, w, alpha, ...) { xcrs <- crs(x) crs(x) <- "+proj=utm +zone=1" s <- terra::spatSample(x, max(n*4, 1000, log(n) * 100), "regular") xy <- terra::crds(s) if (!is.null(w)) { e <- extract(w, s, ID=FALSE) alpha <- rep_len(alpha, 2) xy[,1] <- xy[,1] * alpha[1] xy[,2] <- xy[,2] * alpha[2] xy <- na.omit(cbind(xy, e)) } k <- stats::kmeans(xy, centers = n, ...) ctrs <- k$centers[, 1:2] if (!is.null(w)) { ctrs[,1] <- ctrs[,1] / alpha[1] ctrs[,2] <- ctrs[,2] / alpha[2] } v <- terra::voronoi(vect(ctrs, crs=xcrs), bnd=x) terra::crop(v, x) } setMethod("divide", signature(x="SpatVector"), function(x, n=5, w=NULL, alpha=1, ...) { if (geomtype(x) != "polygons") { error("divide", "the geometry type must be polgyons") } if (is.list(n)) { vertical <- check_frac(n$v) horizontal <- check_frac(n$h) if (is.null(vertical) && is.null(horizontal)) return(x) out <- lapply(1:nrow(x), function(i) strip_polygon(x[i], vertical, horizontal)) } else { n <- round(n) stopifnot(n > 0) if (n == 1) return(deepcopy(x)) out <- lapply(1:nrow(x), function(i) divide_polygon(x[i], n, w, alpha, ...)) } do.call(rbind, out) } ) terra/R/colors.R0000644000176200001440000000473114726700274013232 0ustar liggesusers setMethod ("has.colors" , "SpatRaster", function(x) { x@pntr$hasColors() } ) setMethod ("coltab" , "SpatRaster", function(x) { hascols <- x@pntr$hasColors() if (any(hascols)) { d <- x@pntr$getColors() d <- lapply(d, .getSpatDF) d[!hascols] <- list(NULL) } else { d <- vector("list", length(hascols)) } d } ) setMethod ("coltab<-" , "SpatRaster", function(x, ..., layer=1, value) { x@pntr <- x@pntr$deepcopy() if (inherits(value, "list")) { for (i in seq_along(value)) { layer <- i-1 if (is.null(value[[i]])) { x@pntr$removeColors(layer) } if (inherits(value[[i]], "character")) { value[[i]] <- data.frame(t(grDevices::col2rgb(value[[i]], alpha=TRUE)), stringsAsFactors=FALSE) } else if (inherits(value[[i]], "matrix")) { value[[i]] <- data.frame(value[[i]]) } if (!inherits(value[[i]], "data.frame")) { error("coltab<-", "cannot process these color values") } if (ncol(value[[i]]) == 2) { value[[i]] <- data.frame(values=value[[i]][,1], t(grDevices::col2rgb(value[[i]][,2], alpha=TRUE)), stringsAsFactors=FALSE) } value[[i]][, 1] <- as.integer(value[[i]][, 1]) for (j in 2:ncol(value[[i]])) { value[[i]][, j] <- as.integer(clamp(value[[i]][, j], 0, 255)) } value[[i]][is.na(value[[i]])] <- 255 d <- .makeSpatDF(value[[i]]) if (!x@pntr$setColors(layer, d)) { messages(x, "cols<-") } } } else { layer <- layer[1]-1 if (is.null(value)) { x@pntr$removeColors(layer) return(x) } if (inherits(value, "character")) { value <- data.frame(t(grDevices::col2rgb(value, alpha=TRUE)), stringsAsFactors=FALSE) } else if (inherits(value, "matrix")) { value <- data.frame(value) } if (!inherits(value, "data.frame")) { error("coltab<-", "cannot process these color values") } if (ncol(value) == 2) { value <- data.frame(values=value[,1], t(grDevices::col2rgb(value[,2], alpha=TRUE)), stringsAsFactors=FALSE) } #else { # nms <- tolower(names(value)) # if (!(grepl("value", nms))) { # value <- cbind(values=(1:nrow(value))-1, value) # } # #value <- value[1:256,] # if (ncol(value) == 4) { # value <- cbind(value, alpha=255) # } #} value[, 1] <- as.integer(value[, 1]) for (i in 2:ncol(value)) { value[, i] <- as.integer(clamp(value[, i], 0, 255)) } value[is.na(value)] <- 255 d <- .makeSpatDF(value) if (!x@pntr$setColors(layer, d)) { messages(x, "cols<-") } } x } ) terra/R/window.R0000644000176200001440000000120714751211317013224 0ustar liggesusers setMethod("set.window", signature(x="SpatRaster"), function(x, value) { if (inherits(value, "SpatExtent")) { window(x) <- NULL value <- intersect(ext(x), value) if (!(x@pntr$setWindow(value@pntr))) { error("window<-,SpatRaster", "cannot set this window") } } else if (is.null(value) || is.na(value)) { x@pntr$removeWindow() } else { error("window<-", "'value' should be a SpatExtent, NULL or NA") } x } ) setMethod("window<-", signature(x="SpatRaster"), function(x, value) { set.window(deepcopy(x), value) } ) setMethod("window", signature(x="SpatRaster"), function(x) { x@pntr$hasWindow() } ) terra/R/panel.R0000644000176200001440000000601614740004450013013 0ustar liggesusers setMethod("panel", signature(x="SpatRaster"), function(x, main, loc.main="topleft", nc, nr, maxnl=16, maxcell=500000, box=FALSE, pax=list(), plg=list(), range=NULL, halo=TRUE, type=NULL, ...) { if (!is.null(type)) { type <- match.arg(tolower(type), c("classes", "continuous", "interval")) } # dots <- list(...) # if (!is.null(dots$type)) { # error("panel", "you cannot set the plot type") # } # if (!is.null(dots$breaks)) { # error("panel", "you cannot use argument 'breaks'") # } categorical <- FALSE if (is.null(type) && any(is.factor(x))) { x <- combineLevels(x) categorical <- TRUE } nl <- max(1, min(nlyr(x), maxnl)) if (nl==1) { out <- plot(x, 1, maxcell=maxcell, main=main[1], ...) return(invisible(out)) } nrnc <- .get_nrnc(nr, nc, nl) old.par <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(old.par)) mar <- rep(0.33, 4) m <- matrix((1:prod(nrnc))+1, nrow=nrnc[1], ncol=nrnc[2], byrow=TRUE) m <- rbind(1, cbind(1, m, max(m)+1), 1) w <- c(0.05, rep(0.8/nrnc[2], nrnc[2]), 0.15) h <- c(0.05, rep(0.94/nrnc[1], nrnc[1]), 0.05) graphics::layout(m, w, h) plot(0, type="n", axes=FALSE, xlab="", ylab="") maxcell <- maxcell/nl if (missing("main")) { tm <- time(x) if (!any(is.na(tm))) { main <- as.character(time(x)) } else { main <- names(x) } } else { main <- rep_len(main, nl) } legend <- rep(FALSE , nl) legi <- max(1, ceiling(nrnc[1] / 2)) * nrnc[2] legend[legi] <- TRUE left <- c(0,2)[(((1:nl)-1) %% nrnc[2] == 0)+1] b <- ((1:nl) > ((nrnc[1]-1) * nrnc[2]))+1 i <- (prod(nrnc) - nl) if (i > 0) { b[((nrnc[1]-2) * nrnc[2]) + ((nrnc[2]-(i-1)):nrnc[2])] <- 2 } bottom <- c(0,1)[b] if (!categorical) { x <- spatSample(x, maxcell, method="regular", as.raster=TRUE, warn=FALSE) r <- as.matrix(x) if (is.null(range)) { if (all(hasMinMax(x))) { range <- range(minmax(x, FALSE)) if (any(is.nan(range) | is.infinite(range))) { r <- as.matrix(x) r[is.infinite(r)] <- NA range <- range(r, na.rm=TRUE) } } else { r[is.infinite(r)] <- NA range <- range(r, na.rm=TRUE) } } r <- unique(as.vector(r)) if (is.null(type)) { if (length(r) > 10) { type <- "continuous" } else { type <- "classes" } } if (type == "classes") { levs <- data.frame(ID=1:length(r), sort(r)) colnames(levs)[2] <- names(x)[1] x <- categories(x, 0, levs) categorical <- TRUE } } if (is.null(plg$size)) plg$size <- max(1, nrnc[1] * 0.66) if (is.null(plg$cex)) plg$cex <- 1.25 plg$yshift <- (nrnc[1] %% 2 == 0) for (i in 1:nl) { pax$side <- c(bottom[i], left[i]) if (categorical) { plot(x[[i]], 1, main=main[i], mar=mar, legend=legend[i], pax=pax, box=box, loc.main=loc.main, halo=halo, plg=plg, type="classes", all_levels=TRUE, maxcell=Inf, ...) } else { plot(x, i, main=main[i], mar=mar, legend=legend[i], range=range, pax=pax, box=box, loc.main=loc.main, halo=halo, plg=plg, type=type, maxcell=Inf, ...) } } } ) terra/R/plot_legend.R0000644000176200001440000003531714725637141014232 0ustar liggesusers .get_breaks <- function(x, n, method, r=NULL) { #x <- x[!is.na(x)] if (is.function(method)) { if (!is.null(r)) { if (!is.na(r[1])) { x[ x < r[1] ] <- NA } if (!is.na(r[2])) { x[ x > r[2] ] <- NA } } breaks <- method(x) } else if (method[1]=="cases") { if (!is.null(r)) { if (!is.na(r[1])) { x[ x < r[1] ] <- NA } if (!is.na(r[2])) { x[ x > r[2] ] <- NA } } n <- n+1 i <- seq(0, 1, length.out=n) breaks <- quantile(x, i, na.rm=TRUE) breaks <- unique(breaks) if ((breaks[1] %% 1) != 0) { breaks[1] <- breaks[1] - 0.000001 } if ((breaks[n] %% 1) != 0) { breaks[n] <- breaks[n] + 0.000001 } } else { # if (method=="eqint") { if (is.null(r)) { r <- c(min(x, na.rm=TRUE), max(x, na.rm=TRUE)) } else if (any(is.na(r))) { if (is.na(r[1])) r[1] <- min(x, na.rm=TRUE) if (is.na(r[2])) r[2] <- max(x, na.rm=TRUE) } small <- 1e-16 if ((r[1] %% 1) != 0) { r[1] <- r[1] - small } if ((r[2] %% 1) != 0) { r[2] <- r[2] + small } breaks <- seq(r[1] , r[2], length.out=n+1) } unique(breaks) } .get_nrnc <- function(nr, nc, nl) { if (missing(nc)) { nc <- ceiling(sqrt(nl)) } else { nc <- max(1, min(nl, round(nc))) } if (missing(nr)) { nr <- ceiling(nl / nc) } else { nr <- max(1, min(nl, round(nr))) nc <- ceiling(nl / nr) } c(nr, nc) } retro_labels <- function(x, lat=TRUE) { if ((is.null(x)) || (!is.numeric(x))) { return(x) } if ((length(x) > 1) && (min(diff(x)) <= 1/120)) { d <- floor(x) m <- floor(60*(x - d)) s <- round(3600*(x - d - m/60)) } else { d <- floor(x) m <- round(60*(x - d)) s <- 0 } if (lat) { h <- c("S", "", "N")[sign(d)+2] } else { h <- c("W", "", "E")[sign(d)+2] } d <- abs(d) i <- (s == 0) & (m == 0) j <- (s == 0) & (m != 0) m <- formatC(m, width=2, flag="0") s <- formatC(s, width=2, flag="0") r <- paste0(d, "\u00B0" , m, "'", s, '"', h) r[i] <- paste0(d[i], "\u00B0" , h[i]) r[j] <- paste0(d[j], "\u00B0" , m[j], "'", h[j]) r } .get.leg.coords <- function(x) { if (is.null(x$leg$ext)) { if (x$clip) { p <- x$leg$ext <- x$lim } else { p <- x$leg$ext <- graphics::par("usr") } } else { p <- as.vector(x$leg$ext) } xmin <- p[1] xmax <- p[2] ymin <- p[3] ymax <- p[4] flip <- FALSE if (!is.null(x$leg$shrink)) { s <- x$leg$shrink if ((s[1] <= 1) & (s[1] >= 0.5)) { s[1] <- 2*(s[1] - 0.5) } else if (s[1] < 0.5) { s[1] <- (2*(0.5 - s[1])) flip <- TRUE } x$leg$size <- s } if (is.null(x$leg$size)) { x$leg$size <- c(1,1) } else if (length(x$leg$size) == 1) { x$leg$size <- c(x$leg$size, 1) } if (x$leg$size[1] < 0) flip <- TRUE x$leg$size <- abs(x$leg$size) if (!is.null(x$leg$main)) { n <- length(x$leg$main) x$leg$size[1] <- min(x$leg$size[1], (1 - .05*n)) } horiz <- isTRUE(x$leg$x %in% c("top", "bottom")) if (horiz) { # xd <- (xmax - xmin) * x$leg$size[2] # xmin <- xmin + xd # xmax <- xmax - xd rhalf <- (xmax - xmin) / 2 xmid <- xmin + rhalf xd <- rhalf * x$leg$size[1] xmin <- xmid - xd xmax <- xmid + xd # yd <- (ymax - ymin) * x$leg$size[1]/1.5 # ymin <- ymin + yd # ymax <- ymax - yd yd <- ymax - ymin if (x$leg$x == "top") { ymax <- ymin + yd * x$leg$size[2] } else { ymin <- ymax - yd * x$leg$size[2] } if (flip) { tmp <- xmin xmin <- xmax xmax <- tmp } } else { rhalf <- (ymax - ymin) / 2 ymid <- ymin + rhalf yd <- rhalf * x$leg$size[1] ymin <- ymid - yd ymax <- ymid + yd xd <- xmax - xmin #xmin <- xmin + xd * x$leg$size[2]/5 #xmax <- xmax - xd * x$leg$size[2]/5 xmax <- xmin + xd * x$leg$size[2] if (flip) { tmp <- ymin ymin <- ymax ymax <- tmp } } dx <- xmax - xmin dy <- ymax - ymin x$leg$ext <- data.frame(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, dx=dx, dy=dy) x } .line.usr <- function(line, side) { ## https://stackoverflow.com/questions/30765866/get-margin-line-locations-in-log-space/30835971#30835971 lh <- graphics::par("cin")[2] * graphics::par("cex") * graphics::par("lheight") x_off <- diff(graphics::grconvertX(c(0, lh), "inches", "npc")) y_off <- diff(graphics::grconvertY(c(0, lh), "inches", "npc")) if (side == 1) { graphics::grconvertY(-line * y_off, "npc", "user") } else if (side ==2) { graphics::grconvertX(-line * x_off, "npc", "user") } else if (side ==3) { graphics::grconvertY(1 + line * y_off, "npc", "user") } else { graphics::grconvertX(1 + line * x_off, "npc", "user") } } .get.leg.extent <- function(x) { #usr <- graphics::par("usr") dxy <- graphics::par("cxy") * graphics::par("cex") loc <- x$leg$x if (x$clip) { usr <- x$lim } else { usr <- graphics::par("usr") } xmin <- usr[1] xmax <- usr[2] ymin <- usr[3] ymax <- usr[4] p <- NULL if (is.character(loc)) { if (loc == "left") { #s <- .line.usr(trunc(graphics::par("mar")[2]), 2) #p <- c(s+4*dxy[1], s+5*dxy[1], ymin, ymax) if (any(2 %in% x$axs$lab)) { p <- c(xmin-4*dxy[1], xmin-3*dxy[1], ymin, ymax) } else { p <- c(xmin-2*dxy[1], xmin-dxy[1], ymin, ymax) } } else if (loc == "bottom") { s <- .line.usr(trunc(graphics::par("mar")[1]), 1) p <- c(xmin, xmax, s+1.75*dxy[2], s+2.5*dxy[2]) } else if (loc == "top") { p <- c(xmin, xmax, ymax+dxy[2], ymax+1.75*dxy[2]) } else { #if (loc == "right" or "default" p <- c(xmax+dxy[1], xmax+2*dxy[1], ymin, ymax) if (isTRUE(x$leg$yshift)) { hy <- (ymax - ymin) / 2 p[3:4] <- p[3:4] - hy } } } x$leg$ext <- p x$leg$user <- FALSE .get.leg.coords(x) } .txt.loc <- function(x) { if (isTRUE(x$clip)) { dxy <- graphics::par("cxy") * x$cex.main if (grepl("right", x$loc.main)) { px <- x$lim[2] pos <- 2 } else { px <- x$lim[1] pos <- 4 } if (grepl("bottom", x$loc.main)) { py <- x$lim[3] + dxy[2]/2 } else { py <- x$lim[4] - dxy[2]/2 } } else { dxy <- graphics::par("cxy") * x$cex.main usr <- graphics::par("usr") if (grepl("right", x$loc.main)) { px <- usr[2] pos <- 2 } else { px <- usr[1] pos <- 4 } if (grepl("bottom", x$loc.main)) { py <- usr[3] + dxy[2]/2 } else { py <- usr[4] - dxy[2]/2 } } out <- c(px, py, pos) names(out) <- NULL out } .plot.cont.legend <- function(x, ...) { if (!is.null(x$leg$tic)) { accepted <- c("in", "out", "none", "through", "throughout") tics <- accepted[pmatch(x$leg$tic[1], accepted[-5], 5)] } else { tics <- "throughout" } if (!is.null(x$leg$tic.box.col)) { ticboxcol <- x$leg$tic.box.col } else { ticboxcol <- "black" } if (is.null(x$leg$x)) { x$leg$x <- "right" } else if (!(x$leg$x %in% c("left", "right", "top", "bottom"))) { x$leg$x <- "right" } if (is.null(x$leg$ext)) { x <- .get.leg.extent(x) } else { x <- .get.leg.coords(x) } cex <- x$leg$cex if (is.null(cex)) cex <- 1 cex <- cex * 0.8 rotate <- isTRUE(x$leg$rotate) srt <- ifelse(rotate, 90, 0) cols <- rev(x$cols) nc <- length(cols) zlim <- x$range zz <- x$leg$at if (is.null(zz)) { if (is.null(x$levels)){ x$levels <- 5 } zz <- pretty(zlim, n =(x$levels+1)) zz <- zz[zz >= zlim[1] & zz <= zlim[2]] } zztxt <- x$leg$labels if (is.null(zztxt)) { zztxt <- formatC(zz, digits=x$leg$digits, format = "f") if (x$fill_range) { if (isTRUE(x$range_filled[1])) zztxt[1] <- paste0("< ", zztxt[1]) if (isTRUE(x$range_filled[2])) zztxt[length(zztxt)] <- paste0("> ", zztxt[length(zztxt)]) } } e <- x$leg$ext if (x$leg$x %in% c("left", "right")) { Y <- seq(e$ymin, e$ymax, length.out=nc+1) graphics::rect(e$xmin, Y[-(nc + 1)], e$xmax, Y[-1], col=rev(cols), border=NA, xpd=NA) ypos <- e$ymin + (zz - zlim[1])/(zlim[2] - zlim[1]) * e$dy if (x$leg$x == "right") { if (tics == "throughout") { graphics::segments(e$xmin, ypos, e$xmax+e$dx*0.25, ypos, xpd=NA) } else if (tics == "through") { graphics::segments(e$xmin, ypos, e$xmax, ypos, xpd=NA) } else if (tics == "in") { graphics::segments(e$xmax-e$dx*0.25, ypos, e$xmax, ypos, xpd=NA) } else if (tics == "out") { graphics::segments(e$xmax, ypos, e$xmax+e$dx*0.25, ypos, xpd=NA) } text(e$xmax, ypos, zztxt, pos=4, xpd=NA, cex=cex, ...) } else { if (tics == "throughout") { graphics::segments(e$xmin-e$dx*0.25, ypos, e$xmax, ypos, xpd=NA) } else if (tics == "through") { graphics::segments(e$xmin, ypos, e$xmax, ypos, xpd=NA) } else if (tics == "in") { graphics::segments(e$xmin, ypos, e$xmin+e$dx*0.25, ypos, xpd=NA) } else if (tics == "out") { graphics::segments(e$xmin-e$dx*0.25, ypos, e$xmin, ypos, xpd=NA) } text(e$xmin, ypos, zztxt, pos=2, xpd=NA, cex=cex, ...) } } else { X <- seq(e$xmin, e$xmax, length.out=nc+1) graphics::rect(X[-(nc + 1)], e$ymin, X[-1], e$ymax, col=rev(cols), border=NA, xpd=NA) xpos <- e$xmin + (zz - zlim[1])/(zlim[2] - zlim[1]) * e$dx if (x$leg$x == "bottom") { if (tics == "throughout") { graphics::segments(xpos, e$ymin-e$dy*0.25, xpos, e$ymax, xpd=NA) } else if (tics == "through") { graphics::segments(xpos, e$ymin, xpos, e$ymax, xpd=NA) } else if (tics == "in") { graphics::segments(xpos, e$ymin+e$dy*0.25, xpos, e$ymin, xpd=NA) } else if (tics == "out") { graphics::segments(xpos, e$ymin-e$dy*0.25, xpos, e$ymin, xpd=NA) } text(xpos, e$ymin, zztxt, pos=1, xpd=NA, cex=cex) } else { if (tics == "throughout") { graphics::segments(xpos, e$ymin, xpos, e$ymax+e$dy*0.25, xpd=NA) } else if (tics == "through") { graphics::segments(xpos, e$ymin, xpos, e$ymax, xpd=NA) } else if (tics == "in") { graphics::segments(xpos, e$ymax, xpos, e$ymax-e$dy*0.25, xpd=NA) } else if (tics == "out") { graphics::segments(xpos, e$ymax, xpos, e$ymax+e$dy*0.25, xpd=NA) } text(xpos, e$ymax+e$dy*0.25, zztxt, pos=3, xpd=NA, cex=cex) } } graphics::rect(e$xmin, e$ymin, e$xmax, e$ymax, border=ticboxcol, xpd=NA) if (isTRUE("title" %in% names(x$leg))) { leg_i <- x$leg$leg_i if (is.null(leg_i)) leg_i = 1 if (leg_i <= length(x$leg$title)) { legtitle <- x$leg$title[leg_i] } else { legtitle <- x$leg$title[1] } e <- x$leg$ext if (length(legtitle) > 1) { # or perhaps !inherits(legtitle, "expression") if (x$leg$x %in% c("top", "bottom")) { legtitle <- paste(legtitle, collapse=" ") } else { legtitle <- paste(legtitle, collapse="\n") } } # offset=.5*graphics::strheight("a",cex=x$leg$title.cex) text(x=e$xmax, y=e$ymax, labels=legtitle, pos=3, cex=x$leg$title.cex, xpd=NA) } x } get_legxy <- function(r, e, pos, yshift) { xy <- c(r$left, r$top) if (grepl("top", pos)) { xy[2] <- e[4] } else if (grepl("bottom", pos)) { xy[2] <- e[3] + r$h } if (grepl("left", pos)) { xy[1] <- e[1] } else if (grepl("right", pos)) { xy[1] <- e[2] - r$w } if (!is.null(yshift)) { hy <- (e[4] - e[3]) / 2 xy[2] <- xy[2] - hy } xy } .plot.class.legend <- function(x, y, legend, fill, xpd=NA, cex=1, geomtype="", lty=1, lwd=1, pch=1, angle=45, density=NULL, pt.cex = 1, pt.bg="black", pt.lwd=1, bty="n", border="black", seg.len=1, plotlim, yshift=NULL, title=NULL, leg_i=1, ..., # catch and kill merge, trace, size) { cex <- cex * 0.8 if (x %in% c("top", "default")) { #usr <- graphics::par("usr") x <- plotlim[2] y <- plotlim[4] } if (is.null(leg_i)) leg_i = 1 if (leg_i <= length(title)) { title <- title[leg_i] } else { title <- title[1] } #points(leg$rect$left+leg$rect$w, leg$rect$top-leg$rect$h, xpd=T) if (grepl("points", geomtype)) { if (inherits(x, "character")) { r <- legend(x, y, legend, col=fill, xpd=xpd, bty=bty, cex=cex, pch=pch, pt.cex=pt.cex, pt.bg=pt.bg, pt.lwd=pt.lwd, plot=FALSE, title=title, ...)$rect xy <- get_legxy(r, plotlim, x, yshift) leg <- legend(xy[1], xy[2], legend, col=fill, xpd=xpd, bty=bty, cex=cex, pch=pch, pt.cex=pt.cex, pt.bg=pt.bg, pt.lwd=pt.lwd, title=title, ...) } else { leg <- legend(x, y, legend, col=fill, xpd=xpd, bty=bty, cex=cex, pch=pch, pt.cex=pt.cex, pt.bg=pt.bg, pt.lwd=pt.lwd, title=title,...) } } else if (geomtype == "lines") { if (inherits(x, "character")) { r <- legend(x, y, legend, col=fill, xpd=xpd, bty=bty, cex=cex, lty=lty, lwd=lwd, seg.len=seg.len, plot=FALSE, title=title,, ...)$rect xy <- get_legxy(r, plotlim, x, yshift) leg <- legend(xy[1], xy[2], legend, col=fill, xpd=xpd, bty=bty, cex=cex, lty=lty, lwd=lwd, seg.len=seg.len, title=title,, ...) } else { leg <- legend(x, y, legend, col=fill, xpd=xpd, bty=bty, cex=cex, lty=lty, lwd=lwd, seg.len=seg.len, title=title, ...) } } else { if (inherits(x, "character")) { r <- legend(x, y, legend, fill=fill, xpd=xpd, bty=bty, cex=cex, density=density*2, angle=angle, border=border, plot=FALSE, title=title, ...)$rect xy <- get_legxy(r, plotlim, x, yshift) leg <- legend(xy[1], xy[2], legend, fill=fill, xpd=xpd, bty=bty, cex=cex, density=density*2, angle=angle, border=border, title=title, ...) } else { leg <- legend(x, y, legend, fill=fill, xpd=xpd, bty=bty, cex=cex, density=density*2, angle=angle, border=border, title=title, ...) } } leg } add_legend <- function(x, y, ...) { if (inherits(x, "character")) { e <- unlist(get.clip()) if (!is.null(e)) { rct <- graphics::legend(x=x, y=y, plot=FALSE, ...)$rect xy <- get_legxy(rct, e[1:4], x, NULL) graphics::legend(x=xy[1], y=xy[2], ...) } else { graphics::legend(x=x, y=y, ...) } } else { graphics::legend(x=x, y=y, ...) } } add_box <- function(...) { e <- unlist(get.clip()) if (!is.null(e)) { bx <- rbind( cbind(e[1], e[3:4]), cbind(e[2], e[4:3]), cbind(e[1], e[3]) ) if (is.null(list(...)$xpd)) { lines(bx, xpd=TRUE, ...) } else { lines(bx, ...) } } } add_grid <- function(nx=NULL, ny=nx, col="lightgray", lty="dotted", lwd=1) { p <- get.clip() ## adapted from graphics::grid g.grid.at <- function (side, n, axp, usr2) { if (is.null(n)) { stopifnot(is.numeric(ax <- axp), length(ax) == 3L) graphics::axTicks(side, axp=ax, usr=usr2, log=FALSE) } else if (!is.na(n) && (n <- as.integer(n)) >= 1L) { at <- seq.int(usr2[1L], usr2[2L], length.out = n + 1L) at[-c(1L, n + 1L)] } } atx <- if (is.null(nx) || (!is.na(nx) && nx >= 1)) g.grid.at(1L, nx, axp = graphics::par("xaxp"), usr2 = p[1:2]) aty <- if (is.null(ny) || (!is.na(ny) && ny >= 1)) g.grid.at(2L, ny, axp = graphics::par("yaxp"), usr2 = p[3:4]) graphics::abline(v = atx, h = aty, col = col, lty = lty, lwd = lwd) invisible(list(atx = atx, aty = aty)) } add_mtext <- function(text, side=3, line=0, ...) { stopifnot(side %in% 1:4) p <- unlist(get.clip()) h <- graphics::strheight(text, units = "user", ...) srt <- 0 if (side==1) { x <- mean(p[1:2]) y <- p[3] - h - line * h } else if (side==2) { x <- p[1] -1.25 * h - line * h y <- mean(p[3:4]) srt <- 90 } else if (side==3) { x <- mean(p[1:2]) y <- p[4] + h + line * h } else { x <- p[2] + 1.25 * h + line * h y <- mean(p[3:4]) srt <- 270 } text(x=x, y=y, labels=text, xpd=TRUE, srt=srt, ...) } terra/R/tempfiles.R0000644000176200001440000000274314715404523013716 0ustar liggesusers .orphanTmpFiles <- function() { objects <- ls(envir=globalenv()) ftmp <- list() for (i in seq_along(objects)) { x <- get(objects[i], envir=globalenv()) if (inherits(x, "SpatRaster")) { ftmp[[i]] <- sources(x) } } ftmp <- unique(unlist(ftmp)) ftmp <- ftmp[ftmp != ""] pattrn <- "^spat_.*tif$" i <- grep(pattrn, basename(ftmp)) ftmp <- ftmp[i] ff1 <- list.files(tempdir(), pattern=pattrn, full.names=TRUE) ff2 <- list.files(terraOptions(print=FALSE)$tempdir, pattern = pattrn, full.names = TRUE) ff <- unique(c(ff1, ff2)) i <- !(basename(ff) %in% basename(ftmp)) ff[i] } tmpFiles <- function(current=TRUE, orphan=FALSE, old=FALSE, remove=FALSE) { if (!(old | current | orphan)) { error("tmpFiles", "at least one of 'orphan', 'current' and 'old' must be set to TRUE") } opt <- spatOptions() d <- opt$tempdir f <- NULL if (old) { if (normalizePath(tempdir()) != normalizePath(d)) { warn("tmpFiles", "old files can only be found if terra uses the R tempdir") } else { f <- list.files(dirname(d), recursive=TRUE, pattern="^spat_", full.names=TRUE) f <- grep("Rtmp", f, value=TRUE) if ((length(f) > 0) && (!current)) { i <- grep(d, f) if (length(i) > 0) { f <- f[-i] } } } } if (current) { ff <- list.files(d, pattern="^spat", full.names=TRUE) f <- c(f, ff) } else if (orphan) { fo <- .orphanTmpFiles() f <- c(f, fo) # for if old=TRUE } if (remove) { file.remove(f) return(invisible(f)) } else { return(f) } } terra/R/zonal.R0000644000176200001440000003712614726701466013064 0ustar liggesusers replace_with_label <- function(x, v, colnr) { ff <- is.factor(x) if (any(ff)) { cgs <- cats(x) for (f in which(ff)) { cg <- cgs[[f]] if (length(ff) == 1) { r <- 1:nrow(v) } else { r <- which(v[,1] == f) } i <- match(v[r,colnr], cg[,1]) act <- activeCat(x, f) + 1 if (!inherits(cg[[act]], "numeric")) { v[r, colnr] <- as.character(factor(cg[i, act], levels=unique(cg[[act]]))) } else { v[r, colnr] <- cg[i, act] } } } v } setMethod("zonal", signature(x="SpatRaster", z="SpatRaster"), function(x, z, fun="mean", ..., w=NULL, wide=TRUE, as.raster=FALSE, filename="", overwrite=FALSE, wopt=list()) { group <- FALSE made_unique <- FALSE grast <- rast() nlz <- nlyr(z) znms <- names(z) if (nlz == 1) { group <- FALSE } else if ((!as.raster) && (nlz == 2)) { grast <- z[[2]] z <- z[[1]] group <- TRUE } else { ff <- is.factor(z) if (any(ff)) { levs <- levels(z) levels(z) <- NULL } z <- unique(z, as.raster=TRUE) made_unique <- TRUE } txtfun <- .makeTextFun(fun) if (inherits(txtfun, "character") && (txtfun %in% c("max", "min", "mean", "sum", "notNA", "isNA"))) { if ((nlyr(z) > 1) && (nlyr(x) > 1)) { error("zonal", "x and z cannot both have more than one layer") } na.rm <- isTRUE(list(...)$na.rm) opt <- spatOptions() if (!is.null(w)) { if (txtfun != "mean") { error("zonal", "fun must be 'mean' when using weights") } sdf <- x@pntr$zonal_weighted(z@pntr, w@pntr, na.rm, opt) } else { sdf <- x@pntr$zonal(z@pntr, grast@pntr, txtfun, na.rm, opt) } sdf <- messages(sdf, "zonal") out <- .getSpatDF(sdf) nz <- 1 if (group) { out$layer <- out$layer + 1 out <- replace_with_label(z, out, 2) out <- replace_with_label(grast, out, 3) if (nlyr(x) > 1) { out <- split(out[-1], out$layer) out <- Reduce(function(x, y) merge(x=x, y=y, by=1:2, all=TRUE), out) out <- out[order(out[,1], out[,2]), ] } else { out <- out[,-1] } colnames(out) <- c(znms, names(x)) nz <- 2 } else if (!as.raster) { if (made_unique) { # && (!as.raster)) { ulevs <- cats(z)[[1]][, -c(1:2)] if (any(ff)) { for (f in which(ff)) { i <- match(ulevs[,f], levs[[f]][,1]) ulevs[,f] <- levs[[f]][i,2] } } out <- cbind(ulevs, out[,-1,drop=FALSE]) nz <- ncol(ulevs) } else { out <- replace_with_label(z, out, 1) colnames(out)[1] <- znms } } colnames(out) <- make.unique(colnames(out)) } else { if (!is.null(w)) { error("zonal", "can only use weights when fun=mean") } compareGeom(x, z, lyrs=FALSE, crs=FALSE, ext=TRUE, rowcol=TRUE) #if (nlyr(z) > 1) { # warn("zonal", "z can only have one layer with this function") # z <- z[[1]] #} fun <- match.fun(fun) nl <- nlyr(x) nms <- names(x) if (group) { gzx <- c(grast, z, x) v <- as.data.frame(gzx, na.rm=FALSE) out <- stats::aggregate(v[,-c(1:2)], v[,1:2], fun, ...) colnames(out)[-c(1:2)] <- nms } else { for (i in 1:nl) { xz <- c(x[[i]], z) v <- as.data.frame(xz, na.rm=FALSE) d <- stats::aggregate(v[,1], v[,2,drop=FALSE], fun, ...) colnames(d)[2] <- nms[i] if (i == 1) { out <- d } else { out <- merge(out, d, by=1) } } } } if (as.raster) { if (is.null(wopt$names) && (nlyr(x) == 1)) { wopt$names <- names(x) } levels(z) <- NULL out <- subst(z, out[,1], out[,-1], filename=filename, wopt=wopt) } if (wide) { if (group) { nms <- names(out) isch <- inherits(out[,2], "character") #out <- stats::reshape(out, direction="wide", idvar=nms[c(1,3)], timevar=nms[2]) out <- stats::reshape(out, direction="wide", idvar=nms[1], timevar=nms[2]) if (isch) { colnames(out) <- gsub(paste0("^", nms[3], "."), "", colnames(out)) } if (inherits(txtfun, "character") && (txtfun == "sum")) { out[is.na(out)] <- 0 } } } else if (nz == 1){ nls <- as.character(1:nlyr(x)) colnames(out)[-1] <- nls if (colnames(out)[1] == "layer") colnames(out)[1] <- "zone" out <- stats::reshape(out, direction="long", varying=nls, timevar="layer",v.names="value") out <- out[, c(2,1,3)] rownames(out) <- NULL } out } ) setMethod("zonal", signature(x="SpatRaster", z="SpatVector"), function(x, z, fun="mean", na.rm=FALSE, w=NULL, weights=FALSE, exact=FALSE, touches=FALSE, small=TRUE, as.raster=FALSE, as.polygons=FALSE, wide=TRUE, filename="", wopt=list()) { opt <- spatOptions() txtfun <- .makeTextFun(fun) if (!inherits(txtfun, "character")) { error("zonal", "this 'fun' is not supported. You can use extract instead") } else { if (txtfun == "table") { if (!is.null(w)) { error("cannot use 'w' when 'fun=table'") } v <- x@pntr$zonal_poly_table(z@pntr, weights[1], exact[1], touches[1], small[1], na.rm, opt) messages(x, "zonal") v <- lapply(v, function(i) if (length(i) == 0) NA else i) v <- lapply(1:length(v), function(i) cbind(i, matrix(v[[i]], ncol=2))) v <- do.call(rbind, v) v <- as.data.frame(v) colnames(v) <- c("zone", "value", "count") ff <- is.factor(x)[1] if (ff) { cg <- cats(x)[[1]] i <- match(v$value, cg[,1]) act <- activeCat(x, 1) + 1 v$value <- cg[i, act] } if (as.polygons | wide) { nms <- names(v) v <- stats::reshape(v, direction="wide", idvar=nms[1], timevar=nms[2]) names(v) <- gsub("count.", "", names(v)) v[is.na(v)] <- 0 rownames(v) <- NULL } if (as.polygons) { values(z) <- v return(z) } return(v) } else { if (is.null(w)) { out <- x@pntr$zonal_poly(z@pntr, txtfun, weights[1], exact[1], touches[1], small[1], na.rm, opt) } else { if (txtfun != "mean") { error("zonal", "fun must be 'mean' when using weights") } out <- x@pntr$zonal_poly_weighted(z@pntr, w@pntr, weights[1], exact[1], touches[1], small[1], na.rm, opt) } messages(out, "zonal") out <- .getSpatDF(out) } } if (as.raster) { if (is.null(wopt$names)) { wopt$names <- names(x) } x <- rasterize(z, x, 1:nrow(z)) subst(x, 1:nrow(out), out, filename=filename, wopt=wopt) } else if (as.polygons) { cbind(z, out) } else { out } } ) setMethod("zonal", signature(x="SpatVector", z="SpatVector"), function(x, z, fun=mean, ..., weighted=FALSE, as.polygons=FALSE) { if (geomtype(z) != "polygons") { error("zonal", "x must be points, and z must be polygons") } if (nrow(x) == 0) { error("zonal", "x is empty") } isn <- which(sapply(values(x[1,]), is.numeric)) if (!any(isn)) { error("zonal", "x has no numeric variables (attributes) to aggregate") } x <- x[,isn] if (geomtype(x) == "points") { r <- !relate(x, z, "disjoint", pairs=FALSE) i <- apply(r, 1, function(i) if(any(i)) which(i) else (NA)) if (length(i) == 0) { error("zonal", "there are no points in x that overlap with the polygons in z") } a <- aggregate(values(x), data.frame(zone=i), fun, ...) } else { if (as.polygons) { zz <- z values(zz) <- data.frame(zone = 1:nrow(zz)) i <- intersect(zz, x) } else { values(z) <- data.frame(zone = 1:nrow(z)) i <- intersect(z, x) } if (nrow(i) == 0) { error("zonal", "the intersection of x and z is empty") } v <- values(i) if (weighted) { if (geomtype(i) == "lines") { v$w <- perim(i) } else { v$w <- expanse(i) } s <- split(v, v$zone) n <- ncol(v)-2 s <- lapply(s, function(d) { out <- rep(NA, n) for (i in 2:n) { out[i-1] <- weighted.mean(d[[i]], w = d$w) } out }) a <- data.frame(as.integer(names(s)), do.call(rbind, s)) colnames(a) <- names(v)[-ncol(v)] } else { a <- aggregate(v[,-1,drop=FALSE], v[,1,drop=FALSE], fun, ...) } } if (as.polygons) { f <- basename(tempfile()) z[[f]] <- 1:nrow(z) names(a)[1] = f a <- merge(z, a, by=f, all.x=TRUE) a[[f]] <- NULL } a } ) setMethod("global", signature(x="SpatRaster"), function(x, fun="mean", weights=NULL, maxcell=Inf, ...) { nms <- names(x) nms <- make.unique(nms) txtfun <- .makeTextFun(fun) opt <- spatOptions() if (!is.null(weights)) { stopifnot(inherits(weights, "SpatRaster")) stopifnot(txtfun %in% c("mean", "sum")) na.rm <- isTRUE(list(...)$na.rm) tptr <- x@pntr$global_weighted_mean(weights@pntr, txtfun, na.rm, opt) messages(tptr, "global") res <- .getSpatDF(tptr) rownames(res) <- nms return(res) } if (inherits(txtfun, "character")) { if (any(is.na(txtfun))) error("global", "fun cannot be NA") if (any(txtfun %in% c("anynotNA", "anyNA"))) { if (length(txtfun) > 1) error("global", "'anynotNA' and 'anyNA' can not be combined with other functions'") tptr <- x@pntr$globalTF(txtfun, opt) messages(tptr, "global") res <- .getSpatDF(tptr) rownames(res) <- nms return(res) } if (all(txtfun %in% c("prod", "max", "min", "mean", "sum", "range", "rms", "sd", "std", "sdpop", "notNA", "isNA"))) { txtfun[txtfun == "sdpop"] <- "std" i <- grep("range", txtfun) if (length(i) > 0) { txtfun <- txtfun[-i] txtfun <- c(txtfun, "min", "max") } txtfun <- unique(txtfun) na.rm <- isTRUE(list(...)$na.rm) #if (isTRUE(list(...)$old)) { # ptr <- x@pntr$global(txtfun, na.rm, opt) #} else { tptr <- x@pntr$mglobal(txtfun, na.rm, opt) #} messages(tptr, "global") res <- .getSpatDF(tptr) rownames(res) <- nms return(res) } } nl <- nlyr(x) res <- list() if (is.finite(maxcell)) { maxcell <- round(maxcell) if (maxcell < 1) error("global", "maxcell should be positive") x <- spatSample(x, maxcell, "regular", as.raster=TRUE) } for (i in 1:nl) { res[[i]] <- fun(values(x[[i]]), ...) } res <- do.call(rbind, res) res <- data.frame(res) # more efficient but more risky: #apply(data.frame(x), 2, fun, ...) if ((ncol(res) == 1) && (colnames(res) == "res")) { colnames(res) <- "global" } rownames(res) <- nms res } ) setMethod("freq", signature(x="SpatRaster"), function(x, digits=0, value=NULL, bylayer=TRUE, usenames=FALSE, zones=NULL, wide=FALSE) { if (!is.null(zones)) { vna <- (!is.null(value) && is.na(value[1])) # if (vna) levels(x) <- NULL if (inherits(zones, "SpatVector")) { out <- vector("list", nrow(zones)) for (i in 1:nrow(zones)) { z <- zones[i,] e <- align(ext(z), x, snap="near") if (!is.null(intersect(e, ext(x)))) { r <- crop(x, zones[i,], mask=TRUE, touches=FALSE) if (vna) { ra <- rasterize(zones[i,], r, NA, background=0, touches=FALSE) r <- cover(ra, r) } out[[i]] <- freq(r, digits=digits, value=value, bylayer=bylayer, usenames=usenames, zones=NULL) out[[i]]$zone <- i } } } else if (inherits(zones, "SpatRaster")) { compareGeom(x, zones, crs=FALSE) if (nlyr(zones) > 1) zones <- zones[[1]] u <- unlist(unique(zones)) out <- vector("list", length(u)) for (i in 1:length(u)) { r <- mask(x, zones, maskvalues=u[i], inverse=TRUE) out[[i]] <- freq(r, digits=digits, value=value, bylayer=bylayer, usenames=usenames, zones=NULL, wide=FALSE) out[[i]]$zone <- i } } else { error("freq", "zones must be a SpatVector or a SpatRaster") } out <- do.call(rbind, out) if (is.null(out)) return(out) out <- out[!is.na(out$count), ] if (nrow(out) == 0) return(out) out <- out[order(out$layer), ] if (wide) { out$count[is.na(out$count)] <- 0 if (vna) { out$value <- "NA" } out <- stats::reshape(out, idvar=c("layer", "zone"), timevar="value", direction="wide") colnames(out) <- gsub("count.", "", colnames(out)) out[is.na(out)] <- 0 } return(out) } opt <- spatOptions() if (!bylayer) usenames <- FALSE if (!is.null(value)) { value <- unique(value) if (length(value) > 1) { error("freq", "value must have a length of one") } if (is.character(value)) { value <- value[value != ""] if (length(value) == 0) { error("freq", "no valid value") } ff <- is.factor(x) if (!any(ff)) { error("freq", "a character value is only meaningful for categorical rasters") } f <- freq(x[[ff]]) if (usenames) { f$layer <- names(x)[f$layer] } f <- f[f$label == value,] return(f) } if (is.na(digits)) { v <- x@pntr$count(value, bylayer[1], FALSE, 0, opt) } else { v <- x@pntr$count(value, bylayer[1], TRUE, digits, opt) value <- round(value, digits) } if (bylayer) { v <- data.frame(layer=1:nlyr(x), value=value, count=v) } else { v <- data.frame(value=value, count=v) } } else { if (is.na(digits)) { v <- x@pntr$freq(bylayer[1], FALSE, 0, opt) } else { v <- x@pntr$freq(bylayer[1], TRUE, digits, opt) } v <- lapply(v, function(i) if (length(i) == 0) NA else i) v <- lapply(1:length(v), function(i) cbind(i, matrix(v[[i]], ncol=2))) v <- do.call(rbind, v) v <- as.data.frame(v) colnames(v) <- c("layer", "value", "count") ff <- is.factor(x) if (any(ff)) { cgs <- cats(x) v <- data.frame(v) for (f in which(ff)) { cg <- cgs[[f]] j <- which(v[,1] == f) i <- match(v[j,2], cg[,1]) act <- activeCat(x, f) + 1 if (!inherits(cg[[act]], "numeric")) { v[j, 2] <- as.character(factor(cg[i, act], levels=unique(cg[[act]]))) } else { v[j, 2] <- cg[i, act] } } } if (!bylayer) { # if (nlyr(x) > 1) # v <- aggregate(v[,"count",drop=FALSE], v[,"value", drop=FALSE], sum) # } v <- v[,-1] } } if (usenames) { v$layer <- names(x)[v$layer] } if (wide) { v$count[is.na(v$count)] <- 0 if ((!is.null(value)) && is.na(value)) { v$value <- "NA" } v <- stats::reshape(v, idvar="layer", timevar="value", direction="wide") colnames(v) <- gsub("count.", "", colnames(v)) v[is.na(v)] <- 0 } v } ) setMethod ("expanse", "SpatRaster", function(x, unit="m", transform=TRUE, byValue=FALSE, zones=NULL, wide=FALSE, usenames=FALSE) { opt <- spatOptions() if (!is.null(zones)) { if (!inherits(zones, "SpatRaster")) { error("expanse", "zones must be a SpatRaster") } compareGeom(x, zones, lyrs=FALSE, crs=FALSE, ext=TRUE, rowcol=TRUE) v <- x@pntr$sum_area_group(zones@pntr, unit[1], transform[1], byValue[1], opt) messages(x) v <- lapply(v, function(i) matrix(i, ncol=4, byrow=TRUE)) v <- data.frame(do.call(rbind, v)) colnames(v) <- c("layer", "value", "zone", "area") v[,1] <- v[,1] + 1 if (byValue) { v <- replace_with_label(x, v, 2) v <- replace_with_label(zones, v, 3) } else { v <- replace_with_label(zones, v, 3) v$value <- NULL } if (wide) { if (byValue) { v <- stats::reshape(v, idvar=c("layer", "zone"), timevar="value", direction="wide") colnames(v) <- gsub("area.", "", colnames(v)) } else { v <- stats::reshape(v, idvar=c("layer"), timevar="zone", direction="wide") colnames(v) <- gsub("area.", "", colnames(v)) } v[is.na(v)] <- 0 } } else { v <- x@pntr$sum_area(unit, isTRUE(transform[1]), isTRUE(byValue[1]), opt) x <- messages(x, "expanse") if (byValue) { v <- lapply(1:length(v), function(i) cbind(i, matrix(v[[i]], ncol=2, byrow=TRUE))) v <- data.frame(do.call(rbind, v)) colnames(v) <- c("layer", "value", "area") v <- replace_with_label(x, v, 2) } else { v <- v[[1]] v <- data.frame(layer=1:length(v), area=v) } if (wide) { if (byValue) { v <- stats::reshape(v, idvar="layer", timevar="value", direction="wide") colnames(v) <- gsub("area.", "", colnames(v)) } v[is.na(v)] <- 0 } } if (usenames) { v$layer <- names(x)[v$layer] } v } ) terra/R/gcp.R0000644000176200001440000000147014536376240012500 0ustar liggesusers setClass("GCP", representation ( gcp = "matrix" ), prototype ( gcp = cbind(fx=0, fy=0, tx=0, ty=0)[0,] ) ) setMethod("show", signature(object="GCP"), function(object) { m <- object@gcp show(m) if (!is.null(grDevices::dev.list())) { for (i in 1:nrow(m)) { graphics::arrows(m[i,1], m[i,2], x1 = m[i,3], y1 = m[i,4], col="red", length = 0.1) } } } ) #setMethod("add<-", signature(x="GCP"), # function(x, value) { # if (missing(value)) { # value <- terra:::RS_locator(2, "l") # value <- rbind(as.vector(t(value))) # } # if (ncol(value) == 4) { # x@gcp <- rbind(x@gcp, value) # } # if (!is.null(grDevices::dev.list())) { # graphics::arrows(value[1,1], value[1,2], x1 = value[1,3], y1 = value[1,4], col="red", length = 0.1) # } # x # } #) #gcp <- new("GCP") #gcp <- addGCP(gcp) terra/R/ncdf.R0000644000176200001440000004100214733173375012637 0ustar liggesusers .ncdf_extent <- function(x, f) { if (!("ncdf4" %in% rownames(utils::installed.packages()))) { warn("rast", "GDAL did not find an extent. installing the ncdf4 package may help") return(x) } fname <- f zvar <- varnames(x)[1] dims <- 1:3 nc <- ncdf4::nc_open(fname, readunlim=FALSE, suppress_dimvals = TRUE) on.exit( ncdf4::nc_close(nc) ) ncols <- nc$var[[zvar]]$dim[[dims[1]]]$len nrows <- nc$var[[zvar]]$dim[[dims[2]]]$len if (!(ncol(x) == ncols) & (nrow(x) == nrows)) { warn("rast", "GDAL did not find an extent. Cells not equally spaced?") return(x) } xx <- try(ncdf4::ncvar_get(nc, nc$var[[zvar]]$dim[[dims[1]]]$name), silent = TRUE) if (inherits(xx, "try-error")) { xx <- seq_len(nc$var[[zvar]]$dim[[dims[1]]]$len) } rs <- xx[-length(xx)] - xx[-1] if (! isTRUE ( all.equal( min(rs), max(rs), tolerance=0.025, scale= abs(min(rs))) ) ) { warn("rast", "cells are not equally spaced; extent is not defined") return(x) } xrange <- c(min(xx), max(xx)) resx <- (xrange[2] - xrange[1]) / (ncols-1) yy <- try(ncdf4::ncvar_get(nc, nc$var[[zvar]]$dim[[dims[2]]]$name), silent = TRUE) if (inherits(yy, "try-error")) { yy <- seq_len(nc$var[[zvar]]$dim[[dims[2]]]$len) } rs <- yy[-length(yy)] - yy[-1] if (! isTRUE ( all.equal( min(rs), max(rs), tolerance=0.025, scale= abs(min(rs))) ) ) { warn("rast", "cells are not equally spaced; extent is not defined") return(x) } yrange <- c(min(yy), max(yy)) resy <- (yrange[2] - yrange[1]) / (nrows-1) xrange[1] <- xrange[1] - 0.5 * resx xrange[2] <- xrange[2] + 0.5 * resx yrange[1] <- yrange[1] - 0.5 * resy yrange[2] <- yrange[2] + 0.5 * resy ext(x) <- ext(xrange[1], xrange[2], yrange[1], yrange[2]) return(x) } write_tags <- function(tags, nc, varid, prefix="TAG_") { if (length(tags) > 0) { nms <- paste0(prefix, names(tags)) for(i in 1:length(nms)) { ncdf4::ncatt_put(nc, varid, nms[i], tags[i], prec="text") } } } .write_cdf <- function(x, filename, overwrite=FALSE, zname="time", atts="", gridmap="", prec="float", compression=NA, missval, force_v4=TRUE, verbose=FALSE, ...) { n <- length(x) y <- x[1] if (is.lonlat(y, perhaps=TRUE, warn=FALSE)) { xname = "longitude" yname = "latitude" xunit = "degrees_east" yunit = "degrees_north" } else { xname = "easting" yname = "northing" xunit = "meter" # probably yunit = "meter" # probably } xdim <- ncdf4::ncdim_def( xname, xunit, xFromCol(y, 1:ncol(y)) ) ydim <- ncdf4::ncdim_def( yname, yunit, yFromRow(y, 1:nrow(y)) ) vars <- varnames(x) vars[vars == ""] <- paste0("var_", (1:n)[vars == ""]) vars <- make.unique(vars) lvar <- longnames(x) units <- units(x) zname <- rep_len(zname, n) valid_prec <- c("short", "integer", "float", "double", "byte") if (!all(prec %in% valid_prec)) { error("writeCDF", paste("prec must be one of:", paste(valid_prec, collapse=", "))) } prec <- rep_len(prec, n) if (missing(missval)) { miss_vals <- c(-32768, -2147483647, -1.175494e38, -1.7976931348623157e308, 255) missval <- miss_vals[match(prec, valid_prec)] } else { missval <- rep_len(missval, n) } compression <- compression[1] nc <- ncol(x) nr <- nrow(x) nl <- nlyr(x) ncvars <- list() cal <- NA for (i in 1:n) { if ((nl[i] > 1) || (x[i]@pntr$hasTime)) { y <- x[i] if (y@pntr$hasTime) { zv <- y@pntr$time tstep <- y@pntr$timestep cal <- "standard" if (tstep == "seconds") { zunit <- "seconds since 1970-1-1 00:00:00" } else if (tstep == "days") { zunit <- "days since 1970-1-1" zv <- zv / (24 * 3600) } else if (tstep == "months") { zunit <- "months" zv <- time(y) } else if (tstep == "yearmonths") { zunit <- "months since 1970" tm <- time(y) - 1970 yr <- tm %/% 1 zv <- (yr*12) + round(12 * (tm %% 1)) } else if (tstep == "years") { zunit <- "years since 1970" zv <- time(y) - 1970 } else { zunit <- "unknown" } } else { zv <- 1:nlyr(y) zunit <- "unknown" } zdim <- ncdf4::ncdim_def(zname[i], zunit, zv, unlim=FALSE, create_dimvar=TRUE, calendar=cal) ncvars[[i]] <- ncdf4::ncvar_def(vars[i], units[i], list(xdim, ydim, zdim), missval[i], lvar[i], prec = prec[i], compression=compression,...) } else { ncvars[[i]] <- ncdf4::ncvar_def(name=vars[i], units=units[i], dim=list(xdim, ydim), missval=missval[i], longname=lvar[i], prec = prec[i], compression=compression, ...) } } ncvars[[n+1]] <- ncdf4::ncvar_def("crs", "", list(), NULL, prec="integer") ncobj <- ncdf4::nc_create(filename, ncvars, force_v4=force_v4, verbose=verbose) on.exit(ncdf4::nc_close(ncobj)) haveprj <- FALSE prj <- crs(x[1]) prj <- gsub("\n", "", prj) if (prj != "") { haveprj <- TRUE ncdf4::ncatt_put(ncobj, ncvars[[n+1]], "crs_wkt", prj, prec="text") # need for older gdal? ncdf4::ncatt_put(ncobj, ncvars[[n+1]], "spatial_ref", prj, prec="text") prj <- .proj4(x[1]) if (prj != "") { ncdf4::ncatt_put(ncobj, ncvars[[n+1]], "proj4", prj, prec="text") } prj <- crs(x[1], describe=TRUE)[1,2:3] if (!any(is.na(prj))) { prj <- paste0(prj, collapse=":") ncdf4::ncatt_put(ncobj, ncvars[[n+1]], "code", prj, prec="text") } } gridmap <- grep("=", gridmap, value=TRUE) if (length(gridmap)>0) { gridmap <- strsplit(gridmap, "=") for (i in 1:length(gridmap)) { ncdf4::ncatt_put(ncobj, ncvars[[n+1]], gridmap[[i]][1], gridmap[[i]][2], prec="text") } haveprj <- TRUE } e <- ext(x) rs <- res(x) gt <- paste(trimws(formatC(as.vector(c(e$xmin, rs[1], 0, e$ymax, 0, -1 * rs[2])), 22)), collapse=" ") ncdf4::ncatt_put(ncobj, ncvars[[n+1]], "geotransform", gt, prec="text") opt <- spatOptions() bsteps <- blocks(rast(x[[1]], nlyr=sum(nlyr(x))), 4) if (bsteps$n > opt$progress) { progress <- TRUE pb <- utils::txtProgressBar(0, bsteps$n) pcnt <- 0 } else { progress <- FALSE } for (i in 1:n) { y <- x[i] b <- blocks(y, 8) readStart(y) if (length(ncvars[[i]]$dim) == 3) { for (j in 1:b$n) { if (progress) { utils::setTxtProgressBar(pb, pcnt); pcnt <- pcnt + 1 } d <- readValues(y, b$row[j], b$nrows[j], 1, nc, FALSE, FALSE) d[is.nan(d)] <- NA d <- array(d, c(nc, b$nrows[j], nl[i])) ncdf4::ncvar_put(ncobj, ncvars[[i]], d, start=c(1, b$row[j], 1), count=c(nc, b$nrows[j], nl[i])) } } else { for (j in 1:b$n) { if (progress) { utils::setTxtProgressBar(pb, pcnt); pcnt <- pcnt + 1 } d <- readValues(y, b$row[j], b$nrows[j], 1, nc, FALSE, FALSE) d[is.nan(d)] <- NA d <- matrix(d, ncol=b$nrows[j]) ncdf4::ncvar_put(ncobj, ncvars[[i]], d, start=c(1, b$row[j]), count=c(nc, b$nrows[j])) } } readStop(y) if (haveprj) { ncdf4::ncatt_put(ncobj, ncvars[[i]], "grid_mapping", "crs", prec="text") } write_tags(metags(y), ncobj, ncvars[[i]], "") } if (progress) close(pb) ncdf4::ncatt_put(ncobj, 0, "Conventions", "CF-1.4", prec="text") pkgversion <- drop(read.dcf(file=system.file("DESCRIPTION", package="terra"), fields=c("Version"))) ncdf4::ncatt_put(ncobj, 0, "created_by", paste("R packages ncdf4 and terra (version ", pkgversion, ")", sep=""), prec="text") ncdf4::ncatt_put(ncobj, 0, "created_date", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), prec="text") write_tags(metags(x), ncobj, 0, "") atts <- grep("=", atts, value=TRUE) if (length(atts) > 0) { atts <- strsplit(atts, "=") for (i in 1:length(atts)) { ncdf4::ncatt_put(ncobj, 0, atts[[i]][1], atts[[i]][2], prec="text") } } TRUE } setMethod("writeCDF", signature(x="SpatRaster"), function(x, filename, varname, longname="", unit="", split=FALSE, ...) { filename <- trimws(filename) if (length(filename) > 1) { if (length(filename) != nlyr(x)) { stop("either provide a single filename, or the same number as nlyr(x)") } } stopifnot(filename != "") if (split) { y <- sds(as.list(x)) names(y) <- names(x) if (!missing(varname)) { varnames(y) <- varname } if (!missing(longname)) { longnames(y) <- longname } if (!missing(unit)) { units(y) <- unit } else { units(y) <- units(x) } invisible( writeCDF(y, filename=filename, ...) ) } else { if (missing(varname)) { varname <- tools::file_path_sans_ext(basename(filename)) } varnames(x) <- varname longnames(x) <- longname units(x) <- unit x <- sds(x) invisible( writeCDF(x, filename=filename, ...) ) } } ) setMethod("writeCDF", signature(x="SpatRasterDataset"), function(x, filename, overwrite=FALSE, zname="time", atts="", gridmap="", prec="float", compression=NA, missval, ...) { filename <- trimws(filename) stopifnot(filename != "") xt <- tools::file_ext(filename) if (any(!(xt %in% c("nc", "cdf")))) { warn("writeCDF", "for better results use file extension '.nc' or '.cdf'\nsee: https://stackoverflow.com/a/65398262/635245") } if (file.exists(filename) & !overwrite) { error("writeCDF", "file exists, use 'overwrite=TRUE' to overwrite it") } ok <- .write_cdf(x, filename, zname=zname, atts=atts, gridmap=gridmap, prec=prec, compression=compression, missval=missval, ...) if (ok) { if (length(x) > 1) { out <- sds(filename) } else { out <- rast(filename) } invisible(out) } else { error("writeCDF", "?") } } ) .varName <- function(nc, varname="", warn=TRUE) { n <- nc$nvars dims <- vars <- vector(length=n) if (n > 0) { for (i in 1:n) { vars[i] <- nc$var[[i]]$name dims[i] <- nc$var[[i]]$ndims } vars <- vars[dims > 1] dims <- dims[dims > 1] } if (varname=='') { nv <- length(vars) if (nv == 0) { return('z') } if (nv == 1) { varname <- vars } else { varname <- vars[which.max(dims)] if (warn) { if (sum(dims == max(dims)) > 1) { vars <- vars[dims==max(dims)] warning('varname used is: ', varname, '\nIf that is not correct, you can set it to one of: ', paste(vars, collapse=", ") ) } } } } zvar <- which(varname == vars) if (length(zvar) == 0) { stop('varname: ', varname, ' does not exist in the file. Select one from:\n', paste(vars, collapse=", ") ) } return(varname) } .getCRSfromGridMap4 <- function(g) { if (!is.null(g$epsg_code)) { crs <- g$epsg_code if (!grep("EPSG:", crs, ignore.case=TRUE)) { crs <- paste0("epsg:", crs) } return(crs) } sp <- g$standard_parallel if (length(sp) > 1) { g$standard_parallel1 <- sp[1] g$standard_parallel2 <- sp[2] g$standard_parallel <- NULL } vals <- sapply(g, function(i) i[1]) vars <- names(vals) if (any(vars %in% c("proj4", "crs_wkt", "spatial_ref"))) { crs=vals[vars %in% c("proj4", "crs_wkt", "spatial_ref")][1] return(crs) } # based on info at # http://trac.osgeo.org/gdal/wiki/NetCDF_ProjectionTestingStatus # accessed 7 October 2012 prj <- matrix(c("albers_conical_equal_area", "aea", "azimuthal_equidistant", "aeqd", "lambert_cylindrical_equal_area", "cea", "lambert_azimuthal_equal_area", "laea", "lambert_conformal_conic", "lcc", "latitude_longitude", "longlat", "mercator", "merc", "orthographic", "ortho", "polar_stereographic", "stere", "stereographic", "stere", "transverse_mercator", "tmerc"), ncol=2, byrow=TRUE) m <- matrix(c("grid_mapping_name", "+proj", "false_easting", "+x_0","false_northing", "+y_0", "scale_factor_at_projection_origin", "+k_0", "scale_factor_at_central_meridian", "+k_0", "standard_parallel", "+lat_1", "standard_parallel1", "+lat_1", "standard_parallel2", "+lat_2", "longitude_of_central_meridian", "+lon_0", "longitude_of_projection_origin", "+lon_0", "latitude_of_projection_origin", "+lat_0", "straight_vertical_longitude_from_pole", "+lon_0", "longitude_of_prime_meridian", "+pm", "semi_major_axis", "+a", "semi_minor_axis", "+b", "inverse_flattening", "+rf", "earth_radius", "+a"), ncol=2, byrow=TRUE) # add logic that if prime merid is defined but not centr merid. centr merid is same as prime. i <- match(vars, m[,1]) if (all(is.na(i))) { gg <- cbind(vars, vals) mtxt <- paste(apply(gg, 1, function(x) paste(x, collapse='=')), collapse='; ') warning("cannot process the crs\n", mtxt) return(NA) } else if (any(is.na(i))) { vr <- vars[is.na(i)] vl <- vals[is.na(i)] gg <- cbind(vr, vl) gg <- gg[!(gg[,1] %in% c("crs_wkt", "esri_pe_string")), ,drop=FALSE] if (NROW(gg) > 0) { mtxt <- paste(apply(gg, 1, function(x) paste(x, collapse='=')), collapse='\n') warning("cannot process these parts of the crs:\n", mtxt) } vars <- vars[!is.na(i)] vals <- vals[!is.na(i)] i <- stats::na.omit(i) } tab <- cbind(m[i,], vals) rr <- which(tab[,1] == "earth_radius") if (length(rr) > 0) { bb <- tab[rr,] bb[2] <- "+b" tab <- rbind(tab, bb) } p <- which(tab[,2] == '+proj') if (length(p) == 0) { warning("cannot create a valid crs\n", mtxt) return(NA) } else { tab <- rbind(tab[p, ], tab[-p, ]) } j <- match(tab[1,3], prj[,1]) tab[1,3] <- prj[j,2] cr <- paste(apply(tab[,2:3], 1, function(x) paste(x, collapse='=')), collapse=' ') crtst <- try(rast(crs=cr), silent=TRUE) if ( inherits(crtst, "try-error")) { mtxt <- paste(m, collapse='; ') warning("cannot create a valid crs\n", mtxt) return(NA) } else { return(cr) } } .ncdfTime <- function(nc, zvar, dim3, zval) { dodays <- TRUE dohours <- FALSE doseconds <- FALSE un <- nc$var[[zvar]]$dim[[dim3]]$units if (substr(un, 1, 10) == "days since") { startDate = as.Date(substr(un, 12, 22)) } else if (substr(un, 1, 11) == "hours since") { dohours <- TRUE dodays <- FALSE startTime <- substr(un, 13, 30) mult <- 3600 } else if (substr(un, 1, 13) == "seconds since") { doseconds <- TRUE dodays <- FALSE startTime = as.Date(substr(un, 15, 31)) mult <- 1 } else if (substr(un, 1, 12) == "seconds from") { doseconds <- TRUE dodays <- FALSE startTime = as.Date(substr(un, 14, 31)) mult <- 1 } else { return(NULL) } if (!dodays) { start <- strptime(startTime, "%Y-%m-%d %H:%M:%OS", tz = "UTC") if (is.na(start)) start <- strptime(startTime, "%Y-%m-%d", tz = "UTC") if (is.na(start)) return(x) startTime <- start time <- startTime + as.numeric(zval) * mult time <- as.character(time) if (!is.na(time[1])) { return(time) } } else if (dodays) { # cal = nc$var[[zvar]]$dim[[dim3]]$calendar ? cal <- ncdf4::ncatt_get(nc, "time", "calendar") if (! cal$hasatt ) { greg <- TRUE } else { cal <- cal$value if (cal =='gregorian' | cal =='proleptic_gregorian' | cal=='standard') { greg <- TRUE } else if (cal == 'noleap' | cal == '365 day' | cal == '365_day') { greg <- FALSE nday <- 365 } else if (cal == '360_day') { greg <- FALSE nday <- 360 } else { greg <- TRUE warning('assuming a standard calender:', cal) } } if (greg) { time <- as.Date(time, origin=startDate) } else { startyear <- as.numeric( format(startDate, "%Y") ) startmonth <- as.numeric( format(startDate, "%m") ) startday <- as.numeric( format(startDate, "%d") ) year <- trunc( as.numeric(time)/nday ) doy <- (time - (year * nday)) origin <- paste(year+startyear, "-", startmonth, "-", startday, sep='') time <- as.Date(doy, origin=origin) } return(time) } return(NULL) } pointsCDF <- function(filename, varname, polygons=FALSE) { if (!("ncdf4" %in% rownames(utils::installed.packages()))) { warn("rast", "GDAL did not find an extent. installing the ncdf4 package may help") return(x) } zvar <- .varName(nc, varname, warn=TRUE) nc <- ncdf4::nc_open(filename, readunlim=FALSE, suppress_dimvals = TRUE) on.exit( ncdf4::nc_close(nc) ) dims <- 1:3 ncols <- nc$var[[zvar]]$dim[[dims[1]]]$len nrows <- nc$var[[zvar]]$dim[[dims[2]]]$len xx <- try(ncdf4::ncvar_get(nc, nc$var[[zvar]]$dim[[dims[1]]]$name), silent = TRUE) if (inherits(xx, "try-error")) { error("pointsCDF", "no x coordinates found") } yy <- try(ncdf4::ncvar_get(nc, nc$var[[zvar]]$dim[[dims[2]]]$name), silent = TRUE) if (inherits(yy, "try-error")) { error("pointsCDF", "no x coordinates found") } a <- ncdf4::ncatt_get(nc, zvar, "grid_mapping") prj <- NA if ( a$hasatt ) { try(atts <- ncdf4::ncatt_get(nc, a$value), silent=TRUE) try(prj <- .getCRSfromGridMap4(atts), silent=TRUE) } dim3 <- dims[3] dim3_vals <- try(ncdf4::ncvar_get(nc, nc$var[[zvar]]$dim[[dim3]]$name), silent = TRUE) if (inherits(dim3_vals, "try-error")) { dim3_vals <- seq_len(nc$var[[zvar]]$dim[[dim3]]$len) } nms <- NULL if ( nc$var[[zvar]]$dim[[dim3]]$name == "time" ) { try( nms <- .ncdfTime(nc, zvar, dim3, dim3_vals) ) } d <- ncdf4::ncvar_get( nc, varid=zvar) nl <- dim(d)[3] v <- sapply(1:nl, function(i) d[,,i]) natest1 <- ncdf4::ncatt_get(nc, zvar, "_FillValue") natest2 <- ncdf4::ncatt_get(nc, zvar, "missing_value") if (natest1$hasatt) { v[v==natest1$value] <- NA } else if (natest2$hasatt) { v[v==natest2$value] <- NA } if (!is.null(nms)) { colnames(v) <- nms } vect(cbind(rep(xx, length(yy)), rep(yy, each=length(xx))), atts=v, crs=prj) } terra/R/approximate.R0000644000176200001440000000361714536376240014265 0ustar liggesusers# Author: Robert J. Hijmans # Date : February 2012 # Version 1.0 # Licence GPL v3 setMethod("approximate", signature(x="SpatRaster"), function(x, method="linear", yleft, yright, rule=1, f=0, ties=mean, z=NULL, NArule=1, filename="", ...) { out <- rast(x, keeptime=TRUE) nl <- nlyr(out) if (nl < 2) { warning('cannot interpolate with a single layer') return(x) } if (is.null(z)) { xout <- time(x) if (any(is.na(xout))) { xout <- 1:nl } } else { if (length(z)!= nl) { error("approximate", "length of z does not match nlyr(x)") } xout <- z } ifelse((missing(yleft) & missing(yright)), ylr <- 0L, ifelse(missing(yleft), ylr <- 1L, ifelse(missing(yright), ylr <- 2L, ylr <- 3L))) nc <- ncol(out) readStart(x) on.exit(readStop(x)) b <- writeStart(out, filename, sources=sources(x), ...) for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) s <- .rowSums(is.na(v), nrow(v), nl) if (isTRUE(NArule==1)) { j <- s == (nl-1) # one non-NA only if (length(j) > 0 ) { v[j, ] <- apply(v[j,,drop=FALSE ], 1, max, na.rm=TRUE) } } j <- (s < nl-1) # need at least two if (length(j) > 0 ) { if (ylr==0) { v[j,] <- t( apply(v[j,,drop=FALSE], 1, function(x) stats::approx(x=xout, y=x, xout=xout, method=method, rule=rule, f=f, ties=ties)$y ) ) } else if (ylr==1) { v[j,] <- t( apply(v[j,,drop=FALSE], 1, function(x) stats::approx(x=xout, y=x, xout=xout, method=method, yright=yright, rule=rule, f=f, ties=ties)$y ) ) } else if (ylr==2) { v[j,] <- t( apply(v[j,,drop=FALSE], 1, function(x) stats::approx(x=xout, y=x, xout=xout, method=method, yleft=yleft, rule=rule, f=f, ties=ties)$y ) ) } else { v[j,] <- t( apply(v[j,,drop=FALSE], 1, function(x) stats::approx(x=xout, y=x, xout=xout, method=method, yright=yright, yleft=yleft, rule=rule, f=f, ties=ties)$y ) ) } } writeValues(out, v, b$row[i], b$nrows[i]) } writeStop(out) } ) terra/R/init.R0000644000176200001440000000207614731063166012672 0ustar liggesusers# Author: Robert J. Hijmans # Date : May 2019 # Version 1.0 # License GPL v3 setMethod("init", signature(x="SpatRaster"), function(x, fun, ..., filename="", wopt=list()) { x <- rast(x) if (is.character(fun)) { opt <- spatOptions(filename, wopt=wopt) x <- rast(x, 1) fun <- fun[1] if (fun %in% c("x", "y", "row", "col", "cell", "chess")) { x@pntr <- x@pntr$initf(fun, TRUE, opt) messages(x, "init") } else if (is.na(fun)) { x@pntr <- x@pntr$initv(as.numeric(NA), opt) messages(x, "init") } else { error("init", "unknown function") } } else if (is.numeric(fun) || is.logical(fun)) { opt <- spatOptions(filename, wopt=wopt) x@pntr <- x@pntr$initv(fun, opt) messages(x, "init") } else { nc <- ncol(x) * nlyr(x) b <- writeStart(x, filename, sources=sources(x), wopt=wopt) for (i in 1:b$n) { n <- b$nrows[i] * nc; r <- fun(n, ...) if (length(r) != n) { error("init","the number of values returned by 'fun' is not correct") } writeValues(x, r, b$row[i], b$nrows[i]) } writeStop(x) } } ) terra/R/SpatVectorCollection.R0000644000176200001440000000646714726701421016042 0ustar liggesusers setMethod("length", signature(x="SpatVectorCollection"), function(x) { x@pntr$size() } ) setMethod("svc", signature(x="missing"), function(x) { v <- methods::new("SpatVectorCollection") v@pntr <- SpatVectorCollection$new() v } ) setMethod("svc", signature(x="character"), function(x, layer="", query="", extent=NULL, filter=NULL) { if (is.null(filter)) { filter <- SpatVector$new() } else { filter <- filter@pntr } if (is.null(extent)) { extent <- double() } else { extent <- as.vector(ext(extent)) } v <- methods::new("SpatVectorCollection") v@pntr <- SpatVectorCollection$new(x, layer, query, extent, filter) v } ) setMethod("svc", signature(x="SpatVector"), function(x, ...) { r <- methods::new("SpatVectorCollection") r@pntr <- SpatVectorCollection$new() r@pntr$push_back(x@pntr) dots <- list(...) if (length(dots) > 0) { for (i in 1:length(dots)) { if (inherits(dots[[i]], "SpatVector")) { r@pntr$push_back(dots[[i]]@pntr) } else { warn("svc", "cannot add objects of class: ", class(dots[[i]])) } } } messages(r, "svc") } ) setMethod("svc", signature(x="sf"), function(x) { .svc_from_sf(x) } ) setMethod("svc", signature(x="list"), function(x) { r <- methods::new("SpatVectorCollection") r@pntr <- SpatVectorCollection$new() for (i in seq_along(x)) { if (inherits(x[[i]], "SpatVector")) { r@pntr$push_back(x[[i]]@pntr) } } r <- messages(r, "svc") names(r) <- names(x) r } ) setReplaceMethod("[", c("SpatVectorCollection", "numeric", "missing"), function(x, i, j, value) { stopifnot(inherits(value, "SpatVector")) if (any(!is.finite(i)) || any(i<1)) { error("`[<-`", "invalid index") } i <- sort(i) for (j in i) { if (j == (length(x)+1)) { x@pntr$push_back(value@pntr) } else { x@pntr$replace(value@pntr, j-1) } } messages(x, "`[<-`") } ) setMethod("[", c("SpatVectorCollection", "numeric", "missing"), function(x, i, j, drop=TRUE) { if (i < 0) {i <- (1:length(x))[i]} if (drop && (length(i) == 1)) { tptr <- x@pntr$get(i-1) x <- methods::new("SpatVector") x@pntr <- tptr } else { x@pntr <- x@pntr$subset(i-1) } messages(x, "`[`") }) setMethod("[[", c("SpatVectorCollection", "ANY", "missing"), function(x, i, j, drop=TRUE) { if (inherits(i, "character")) { i <- na.omit(match(i, names(x))) if (length(i) == 0) { error("[[", "no matching names") } } x[i, drop=drop] }) setMethod("$", c("SpatVectorCollection"), function(x, name) { i <- na.omit(grep(name, names(x))) if (length(i) == 0) { error("$", "no matching names") } x[i,drop=TRUE] }) setMethod("[[", c("SpatVectorCollection", "numeric", "missing"), function(x, i, j, drop=TRUE) { x[i,drop=drop] }) setMethod("c", signature(x="SpatVector"), function(x, ...) { svc(x, ...) } ) setMethod("c", signature(x="SpatVectorCollection"), function(x, ...) { x@pntr <- x@pntr$subset(0:(x@pntr$size()-1) ) ## deep copy dots <- list(...) for (i in seq_along(dots)) { if (inherits(dots[[i]], "SpatVectorCollection")) { for (j in 1:length(dots[[i]])) { x@pntr$push_back(dots[[i]][[j]]@pntr) } } else if (inherits(dots[[i]], "SpatVector")) { x@pntr$push_back(dots[[i]]@pntr) } else { error("c", "arguments must be SpatVector or SpatVectorCollection") } } messages(x, "c") } ) terra/R/replace_values.R0000644000176200001440000002113714726700274014722 0ustar liggesusers# Author: Robert J. Hijmans # Date: October 2018 # Version 1.0 # License GPL v3 setMethod("set.values", signature(x="SpatRasterDataset"), function(x) { x@pntr$readAll() messages(x, "set.values") } ) setMethod("set.values", signature(x="SpatRaster"), function(x, cells, values, layer=0) { #if (any(is.na(cells))) { # warn("set.values", "cells should not be NA") #} if (is.character(layer)) { layer <- match(layer, names(x)) if (any(is.na(layer))) { error("set.values", "invalid layer") } } layer <- round(layer) if (all(layer > 0)) { if (missing(cells) && missing(values)) { return(invisible(TRUE)); } if (any(is.na(layer))) { error("set.values", "layers cannot be NA")} if (inherits(layer, "character")) { layer <- match(layer, names(x)) if (any(is.na(layer))) { error("set.values", "invalid layer names")} } if (any((layer < 1) | (layer > nlyr(x)))) { error("set.values", "invalid layer numbers") } n <- length(layer) if (n > length(unique(layer))) { error("set.values", "duplicated layers") } bylyr <- FALSE if (!is.null(dim(values))) { if (ncol(values) != n) { error("set.values", "ncol(values) does not match `length(layer)`") } bylyr <- TRUE #if (inherits(values, "data.frame")) { # values <- as.matrix(values) #} values <- as.vector(values) } ok <- x@pntr$replaceCellValuesLayer(layer-1, cells-1, values, bylyr, spatOptions()) messages(x) invisible(TRUE) } else { if (any(layer > 0)) { error("set.values", "some (but not all) layer numbers are < 1") } if (missing(cells) && missing(values)) { x@pntr$readAll() return(messages(x, "set.values")) } bylyr <- FALSE if (!is.null(dim(values))) { if (ncol(values) != nlyr(x)) { error("set.values", "ncol(values) does not match the nlyr(x)") } bylyr <- TRUE #if (inherits(values, "data.frame")) { # values <- as.matrix(values) #} values <- as.vector(values) } ok <- x@pntr$replaceCellValues(cells-1, values, bylyr, spatOptions()) messages(x) } invisible(TRUE) } ) make_replace_index <- function(v, vmx, nreps, name="i") { caller <- paste0("`[<-`(", name, ")") if (inherits(v, "SpatRaster")) { error(caller, paste("index", name, "cannot be a SpatRaster")) } if (inherits(v, "SpatVector")) { error(caller, paste("index", name, "cannot be a SpatVector")) } if (inherits(v, "SpatExtent")) { error(caller, paste("index", name, "cannot be a SpatExtent")) } if (!is.numeric(v)) { if (NCOL(v) > 1) { error(caller, paste("index", name, "has multiple columns")) } if (inherits(v, "data.frame")) { v <- v[,1,drop=TRUE] } else if (inherits(v, "matrix")) { v <- as.vector(v) } if (!is.vector(v)) { error(caller, paste("the type of index", name, "is unexpected:", class(v)[1])) } if (is.factor(v) || is.character(v)) { error(caller, paste("the type of index", name, "cannot be a factor or character")) } if (is.logical(v)) { if (length(v) > vmx) { error(caller, paste("index", name, "is too long")) } if (length(v) <= vmx) { v <- which(rep_len(v, vmx)) } } else { v <- as.numeric(v) } } if (inherits(v, "matrix")) { if (ncol(v) == 1) { v <- v[,1] } else if (nrow(v) == 1) { v <- v[1,] } else { error(caller, paste("index", name, "has unexpected dimensions:", paste(dim(v), collapse=", "))) } } if (any(is.na(v))) { if (nreps > 1) { error(caller, "NAs are not allowed in subscripted assignments") } else { v <- v[!is.na(v)] } } #vv <- stats::na.omit(v) if (all(v < 0)) { if (any(v < -vmx)) { error(caller, paste(name, "is out of its valid range")) } v <- (1:vmx)[v] } if (any(v < 1 | v > vmx)) { error(caller, paste(name, "is out of its valid range")) } v } .replace_all <- function(x, value) { nl <- nlyr(x) if (is.matrix(value)) { d <- dim(value) if (!all(d == c(ncell(x), nl))) { if ((d[2] == nl) && (d[1] < ncell(x))) { value <- apply(value, 2, function(i) rep_len(i, ncell(x))) } else { error("`[`","dimensions of the matrix do not match the SpatRaster") } } x <- try( setValues(x, value, TRUE, TRUE) ) } else { v <- try( matrix(nrow=ncell(x), ncol=nl) ) if (! inherits(x, "try-error")) { v[] <- value x <- try( setValues(x, v, TRUE, TRUE) ) } } if (inherits(x, "try-error")) { error("`[`", "cannot set values") } return(x) } .replace_cell <- function(x, i, k, value) { bylyr = FALSE if (!is.null(dim(value))) { stopifnot(ncol(value) == nlyr(x)) bylyr <- TRUE if (inherits(value, "data.frame")) { value <- as.matrix(value) } value <- as.vector(value) } opt <- spatOptions() x@pntr <- x@pntr$deepcopy() if (is.na(k[1])) { if (!x@pntr$replaceCellValues(i-1, value, bylyr, opt)) { messages(x, "`[<-`") } } else { if (!x@pntr$replaceCellValuesLayer(k-1, i-1, value, bylyr, opt)) { messages(x, "`[<-`") } } x } .replace_cell_lyr <- function(x, cell, lyrs, value) { ulyrs <- sort(unique(lyrs)) opt <- spatOptions() for (lyr in ulyrs) { y <- x[[lyr]] i <- which(lyrs == lyr) if (!y@pntr$replaceCellValues(cell[i]-1, value[i], FALSE, opt)) { messages(y, "`[<-`") } x[[lyr]] <- y } x } .replace_spatvector <- function(x, i, value) { if (length(value) > 1) { if (length(value) > nrow(i)) { # could be by layer if NCOL>1? error("`[`", "value is too long") } value <- rep_len(value, length.out=length(i)) } rasterize(i, x, field=value, update=TRUE) } .replace_spatextent <- function(x, i, value) { if (length(value) > 1) { if (length(value) > nrow(i)) { # could be by layer if NCOL>1? error("`[`", "value is too long") } value <- rep_len(value, length.out=length(i)) } rasterize(as.polygons(i), x, field=value, update=TRUE) } .replace_spatraster <- function(x, i, value) { if (inherits(value, "SpatRaster")) { x <- mask(x, i, maskvalues=TRUE) cover(x, value) } else { if (NCOL(value) > 1) { error("`[<-`", "cannot use a data.frame with multiple columns") } value <- unlist(value) if (length(value) == 1) { mask(x, i, maskvalues=TRUE, updatevalue=value[1]) } else { i <- as.logical(values(i)) i[is.na(i)] <- FALSE #TRUE, for #1115 i <- which(i) x[i] <- value x } } } setReplaceMethod("[", c("SpatRaster", "ANY", "ANY", "ANY"), function(x, i, j, k, value) { m <- c(missing(i), missing(j), missing(k)) if (all(m) && is.matrix(value) && ((nrow(value) == nrow(x)) && (ncol(value) == ncol(x) * nlyr(x)))) { values(x) <- value return(x) } s <- rep(FALSE, 3) if (!m[1]) s[1] <- inherits(i, "list") if (!m[2]) s[2] <- inherits(j, "list") if (!m[3]) s[3] <- inherits(k, "list") if (any(s)) { if (m[1]) i <- NULL if (m[2]) j <- NULL if (m[3]) k <- NULL i <- rcl(x, i, j, k) m <- c(FALSE, TRUE, TRUE) } if (missing(value)) { value <- k k <- NA m[3] <- TRUE } if ((!m[1]) && (inherits(i, "matrix"))) { if (ncol(i) == 1) { i <- i[,1] } else if (ncol(i) == 2) { i <- cellFromRowCol(x, i[,1], i[,2]) m[2] <- TRUE m[3] <- TRUE } else if (ncol(i) == 3) { k <- i[,3] value <- rep_len(value, length(k)) i <- cellFromRowCol(x, i[,1], i[,2]) return(.replace_cell_lyr(x, i, k, value)) } else { error("`[<-`", paste("index i has", ncol(i), "columns")) } } if (!m[3]) { if (inherits(k, "character")) { k <- match(k, names(x)) if (any(is.na(k))) { stop() } } else { k <- make_replace_index(k, nlyr(x), length(value), "k") } } else { k <- NA } if (all(m)) { return(.replace_all(x, value)) } if (!m[1]) { # i not missing if (inherits(i, "SpatRaster")) { return(.replace_spatraster(x, i, value)) } if (inherits(i, "SpatVector")) { return(.replace_spatvector(x, i, value)) } if (inherits(i, "SpatExtent")) { return(.replace_spatextent(x, i, value)) } theCall <- sys.call(-1) narg <- length(theCall)-length(match.call(call=theCall)) if ((narg==0) && m[2]) { # cell i <- make_replace_index(i, ncell(x), length(value), "i") } else if (m[2]) { # row i <- make_replace_index(i, nrow(x), length(value), "i") i <- cellFromRowColCombine(x, i, 1:ncol(x)) } else { #row,col i <- make_replace_index(i, nrow(x), length(value), "i") j <- make_replace_index(j, ncol(x), length(value), "j") i <- cellFromRowColCombine(x, i, j) } } else if (!m[2]) { #col j <- make_replace_index(j, ncol(x), length(value), "j") i <- cellFromRowColCombine(x, 1:nrow(x), j) } else { if (inherits(value, "SpatRaster")) { x[[k]] <- value return(x) } i <- 1:ncell(x) } return(.replace_cell(x, i, k, value)) } ) terra/R/geom.R0000644000176200001440000004135714752746600012667 0ustar liggesusers # buffer2 <- function(x, width, quadsegs=10) { # if (is.character(width)) { # if (!(width %in% names(x))) { # error("buffer2", paste(width, "is not a field in x")) # } # width <- x[[width, drop=TRUE]] # } # if (!is.numeric(width)) { # error("buffer2", "width is not numeric") # } # x@pntr <- x@pntr$buffer2(width, quadsegs) # messages(x, "buffer2") # } # buffer3 <- function(x, width, quadsegs=10) { # if (is.character(width)) { # if (!(width %in% names(x))) { # error("buffer3", paste(width, "is not a field in x")) # } # width <- x[[width, drop=TRUE]] # } # if (!is.numeric(width)) { # error("buffer3", "width is not numeric") # } # x@pntr <- x@pntr$buffer3(width, quadsegs) # messages(x, "buffer3") # } # buffer4 <- function(x, width, quadsegs=10) { # if (is.character(width)) { # if (!(width %in% names(x))) { # error("buffer4", paste(width, "is not a field in x")) # } # width <- x[[width, drop=TRUE]] # } # if (!is.numeric(width)) { # error("buffer4", "width is not numeric") # } # x@pntr <- x@pntr$buffer4(width, quadsegs) # messages(x, "buffer4") # } roundtrip <- function(x, coll=FALSE) { if (coll) { p <- methods::new("SpatVectorCollection") p@pntr <- x@pntr$bienvenue() return(p) } else { x@pntr <- x@pntr$allerretour() return(x) } } get_invalid_coords <- function(x) { x <- x[!x[,1], ] if (nrow(x) > 0) { id <- as.integer(rownames(x)) txt <- x[,2] txt <- gsub("Ring Self-intersection\\[", "", txt) txt <- gsub("Self-intersection\\[", "", txt) txt <- gsub("Too few points in geometry component\\[", "", txt) txt <- unlist(strsplit(gsub("]", "", txt), " ")) txt <- matrix(as.numeric(txt), ncol=2, byrow=TRUE) v <- vect(txt) values(v) <- data.frame(id=id, msg=x[,2]) v } else { vect() } } setMethod("is.valid", signature(x="SpatVector"), function(x, messages=FALSE, as.points=FALSE) { if (as.points) messages = TRUE if (messages) { r <- x@pntr$geos_isvalid_msg() d <- data.frame(matrix(r, ncol=2, byrow=TRUE)) d[,1] = d[,1] == "\001" colnames(d) <- c("valid", "reason") if (as.points) { p <- try(get_invalid_coords(d), silent=TRUE) if (inherits(p, "try-error")) { warn("is.valid", "as.points failed, returning matrix") return(d) } else { return(p) } } d } else { x@pntr$geos_isvalid() } } ) setMethod("makeValid", signature(x="SpatVector"), function(x) { x@pntr <- x@pntr$make_valid2() messages(x) } ) setMethod("is.na", signature(x="SpatVector"), function(x) { x@pntr$naGeoms() } ) setMethod("na.omit", signature("SpatVector"), function(object, field=NA, geom=FALSE) { if (geom) { g <- geom(object) g <- g[is.na(g[,"x"]) | is.na(g[,"y"]), 1] if (length(g) > 0) { object <- object[-g, ] } } stopifnot(is.vector(field)) if (!is.na(field[1])) { field <- field[!is.na(field)] v <- values(object) if (!any(field == "")) { v <- v[, field, drop=FALSE] } i <- apply(v, 1, function(i) any(is.na(i))) if (any(i)) { object <- object[!i, ] } } object } ) setMethod("deepcopy", signature("SpatVector"), function(x) { x@pntr <- x@pntr$deepcopy() x } ) as.list.svc <- function(x) { v <- vect() out <- lapply(1:x$size(), function(i) { v@pntr <- x$get(i-1) v }) names(out) <- x$names out } setMethod("cover", signature(x="SpatVector", y="SpatVector"), function(x, y, identity=FALSE, expand=TRUE) { x@pntr <- x@pntr$cover(y@pntr, identity[1], expand[1]) messages(x, "cover") } ) setMethod("symdif", signature(x="SpatVector", y="SpatVector"), function(x, y) { x@pntr <- x@pntr$symdif(y@pntr) messages(x, "symdif") } ) setMethod("erase", signature(x="SpatVector", y="SpatVector"), function(x, y) { x@pntr <- x@pntr$erase_agg(y@pntr) messages(x, "erase") } ) setMethod("erase", signature(x="SpatVector", y="missing"), function(x, sequential=TRUE) { x@pntr <- x@pntr$erase_self(sequential) messages(x, "erase") } ) setMethod("erase", signature(x="SpatVector", y="SpatExtent"), function(x, y) { y <- as.polygons(y) x@pntr <- x@pntr$erase(y@pntr) messages(x, "erase") } ) setMethod("gaps", signature(x="SpatVector"), function(x) { x@pntr <- x@pntr$gaps() messages(x, "gaps") } ) setMethod("union", signature(x="SpatVector", y="missing"), function(x, y) { x@pntr <- x@pntr$union_self() messages(x, "union") } ) setMethod("union", signature(x="SpatVector", y="SpatVector"), function(x, y) { if (geomtype(x) != "polygons") { unique(rbind(x, y)) } else { x@pntr <- x@pntr$union(y@pntr) messages(x, "union") } } ) setMethod("union", signature(x="SpatVector", y="SpatExtent"), function(x, y) { y <- as.vector(y) x@pntr <- x@pntr$union(y@pntr) messages(x, "union") } ) setMethod("union", signature(x="SpatExtent", y="SpatExtent"), function(x, y) { x + y } ) setMethod("intersect", signature(x="SpatVector", y="SpatVector"), function(x, y) { x@pntr <- x@pntr$intersect(y@pntr, TRUE) messages(x, "intersect") } ) setMethod("intersect", signature(x="SpatExtent", y="SpatExtent"), function(x, y) { x@pntr <- x@pntr$intersect(y@pntr) if (!x@pntr$valid_notempty) { return(NULL) } x } ) setMethod("intersect", signature(x="SpatVector", y="SpatExtent"), function(x, y) { #x@pntr <- x@pntr$crop_ext(y@pntr) #x crop(x, y) } ) setMethod("intersect", signature(x="SpatExtent", y="SpatVector"), function(x, y) { y <- ext(y) x * y } ) setMethod("mask", signature(x="SpatVector", mask="SpatVector"), function(x, mask, inverse=FALSE) { x@pntr <- x@pntr$mask(mask@pntr, inverse) messages(x, "mask") } ) setMethod("mask", signature(x="SpatVector", mask="SpatExtent"), function(x, mask, inverse=FALSE) { mask <- vect(mask, crs=crs(x)) x@pntr <- x@pntr$mask(mask@pntr, inverse) messages(x, "mask") } ) setMethod("intersect", signature(x="SpatExtent", y="SpatRaster"), function(x, y) { x <- align(x, y, snap="near") intersect(x, ext(y)) } ) setMethod("intersect", signature(x="SpatRaster", y="SpatExtent"), function(x, y) { intersect(y, x) } ) setMethod("buffer", signature(x="SpatVector"), function(x, width, quadsegs=10, capstyle="round", joinstyle="round", mitrelimit=NA, singlesided=FALSE) { if (is.character(width)) { if (!(width %in% names(x))) { error("buffer", paste(width, "is not a field in x")) } width <- x[[width, drop=TRUE]] } if (!is.numeric(width)) { error("buffer", "width is not numeric") } x@pntr <- x@pntr$buffer(width, quadsegs, tolower(capstyle), tolower(joinstyle), mitrelimit, singlesided) messages(x, "buffer") } ) setMethod("crop", signature(x="SpatVector", y="ANY"), function(x, y, ext=FALSE) { if (ext) { y <- ext(y) x@pntr <- x@pntr$crop_ext(y@pntr, TRUE) return(x) } if (inherits(y, "SpatVector")) { x@pntr <- x@pntr$crop_vct(y@pntr) } else { if (!inherits(y, "SpatExtent")) { y <- try(ext(y), silent=TRUE) if (inherits(y, "try-error")) { stop("y does not have a SpatExtent") } } ## crop_ext does not include points on the borders ## https://github.com/rspatial/raster/issues/283 #x@pntr <- x@pntr$crop_ext(y@pntr) if (geomtype(x) == "points") { y <- as.polygons(y) x@pntr <- x@pntr$crop_vct(y@pntr) } else { x@pntr <- x@pntr$crop_ext(y@pntr, TRUE) } } messages(x, "crop") } ) setMethod("hull", signature(x="SpatVector"), function(x, type="convex", by="", param=1, allowHoles=TRUE, tight=TRUE) { type <- match.arg(tolower(type), c("convex", "rectangle", "circle", "concave_ratio", "concave_length", "concave_polygons")) x@pntr <- x@pntr$hull(type, by[1], param, allowHoles, tight) messages(x, "hull") } ) setMethod("disagg", signature(x="SpatVector"), function(x, segments=FALSE) { x@pntr <- x@pntr$disaggregate(segments[1]) messages(x, "disagg") } ) setMethod("flip", signature(x="SpatVector"), function(x, direction="vertical") { d <- match.arg(direction, c("vertical", "horizontal")) x@pntr <- x@pntr$flip(d == "vertical") messages(x, "flip") } ) setMethod("spin", signature(x="SpatVector"), function(x, angle, x0, y0) { e <- as.vector(ext(x)) if (missing(x0)) { x0 <- mean(e[1:2]) } if (missing(y0)) { y0 <- mean(e[3:4]) } angle <- angle[1] stopifnot(is.numeric(angle) && !is.nan(angle)) x@pntr <- x@pntr$rotate(angle, x0, y0) messages(x, "spin") } ) setMethod("delaunay", signature(x="SpatVector"), function(x, tolerance=0, as.lines=FALSE, constrained=FALSE) { x@pntr <- x@pntr$delaunay(tolerance, as.lines, constrained) messages(x, "delaunay") } ) voronoi_deldir <- function(x, bnd=NULL, eps=1e-09, ...){ xy <- crds(x) dat <- values(x) if (nrow(dat > 0)) { dups <- duplicated(xy) if (any(dups)) { xy <- xy[!dups, ,drop=FALSE] dat <- dat[!dups, ,drop=FALSE] } } else { xy <- stats::na.omit(xy[, 1:2]) xy <- unique(xy) } e <- bnd if (!is.null(e)) { e <- as.vector(ext(bnd)) } dd <- deldir::deldir(xy[,1], xy[,2], rw=e, eps=eps, suppressMsge=TRUE) g <- lapply(deldir::tile.list(dd), function(i) cbind(i$ptNum, 1, i$x, i$y)) g <- do.call(rbind, g) g <- vect(g, "polygons", crs=crs(x)) if (nrow(g) == nrow(dat)) { values(g) <- dat } else { values(g) <- data.frame(id=dd$ind.orig) } g } setMethod("voronoi", signature(x="SpatVector"), function(x, bnd=NULL, tolerance=0, as.lines=FALSE, deldir=FALSE) { if (nrow(x) ==0) { error("voronoi", "input has no geometries") } if (geomtype(x) != "points") { x <- as.points(x) } if (deldir) { voronoi_deldir(x, bnd, tolerance=tolerance) } else { if (is.null(bnd)) { bnd <- vect() } else { bnd <- as.polygons(ext(bnd)) } x@pntr <- x@pntr$voronoi(bnd@pntr, tolerance, as.lines) messages(x, "voronoi") } } ) setMethod("elongate", signature(x="SpatVector"), function(x, length=1, flat=FALSE) { x@pntr <- x@pntr$elongate(length, flat) messages(x, "elongate") } ) setMethod("width", signature(x="SpatVector"), function(x, as.lines=FALSE) { x@pntr <- x@pntr$width() x <- messages(x, "width") if (!as.lines) { x <- perim(x) } x } ) setMethod("clearance", signature(x="SpatVector"), function(x, as.lines=FALSE) { x@pntr <- x@pntr$clearance() x <- messages(x, "clearance") if (!as.lines) { x <- perim(x) } x } ) setMethod("mergeLines", signature(x="SpatVector"), function(x) { x@pntr <- x@pntr$line_merge() messages(x, "line_merge") } ) setMethod("makeNodes", signature(x="SpatVector"), function(x) { x@pntr <- x@pntr$make_nodes() messages(x, "makeNodes") } ) setMethod("removeDupNodes", signature(x="SpatVector"), function(x, digits=-1) { x@pntr <- x@pntr$remove_duplicate_nodes(digits) messages(x, "removeDupNodes") } ) setMethod("simplifyGeom", signature(x="SpatVector"), function(x, tolerance=0.1, preserveTopology=TRUE, makeValid=TRUE) { x@pntr <- x@pntr$simplify(tolerance, preserveTopology) x <- messages(x, "simplifyGeom") if (makeValid) { x <- makeValid(x) } x } ) setMethod("thinGeom", signature(x="SpatVector"), function(x, threshold=1e-6, makeValid=TRUE) { x@pntr <- x@pntr$thin(threshold) x <- messages(x, "thinGeom") if (makeValid) { x <- makeValid(x) } x } ) setMethod("sharedPaths", signature(x="SpatVector"), function(x, y=NULL) { if (is.null(y)) { x@pntr <- x@pntr$shared_paths(TRUE) } else { x@pntr <- x@pntr$shared_paths2(y@pntr, TRUE) } x <- messages(x, "sharedPaths") # sort data to ensure consistent order with spatial indices if (nrow(x) > 0) x <- x[order(x$id1, x$id2), ] x } ) setMethod("snap", signature(x="SpatVector"), function(x, y=NULL, tolerance) { if (is.null(y)) { x@pntr <- x@pntr$snap(tolerance) } else { x@pntr <- x@pntr$snapto(y@pntr, tolerance) } messages(x, "snap") } ) setMethod("combineGeoms", signature(x="SpatVector", y="SpatVector"), function(x, y, overlap=TRUE, boundary=TRUE, distance=TRUE, append=TRUE, minover=0.1, maxdist=Inf, dissolve=TRUE, erase=TRUE) { if ((geomtype(x) != "polygons") || (geomtype(y) != "polygons")) { error("combineGeoms", "x and y must be polygons") } if (nrow(x) == 0) { if (append) { return(rbind(x, y)) } else { return(x) } } if (nrow(y) == 0) { return(x) } xcrs <- crs(x) ycrs <- crs(y) if ((xcrs == "") || (ycrs == "")) { error("combineGeoms", "x and y must have a crs") } else if (xcrs != ycrs) { error("combineGeoms", "x and y do not have the same crs") } dx <- values(x) dy <- values(y) values(x) = data.frame(idx=1:nrow(x)) values(y) = data.frame(idy=1:nrow(y)) y <- erase(y) # no self-overlaps if (overlap) { #avoid Warning message: [intersect] no intersection xy <- suppressWarnings(intersect(y, x)) if (nrow(xy) > 0) { xy$aint <- expanse(xy) a <- values(xy) a <- a[order(a$idy, -a$aint),] a <- a[!duplicated(a$idy),] yi <- y[a$idy,] atot <- expanse(yi) a <- a[(a$aint / atot) >= minover, ] if (nrow(a) > 0) { if (erase) { ye <- erase(y, x) i <- stats::na.omit(match(a$idy, ye$idy)) if (length(i) > 0) { yi <- ye[i,] values(yi) <- data.frame(idx=a$idx[i]) } else { yi <- vect() } } else { yi <- y[a$idy,] values(yi) <- data.frame(idx=a$idx) } if (nrow(yi) > 0) { x <- aggregate(rbind(x, yi), "idx", dissolve=dissolve, counts=FALSE) } y <- y[-a$idy,] } } } if (boundary && (nrow(y) > 0)) { ye <- erase(y, x) p <- sharedPaths(ye, x) if (nrow(p) > 0) { p$s <- perim(p) p <- values(p) p <- p[order(p$id1, -p$s),] p <- p[!duplicated(p$id1),] if (erase) { i <- p$id1 yi <- ye[p$id1,] yi$idx <- p$id2 yi$idy <- NULL } else { i <- ye$idy[p$id1] i <- match(i, y$idy) yi <- y[i,] yi$idx <- 0 yi$idx[i] <- p$id2[i] } yi$idy <- NULL x <- aggregate(rbind(x, yi), "idx", dissolve=dissolve, counts=FALSE) y <- y[-i,] } } if (distance && (nrow(y) > 0) && (maxdist > 0)) { n <- nearest(y, x) n <- n[n$distance <= maxdist, ] if (nrow(n) > 0) { yi <- y[n$from_id, ] yi$idx <- n$to_id yi$idy <- NULL x <- aggregate(rbind(x, yi), "idx", dissolve=FALSE, counts=FALSE) y <- y[-n$from_id, ] } } values(x) <- dx[x$idx, ,drop=FALSE] if (append && (nrow(y) > 0)) { values(y) <- dy[y$idy, ,drop=FALSE] if (erase) { y <- erase(y, x) } x <- rbind(x, y) } x } ) setMethod("split", signature(x="SpatVector", f="ANY"), function(x, f) { if (length(f) > 1) { x <- deepcopy(x) x$f <- f f <- "f" } x <- messages(x@pntr$split(f), "split") as.list.svc(x) } ) #setMethod("split", signature(x="SpatVector", f="SpatVector"), badsplit <- function(x, f) { if (geomtype(x) != "polygons") error("split", "first argument must be polygons") if (!(geomtype(f) %in% c("lines", "polygons"))) { error("split", "argument 'f' must have a lines or polygons geometry") } values(f) <- NULL ex <- ext(x) r <- relate(x, f, "intersects") if (sum(r) == 0) { warn("split", "x and f do not intersect") return(x) } #r <- r[rowSums(r) > 0, ,drop=FALSE] ri <- which(rowSums(r) > 0) y <- x[ri,] r <- r[ri, , drop=FALSE] values(y) <- NULL ss <- vector("list", nrow(y)) if (geomtype(f) == "lines") { for (i in 1:nrow(y)) { yi <- y[i] yi <- disagg(yi) add <- NULL if (nrow(yi) > 1) { ri <- relate(yi, f, "intersects") if (any(!ri)) { add <- yi[!ri] yi <- yi[ri] } } lin <- intersect(f[r[i,],], yi) v <- rbind(as.lines(yi), lin) v <- makeNodes( aggregate(v) ) v <- as.polygons(v) if (!is.null(add)) { v <- combineGeoms(v, add, overlap=FALSE, boundary=FALSE, distance=TRUE, dissolve=FALSE, erase=FALSE) } v$id <- i ss[[i]] <- v } ss <- vect(ss) v <- values(x) values(ss) <- v[ss$id, ] rbind(x[-i,], ss) } else { #if (geomtype(f) == "polygons") { for (i in 1:nrow(r)) { yi <- y[i] v <- rbind(intersect(yi, f[r[i,],]), erase(yi, f[r[i,],])) v$id <- i ss[[i]] <- v } ss <- vect(ss) v <- values(x) values(ss) <- v[ss$id, ] rbind(x[-i,], ss) } } #) setMethod("split", signature(x="SpatVector", f="SpatVector"), function(x, f) { if (geomtype(x) != "polygons") error("split", "first argument must be polygons") if (!(geomtype(f) %in% c("lines", "polygons"))) { error("split", "argument 'f' must have a lines or polygons geometry") } values(f) <- NULL f <- as.lines(f) r <- relate(x, f, "intersects") if (sum(r) == 0) { warn("split", "x and f do not intersect") return(x) } e <- elongate(intersect(as.lines(f), x), 0.00001) k <- aggregate(rbind(as.lines(x), e)) nds <- makeNodes(k) p <- as.polygons(nds) intersect(x, p) } ) setMethod("forceCCW", signature(x="SpatVector"), function(x) { x <- deepcopy(x) x@pntr$make_CCW() messages(x) } ) setMethod("is.empty", signature(x="SpatVector"), function(x) { nrow(x) == 0 } ) terra/R/plot_scale.R0000644000176200001440000002106014624315507014046 0ustar liggesusers ..assume_lonlat <- function(pr) { (pr$usr[1] > -300) && (pr$usr[2] < 300) && (pr$yaxp[1] > -200) && (pr$yaxp[2] < 200) } .get_dd <- function(pr, lonlat, d=NULL) { if (lonlat) { lat <- mean(pr$usr[3:4]) if (is.null(d)) { dx <- (pr$usr[2] - pr$usr[1]) / 6 d <- as.vector(distance(cbind(0, lat), cbind(dx, lat), TRUE)) d <- max(1, 5 * round(d/5000)) } p <- cbind(0, lat) dd <- .destPoint(p, d * 1000) dd <- c(dd[1,1], d) } else { if (is.null(d)) { d <- (pr$usr[2] - pr$usr[1]) / 6 digits <- floor(log10(d)) + 1 d <- round(d, -(digits-1)) } dd <- c(d, d) } dd } .get_xy <- function(xy, dx=0, dy=0, pr, defpos="bottomleft", caller="") { if (is.null(xy)) { xy <- defpos } if (!is.character(xy)) { return( cbind(xy[1], xy[2]) ) } xy <- tolower(xy) parrange <- c(pr$usr[2] - pr$usr[1], pr$usr[4] - pr$usr[3]) pad=c(5,5) / 100 if (xy == "bottom") { xy <- c(pr$usr[1]+0.5*parrange[1]-0.5*dx, pr$usr[3]+(pad[2]*parrange[2])) + c(0,dy) } else if (xy == "bottomleft") { xy <- c(pr$usr[1]+(pad[1]*parrange[1]), pr$usr[3]+(pad[2]*parrange[2])) + c(0,dy) } else if (xy == "bottomright") { xy <- c(pr$usr[2]-(pad[1]*parrange[1]), pr$usr[3]+(pad[2]*parrange[2])) - c(dx,-dy) } else if (xy == "topright") { xy <- c(pr$usr[2]-(pad[1]*parrange[1]), pr$usr[4]-(pad[2]*parrange[2])) - c(dx,dy) } else if (xy == "top") { xy <- c(pr$usr[1]+0.5*parrange[1]-0.5*dx, pr$usr[4]-(pad[2]*parrange[2])) - c(0,dy) } else if (xy == "topleft") { xy <- c(pr$usr[1]+(pad[1]*parrange[1]), pr$usr[4]-(pad[2]*parrange[2])) - c(0,dy) } else if (xy == "left") { xy <- c(pr$usr[1]+(pad[1]*parrange[1]), pr$usr[3]+0.5*parrange[2]-0.5*dy) } else if (xy == "right") { xy <- c(pr$usr[2]-(pad[1]*parrange[1])-dx, pr$usr[3]+0.5*parrange[2]-0.5*dy) } else { error(caller, 'xy must be a coordinate pair (two numbers) or one of "bottomleft", "bottom", "bottomright", topleft", "top", "topright"') } xy } .destPoint <- function (p, d, b=90, r=6378137) { toRad <- pi/180 lon1 <- p[, 1] * toRad lat1 <- p[, 2] * toRad b <- b * toRad lat2 <- asin(sin(lat1) * cos(d/r) + cos(lat1) * sin(d/r) * cos(b)) lon2 <- lon1 + atan2(sin(b) * sin(d/r) * cos(lat1), cos(d/r) - sin(lat1) * sin(lat2)) lon2 <- (lon2 + pi)%%(2 * pi) - pi cbind(lon2, lat2)/toRad } add_N <- function(x, y, asp, label, type=0, user="", angle=0, cex=1, srt=0, xpd=TRUE, ...) { type <- type[1] if (type == 0) { symbol = user[1] } else if (type == 2) { symbol = "\u27A2" } else if (type == 3) { symbol = "\u2799" } else if (type == 4) { symbol = "\u27B2" } else if (type == 5) { symbol = "\u27BE" } else if (type == 6) { symbol = "\u27B8" } else if (type == 7) { symbol = "\u27BB" } else if (type == 8) { symbol = "\u27B5" } else if (type == 9) { symbol = "\u279F" } else if (type == 10) { symbol = "\u261B" } else if (type == 11) { symbol = "\u2708" } else { symbol = "\u2629"} if (type == 11) { rangle <- 45 - angle mcex <- 1.5 } else { rangle <- 90 - angle mcex <- 3 } text(x, y, symbol, cex=cex*mcex, srt=rangle, xpd=xpd, ...) xs <- graphics::strwidth(symbol,cex=cex*3) ys <- graphics::strheight(symbol,cex=cex*3) b <- pi * angle / 180 rxs <- (abs(xs * cos(b)) + abs(ys * sin(b)))# / asp rys <- (abs(xs * sin(b)) + abs(ys * cos(b)))# * asp # xoff <- (rxs - xs) / 2 # yoff <- rys + 0.05 * graphics::strheight(label,cex=cex) xoff = 0.1 * rxs yoff = 0.8 * rys * max(0.5, abs(cos(angle))) if (type == 4) { .halo(x+xoff, y-0.2*yoff, label, cex = cex, srt = srt, xpd = xpd, ...) } else if (type == 10) { .halo(x+xoff, y-yoff, label, cex = cex, srt = srt, xpd = xpd, ...) } else { text(x+xoff, y+yoff, label, cex = cex, srt = srt, xpd = xpd, ...) } } north <- function(xy=NULL, type=1, label="N", angle=0, d, head=0.1, xpd=TRUE, ...) { pr <- graphics::par() pr$usr <- unlist(get.clip()[1:4]) pa <- c(pr$usr[2] - pr$usr[1], pr$usr[4] - pr$usr[3]) asp <- pa[2]/pa[1] if (missing(d)) { d <- 0.07 * pa[2] } xy <- .get_xy(xy, 0, d, pr, "topright", caller="north") if (inherits(type, "character")) { usertype <- type type = 0 } else { type <- round(type) usertype <- "" } if (type == 1) { if (angle != 0) { b <- angle * pi / 180; p2 <- xy + c(d * sin(b), d * cos(b)) b <- b + pi p1 <- xy + c(d * sin(b), d * cos(b)) if ((p2[1] - p1[1]) > (d/asp)) { m <- xy[1] #p1[1] + (p2[1] - p1[1]) / 2 slope = (p2[2] - p1[2])/(p2[1] - p1[1]) newx <- m - 0.5 * d / asp p1[2] <- p1[2] + (newx-p1[1]) * slope p1[1] <- newx newx <- m + 0.5 * d / asp p2[2] <- p2[2] - (p2[1]-newx) * slope p2[1] <- newx } } else { p1 <- xy - c(0,d) p2 <- xy + c(0,d) } lwd <- list(...)$lwd + 2 if (is.null(lwd)) lwd <- 3 graphics::arrows(p1[1], p1[2], p2[1], p2[2], length=head, lwd=lwd, col="white", xpd=xpd) graphics::arrows(p1[1], p1[2], p2[1], p2[2], length=head, xpd=xpd, ...) if (label != "") { if (is.null(list(...)$hw)) { .halo(xy[1], xy[2], label, hw=.2, xpd=xpd, ... ) } else { .halo(xy[1], xy[2], label, xpd=xpd, ... ) } } } else { add_N(xy[1], xy[2], asp=asp, label=label, angle=angle, type=type, user=usertype, xpd=xpd, ...) } } sbar <- function(d, xy=NULL, type="line", divs=2, below="", lonlat=NULL, labels, adj=c(0.5, -1), lwd=2, xpd=TRUE, ticks=FALSE, scaleby=1, halo=TRUE, ...){ stopifnot(type %in% c("line", "bar")) pr <- graphics::par() clp <- get.clip() pr$usr <- unlist(clp[,1:4]) if (is.null(lonlat)) { lonlat <- isTRUE(clp[[5]]) } if (missing(d)) { labels <- NULL d <- NULL } dd <- .get_dd(pr, lonlat, d) d <- dd[2] dd <- dd[1] xy <- .get_xy(xy, dd, 0, pr, "bottomleft", caller="sbar") if (type == "line") { if (halo) { lines(matrix(c(xy[1], xy[2], xy[1]+dd, xy[2]), byrow=T, nrow=2), lwd=lwd+1, xpd=xpd, col="white") } lines(matrix(c(xy[1], xy[2], xy[1]+dd, xy[2]), byrow=T, nrow=2), lwd=lwd, xpd=xpd, ...) if (missing(labels) || is.null(labels)) { ds <- d / scaleby if (divs > 2) { labels <- c(0, round(ds/2, 1), ds) } else { labels <- paste(ds) } } if (missing(adj)) { adj <- c(0.5, -0.2-lwd/20 ) } tadd <- 0 if (!isFALSE(ticks)) { if (isTRUE(ticks)) { tadd <- dd / (15 * diff(pr$usr[1:2]) / diff(pr$usr[3:4])) } else { tadd <- ticks } if (length(labels) == 1) { xtick <- c(xy[1], xy[1]+dd) } else { xtick <- c(xy[1], xy[1]+dd/2, xy[1]+dd) } for (i in 1:length(xtick)) { lines(rbind(c(xtick[i], xy[2]), c(xtick[i], xy[2]+tadd)), lwd=ceiling(lwd/2), ...) } } tadd <- max(0, tadd) if (length(labels) == 1) labels =c("", labels, "") if (halo) { .halo(xy[1], xy[2]+tadd,labels=labels[1], xpd=xpd, adj=adj, ...) .halo(xy[1]+0.5*dd, xy[2]+tadd,labels=labels[2], xpd=xpd, adj=adj,...) .halo(xy[1]+dd, xy[2]+tadd,labels=labels[3], xpd=xpd, adj=adj,...) } else { text(xy[1], xy[2]+tadd,labels=labels[1], xpd=xpd, adj=adj, ...) text(xy[1]+0.5*dd, xy[2]+tadd,labels=labels[2], xpd=xpd, adj=adj,...) text(xy[1]+dd, xy[2]+tadd,labels=labels[3], xpd=xpd, adj=adj,...) } xy[2] <- xy[2] - dd/10 } else if (type == "bar") { stopifnot(divs > 0) if (missing(adj)) { adj <- c(0.5, -1 ) } lwd <- dd / 25 if (divs==2) { half <- xy[1] + dd / 2 graphics::polygon(c(xy[1], xy[1], half, half), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col="white", xpd=xpd) graphics::polygon(c(half, half, xy[1]+dd, xy[1]+dd ), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col="black", xpd=xpd) if (missing(labels) || is.null(labels)) { labels <- c("0", "", d/scaleby) } text(xy[1], xy[2],labels=labels[1], xpd=xpd, adj=adj,...) text(xy[1]+0.5*dd, xy[2],labels=labels[2], xpd=xpd, adj=adj,...) text(xy[1]+dd, xy[2],labels=labels[3], xpd=xpd, adj=adj,...) } else { q1 <- xy[1] + dd / 4 half <- xy[1] + dd / 2 q3 <- xy[1] + 3 * dd / 4 end <- xy[1] + dd graphics::polygon(c(xy[1], xy[1], q1, q1), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col="white", xpd=xpd) graphics::polygon(c(q1, q1, half, half), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col="black", xpd=xpd) graphics::polygon(c(half, half, q3, q3 ), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col="white", xpd=xpd) graphics::polygon(c(q3, q3, end, end), c(xy[2], xy[2]+lwd, xy[2]+lwd, xy[2]), col="black", xpd=xpd) if (missing(labels) || is.null(labels)) { ds <- d / scaleby labels <- c("0", round(0.5*ds), ds) } text(xy[1], xy[2], labels=labels[1], xpd=xpd, adj=adj, ...) text(half, xy[2], labels=labels[2], xpd=xpd, adj=adj,...) text(end, xy[2],labels=labels[3], xpd=xpd, adj=adj,...) } } if (below != "") { adj[2] <- -adj[2] text(xy[1]+(0.5*dd), xy[2], xpd=xpd, labels=below, adj=adj,...) } } terra/R/arith.R0000644000176200001440000000172714536376240013043 0ustar liggesusers # setMethod("arith", signature(x="SpatRaster"), ## not exported arith <- function(x, fun, ..., filename="", overwrite=FALSE, wopt=list()) { out <- rast(x) nc <- ncol(x) readStart(x) on.exit(readStop(x)) # # test the shape of the output by testing with one row v <- readValues(x, round(0.5*nrow(x)), 1, 1, nc, mat=TRUE) r <- try(fun(as.vector(v), ...)) if (inherits(r, "try-error")) { error("arith", "'fun' is not valid") } if (!is.vector(r)) { error("arith", "'fun' does not return a vector") } if (!(is.numeric(r) | is.logical(r))) { error("arith", "'fun' does not return a numeric vector") } if (length(r) != length(v)) { error("arith", "'fun' does not return the same number of values as the input") } b <- writeStart(out, filename, overwrite, sources=sources(x), wopt=wopt) for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) v <- fun(as.vector(v), ...) writeValues(out, v, b$row[i], b$nrows[i]) } writeStop(out) } # ) terra/R/interpolate.R0000644000176200001440000000440314536376240014254 0ustar liggesusers# Author: Robert J. Hijmans # Date : August 2009 # Version 0.9 # License GPL v3 setMethod("interpolate", signature(object="SpatRaster"), function(object, model, fun=predict, ..., xyNames=c("x", "y"), factors=NULL, const=NULL, index=NULL, cores=1, cpkgs=NULL, na.rm=FALSE, filename="", overwrite=FALSE, wopt=list()) { out <- rast(object) hv <- hasValues(object) nms <- c(xyNames, names(object)) if (length(unique(nms)) != length(nms)) { tab <- table(nms) error("interpolate", "duplicate names: ", tab[tab>1]) } nc <- ncol(out) testrow <- round(0.51*nrow(object)) ntest <- min(nc, 500) xy <- xyFromCell(out, cellFromRowCol(out, testrow, 1):cellFromRowCol(out, testrow, ntest)) colnames(xy) <- xyNames if (hv) { readStart(object) on.exit(readStop(object)) d <- readValues(object, testrow, 1, 1, ntest, TRUE, TRUE) xy <- cbind(xy, d) } r <- .runModel(model, fun, xy, 1, const, (na.rm & hv), index, cores=NULL, ...) rdim <- dim(r) if (!is.null(rdim)) { if (rdim[1] == 1) { nl <- rdim[1] } else { nl <- rdim[2] } } else { nl <- 1 } out <- rast(object, nlyrs=nl) cn <- colnames(r) if (length(cn) == nl) names(out) <- make.names(cn, TRUE) doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } if (doclust) { parallel::clusterExport(cores, c("model", "fun"), environment()) if (!is.null(cpkgs)) { parallel::clusterExport(cores, "cpkgs", environment()) parallel::clusterCall(cores, function() for (i in 1:length(cpkgs)) {library(cpkgs[i], character.only=TRUE) }) } export_args(cores, ..., caller="interpolate") } else { cores <- NULL } b <- writeStart(out, filename, overwrite, sources=sources(object), wopt=wopt) for (i in 1:b$n) { xy <- xyFromCell(out, cellFromRowCol(out, b$row[i], 1):cellFromRowCol(out, b$row[i]+b$nrows[i]-1, nc)) colnames(xy) <- xyNames if (hv) { d <- readValues(object, b$row[i], b$nrows[i], 1, nc, TRUE, TRUE) xy <- cbind(xy, d) } v <- .runModel(model, fun, xy, nl, const, (na.rm & hv), index, cores=cores, ...) writeValues(out, v, b$row[i], b$nrows[i]) } writeStop(out) } ) terra/R/replace.R0000644000176200001440000001726614726700274013353 0ustar liggesusers# # Author: Robert J. Hijmans # # Date: October 2018 # # Version 1.0 # # License GPL v3 # .rast_replace <- function(x, name, value, caller="$<-") { # if (inherits(value, "SpatRaster")) { # value <- value[[1]] # names(value) <- name # } else if (!is.null(value)) { # y <- rast(x, nlyrs=1) # test <- try(values(y) <- value, silent=TRUE) # if (inherits(test, "try-error")) { # error(caller, "the replacement value is not valid") # } # value <- y # names(value) <- name # } # i <- which(name == names(x))[1] # if (is.null(value)) { # if (is.na(i)) { # return(x) # } else { # return(subset(x, -i, NSE=FALSE)) # } # } # if (is.na(i)) { # c(x, value) # } else if (nlyr(x) == 1) { # value$deepcopy() # } else if (i == 1) { # c(value, x[[2:nlyr(x)]]) # } else if (i == nlyr(x)) { # c(x[[1:(nlyr(x)-1)]], value) # } else { # c(x[[1:(i-1)]], value, x[[(i+1):nlyr(x)]]) # } # } # setMethod("$<-", "SpatRaster", # function(x, name, value) { # .rast_replace(x, name, value, "$<-") # } # ) # setReplaceMethod("[[", c("SpatRaster", "character", "missing"), # function(x, i, j, value) { # if (inherits(value, "SpatRaster")) { # if (nlyr(value) != length(i)) { # error("`[[`", "length of names must be equal to the number of layers") # } # names(value) <- i # } else if (length(i) > 1) { # if (NCOL(value) > 1) { # value <- as.list(data.frame(value)) # } else { # stopifnot(length(i) == length(value)) # } # } else if (!is.list(value)) { # value <- list(value) # } # for (k in 1:length(i)) { # x <- .rast_replace(x, i[k], value[[k]], " [[<- ") # # eval(parse(text = paste0("x$", i[k], " <- value[[k]]"))) # } # x # } # ) # setReplaceMethod("[[", c("SpatRaster", "numeric", "missing"), # function(x, i, j, value) { # if (!inherits(value, "SpatRaster")) { # error("`[[<-`", "Expected a SpatRaster as replacement value") # } # if (nlyr(value) != length(i)) { # error("`[[`", "length of indices must be equal to the number of layers") # } # if (any(i<1) | any(i > nlyr(x))) { # error("`[[`", "indices must be between 1 and the number of layers") # } # if (nlyr(x) == 1) { # compareGeom(x, value, crs=FALSE, warncrs=TRUE) # return(value) # } # for (k in 1:length(i)) { # if (i[k] == 1) { # x <- c(value[[k]], x[[2:nlyr(x)]]) # } else if (i[k] == nlyr(x)) { # x <- c(x[[1:(nlyr(x)-1)]], value[[k]]) # } else { # x <- c(x[[1:(i[k]-1)]], value[[k]], x[[(i[k]+1):nlyr(x)]]) # } # } # g <- gc() # x # } # ) # setReplaceMethod("[", c("SpatRaster", "missing", "missing"), # function(x, i, j, value) { # nl <- nlyr(x) # if (is.matrix(value)) { # d <- dim(value) # if (!all(d == c(ncell(x), nl))) { # if ((d[2] == nl) && (d[1] < ncell(x))) { # value <- apply(value, 2, function(i) rep_len(i, ncell(x))) # } else { # error("`[`","dimensions of the matrix do not match the SpatRaster") # } # } # x <- try( setValues(x, value, TRUE, TRUE) ) # } else { # v <- try( matrix(nrow=ncell(x), ncol=nl) ) # if (! inherits(x, "try-error")) { # v[] <- value # x <- try( setValues(x, v, TRUE, TRUE) ) # } # } # if (inherits(x, "try-error")) { # error("`[`", "cannot set values") # } # return(x) # } # ) # setReplaceMethod("[", c("SpatRaster","numeric", "missing"), # function(x, i, j, value) { # theCall <- sys.call(-1) # narg <- length(theCall)-length(match.call(call=sys.call(-1))) # if (narg > 0) { # row # i <- cellFromRowColCombine(x, i, 1:ncol(x)) # } # #if (any(is.na(i))) { # # warn("`[`", "indices should not be NA") # #} # bylyr = FALSE # if (!is.null(dim(value))) { # #x@pntr <- x@pntr$replaceValues(i, value, ncol(value)) # stopifnot(ncol(value) == nlyr(x)) # bylyr <- TRUE # if (inherits(value, "data.frame")) { # value <- as.matrix(value) # } # value <- as.vector(value) # } # x@pntr <- x@pntr$deepcopy() # opt <- spatOptions() # if (!x@pntr$replaceCellValues(i-1, value, bylyr, opt)) { # messages(x, "`[<-`") # } else { # x # } # } # ) # setMethod("set.values", signature(x="SpatRaster"), # function(x, cells, values, layer=0) { # #if (any(is.na(cells))) { # # warn("set.values", "cells should not be NA") # #} # if (is.character(layer)) { # layer <- match(layer, names(x)) # if (any(is.na(layer))) { # error("set.values", "invalid layer") # } # } # layer <- round(layer) # if (all(layer > 0)) { # if (missing(cells) && missing(values)) { # return(invisible(TRUE)); # } # if (any(is.na(layer))) { error("set.values", "layers cannot be NA")} # if (inherits(layer, "character")) { # layer <- match(layer, names(x)) # if (any(is.na(layer))) { error("set.values", "invalid layer names")} # } # if (any((layer < 1) | (layer > nlyr(x)))) { error("set.values", "invalid layer numbers") } # n <- length(layer) # if (n > length(unique(layer))) { error("set.values", "duplicated layers") } # bylyr <- FALSE # if (!is.null(dim(values))) { # if (ncol(values) != n) { # error("set.values", "ncol(values) does not match the `length(layer)`") # } # bylyr <- TRUE # #if (inherits(values, "data.frame")) { # # values <- as.matrix(values) # #} # values <- as.vector(values) # } # ok <- x@pntr$replaceCellValuesLayer(layer-1, cells-1, values, bylyr, spatOptions()) # messages(x) # invisible(TRUE) # } else { # if (any(layer > 0)) { # error("set.values", "some (but not all) layer numbers are < 1") # } # if (missing(cells) && missing(values)) { # x@pntr$readAll() # return(invisible(TRUE)); # } # bylyr <- FALSE # if (!is.null(dim(values))) { # if (ncol(values) != nlyr(x)) { # error("set.values", "ncol(values) does not match the nlyr(x)") # } # bylyr <- TRUE # #if (inherits(values, "data.frame")) { # # values <- as.matrix(values) # #} # values <- as.vector(values) # } # ok <- x@pntr$replaceCellValues(cells-1, values, bylyr, spatOptions()) # messages(x) # } # invisible(TRUE) # } # ) # setReplaceMethod("[", c("SpatRaster", "numeric", "numeric"), # function(x, i, j, value) { # i <- cellFromRowColCombine(x, i, j) # x[i] <- value # x # } # ) # setReplaceMethod("[", c("SpatRaster","missing", "numeric"), # function(x, i, j, value) { # i <- cellFromRowColCombine(x, 1:nrow(x), j) # x[i] <- value # x # } # ) # setReplaceMethod("[", c("SpatRaster", "logical", "missing"), # function(x, i, j, value) { # i <- which(rep_len(i, ncell(x))) # x[i] <- value # x # } # ) # setReplaceMethod("[", c("SpatRaster", "SpatRaster", "ANY"), # function(x, i, j, value) { # theCall <- sys.call(-1) # narg <- length(theCall)-length(match.call(call=sys.call(-1))) # if (narg > 0) { # row # error("`[`", "you cannot use a SpatRaster as a row index") # } # if (inherits(value, "SpatRaster")) { # x <- mask(x, i, maskvalues=TRUE) # cover(x, value) # } else { # if (NCOL(value) > 1) { # error(" [", "cannot use a data.frame with multiple columns") # } # value <- unlist(value) # if (length(value) == 1) { # mask(x, i, maskvalues=TRUE, updatevalue=value[1]) # } else { # i <- as.logical(values(i)) # i[is.na(i)] <- TRUE # i <- which(i) # x[i] <- value # x # } # } # } # ) # setReplaceMethod("[", c("SpatRaster", "SpatVector", "missing"), # function(x, i, j, value) { # theCall <- sys.call(-1) # narg <- length(theCall)-length(match.call(call=sys.call(-1))) # if (narg > 0) { # row # error("`[`", "you cannot use a SpatVector as a row index") # } # if (length(value) > 1) { # value <- rep_len(value, length.out=length(x)) # } # rasterize(i, x, field=value, update=TRUE) # } # )terra/R/draw.R0000644000176200001440000000450314732341311012651 0ustar liggesusers RS_locator <- function(n, type, id=FALSE, pch=20, ...) { # locator that also works in RStudio # Berry Boessenkool # https://stackoverflow.com/a/65147220/635245 on.exit(return(cbind(x, y))) x <- y <- NULL for (i in seq_len(n)) { p <- graphics::locator(1) if (is.null(p)) break # ESC x <- c(x, p$x) y <- c(y, p$y) points(x, y, type=type, pch=pch, ...) if (id) { text(p$x, p$y, labels=i, pos=4, ...) } } } .drawPol <- function(n=1000, id=FALSE, ...) { #xy <- graphics::locator(n=1000, type="l", col=col, lwd=lwd, ...) #xy <- cbind(xy$x, xy$y) xy <- RS_locator(n, "l", id=id, ...) xy <- rbind(xy, xy[1,]) graphics::lines(xy[(length(xy[,1])-1):length(xy[,1]),], ...) g <- cbind(1,1,xy,0) vect(g, "polygons") } .drawLin <- function(n=1000, ...) { #xy <- graphics::locator(n=1000, type="l", col=col, lwd=lwd, ...) #xy <- cbind(xy$x, xy$y) xy <- RS_locator(n, "l", ...) g <- cbind(1,1,xy) vect(g, "lines") } .drawPts <- function(n=1000, ...) { #xy <- graphics::locator(n=1000, type="p", col=col, lwd=lwd, ...) #xy <- cbind(xy$x, xy$y) xy <- RS_locator(n, "p", ...) g <- cbind(1:nrow(xy), 1, xy) vect(g, "points") } .drawExt <- function(...) { loc1 <- graphics::locator(n=1, type="p", pch="+", ...) loc2 <- graphics::locator(n=1, type="p", pch="+", ...) loc <- rbind(unlist(loc1), unlist(loc2)) e <- c(min(loc[,'x']), max(loc[,'x']), min(loc[,'y']), max(loc[,'y'])) if (e[1] == e[2]) { e[1] <- e[1] - 0.0000001 e[2] <- e[2] + 0.0000001 } if (e[3] == e[4]) { e[3] <- e[3] - 0.0000001 e[4] <- e[4] + 0.0000001 } p <- rbind(c(e[1], e[3]), c(e[1], e[4]), c(e[2], e[4]), c(e[2], e[3]), c(e[1], e[3]) ) graphics::lines(p, ...) return(ext(e)) } setMethod("draw", signature(x="character"), function(x="extent", col="red", lwd=2, id=FALSE, n=1000, xpd=TRUE, ...){ RStudio_warning() x <- match.arg(tolower(x), c("extent", "polygon", "lines", "points")) if (x == "extent") { .drawExt(col=col, lwd=lwd, xpd=xpd, ...) } else if (x == "polygon") { .drawPol(n, col=col, lwd=lwd, id=id, xpd=xpd, ...) } else if (x == "lines") { .drawLin(n, col=col, lwd=lwd, id=id, xpd=xpd, ...) } else if (x == "points" || x == "multipoints" ) { .drawPts(n, col=col, id=id, xpd=xpd, ...) } } ) setMethod("draw", signature(x="missing"), function(x="extent", ...){ RStudio_warning() draw("extent", ...) } ) terra/R/plotExtent.R0000644000176200001440000000165214536376240014077 0ustar liggesusers# Author: Robert J. Hijmans # Date : July 2019 # Version 1.0 # License GPL v3 setMethod("lines", signature(x="SpatExtent"), function(x, col="black", alpha=1, ...) { e <- as.vector(x) p <- rbind(c(e[1],e[3]), c(e[1],e[4]), c(e[2],e[4]), c(e[2],e[3]), c(e[1],e[3])) col <- .getCols(1, col, alpha) graphics::lines(p, col=col, ...) } ) setMethod("polys", signature(x="SpatExtent"), function(x, col="black", alpha=1, ...) { polys(as.polygons(x), col=col, alpha=alpha, ...) } ) setMethod("plot", signature(x="SpatExtent", y="missing"), function(x, ...) { if (!is.valid(x)) { error("plot", "invalid SpatExtent") } plot(as.polygons(x), ...) } ) setMethod("points", signature(x="SpatExtent"), function(x, col="black", alpha=1, ...) { e <- as.vector(x) p <- rbind(c(e[1],e[3]), c(e[1],e[4]), c(e[2],e[4]), c(e[2],e[3]), c(e[1],e[3])) col <- .getCols(4, col, alpha) graphics::points(p, col=col, ...) } ) terra/R/subset.R0000644000176200001440000001503114727110511013217 0ustar liggesusers# Authors: Robert J. Hijmans # Date : October 2018 # Version 1.0 # License GPL v3 positive_indices <- function(i, n, na.rm=TRUE, caller="`[`") { i <- stats::na.omit(i) if (!is.logical(i)) { stopifnot(is.numeric(i)) if (!(all(i <= 0) || all(i >= 0))) { error(caller, "you cannot mix positive and negative indices") } } i <- (1:n)[i] if (na.rm) { i[!is.na(i)] } else { i } } setMethod("subset", signature(x="SpatRaster"), function(x, subset, negate=FALSE, NSE=FALSE, filename="", overwrite=FALSE, ...) { if (NSE) { subset <- if (missing(subset)) { 1:nlyr(x) } else { nl <- as.list(seq_along(names(x))) names(nl) <- nms <- names(x) v <- eval(substitute(subset), nl, parent.frame()) if (!inherits(substitute(subset), "character")) { if (sum(nms %in% nms[v]) > length(v)) { error("subset", "you cannot select a layer with a name that is not unique") } } v } } if (is.character(subset)) { nms <- names(x) if (!all(subset %in% nms)) { error("subset", "invalid name(s)") } if (sum(nms %in% subset) > length(subset)) { error("subset", "you cannot select a layer with a name that is not unique") } subset <- match(subset, nms) } if (any(is.na(subset))) { error("subset", "undefined layer(s) selected") } if (negate) subset = -subset subset <- positive_indices(subset, nlyr(x), TRUE, "subset") opt <- spatOptions(filename, overwrite, ...) x@pntr <- x@pntr$subset(subset-1, opt) messages(x, "subset") } ) ## exact matching setMethod("$", "SpatRaster", function(x, name) { if ((nlyr(x) == 1) && is.factor(x)) { factnms <- names(cats(x)[[1]]) i <- match(name, factnms[-1]) if (!is.na(i)) { activeCat(x) <- i return(x) } } subset(x, name, NSE=FALSE) } ) setMethod("[[", c("SpatRaster", "character","missing"), function(x, i, j) { subset(x, i, NSE=FALSE) }) setMethod("[[", c("SpatRaster", "logical", "missing"), function(x, i, j) { subset(x, which(i), NSE=FALSE) }) setMethod("[[", c("SpatRaster", "numeric", "missing"), function(x, i, j) { subset(x, i, NSE=FALSE) }) setMethod("[[", c("SpatRaster", "ANY", "missing"), function(x, i, j) { i <- as.vector(unlist(i)) x[[i]] }) setMethod("subset", signature(x="SpatVector"), function(x, subset, select, drop=FALSE, NSE=FALSE) { if (NSE) { d <- as.list(x) # from the subset method r <- if (missing(subset)) { TRUE } else { e <- substitute(subset) # r <- eval(e, d, parent.frame()) # for #1600 r <- eval(e, d, globalenv()) if (!is.logical(r)) error("subset", "argument 'subset' must be logical") r & !is.na(r) } v <- if (missing(select)) { TRUE } else { nl <- as.list(seq_along(d)) names(nl) <- names(d) # eval(substitute(select), nl, parent.frame()) eval(substitute(select), nl, globalenv()) } x <- x[r, v, drop=drop] } else { if (missing(select)) { x <- x[which(as.vector(subset)), drop=drop] } else { x <- x[which(as.vector(subset)), select, drop=drop] } } #g <- gc() x } ) .subset_cols <- function(x, subset, drop=FALSE) { if (is.character(subset)) { i <- stats::na.omit(match(subset, names(x))) if (length(i)==0) { error("subset", "no valid variable name found") } else if (length(i) < length(subset)) { warn("subset", "invalid variable name(s) excluded") } } else { i <- positive_indices(subset, ncol(x), TRUE, "subset") if (length(i)==0) { i <- 0 } } x@pntr <- x@pntr$subset_cols(i-1) x <- messages(x, "subset") if (drop) { # drop geometry .getSpatDF(x@pntr$df) } else { x } } setMethod("[", c("SpatVector", "numeric", "missing"), function(x, i, j, ... , drop=FALSE) { i <- positive_indices(i, nrow(x), TRUE, "`[`") x@pntr <- x@pntr$subset_rows(i-1) x <- messages(x, "[") if (drop) { as.data.frame(x) } else { x } }) setMethod("[", c("SpatVector", "numeric", "logical"), function(x, i, j, drop=FALSE) { j <- which(rep_len(j, ncol(x))) x[i, j, drop=drop] }) setMethod("[", c("SpatVector", "logical", "missing"), function(x, i, j, drop=FALSE) { i <- which(rep_len(i, nrow(x))) x@pntr <- x@pntr$subset_rows(i-1) x <- messages(x, "[") if (drop) { as.data.frame(x) } else { x } }) setMethod("[", c("SpatVector", "numeric", "numeric"), function(x, i, j, drop=FALSE) { i <- positive_indices(i, nrow(x), TRUE, "`[`") j <- positive_indices(j, ncol(x), TRUE, "`[`") p <- x@pntr$subset_rows(i-1) x@pntr <- p$subset_cols(j-1) x <- messages(x, "'['") if (drop) { as.data.frame(x) } else { x } }) setMethod("[", c("SpatVector", "missing", "numeric"), function(x, i, j, drop=FALSE) { j <- positive_indices(j, ncol(x), TRUE, "`[`") x@pntr <- x@pntr$subset_cols(j-1) x <- messages(x, "[") if (drop) { as.data.frame(x) } else { x } }) setMethod("[", c("SpatVector", "missing", "character"), function(x, i, j, drop=FALSE) { if (j[1] == "") { jj <- 0 } else { jj <- match(j, names(x)) if (any(is.na(jj))) { mis <- paste(j[is.na(jj)], collapse=", ") error(" x[,j] ", paste("name(s) not in x:", mis)) } if (length(jj) == 0) { jj <- 0 } } x[,jj,drop=drop] }) setMethod("[", c("SpatVector", "missing", "logical"), function(x, i, j, drop=FALSE) { j <- which(rep_len(j, ncol(x))) x[,j,drop=drop] }) setMethod("[", c("SpatVector", "numeric", "character"), function(x, i, j, drop=FALSE) { j <- stats::na.omit(match(j, names(x))) if (length(j) == 0) j <- 0 x <- x[i,j,drop=drop] }) setMethod("[", c("SpatVector", "logical", "character"), function(x, i, j, drop=FALSE) { i <- which(rep_len(i, nrow(x))) x[i,j,drop=drop] }) setMethod("[", c("SpatVector", "logical", "numeric"), function(x, i, j, drop=FALSE) { i <- which(rep_len(i, nrow(x))) x[i,j,drop=drop] }) setMethod("[", c("SpatVector", "logical", "logical"), function(x, i, j, drop=FALSE) { i <- which(rep_len(i, nrow(x))) j <- which(rep_len(j, ncol(x))) x[i,j,drop=drop] }) setMethod("[", c("SpatVector", "missing", "missing"), function(x, i, j, drop=FALSE) { if (drop) { values(x) } else { x } }) setMethod("[", c("SpatVector", "matrix", "missing"), function(x, i, j, drop=FALSE) { if (ncol(i) > 1) warn("`[`", "using the first column of i to subset x") x[i[,1]] }) setMethod("[", c("SpatVector", "data.frame", "missing"), function(x, i, j, drop=FALSE) { if (ncol(i) > 1) warn("`[`", "using the first column of i to subset x") x[i[,1]] }) setMethod("[", c("SpatVector", "data.frame", "ANY"), function(x, i, j, drop=FALSE) { x <- x[i[,1], j] }) setMethod("[", c("SpatVector", "character", "missing"), function(x, i, j, ... , drop=FALSE) { x[, i] }) terra/R/replace_layer.R0000644000176200001440000000604514536376240014541 0ustar liggesusers# Author: Robert J. Hijmans # Date: October 2018 # Version 1.0 # License GPL v3 .rast_replace <- function(x, name, value, caller="$<-") { if (inherits(value, "SpatRaster")) { value <- value[[1]] names(value) <- name } else if (!is.null(value)) { y <- rast(x, nlyrs=1) test <- try(values(y) <- value, silent=TRUE) if (inherits(test, "try-error")) { error(caller, "the replacement value is not valid") } value <- y names(value) <- name } i <- which(name == names(x))[1] if (is.null(value)) { if (is.na(i)) { return(x) } else { return(subset(x, -i, NSE=FALSE)) } } if (is.na(i)) { if (hasValues(x)) { c(x, value) } else if (hasValues(value)) { value } else { c(x, value) } } else if (nlyr(x) == 1) { value$deepcopy() } else if (i == 1) { c(value, x[[2:nlyr(x)]]) } else if (i == nlyr(x)) { c(x[[1:(nlyr(x)-1)]], value) } else { c(x[[1:(i-1)]], value, x[[(i+1):nlyr(x)]]) } } setMethod("$<-", "SpatRaster", function(x, name, value) { .rast_replace(x, name, value, "`$<-`") } ) setReplaceMethod("[[", c("SpatRaster", "character"), function(x, i, value) { if (inherits(value, "numeric")) { r <- rast(x, nlyr=length(i)) value <- init(r, value) names(value) <- i } else if (inherits(value, "SpatRaster")) { if (nlyr(value) != length(i)) { error("`[[`", "length of names must be equal to the number of layers") } names(value) <- i } else if (length(i) > 1) { if (NCOL(value) > 1) { value <- as.list(data.frame(value)) } else { stopifnot(length(i) == length(value)) } } else if (!is.list(value)) { value <- list(value) } for (k in 1:length(i)) { x <- .rast_replace(x, i[k], value[[k]], "`[[<-`") # eval(parse(text = paste0("x$", i[k], " <- value[[k]]"))) } x } ) setReplaceMethod("[[", c("SpatRaster", "numeric"), function(x, i, value) { if (inherits(value, "numeric")) { r <- rast(x, nlyr=length(i)) value <- init(r, value) } else if (!inherits(value, "SpatRaster")) { error("`[[<-`", "Expected a SpatRaster or numeric as replacement value") } if (nlyr(value) < length(i)) { if (nlyr(value) > 1) { j <- rep_len(1:nlyr(value), length(i)) value <- value[[j]] } } else if (nlyr(value) > length(i)) { error("`[[`", "length of indices must be <= the number of layers") } if (any(i<1) | any(i > nlyr(x))) { error("`[[`", "indices must be between 1 and the number of layers") } if (nlyr(x) == 1) { compareGeom(x, value, crs=FALSE, warncrs=TRUE) return(value) } if (nlyr(value) == 1) { for (k in 1:length(i)) { if (i[k] == 1) { x <- c(value, x[[2:nlyr(x)]]) } else if (i[k] == nlyr(x)) { x <- c(x[[1:(nlyr(x)-1)]], value) } else { x <- c(x[[1:(i[k]-1)]], value, x[[(i[k]+1):nlyr(x)]]) } } } else { for (k in 1:length(i)) { if (i[k] == 1) { x <- c(value[[k]], x[[2:nlyr(x)]]) } else if (i[k] == nlyr(x)) { x <- c(x[[1:(nlyr(x)-1)]], value[[k]]) } else { x <- c(x[[1:(i[k]-1)]], value[[k]], x[[(i[k]+1):nlyr(x)]]) } } } #g <- gc() x } ) terra/R/select.R0000644000176200001440000000147514536376240013213 0ustar liggesusers# Author: Robert J. Hijmans # Date : December 2011 # Version 1.0 # License GPL v3 setMethod("sel", signature(x="SpatRaster"), function(x, ...) { e <- draw(...) int <- intersect(e, ext(x)) if (is.null(int)) { x <- NULL } else { x <- crop(x, e) } x } ) setMethod("sel", signature(x="SpatVector"), function(x, use="rec", show=TRUE, col="cyan", draw=TRUE, ...) { use <- substr(tolower(use), 1, 3) use <- match.arg(use, c("rec", "pol")) scol <- ifelse(draw, "red", NA) if (use == "rec") { e <- draw(col=scol) # e <- as.polygons(e) } else { e <- draw("pol", col=scol) } i <- is.related(x, e, "intersects") x <- x[i, ] if (show) { if (geomtype(x) == "points" || geomtype(x) == "multipoints") { points(x, col=col, ...) } else { lines(x, col=col, ...) } } x } ) terra/R/focalMat.R0000644000176200001440000000327314734631337013461 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2013 # Version 1.0 # License GPL v3 .circular.weight <- function(rs, d, fillNA=FALSE) { nx <- 1 + 2 * floor(d/rs[1]) ny <- 1 + 2 * floor(d/rs[2]) m <- matrix(ncol=nx, nrow=ny) m[ceiling(ny/2), ceiling(nx/2)] <- 1 if ((nx != 1) || (ny != 1)) { x <- rast(m, crs="+proj=utm +zone=1 +datum=WGS84") ext(x) <- c(xmin=0, xmax=nx*rs[1], ymin=0, ymax=ny*rs[2]) d <- as.matrix(distance(x), wide=TRUE) <= d m <- d / sum(d) } if (fillNA) { m[m <= 0] <- NA } m } .Gauss.weight <- function(rs, sigma) { if (length(sigma) == 1) { d <- 3 * sigma } else { d <- sigma[2] sigma <- sigma[1] } nx <- 1 + 2 * floor(d/rs[1]) ny <- 1 + 2 * floor(d/rs[2]) m <- matrix(ncol=nx, nrow=ny) xr <- (nx * rs[1]) / 2 yr <- (ny * rs[2]) / 2 r <- rast(m, crs="+proj=utm +zone=1 +datum=WGS84") ext(r) <- c(xmin=-xr[1], xmax=xr[1], ymin=-yr[1], ymax=yr[1]) p <- xyFromCell(r, 1:ncell(r))^2 # according to http://en.wikipedia.org/wiki/Gaussian_filter m <- 1/(2*pi*sigma^2) * exp(-(p[,1]+p[,2])/(2*sigma^2)) m <- matrix(m, ncol=nx, nrow=ny, byrow=TRUE) # sum of weights should add up to 1 m / sum(m) } .rectangle.weight <- function(rs, d) { d <- rep(d, length.out=2) nx <- 1 + 2 * floor(d[1]/rs[1]) ny <- 1 + 2 * floor(d[2]/rs[2]) m <- matrix(1, ncol=nx, nrow=ny) m / sum(m) } focalMat <- function(x, d, type=c("circle", "Gauss", "rectangle"), fillNA=FALSE) { type <- match.arg(type) x <- res(x) if (type == 'circle') { .circular.weight(x, d[1], fillNA) } else if (type == 'Gauss') { if (!length(d) %in% 1:2) { error("focalMath", "if type=Gauss, d should be a vector of length 1 or 2") } .Gauss.weight(x, d) } else { .rectangle.weight(x, d) } } terra/R/sample.R0000644000176200001440000006014014753300072013176 0ustar liggesusers regular_exact <- function(r, size) { size <- round(size) stopifnot(size > 0) if (size >= ncell(r)) { return(xyFromCell(r, 1:ncell(r))) } x <- (ymax(r) - ymin(r)) / (xmax(r) - xmin(r)) if (x < 1) { nc <- min(max(1, size * 1/(1 + 1/x)), ncol(r)) nr <- (size / nc) } else { nr <- min(max(1, size * 1/(1 + x)), nrow(r)) nc <- (size / nr) } addrow <- addcol <- 0 floor <- TRUE if ((nc%%1) >= (nr%%1)) { nc <- round(nc) if ((nc * ceiling(nr)) <= size) { nr <- ceiling(nr) floor <- FALSE } else { nr <- floor(nr) if ((nr * nc) > size) { nc <- nc-1 } } d <- size - nr * nc if (d > 0) { if (floor) { addcol <- d } else { addrow <- d } } } else { nr <- round(nr) if ((nr * ceiling(nc)) <= size) { nc <- ceiling(nc) floor <- FALSE } else { nc <- floor(nc) if ((nr * nc) > size) { nr <- nr-1 } } d <- size - nr * nc if (d > 0) { if (floor) { addcol <- d } else { addrow <- d } } } if (addcol > 0) { ncs <- rep(nr, nc+1) b <- (nr+addcol)/2 ncs[1] <- ceiling(b) ncs[nc+1] <- floor(b) nc=ncs } else if (addrow > 0) { nrs <- rep(nc, nr+1) b <- (nc+addrow)/2 nrs[1] <- ceiling(b) nrs[nr+1] <- floor(b) nr=nrs } nnr <- length(nr) nnc <- length(nc) if ((nnr == 1) && (nnc == 1)) { dx <- (xmax(r) - xmin(r)) / nc x <- xmin(r) + dx/2 + (0:(nc-1)) * dx dy <- (ymax(r) - ymin(r)) / nr y <- ymin(r) + dy/2 + (0:(nr-1)) * dy expand.grid(x=x, y=y) } else if (nnc == 1) { dy <- (ymax(r) - ymin(r)) / nnr y <- ymin(r) + dy/2 + (0:(nnr-1)) * dy out <- vector("list", nnr) for (i in 1:nnr) { dx <- (xmax(r) - xmin(r)) / nr[i] x <- xmin(r) + dx/2 + (0:(nr[i]-1)) * dx out[[i]] <- expand.grid(x=x, y=y[i]) } do.call(rbind, out) } else { dx <- (xmax(r) - xmin(r)) / nnc x <- xmin(r) + dx/2 + (0:(nnc-1)) * dx out <- vector("list", nnc) for (i in 1:nnc) { dy <- (ymax(r) - ymin(r)) / nc[i] y <- ymin(r) + dy/2 + (0:(nc[i]-1)) * dy out[[i]] <- expand.grid(x=x[i], y=y) } do.call(rbind, out) } } sampleWeights <- function(x, size, replace=FALSE, as.df=TRUE, as.points=FALSE, values=TRUE, cells=FALSE, xy=FALSE, ext=NULL) { if (!is.null(ext)) { x <- crop(x, ext) } x <- classify(x, cbind(-Inf, 0, NA)) res <- as.data.frame(x, cells=cells, xy=(xy | as.points)) if (!replace) { if (size >= nrow(res)) { i <- 1:nrow(res) } else { i <- sample.int(nrow(res), size, prob=res[,ncol(res)], replace=replace) } } else { i <- sample.int(nrow(res), size, prob=res[,ncol(res)], replace=replace) } res <- res[i, , drop=FALSE] if (!values) res <- res[ , 1:(cells + 2*(xy | as.points)), drop=FALSE] if (as.points) { res <- vect(res, c("x", "y"), crs=crs(x)) if (!xy) { res$x <- NULL res$y <- NULL } } #else if (as.df) { #res <- data.frame(res) #} res } sampleStratMemory <- function(x, size, replace, lonlat, ext=NULL, weights=NULL, warn=TRUE, each) { if (!is.null(ext)) { xold <- rast(x) x <- crop(x, ext) cells <- cells(xold, ext) if (!is.null(weights)) { weights <- crop(weights, ext) } } else { cells <- 1:ncell(x) } doprob <- TRUE prob <- NULL if (!is.null(weights)) { if (!inherits(weights, "SpatRaster")) { error("spatSample", "weights must be a SpatRaster") } if (!compareGeom(x, weights)) { error("spatSample", "geometry of weights does not match the geometry of x") } v <- na.omit(cbind(cell=cells, values(x), values(weights))) } else if (lonlat) { v <- cbind(cell=cells, values(x), abs(cos(pi * values(init(x, "y")) / 360))) } else { v <- cbind(cell=cells, values(x)) doprob <- FALSE } v <- v[!is.na(v[,2]), ] uv <- sort(unique(v[,2])) nuv <- length(uv) if (each) { sz <- rep(size, nuv) } else { sz <- rep(floor(size / nuv), nuv) d <- size - sum(sz) i <- sample(nuv, d) sz[i] <- sz[i] + 1 } ys <- vector(mode="list", length=nuv) for (i in seq_len(length(uv))) { if (sz[i] == 0) next vv <- v[v[,2] == uv[i], ] if (doprob) prob <- vv[,3] if (replace) { s <- sample.int(nrow(vv), sz[i], prob=prob, replace=TRUE) } else { s <- sample.int(nrow(vv), min(sz[i], nrow(vv)), prob=prob, replace=FALSE) } ys[[i]] <- vv[s,-3] } ys <- do.call(rbind, ys) if (warn) { ta <- tapply(ys[,1], ys[,2], length) sz <- sz[sz > 0] ta <- names(ta)[ta < sz] if (length(ta) > 0) { warn("spatSample", 'fewer samples than requested are available for group(s): ', paste(ta, collapse=', ')) } } ys } sampleStratified <- function(x, size, replace=FALSE, as.df=TRUE, as.points=FALSE, values=TRUE, cells=TRUE, xy=FALSE, ext=NULL, warn=TRUE, exp=5, weights=NULL, exhaustive=FALSE, lonlat, each) { if (nlyr(x) > 1) { x <- x[[1]] warn("spatSample", "only the first layer of x is used") } if (!hasValues(x)) { error("spatSample", "x has no values") } if ((blocks(x, n=4)$n == 1) || exhaustive) { res <- sampleStratMemory(x, size, replace, lonlat, ext, weights, warn, each=each) } else { f <- unique(x)[,1] exp <- max(1, exp) ss <- exp * size * length(f) if (is.null(weights)) { if ((!lonlat) && (ss > (0.8 * ncell(x)))) { if (!is.null(ext)) { x <- crop(x, ext) } sr <- cbind(1:ncell(x), values(x)) colnames(sr) <- c("cell", names(x)) } else { sr <- spatSample(x, ss, "random", replace=replace, na.rm=TRUE, ext=ext, cells=TRUE, values=TRUE, warn=FALSE) } } else { if (!inherits(weights, "SpatRaster")) { error("spatSample", "weights must be a SpatRaster") } if (!compareGeom(x, weights)) { error("spatSample", "geometry of weights does not match the geometry of x") } sr <- vector("list", length=length(f)) for (i in 1:length(f)) { r <- x == f[i] r <- mask(weights, r, maskvalue=TRUE, inverse=TRUE) sr[[i]] <- sampleWeights(r, size, replace=replace, values=FALSE, cells=TRUE, ext=ext) } sr <- unlist(sr) sr <- cbind(cell=sr, extract(x, sr)) } uv <- unique(sr[,2]) nuv <- length(uv) if (each) { sz <- rep(size, nuv) } else { sz <- rep(floor(size / nuv), nuv) d <- size - sum(sz) i <- sample(nuv, d) sz[i] <- sz[i] + 1 } ys <- vector(mode="list", length=length(uv)) for (i in seq_len(length(uv))) { y <- sr[sr[, 2] == uv[i], ,drop=FALSE] if (nrow(y) > sz[i]) { y <- y[sample.int(nrow(y), sz[i]), ,drop=FALSE] } ys[[i]] <- y } res <- do.call(rbind, ys) colnames(res) <- c('cell', names(x)) if (warn) { ta <- table(res[,2]) sz <- sz[sz > 0] ta <- names(ta[ta < sz]) tb <- f[!(f %in% unique(res[,2]))] tba <- c(tb, ta) if ((length(tba) > 0)) { warn("spatSample", "fewer samples than requested for group(s): ", paste(tba, collapse=", ")) } } } if ((!xy) && (!as.points)) cells <- TRUE if (xy) { pts <- xyFromCell(x, res[,1]) res <- cbind(res[,1,drop=FALSE], pts, res[,2,drop=FALSE]) } if (!values) { res <- res[,1:(1 + 2*(xy|as.points)), drop=FALSE] } if (as.points) { if (!xy) { pts <- xyFromCell(x, res[,1]) } res <- vect(pts, crs=crs(x), atts=data.frame(res)) } else if (as.df) { res <- data.frame(res) } if (!cells) { res <- res[,-1,drop=FALSE] } res } .seed <- function() { sample.int(.Machine$integer.max, 1) } .sampleCellsMemory <- function(x, size, replace, lonlat, ext=NULL) { if (!is.null(ext)) { x <- crop(x, ext) } if (nlyr(x) > 1) { x <- subst(anyNA(x), 1, NA) } if (lonlat) { v <- cbind(cell=1:ncell(x), abs(cos(pi * values(init(x, "y")) / 360)), values(x)) v <- v[!is.na(v[,3]),] ssize <- ifelse(replace, size, min(size, nrow(v))) i <- sample.int(nrow(v), ssize, prob=v[,2], replace=replace) } else { v <- cbind(cell=1:ncell(x), values(x)) v <- v[!is.na(v[,2]),] ssize <- ifelse(replace, size, min(size, nrow(v))) i <- sample.int(nrow(v), ssize, replace=replace) } v[i,1] } .sampleCells <- function(x, size, method, replace, na.rm=FALSE, ext=NULL, exp=5, exact=FALSE) { r <- rast(x) lonlat <- is.lonlat(r, perhaps=TRUE, warn=TRUE) if (!is.null(ext)) { r <- crop(rast(r), ext) } if ((!replace) && (size >= ncell(r))) { cells <- 1:ncell(r) } else if (method == "random") { if (na.rm) { esize <- size * exp } else { esize <- size } if (na.rm && (blocks(x, n=4)$n == 1)) { cells <- .sampleCellsMemory(x, esize, replace, lonlat, ext) } else if (lonlat) { m <- ifelse(replace, 1.5, 2) n <- m * esize y <- yFromRow(r, 1:nrow(r)) rows <- sample.int(nrow(r), n, replace=TRUE, prob=abs(cos(pi*y/180))) cols <- sample.int(ncol(r), n, replace=TRUE) cells <- cellFromRowCol(r, rows, cols) if (!replace) { cells <- unique(cells) } } else { if (!replace) esize <- min(ncell(r), esize) cells <- sample.int(ncell(r), esize, replace=replace) } } else { # regular if (TRUE) { if (exact) { xy <- regular_exact(r, size) } else { xy <- spatSample(ext(r), size, method, lonlat, FALSE) } cells <- cellFromXY(r, xy) } else { if (lonlat) { #ratio <- ncol(r)/nrow(r) e <- ext(r) r1 = e$xmax - e$xmin; r2 = e$ymax - e$ymin; halfy = e$ymin + r2/2; # beware that -180 is the same as 180; and that latitude can only go from -90:90 therefore: dx = distance(cbind(e$xmin, halfy), cbind(e$xmin + 1, halfy), TRUE, TRUE) * min(180.0, r1); dy = distance(cbind(0, e$ymin), cbind(0, e$ymax), TRUE, TRUE); ratio = dy/dx; n <- sqrt(size) #nx <- max(1, (round(n*ratio))) #ny <- max(1, (round(n/ratio))) nx <- min(max(1, round(n/ratio)), ncol(r)) ny <- min(max(1, round(n*ratio)), nrow(r)) xi <- ncol(r) / nx yi <- nrow(r) / ny rows <- unique(round(seq(.5*yi, nrow(r), yi))) w <- cos(pi*yFromRow(r, rows)/180) w <- w * length(w)/sum(w) xi <- xi / w xi <- pmax(1,pmin(xi, ncol(r))) z <- list() # needs refinement: global <- diff(e[1:2]) > 355 if (global) { xi <- round(ncol(r) / round(ncol(r) / xi)) for (i in 1:length(rows)) { if (xi[i] == 1) { cols <- 1:ncol(r) } else { cols <- seq(xi[i]/2, ncol(r)-1, xi[i]) } z[[i]] <- cbind(rows[i], cols) } } else { # xi <- round(ncol(r) / (round((ncol(r) / xi))+1)) for (i in 1:length(rows)) { cols <- seq(xi[i]/2, ncol(r), xi[i]) z[[i]] <- cbind(rows[i], cols) } } z <- do.call(rbind, z) cells <- cellFromRowCol(r, z[,1], z[,2]) } else { f <- sqrt(size / ncell(r)) nr <- ceiling(nrow(r) * f) nc <- ceiling(ncol(r) * f); xstep <- ncol(r) / nc ystep <- nrow(r) / nr xsamp <- seq(0.5*xstep, ncol(r), xstep) ysamp <- seq(0.5*ystep, nrow(r), ystep) xy <- expand.grid(ysamp, xsamp) cells <- cellFromRowCol(r, xy[,1], xy[,2]) } } } if (!is.null(ext)) { cells <- cellFromXY(x, xyFromCell(r, cells)) } if (na.rm) { v <- rowSums(is.na(x[cells])) == 0 cells <- cells[v] } if (method == "random") { if (length(cells) > size) { cells <- cells[1:size] } } cells } set_factors <- function(x, ff, cts, asdf) { if (!asdf) return(x) if (any(ff)) { x <- data.frame(x) for (i in which(ff)) { ct <- cts[[i]] m <- match(x[[i]], ct[,1]) if (!inherits(ct[[2]], "numeric")) { x[[i]] <- factor(ct[m,2], levels=unique(ct[[2]])) } else { x[[i]] <- ct[m,2] } } } data.frame(x) } .sampleCellsExhaustive <- function(x, size, replace, ext=NULL, weights=NULL, warn=TRUE) { if (!is.null(ext)) { x <- crop(x, ext) } rx <- rast(x) x <- cells(x) if (length(x) < size) { if (!replace) { warn("spatSample", "fewer samples than requested are available") return(x) } size <- length(x) } if (!is.null(weights)) { if (!inherits(weights, "SpatRaster")) { error("spatSample", "weights must be a SpatRaster") } weights <- weights[[1]] if (!is.null(ext)) { weights <- crop(weights, ext) } if (!compareGeom(x, weights)) { error("spatSample", "geometry of weights does not match the geometry of x") } weights <- weights[x] s <- sample.int(x, size, prob=weights, replace=replace) } else if (is.lonlat(rx)) { y <- xyFromCell(rx, x)[,2] weights <- abs(cos(pi * y / 360)) s <- sample(x, size, prob=weights, replace=replace) } else { s <- sample(x, size, replace=replace) } s } sampleRaster <- function(x, size, method, replace, ext=NULL, warn, overview=FALSE) { # hadWin <- hasWin <- FALSE if (!is.null(ext)) { # hasWin <- TRUE # hadWin <- window(x) # oldWin <- ext(x) w <- intersect(ext(x), ext(ext)) if (is.null(w)) { error("sampleRaster", "x and ext do not intersect") } x <- deepcopy(x) window(x) <- w } if (method == "regular") { if (length(size) > 1) { x@pntr <- x@pntr$sampleRowColRaster(size[1], size[2], warn[1]) } else { x@pntr <- x@pntr$sampleRegularRaster(size, overview) } } else if (method == "random") { x@pntr <- x@pntr$sampleRandomRaster(size, replace, .seed()) } else { error("spatSample", "method must be 'regular' or 'random' if as.raster=TRUE") } # if (hasWin) { # window(x) <- NULL # if (any(hadWin)) { # window(x) <- oldWin # } # } messages(x, "spatSample") } setMethod("spatSample", signature(x="SpatRaster"), function(x, size, method="random", replace=FALSE, na.rm=FALSE, as.raster=FALSE, as.df=TRUE, as.points=FALSE, values=TRUE, cells=FALSE, xy=FALSE, ext=NULL, warn=TRUE, weights=NULL, exp=5, exhaustive=FALSE, exact=FALSE, each=TRUE) { if (method == "display") return(sampleRaster(x, size, "regular", FALSE, ext=ext, warn=FALSE, overview=TRUE)) if (!as.points) { if (!(values || cells || xy)) { error("spatSample", "at least one of 'values', 'cells', or 'xy' must be TRUE; or 'as.points' must be TRUE") } } exp <- max(c(1, exp), na.rm=TRUE) size <- round(size) if (isTRUE(any(size < 1)) || isTRUE(any(is.na(size)))) { error("spatSample", "sample size must be a positive integer") } method <- match.arg(tolower(method), c("random", "regular", "stratified", "weights")) if ((!replace) && (method != "regular")) { if (length(size) > 1) { error("spatSample", "sample size must be a single number") } if (warn && (size > ncell(x))) { warn("spatSample", "requested sample size is larger than the number of cells") size <- ncell(x) } } if (as.raster) return(sampleRaster(x, size, method, replace, ext, warn)) lonlat <- is.lonlat(x, perhaps=TRUE, warn=FALSE) if (lonlat) exact <- FALSE if (method == "stratified") { return( sampleStratified(x, size, replace=replace, as.df=as.df, as.points=as.points, cells=cells, values=values, xy=xy, ext=ext, warn=warn, exp=exp, weights=weights, exhaustive=exhaustive, lonlat=lonlat, each=each) ) } else if (!is.null(weights)) { error("spatSample", "argument weights is only used when method='stratified'") } if (method == "weights") { if (nlyr(x) > 1) { x <- x[[1]] warn("spatSample", "only the first layer of x is used") } if (!hasValues(x)) { error("spatSample", "x has no values") } out <- try(sampleWeights(x, size, replace=replace, as.df=as.df, values=values, as.points=as.points, cells=cells, xy=xy, ext=ext) ) if (inherits(out, "try-error")) { error("spatSample", "weighted sample failed. Perhaps the data set is too big") } return (out) } ff <- is.factor(x) lv <- levels(x) if (cells || xy || as.points) { size <- size[1] if (exhaustive && (method=="random") && na.rm) { cnrs <- .sampleCellsExhaustive(x, size, replace, ext, weights=NULL, warn=FALSE) } else { cnrs <- .sampleCells(x, size, method, replace, na.rm, ext, exp=exp, exact=exact) } if (method == "random") { if ((length(cnrs) < size) && warn) { warn("spatSample", "fewer cells returned than requested") } else if (length(cnrs) > size) { cnrs <- cnrs[1:size] } } out <- NULL if (cells) { out <- matrix(cnrs, ncol=1) colnames(out) <- "cell" } if (xy) { out <- cbind(out, xyFromCell(x, cnrs)) } if (values && hasValues(x)) { e <- extract(x, cnrs) if (is.null(out)) { out <- e } else { out <- cbind(out, e) } } if (as.points) { if (xy) { out <- data.frame(out) out <- vect(out, geom=c("x", "y"), crs=crs(x)) } else { xy <- xyFromCell(x, cnrs) # xy is a matrix, no geom argument v <- vect(xy, crs=crs(x)) values(v) <- out return(v) } } return(out) } if (!hasValues(x)) { error("spatSample", "SpatRaster has no values") } #method <- tolower(method) #stopifnot(method %in% c("random", "regular")) if (!is.null(ext)) x <- crop(x, ext) if (method == "regular") { if (exact && (length(size) == 1)) { xy <- regular_exact(x, size) v <- extract(x, xy, ID=FALSE) } else { opt <- spatOptions() if (length(size) > 1) { v <- x@pntr$sampleRowColValues(size[1], size[2], opt) } else { v <- x@pntr$sampleRegularValues(size, opt) } x <- messages(x, "spatSample") if (length(v) > 0) { v <- do.call(cbind, v) colnames(v) <- names(x) } v <- set_factors(v, ff, lv, as.df) } return(v) } else { # random size <- size[1] if (exhaustive && na.rm) { cnrs <- .sampleCellsExhaustive(x, size, replace, ext, weights=NULL, warn=FALSE) out <- x[cnrs] } else { #v <- x@pntr$sampleRandomValues(size, replace, seed) if (size > 0.75 * ncell(x)) { if (na.rm) { out <- stats::na.omit(values(x)) attr(out, "na.action") <- NULL if (nrow(out) < size) { if (replace) { out <- out[sample.int(nrow(out), size, replace=TRUE), ,drop=FALSE] } else { warn("spatSample", "more non-NA cells requested than available") } } else { out <- out[sample.int(nrow(out), size), ,drop=FALSE] } } else { out <- values(x) out <- out[sample.int(nrow(out), size, replace=replace), ,drop=FALSE] } out <- set_factors(out, ff, lv, as.df) return(out) } if (na.rm) { scells <- NULL ssize <- size*2 for (i in 1:10) { scells <- c(scells, .sampleCells(x, ssize, method, replace, na.rm, exact=exact)) if ((i>1) && (!replace)) { scells <- unique(scells) } out <- extractCells(x, scells, raw=!as.df) out <- stats::na.omit(out) if (nrow(out) >= size) { out <- out[1:size, ,drop=FALSE] attr(out, "na.action") <- NULL rownames(out) <- NULL break } } } else { scells <- .sampleCells(x, size, method, replace, exact=exact) out <- extractCells(x, scells, raw=!as.df) } if (NROW(out) < size) { if (warn) warn("spatSample", "fewer values returned than requested") } else if (is.null(dim(out))) { out = out[1:size] } else { out = out[1:size, ,drop=FALSE] } #out <- set_factors(out, ff, lv, as.df) return(out) } } } ) setMethod("spatSample", signature(x="SpatExtent"), function(x, size, method="random", lonlat, as.points=FALSE, exact=FALSE) { if (missing(lonlat)) { error("spatSample", "provide a lonlat argument") } if (lonlat) { stopifnot(x$ymax <= 90 || x$ymin >= -90) } method <- match.arg(method, c("regular", "random")) size <- round(size) stopifnot(size > 0) if (method=="random") { s <- x@pntr$sampleRandom(size, lonlat, .seed()) } else if (exact) { s <- regular_exact(x, size) colnames(s) <- c("x", "y") if (as.points) { s <- vect(s) } return(s) } else { s <- x@pntr$sampleRegular(size, lonlat) } s <- do.call(cbind, s) colnames(s) <- c("x", "y") if (as.points) { s <- vect(s) } s } ) .grid_sample <- function(xy, n=1, r, chess="") { cell <- cellFromXY(r, xy) uc <- unique(stats::na.omit(cell)) chess <- trimws(chess) if (chess != "") { chess <- match.arg(tolower(chess), c("white", "black")) nc <- ncol(r) if (nc %% 2 == 1) { if (chess=="white") { tf <- 1:ceiling(ncell(r)/2) * 2 - 1 } else { tf <- 1:ceiling((ncell(r)-1)/2) * 2 } } else { nr <- nrow(r) row1 <- 1:(ceiling(nr / 2)) * 2 - 1 row2 <- row1 + 1 row2 <- row2[row2 <= nr] if (chess=="white") { col1 <- 1:(ceiling(nc / 2)) * 2 - 1 col2 <- col1 + 1 col2 <- col2[col2 <= nc] } else { col1 <- 1:(ceiling(nc / 2)) * 2 col2 <- col1 - 1 col1 <- col1[col1 <= nc] } cells1 <- cellFromRowColCombine(r, row1, col1) cells2 <- cellFromRowColCombine(r, row2, col2) tf <- c(cells1, cells2) } uc <- uc[uc %in% tf] } cell <- cellFromXY(r, xy) cell <- cbind(1:nrow(xy), cell, stats::runif(nrow(xy))) cell <- stats::na.omit(cell) cell <- cell[order(cell[,3]), ] sel <- list() for (i in 1:length(uc)) { ss <- subset(cell, cell[,2] == uc[i]) sel[[i]] <- ss[1:min(n, nrow(ss)), 1] } unlist(sel) } #coordinates <- function(x) { # do.call(cbind, x@pntr$coordinates()) #} get_field_name <- function(x, nms, sender="") { x <- x[1] if (is.numeric(x)) { x <- round(x) if (x > 0 && x <= length(nms)) { x = nms[x] } else { error(sender, "invalid index. there are ", length(nms), " columns") } } else if (is.character(x)) { if (!(x %in% nms)) { error(sender, "invalid name") } } x } setMethod("spatSample", signature(x="SpatVector"), function(x, size, method="random", strata=NULL, chess="") { method = match.arg(tolower(method), c("regular", "random")) size <- round(size) stopifnot(size > 0) gtype <- geomtype(x) if (gtype == "polygons") { if (!is.null(strata)) { if (length(strata) == 1) { if (is.character(strata)) { stopifnot(strata %in% names(x)) } else { stopifnot((strata > 0) && (strata < ncol(x))) } strata <- x[[strata, drop=TRUE]] } else if (length(strata) != length(x)) { stop("length of strata must be 1 or length(x)") } s <- stats::na.omit(unique(strata)) n <- length(size) if (n==1) { n <- rep_len(n, length(s)) } else if (length(s) != n) { stop("length of strata must be 1 or length(na.omit(unique(strata)))") } r <- lapply(s, function(s) { spatSample(x[strata == s, ], size, method, NULL, "") }) r <- do.call(rbind, r) return(r) } out <- vect() if (length(size) == 1) { out@pntr <- x@pntr$sample(size, method[1], .seed()) } else { out@pntr <- x@pntr$sampleGeom(size, method[1], .seed()) } messages(x, "spatSample") return(messages(out, "spatSample")) } else if (grepl(gtype, "points")) { if (!is.null(strata)) { if (inherits(strata, "SpatRaster")) { xy <- crds(x) i <- .grid_sample(xy, size[1], rast(strata), chess) return(x[i,]) } else { error("spatSample", "not yet implemented for these strata") } } else { error("spatSample", "use `sample` to sample (point) geometries") } } else { error("spatSample", "not yet implemented for lines") } } ) #spatSample(disagg(as.points(v)), 1, "stratified", strata=r, chess="") # setMethod("spatSample", signature(x="SpatExtent"), # function(x, size, method="regular", lonlat, ...) { # if (missing(lonlat)) { # stop("provide a lonlat argument") # } # method = match.arg(method, c("regular", "random")) # size <- round(size) # stopifnot(size > 0) # e <- as.vector(x) # if (method=="random") { # if (lonlat) { # d <- round((e[4] - e[3]) * 1000); # dx <- (e[4] - e[3]) / (2 * d) # r <- unique(seq(e[3], e[4], length.out=d)) # w <- abs(cos(pi*r/180)) # x <- sample.int(length(r), size, prob=w, replace=TRUE) # lat <- r[x] + stats::runif(size, -dx, dx) # lon <- stats::runif(size, min = e[1], max = e[2]) # vect(cbind(lon,lat), crs="+proj=lonlat +datum=WGS84") # } else { # x <- stats::runif(size, min = e[1], max = e[2]) # y <- stats::runif(size, min = e[3], max = e[4]) # vect(cbind(x, y)) # } # } else { # r <- range(x) # ratio <- 0.5 * r[1]/r[2] # n <- sqrt(size) # nx <- max(1, (round(n*ratio))) # ny <- max(1, (round(n/ratio))) # xi <- r[1] / nx # yi <- r[2] / ny # if (lonlat) { # lat <- seq(e[3]+0.5*yi, e[4], yi) # w <- cos(pi*lat/180) # w <- w * length(w)/sum(w) # xi <- xi / w # xi <- pmin(xi, 180) # z <- list() # #off <- stats::runif(1) # for (i in 1:length(lat)) { # z[[i]] <- cbind(seq(e[1]+0.5*xi[i], e[2], xi[i]), lat[i]) # } # z <- do.call(rbind, z) # vect(z, crs="+proj=lonlat +datum=WGS84") # } else { # x <- seq(e[1]+0.5*xi, e[2], xi) # y <- seq(e[3]+0.5*yi, e[4], yi) # vect(cbind(rep(x, length(y)), rep(y, each=length(x)))) # } # } # } # ) terra/R/hist.R0000644000176200001440000000432714544575727012714 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2008 # Version 1.0 # License GPL v3 setMethod("hist", signature(x="SpatRaster"), function(x, layer, maxcell=1000000, plot=TRUE, maxnl=16, main, ...) { if (missing(layer)) { y <- 1:nlyr(x) } else if (is.character(layer)) { y <- match(layer, names(x)) maxnl <- Inf } else { y <- layer maxnl <- Inf } y <- as.integer(round(y)) y <- stats::na.omit(y) y <- y[ y >= 1 & y <= nlyr(x) ] nl <- length(y) if (nl == 0) { error("hist", "no valid layers selected") } if (missing(main)) { main=names(x) } if (nl > 1) { res <- list() if (nl > maxnl) { warn(paste("hist", "only the first", maxnl, "layers are used (see argument maxnl)")) nl <- maxnl y <- y[1:maxnl] } nc <- ceiling(sqrt(nl)) nr <- ceiling(nl / nc) mfrow <- graphics::par("mfrow") spots <- mfrow[1] * mfrow[2] if (spots < nl) { old.par <- graphics::par(no.readonly =TRUE) on.exit(graphics::par(old.par)) graphics::par(mfrow=c(nr, nc)) } for (i in 1:length(y)) { res[[i]] = .hist1(x[[ y[i] ]], maxcell=maxcell, main=main[y[i]], plot=plot, ...) } } else if (nl==1) { if (nlyr(x) > 1) { x <- x[[y]] main <- main[y] } res <- .hist1(x, maxcell=maxcell, main=main, plot=plot, ...) } if (plot) { return(invisible(res)) } else { return(res) } } ) .hist1 <- function(x, maxcell, main, plot, ...){ stopifnot(hasValues(x)) if ( ncell(x) <= maxcell ) { v <- stats::na.omit(values(x)) } else { # TO DO: make a function that does this by block and combines all data into a single histogram v <- spatSample(x, maxcell, method="regular", as.df=FALSE, as.raster=FALSE, warn=FALSE) msg <- paste("a sample of ", round(100 * length(v) / ncell(x)), "% of the cells was used", sep="") if (any(is.na(v))) { v <- stats::na.omit(v) msg <- paste(msg, " (of which ", 100 - round(100 * length(v) / maxcell ), "% was NA)", sep="") } warn("hist", msg) } if (nrow(v) == 0) { error("hist", "all (sampled) values are NA") } # if (.shortDataType(x) == 'LOG') { # v <- v * 1 # } if (plot) { out <- hist(v, main=main, plot=plot, ...) } else { out <- hist(v, plot=plot, ...) } out$xname <- names(x) out } terra/R/lapp.R0000644000176200001440000002371714746056417012677 0ustar liggesusers# Author: Robert J. Hijmans # Date : May 2020 # Version 1.0 # License GPL v3 .lapp_test <- function(v, fun, usenames, ...) { # figure out the shape of the output nms = "" nr <- nrow(v) if (!usenames) colnames(v) <- NULL vtst <- try(do.call(fun, c(v, list(...))), silent=FALSE) if (inherits(vtst, "try-error")) { nl <- -1 msg <- "cannot use 'fun'" } if (length(vtst) >= nr) { if ((length(vtst) %% nr) == 0) { nl <- length(vtst) / nr } else { if (is.null(dim(vtst))) { msg <- paste0("cannot use 'fun'. The number of values returned is not divisible by the number of input cells (returning: ", length(vtst), ", expecting :", nr, ")") } else { msg <- paste0("cannot use 'fun'. The number of rows returned is not divisible by the number of input cells (returning: ", nrow(vtst), ", expecting: ", nr, ")") } nl <- -1 } } else { if (is.null(dim(vtst))) { msg <- paste0("cannot use 'fun'. The number of values returned is less than the number of input cells.\n(returning: ", length(vtst), ", expecting: ", nr, ")\nPerhaps the function is not properly vectorized") } else { msg <- paste("cannot use 'fun'. The number of rows returned is less than the number of input cells.\n(returning:", nrow(vtst), ", expecting:", nr, ")\nPerhaps the function is not properly vectorized") } nl <- -1 } if (nl < 0) { error("lapp", msg) } if (is.matrix(vtst)) { nms <- colnames(vtst) } list(nl=nl, names=nms) } setMethod("lapp", signature(x="SpatRaster"), function(x, fun, ..., usenames=FALSE, cores=1, filename="", overwrite=FALSE, wopt=list()) { fun <- match.fun(fun) dots <- list(...) if (any(sapply(dots, function(i) inherits(i, "SpatRaster")))) { error("lapp", "only 'x' can be a SpatRaster") # otherwise .lapp_test may crash! } # if (usenames) { # fnames <- names(formals(fun)) # i <- names(x) %in% fnames # if (!all(i)) { # warn("lapp", paste(paste(names(x)[!i], collapse=","), "are not used", collapse=", ")) # x <- x[[names(x) %in% fnames]] # } # } doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } readStart(x) on.exit(readStop(x), add=TRUE) ncx <- ncol(x) v <- readValues(x, round(0.51*nrow(x)), 1, 1, ncx, dataframe=TRUE) test <- .lapp_test(v, fun, usenames, ...) if (test$nl < 1) error("lapp", "cannot use 'fun'. The number of values returned is not divisible by the number of input cells") out <- rast(x, nlyrs=test$nl) if (length(test$names == test$nl)) { if (is.null(wopt$names)) wopt$names <- test$names } b <- writeStart(out, filename, overwrite, sources=sources(x), wopt=wopt) expected <- test$nl * ncx if (doclust) { ncores <- length(cores) export_args(cores, ..., caller="lapp") cfun <- function(i, ...) do.call(fun, i, ...) parallel::clusterExport(cores, "cfun", environment()) for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, ncx, dataframe=TRUE) if (!usenames) colnames(v) <- NULL v <- split(v, rep(1:ncores, each=ceiling(nrow(v) / ncores))[1:nrow(v)]) v <- unlist(parallel::parLapply(cores, v, cfun, ...)) if (length(v) != (expected * b$nrows[i])) { out <- writeStop(out) error("lapp", "output length of fun is not correct") } writeValues(out, v, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, ncx, dataframe=TRUE) if (!usenames) colnames(v) <- NULL v <- do.call(fun, c(v, list(...))) if (length(v) != (expected * b$nrows[i])) { out <- writeStop(out) error("lapp", "output length of fun is not correct") } writeValues(out, v, b$row[i], b$nrows[i]) } } out <- writeStop(out) return(out) } ) .lapp_test_stack_call <- function(v, fun, recycle, ...) { # figure out the shape of the output nms <- msg <- "" nr <- nrow(v[[1]]) if (recycle) { v <- lapply(v, as.vector) } vtst <- try(do.call(fun, c(v, list(...))), silent=FALSE) # vtst2 <- try(apply(v, fun, ...), silent=TRUE) if (inherits(vtst, "try-error")) { nl <- -1 msg <- "cannot use 'fun'" } if (length(vtst) >= nr) { if ((length(vtst) %% nr) == 0) { nl <- length(vtst) / nr } else { if (is.null(dim(vtst))) { msg <- paste0("cannot use 'fun'. The number of values returned is not divisible by the number of input cells (returning: ", length(vtst), ", expecting :", nr, ")") } else { msg <- paste0("cannot use 'fun'. The number of rows returned is not divisible by the number of input cells (returning: ", nrow(vtst), ", expecting: ", nr, ")") } nl <- -1 } } else { if (is.null(dim(vtst))) { msg <- paste0("cannot use 'fun'. The number of values returned is less than the number of input cells.\n(returning: ", length(vtst), ", expecting: ", nr, ")\nPerhaps the function is not properly vectorized.") } else { msg <- paste("cannot use 'fun'. The number of rows returned is less than the number of input cells.\n(returning:", nrow(vtst), ", expecting:", nr, ")\nPerhaps the function is not properly vectorized.") } nl <- -1 } if (nl > 0) { if (is.matrix(vtst)) { nms <- colnames(vtst) } } list(nl=nl, names=nms, msg=msg) } .lapp_test_stack_mapp <- function(v, fun, recycle, ...) { # figure out the shape of the output nms <- msg <- "" nr <- nrow(v[[1]]) if (recycle) { v <- lapply(v, as.vector) } v <- lapply(v, function(i) data.frame(t(i))) vtst <- try(do.call(mapply, c(v, list(...), FUN=fun)), silent=FALSE) if (inherits(vtst, "try-error")) { return(list(nl=-10, names="", msg="cannot use 'fun'", trans=FALSE)) } trans <- FALSE if (!is.null(dim(vtst))) { trans <- TRUE vtst <- as.vector(t(vtst)) } if (length(vtst) >= nr) { if ((length(vtst) %% nr) == 0) { nl <- length(vtst) / nr } else { if (is.null(dim(vtst))) { msg <- paste0("cannot use 'fun'. The number of values returned is not divisible by the number of input cells (returning: ", length(vtst), ", expecting :", nr, ")") } else { msg <- paste0("cannot use 'fun'. The number of rows returned is not divisible by the number of input cells (returning: ", nrow(vtst), ", expecting: ", nr, ")") } nl <- -1 } } else { if (is.null(dim(vtst))) { msg <- paste0("cannot use 'fun'. The number of values returned is less than the number of input cells.\n(returning: ", length(vtst), ", expecting: ", nr, ")\nPerhaps the function is not properly vectorized.") } else { msg <- paste("cannot use 'fun'. The number of rows returned is less than the number of input cells.\n(returning:", nrow(vtst), ", expecting:", nr, ")\nPerhaps the function is not properly vectorized.") } nl <- -10 } if (nl > 0) { if (is.matrix(vtst)) { nms <- colnames(vtst) } } list(nl=nl, names=nms, msg=msg, trans=trans) } setMethod("lapp", signature(x="SpatRasterDataset"), function(x, fun, ..., usenames=FALSE, recycle=FALSE, cores=1, filename="", overwrite=FALSE, wopt=list()) { fun <- match.fun(fun) dots <- list(...) if (any(sapply(dots, function(i) inherits(i, "SpatRasterDataset")))) { error("lapp", "only 'x' can be a SpatRasterDataset") # otherwise .lapp_test_stack fails } ncx <- ncol(x[1]) nrx <- nrow(x[1]) readStart(x) on.exit(readStop(x)) nms <- names(x) v <- lapply(1:length(x), function(i) readValues(x[i], round(0.51*nrx), 1, 1, ncx, mat=TRUE)) if (usenames) names(v) <- nms mapp <- FALSE trans <- FALSE test <- .lapp_test_stack_call(v, fun, recycle, ...) if (test$nl < 1) { oldtst <- test test <- .lapp_test_stack_mapp(v, fun, recycle, ...) if (test$nl == 0) { error("lapp", paste0(oldtst$msg, "\n", test$msg)) } mapp <- TRUE trans <- test$trans } out <- rast(x[1]) nlyr(out) <- test$nl if (length(test$names == test$nl)) { if (is.null(wopt$names)) wopt$names <- test$names } nltot <- sum(nlyr(x)) + nlyr(out) fact <- max(4, 4 * nltot / nlyr(out)) b <- writeStart(out, filename, overwrite, sources=unlist(sources(x)), wopt=wopt, n=fact) doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } if (mapp) { if (doclust) { warn("lapp", "no parallel method for this case") } for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, ncx, mat=TRUE) if (recycle) { v <- lapply(v, as.vector) } if (usenames) { names(v) <- nms } v <- lapply(v, function(j) data.frame(t(j))) v <- do.call(mapply, c(v, list(...), FUN=fun)) if (test$trans) { v <- as.vector(t(v)) } writeValues(out, v, b$row[i], b$nrows[i]) } } else { if (doclust) { ncores <- length(cores) export_args(cores, ..., caller="lapp") cfun <- function(i, ...) do.call(fun, i, ...) parallel::clusterExport(cores, "cfun", environment()) for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, ncx, mat=TRUE) if (usenames) { names(v) <- nms } else { names(v) <- NULL } if (recycle) { repl <- max(sapply(v, function(j) prod(dim(j)))) v <- lapply(v, function(j) rep_len(as.vector(j), repl)) j <- split(1:length(v[[1]]), rep(1:ncores, each=ceiling(length(v[[1]]) / ncores))[1:length(v[[1]])]) v <- parallel::parLapply(cores, 1:ncores, function(x, ...) cfun(lapply(v, function(d) d[j[[x]]]), ...)) } else { j <- split(1:nrow(v[[1]]), rep(1:ncores, each=ceiling(nrow(v[[1]]) / ncores))[1:nrow(v[[1]])]) v <- parallel::parLapply(cores, 1:ncores, function(x, ...) cfun(lapply(v, function(d) d[j[[x]], , drop=FALSE]), ...)) } v <- unlist(v) if (length(v) != (b$nrows[i] * test$nl * ncx)) { out <- writeStop(out) error("lapp", "output length of fun is not correct") } writeValues(out, v, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, ncx, mat=TRUE) if (recycle) { v <- lapply(v, as.vector) } if (usenames) { names(v) <- nms } v <- do.call(fun, c(v, list(...))) writeValues(out, v, b$row[i], b$nrows[i]) } } } writeStop(out) } ) terra/R/predict.R0000644000176200001440000001503314715131207013350 0ustar liggesusers# Author: Robert J. Hijmans # Date : August 2009 # Version 0.9 # License GPL v3 parfun <- function(cls, d, fun, model, ...) { nr <- nrow(d) nc <- length(cls) s <- split(d, rep(1:nc, each=ceiling(nr/nc), length.out=nr)) p <- parallel::clusterApply(cls, s, function(i, ...) fun(model, i, ...), ...) if (!is.null(dim(p[[1]]))) { do.call(rbind, p) } else { unlist(p) } } .runModel <- function(model, fun, d, nl, const, na.rm, index, cores, ...) { doPar <- !is.null(cores) if (!is.data.frame(d)) { d <- data.frame(d) } if (!is.null(const)) { nms <- names(const) for (i in 1:ncol(const)) { # avoid rowname recycling warnings d[[ nms[i] ]] <- const[[ nms[i] ]] } } if (na.rm) { n <- nrow(d) i <- rowSums(is.na(d)) == 0 d <- d[i,,drop=FALSE] if (nrow(d) > 0) { if (doPar) { r <- parfun(cores, d, fun, model, ...) } else { r <- fun(model, d, ...) } if (is.list(r)) { r <- as.data.frame(r) # data.frame(lapply) instead of sapply to catch a one-row case r <- data.frame(lapply(r, as.numeric)) } else if (is.factor(r)) { r <- as.integer(r) } r <- as.matrix(r) if (!all(i)) { m <- matrix(NA, nrow=n, ncol=ncol(r)) m[i,] <- r colnames(m) <- colnames(r) r <- m } } else { if (!is.null(index)) { r <- matrix(NA, nrow=nl*n, ncol=length(index)) index <- NULL } else { r <- matrix(NA, nrow=nl*n, ncol=1) } } } else { if (doPar) { r <- parfun(cores, d, fun, model, ...) } else { r <- fun(model, d, ...) } if (is.list(r)) { r <- as.data.frame(lapply(r, as.numeric)) } else if (is.factor(r)) { r <- as.integer(r) } else if (is.data.frame(r)) { r <- sapply(r, as.numeric) } r <- as.matrix(r) } if (inherits(model, "gstat")) { if (ncol(r) > 2) { nr <- max(nrow(d), 5) xy <- as.matrix(d[1:nr,1:2]) if (all(xy == r[1:nr, 1:2])) { r <- r[,-c(1:2)] # x, y } } } if (!is.null(index)) { r <- r[, index, drop=FALSE] } r } .getFactors <- function(model, fun, d, nl, const, na.rm, index, ...) { if (!is.data.frame(d)) { d <- data.frame(d) } if (! is.null(const)) { for (i in 1:ncol(const)) { d <- cbind(d, const[,i,drop=FALSE]) } } if (na.rm) { n <- nrow(d) i <- rowSums(is.na(d)) == 0 d <- d[i,,drop=FALSE] } if (nrow(d) > 0) { r <- fun(model, d, ...) } else { return(NULL) } if (inherits(model, "gstat")) { nr <- max(nrow(d), 5) xy <- d[1:nr,1:2] if (all(xy == r[1:nr, 1:2])) { r <- r[,-c(1:2)] # x, y } } if (is.factor(r)) { levs <- levels(r) data.frame(value=1:length(levs), class=levs) } else if (is.list(r) || is.data.frame(r)) { r <- as.data.frame(r) out <- sapply(r, levels) for (i in 1:length(out)) { if (!is.null(out[[i]])) { out[[i]] <- data.frame(value=1:length(out[[i]]), label=out[[i]]) } } out } else { NULL } } find_dims <- function(object, model, nc, fun, const, na.rm, index, ...) { nr <- nrow(object) nl <- 1 testrow <- round(0.51*nr) rnr <- 1 if (nc==1) rnr <- min(nr, 20) - testrow + 1 d <- readValues(object, testrow, rnr, 1, nc, TRUE, TRUE) cn <- NULL levs <- NULL if (!is.null(index)) { nl <- length(index) r <- .runModel(model, fun, d, nl, const, na.rm, index, cores=NULL, ...) rdim <- dim(r) if (is.null(rdim)) { cn <- "" } else { cn <- colnames(r) } } else { allna <- FALSE if (na.rm) { allna <- all(nrow(stats::na.omit(d)) == 0) if (allna) { testrow <- ceiling(testrow - 0.25*nr) d <- readValues(object, testrow, rnr, 1, nc, TRUE, TRUE) allna <- all(nrow(stats::na.omit(d)) == 0) } if (allna) { testrow <- floor(testrow + 0.5*nr) if ((testrow + rnr) > nr) rnr = nr - testrow + 1 d <- readValues(object, testrow, rnr, 1, nc, TRUE, TRUE) allna <- all(nrow(stats::na.omit(d)) == 0) } if (allna && (ncell(object) < 1000)) { d <- readValues(object, 1, nr, 1, nc, TRUE, TRUE) allna <- all(nrow(stats::na.omit(d)) == 0) #if (allna) { # error("predict", "all predictor values are NA") #} } if (allna) { d <- spatSample(object, min(1000, ncell(object)), "regular", warn=FALSE) allna <- all(nrow(stats::na.omit(d)) == 0) } if (allna) { d[] <- stats::runif(prod(dim(d))) } } r <- .runModel(model, fun, d, nl, const, na.rm, index, cores=NULL, ...) if (ncell(object) > 1) { rdim <- dim(r) if (is.null(rdim)) { nl <- 1 cn <- "" } else { if (isTRUE(any(rdim == 1))) { nl <- 1 cn <- colnames(r)[1] } else { nl <- ncol(r) cn <- colnames(r) } } } else { nl <- length(r) } levs <- .getFactors(model, fun, d, nl, const, na.rm, index, ...) } out <- rast(object, nlyrs=nl) if (!all(sapply(levs, is.null))) levels(out) <- levs if (length(cn) == nl) names(out) <- make.names(cn, TRUE) out } setMethod("predict", signature(object="SpatRaster"), function(object, model, fun=predict, ..., const=NULL, na.rm=FALSE, index=NULL, cores=1, cpkgs=NULL, filename="", overwrite=FALSE, wopt=list()) { nms <- names(object) if (length(unique(nms)) != length(nms)) { tab <- table(nms) error("predict", "duplicate names in SpatRaster: ", tab[tab>1]) } nc <- ncol(object) #tomat <- FALSE readStart(object) on.exit(readStop(object)) if (!is.null(const)) { const <- data.frame(const)[1,,drop=FALSE] rownames(const) <- NULL } out <- terra:::find_dims(object, model, nc, fun, const, na.rm, index, ...) nl <- nlyr(out) doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } if (doclust) { parallel::clusterExport(cores, c("model", "fun"), environment()) if (!is.null(cpkgs)) { parallel::clusterExport(cores, "cpkgs", environment()) parallel::clusterCall(cores, function() for (i in 1:length(cpkgs)) {library(cpkgs[i], character.only=TRUE) }) } export_args(cores, ..., caller="predict") } else { cores <- NULL } b <- writeStart(out, filename, overwrite, wopt=wopt, n=max(nlyr(out), nlyr(object))*4, sources=sources(object)) for (i in 1:b$n) { d <- readValues(object, b$row[i], b$nrows[i], 1, nc, TRUE, TRUE) r <- .runModel(model, fun, d, nl, const, na.rm, index, cores=cores, ...) if (prod(NROW(r), NCOL(r)) != prod(b$nrows[i], nc, nl)) { msg <- "the number of values returned by 'fun' (model predict function) does not match the input." if (!na.rm) msg <- paste(msg, "Try na.rm=TRUE?") error("predict", msg) } writeValues(out, r, b$row[i], b$nrows[i]) } writeStop(out) # return(out) } ) terra/R/Agenerics.R0000644000176200001440000010352514750557734013642 0ustar liggesusers#if (!isGeneric("#")) { setGeneric("#", function(x, ...) standardGeneric("#")) } #if (!isGeneric("prcomp")) {setGeneric("prcomp", function(x, ...) standardGeneric("princomp"))} ## ADDED BY ecor if (!isGeneric("watershed")) {setGeneric("watershed", function(x, ...) standardGeneric("watershed"))} if (!isGeneric("pitfinder")) {setGeneric("pitfinder", function(x, ...) standardGeneric("pitfinder"))} if (!isGeneric("NIDP")) {setGeneric("NIDP", function(x, ...) standardGeneric("NIDP"))} if (!isGeneric("flowAccumulation")) {setGeneric("flowAccumulation", function(x, ...) standardGeneric("flowAccumulation"))} if (!isGeneric("thresh")) {setGeneric("thresh", function(x, ...) standardGeneric("thresh"))} if (!isGeneric("divide")) {setGeneric("divide", function(x, ...) standardGeneric("divide"))} if (!isGeneric("bestMatch")) {setGeneric("bestMatch", function(x, y, ...) standardGeneric("bestMatch"))} if (!isGeneric("k_means")) {setGeneric("k_means", function(x, ...) standardGeneric("k_means"))} if (!isGeneric("princomp")) {setGeneric("princomp", function(x, ...) standardGeneric("princomp"))} if (!isGeneric("extractRange")) { setGeneric("extractRange", function(x, y, ...) standardGeneric("extractRange"))} if (!isGeneric("getTileExtents")) {setGeneric("getTileExtents", function(x, ...) standardGeneric("getTileExtents"))} if (!isGeneric("layerCor")) {setGeneric("layerCor", function(x, ...) standardGeneric("layerCor"))} if (!isGeneric("metags")) {setGeneric("metags", function(x, ...) standardGeneric("metags"))} if (!isGeneric("metags<-")) {setGeneric("metags<-", function(x, ..., value) standardGeneric("metags<-"))} if (!isGeneric("forceCCW")) {setGeneric("forceCCW", function(x, ...) standardGeneric("forceCCW"))} if (!isGeneric("addCats")) {setGeneric("addCats", function(x, ...) standardGeneric("addCats"))} if (!isGeneric("regress")) {setGeneric("regress", function(y, x, ...) standardGeneric("regress"))} if (!isGeneric("panel")) {setGeneric("panel", function(x, ...) standardGeneric("panel"))} #if (!isGeneric("colSums")) {setGeneric("colSums", function(x, ...) standardGeneric("colSums"))} #if (!isGeneric("rowSums")) {setGeneric("rowSums", function(x, ...) standardGeneric("rowSums"))} #if (!isGeneric("colMeans")) {setGeneric("colMeans", function(x, ...) standardGeneric("colMeans"))} #if (!isGeneric("rowMeans")) {setGeneric("rowMeans", function(x, ...) standardGeneric("rowMeans"))} if (!isGeneric("logic")) {setGeneric("logic", function(x, ...) standardGeneric("logic"))} if (!isGeneric("compare")) {setGeneric("compare", function(x, y, ...) standardGeneric("compare"))} if (!isGeneric("meta")) {setGeneric("meta", function(x, ...) standardGeneric("meta"))} if (!isGeneric("rangeFill")) {setGeneric("rangeFill", function(x, ...) standardGeneric("rangeFill"))} if (!isGeneric("roll")) {setGeneric("roll", function(x, ...) standardGeneric("roll"))} if (!isGeneric("elongate")) {setGeneric("elongate", function(x, ...) standardGeneric("elongate"))} if (!isGeneric("update")) {setGeneric("update", function(object, ...) standardGeneric("update"))} if (!isGeneric("viewshed")) {setGeneric("viewshed", function(x, ...) standardGeneric("viewshed"))} if (!isGeneric("sieve")) {setGeneric("sieve", function(x, ...) standardGeneric("sieve"))} if (!isGeneric("rasterizeWin")) {setGeneric("rasterizeWin", function(x, y, ...) standardGeneric("rasterizeWin"))} if (!isGeneric("interpNear")) {setGeneric("interpNear", function(x, y, ...) standardGeneric("interpNear"))} if (!isGeneric("interpIDW")) {setGeneric("interpIDW", function(x, y, ...) standardGeneric("interpIDW"))} if (!isGeneric("normalize.longitude")) {setGeneric("normalize.longitude", function(x, ...) standardGeneric("normalize.longitude"))} if (!isGeneric("allNA")) {setGeneric("allNA", function(x, ...) standardGeneric("allNA"))} if (!isGeneric("noNA")) {setGeneric("noNA", function(x, ...) standardGeneric("noNA"))} if (!isGeneric("countNA")) {setGeneric("countNA", function(x, ...) standardGeneric("countNA"))} if (!isGeneric("scoff")) {setGeneric("scoff", function(x, ...) standardGeneric("scoff"))} if (!isGeneric("scoff<-")) {setGeneric("scoff<-", function(x, ..., value) standardGeneric("scoff<-"))} if (!isGeneric("blocks")) {setGeneric("blocks", function(x, ...) standardGeneric("blocks"))} if (!isGeneric("droplevels")) {setGeneric("droplevels", function(x, ...) standardGeneric("droplevels"))} if (!isGeneric("str")) { setGeneric("str", function(object, ...) standardGeneric("str"))} if (!isGeneric("plet")) { setGeneric("plet", function(x, ...) standardGeneric("plet"))} if (!isGeneric("combineGeoms")) {setGeneric("combineGeoms", function(x, y, ...) standardGeneric("combineGeoms"))} if (!isGeneric("concats")) {setGeneric("concats", function(x, ...) standardGeneric("concats"))} if (!isGeneric("has.colors")) {setGeneric("has.colors", function(x, ...) standardGeneric("has.colors"))} if (!isGeneric("has.RGB")) {setGeneric("has.RGB", function(x, ...) standardGeneric("has.RGB"))} if (!isGeneric("emptyGeoms")) {setGeneric("emptyGeoms", function(x, ...) standardGeneric("emptyGeoms"))} if (!isGeneric("serialize")) {setGeneric("serialize", function(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) standardGeneric("serialize"))} if (!isGeneric("saveRDS")) {setGeneric("saveRDS", function (object, file="", ascii=FALSE, version=NULL, compress=TRUE, refhook=NULL) standardGeneric("saveRDS"))} if (!isGeneric("query")) {setGeneric("query", function(x, ...) standardGeneric("query"))} if (!isGeneric("set.values")) {setGeneric("set.values", function(x, ...) standardGeneric("set.values"))} if (!isGeneric("set.ext")) {setGeneric("set.ext", function(x, ...) standardGeneric("set.ext"))} if (!isGeneric("set.names")) {setGeneric("set.names", function(x, ...) standardGeneric("set.names"))} if (!isGeneric("set.crs")) {setGeneric("set.crs", function(x, ...) standardGeneric("set.crs"))} if (!isGeneric("set.RGB")) {setGeneric("set.RGB", function(x, ...) standardGeneric("set.RGB"))} if (!isGeneric("set.window")) {setGeneric("set.window", function(x, ...) standardGeneric("set.window"))} if (!isGeneric("math")) { setGeneric("math", function(x, ...) standardGeneric("math")) } if (!isGeneric("all.equal")) { setGeneric("all.equal", function(target, current, ...) standardGeneric("all.equal")) } if (!isGeneric("impose")) { setGeneric("impose", function(x, ...) standardGeneric("impose")) } if (!isGeneric("density")) { setGeneric("density", function(x, ...) standardGeneric("density"))} if (!isGeneric("densify")) { setGeneric("densify", function(x, ...) standardGeneric("densify"))} if (!isGeneric("selectHighest")) {setGeneric("selectHighest", function(x, ...) standardGeneric("selectHighest"))} if (!isGeneric("focal3D")) { setGeneric("focal3D", function(x, ...) standardGeneric("focal3D")) } if (!isGeneric("focalReg")) { setGeneric("focalReg", function(x, ...) standardGeneric("focalReg")) } if (!isGeneric("focalCpp")) { setGeneric("focalCpp", function(x, ...) standardGeneric("focalCpp")) } if (!isGeneric("focalPairs")) { setGeneric("focalPairs", function(x, ...) standardGeneric("focalPairs")) } if (!isGeneric("clearance")) {setGeneric("clearance", function(x, ...) standardGeneric("clearance"))} if (!isGeneric("width")) {setGeneric("width", function(x, ...) standardGeneric("width"))} if (!isGeneric("simplifyGeom")) {setGeneric("simplifyGeom", function(x, ...) standardGeneric("simplifyGeom"))} if (!isGeneric("thinGeom")) {setGeneric("thinGeom", function(x, ...) standardGeneric("thinGeom"))} if (!isGeneric("mergeLines")) {setGeneric("mergeLines", function(x, ...) standardGeneric("mergeLines"))} if (!isGeneric("mergeTime")) {setGeneric("mergeTime", function(x, ...) standardGeneric("mergeTime"))} if (!isGeneric("fillTime")) {setGeneric("fillTime", function(x, ...) standardGeneric("fillTime"))} if (!isGeneric("makeNodes")) {setGeneric("makeNodes", function(x, ...) standardGeneric("makeNodes"))} if (!isGeneric("removeDupNodes")) {setGeneric("removeDupNodes", function(x, ...) standardGeneric("removeDupNodes"))} if (!isGeneric("snap")) {setGeneric("snap", function(x, ...) standardGeneric("snap"))} if (!isGeneric("weighted.mean")) {setGeneric("weighted.mean", function(x, w, ...) standardGeneric("weighted.mean"))} if (!isGeneric("split")) {setGeneric("split", function(x, f, drop = FALSE, ...) standardGeneric("split"))} if (!isGeneric("cellSize")) {setGeneric("cellSize", function(x, ...) standardGeneric("cellSize"))} if (!isGeneric("surfArea")) {setGeneric("surfArea", function(x, ...) standardGeneric("surfArea"))} if (!isGeneric("na.omit")) {setGeneric("na.omit", function(object, ...) standardGeneric("na.omit"))} if (!isGeneric("catalyze")) {setGeneric("catalyze", function(x, ...) standardGeneric("catalyze"))} if (!isGeneric("activeCat")) {setGeneric("activeCat", function(x, ...) standardGeneric("activeCat"))} if (!isGeneric("activeCat<-")) {setGeneric("activeCat<-", function(x, ..., value) standardGeneric("activeCat<-"))} if (!isGeneric("sharedPaths")) {setGeneric("sharedPaths", function(x, ...) standardGeneric("sharedPaths"))} if (!isGeneric("isTRUE")) {setGeneric("isTRUE", function(x) standardGeneric("isTRUE"))} if (!isGeneric("subst")) {setGeneric("subst", function(x, ...) standardGeneric("subst"))} if (!isGeneric("colorize")) {setGeneric("colorize", function(x, ...) standardGeneric("colorize"))} if (!isGeneric("RGB")) {setGeneric("RGB", function(x, ...) standardGeneric("RGB"))} if (!isGeneric("RGB<-")) {setGeneric("RGB<-", function(x, ..., value) standardGeneric("RGB<-"))} if (!isGeneric("autocor")) {setGeneric("autocor", function(x, ...) standardGeneric("autocor"))} if (!isGeneric("delaunay")) {setGeneric("delaunay", function(x, ...) standardGeneric("delaunay"))} if (!isGeneric("voronoi")) {setGeneric("voronoi", function(x, ...) standardGeneric("voronoi"))} if (!isGeneric("hull")) {setGeneric("hull", function(x, ...) standardGeneric("hull"))} if (!isGeneric("convHull")) {setGeneric("convHull", function(x, ...) standardGeneric("convHull"))} if (!isGeneric("minRect")) {setGeneric("minRect", function(x, ...) standardGeneric("minRect"))} if (!isGeneric("minCircle")) {setGeneric("minCircle", function(x, ...) standardGeneric("minCircle"))} #if (!isGeneric("which.related")) {setGeneric("which.related", function(x, y, ...) standardGeneric("which.related"))} if (!isGeneric("is.related")) {setGeneric("is.related", function(x, y, ...) standardGeneric("is.related"))} if (!isGeneric("relate")) {setGeneric("relate", function(x, y, ...) standardGeneric("relate"))} if (!isGeneric("intersect")) {setGeneric("intersect", function(x, y) standardGeneric("intersect"))} if (!isGeneric("not.na")) {setGeneric("not.na", function(x, ...) standardGeneric("not.na"))} if (!isGeneric("erase")) {setGeneric("erase", function(x, y, ...) standardGeneric("erase"))} if (!isGeneric("gaps")) {setGeneric("gaps", function(x, ...) standardGeneric("gaps"))} if (!isGeneric("is.rotated")) {setGeneric("is.rotated", function(x, ...) standardGeneric("is.rotated"))} if (!isGeneric("is.flipped")) {setGeneric("is.flipped", function(x, ...) standardGeneric("is.flipped"))} if (!isGeneric("is.int")) {setGeneric("is.int", function(x) standardGeneric("is.int"))} if (!isGeneric("as.int")) {setGeneric("as.int", function(x, ...) standardGeneric("as.int"))} if (!isGeneric("is.bool")) {setGeneric("is.bool", function(x) standardGeneric("is.bool"))} if (!isGeneric("as.bool")) {setGeneric("as.bool", function(x, ...) standardGeneric("as.bool"))} if (!isGeneric("nearby")) {setGeneric("nearby", function(x, ...) standardGeneric("nearby"))} if (!isGeneric("nearest")) {setGeneric("nearest", function(x, ...) standardGeneric("nearest"))} if (!isGeneric("cartogram")) {setGeneric("cartogram", function(x, ...) standardGeneric("cartogram"))} if (!isGeneric("dots")) {setGeneric("dots", function(x, ...) standardGeneric("dots"))} if (!isGeneric("crds")) {setGeneric("crds", function(x, ...) standardGeneric("crds"))} if (!isGeneric("symdif")) {setGeneric("symdif", function(x, y, ...) standardGeneric("symdif"))} if (!isGeneric("median")) {setGeneric("median", function(x, na.rm) standardGeneric("median"))} if (!isGeneric("polys")) {setGeneric("polys", function(x,...) standardGeneric("polys"))} if (!isGeneric("centroids")) {setGeneric("centroids", function(x, ...) standardGeneric("centroids"))} if (!isGeneric("coltab")) {setGeneric("coltab", function(x, ...) standardGeneric("coltab"))} if (!isGeneric("coltab<-")) { setGeneric("coltab<-", function(x, ..., value) standardGeneric("coltab<-")) } if (!isGeneric("deepcopy")) { setGeneric("deepcopy", function(x, ...) standardGeneric("deepcopy")) } if (!isGeneric("window")) {setGeneric("window", function(x, ...) standardGeneric("window"))} if (!isGeneric("window<-")) {setGeneric("window<-", function(x, ..., value) standardGeneric("window<-"))} if (!isGeneric("NAflag")) {setGeneric("NAflag", function(x, ...) standardGeneric("NAflag"))} if (!isGeneric("NAflag<-")) {setGeneric("NAflag<-", function(x, ..., value) standardGeneric("NAflag<-"))} if (!isGeneric("app")) { setGeneric("app", function(x, ...) standardGeneric("app"))} if (!isGeneric("lapp")) { setGeneric("lapp", function(x, ...) standardGeneric("lapp"))} if (!isGeneric("rapp")) { setGeneric("rapp", function(x, ...) standardGeneric("rapp"))} if (!isGeneric("tapp")) { setGeneric("tapp", function(x, ...) standardGeneric("tapp"))} if (!isGeneric("sapp")) { setGeneric("sapp", function(x, ...) standardGeneric("sapp"))} if (!isGeneric("xpp")) { setGeneric("xapp", function(x, y, ...) standardGeneric("xapp"))} if (!isGeneric("add<-")) {setGeneric("add<-", function(x, value) standardGeneric("add<-"))} if (!isGeneric("align")) { setGeneric("align", function(x, y, ...) standardGeneric("align"))} if (!isGeneric("as.contour")) {setGeneric("as.contour", function(x,...) standardGeneric("as.contour"))} if (!isGeneric("as.lines")) {setGeneric("as.lines", function(x,...) standardGeneric("as.lines"))} if (!isGeneric("as.points")) {setGeneric("as.points", function(x,...) standardGeneric("as.points"))} if (!isGeneric("as.polygons")) {setGeneric("as.polygons", function(x,...) standardGeneric("as.polygons"))} if (!isGeneric("classify")) { setGeneric("classify", function(x, ...) standardGeneric("classify")) } if (!isGeneric("cells")) { setGeneric("cells", function(x, y, ...) standardGeneric("cells")) } if (!isGeneric("tighten")) {setGeneric("tighten", function(x, ...) standardGeneric("tighten"))} if (!isGeneric("compareGeom")) {setGeneric("compareGeom", function(x,y,...) standardGeneric("compareGeom"))} if (!isGeneric("crosstab")) { setGeneric("crosstab", function(x, y, ...) standardGeneric("crosstab")) } if (!isGeneric("describe")) { setGeneric("describe", function(x, ...) standardGeneric("describe"))} if (!isGeneric("depth")) {setGeneric("depth", function(x,...) standardGeneric("depth"))} if (!isGeneric("depth<-")) {setGeneric("depth<-", function(x, value) standardGeneric("depth<-"))} if (!isGeneric("draw")) {setGeneric("draw", function(x,...) standardGeneric("draw"))} if (!isGeneric("ext")) { setGeneric("ext", function(x, ...) standardGeneric("ext"))} if (!isGeneric("ext<-")) { setGeneric("ext<-", function(x, value) standardGeneric("ext<-")) } if (!isGeneric("fillHoles") ) { setGeneric("fillHoles", function(x, ...) standardGeneric("fillHoles")) } if (!isGeneric("geomtype")) {setGeneric("geomtype", function(x, ...) standardGeneric("geomtype"))} if (!isGeneric("datatype")) {setGeneric("datatype", function(x, ...) standardGeneric("datatype"))} if (!isGeneric("global")) {setGeneric("global", function(x, ...) standardGeneric("global"))} if (!isGeneric("makeValid")) {setGeneric("makeValid", function(x,...) standardGeneric("makeValid"))} if (!isGeneric("is.valid")) {setGeneric("is.valid", function(x,...) standardGeneric("is.valid"))} if (!isGeneric("is.empty")) {setGeneric("is.empty", function(x,...) standardGeneric("is.empty"))} if (!isGeneric("is.points")) {setGeneric("is.points", function(x,...) standardGeneric("is.points"))} if (!isGeneric("is.lines")) {setGeneric("is.lines", function(x,...) standardGeneric("is.lines"))} if (!isGeneric("is.polygons")) {setGeneric("is.polygons", function(x,...) standardGeneric("is.polygons"))} if (!isGeneric("makeTiles")) {setGeneric("makeTiles", function(x,...) standardGeneric("makeTiles"))} if (!isGeneric("vrt")) {setGeneric("vrt", function(x,...) standardGeneric("vrt"))} if (!isGeneric("isTRUE")) { setGeneric("isTRUE", function(x) standardGeneric("isTRUE"))} if (!isGeneric("isFALSE")) { setGeneric("isFALSE", function(x) standardGeneric("isFALSE"))} if (!isGeneric("varnames")) {setGeneric("varnames", function(x,...) standardGeneric("varnames"))} if (!isGeneric("varnames<-")) {setGeneric("varnames<-", function(x, value) standardGeneric("varnames<-"))} if (!isGeneric("log")) {setGeneric("log", function(x,...) standardGeneric("log"))} if (!isGeneric("longnames")) {setGeneric("longnames", function(x,...) standardGeneric("longnames"))} if (!isGeneric("longnames<-")) {setGeneric("longnames<-", function(x, value) standardGeneric("longnames<-"))} if (!isGeneric("hasMinMax")) {setGeneric("hasMinMax", function(x) standardGeneric("hasMinMax"))} if (!isGeneric("minmax")) {setGeneric("minmax", function(x, ...) standardGeneric("minmax"))} if (!isGeneric("nsrc")) { setGeneric("nsrc", function(x) standardGeneric("nsrc")) } if (!isGeneric("perim")) {setGeneric("perim", function(x, ...) standardGeneric("perim"))} if (!isGeneric("nseg")) {setGeneric("nseg", function(x, ...) standardGeneric("nseg"))} if (!isGeneric("project")) {setGeneric("project", function(x,...) standardGeneric("project"))} if (!isGeneric("wrapCache")) {setGeneric("wrapCache", function(x, ...) standardGeneric("wrapCache"))} if (!isGeneric("wrap")) {setGeneric("wrap", function(x, ...) standardGeneric("wrap"))} if (!isGeneric("unwrap")) {setGeneric("unwrap", function(x, ...) standardGeneric("unwrap"))} if (!isGeneric("cats")) { setGeneric("cats", function(x, ...) standardGeneric("cats")) } if (!isGeneric("categories")) { setGeneric("categories", function(x, ...) standardGeneric("categories")) } if (!isGeneric("set.cats")) { setGeneric("set.cats", function(x, ...) standardGeneric("set.cats")) } if (!isGeneric("as.raster")) { setGeneric("as.raster", function(x, ...) standardGeneric("as.raster"))} if (!isGeneric("rast") ) { setGeneric("rast", function(x, ...) standardGeneric("rast")) } if (!isGeneric("rev") ) { setGeneric("rev", function(x) standardGeneric("rev")) } if (!isGeneric("sds") ) { setGeneric("sds", function(x, ...) standardGeneric("sds")) } if (!isGeneric("sprc") ) { setGeneric("sprc", function(x, ...) standardGeneric("sprc")) } if (!isGeneric("svc") ) { setGeneric("svc", function(x, ...) standardGeneric("svc")) } if (!isGeneric("sel")) {setGeneric("sel", function(x, ...) standardGeneric("sel"))} if (!isGeneric("segregate")) {setGeneric("segregate", function(x, ...) standardGeneric("segregate"))} if (!isGeneric("selectRange")) {setGeneric("selectRange", function(x, ...) standardGeneric("selectRange"))} if (!isGeneric("setValues")) {setGeneric("setValues", function(x, values, ...) standardGeneric("setValues"))} if (!isGeneric("expanse")) {setGeneric("expanse", function(x, ...) standardGeneric("expanse"))} if (!isGeneric("size")) {setGeneric("size", function(x, ...) standardGeneric("size"))} if (!isGeneric("inMemory")) {setGeneric("inMemory", function(x, ...) standardGeneric("inMemory"))} if (!isGeneric("sources")) {setGeneric("sources", function(x, ...) standardGeneric("sources"))} if (!isGeneric("spatSample")) { setGeneric("spatSample", function(x, ...) standardGeneric("spatSample"))} if (!isGeneric("terrain")) {setGeneric("terrain", function(x, ...) standardGeneric("terrain"))} if (!isGeneric("has.time")) {setGeneric("has.time", function(x,...) standardGeneric("has.time"))} if (!isGeneric("time")) {setGeneric("time", function(x,...) standardGeneric("time"))} if (!isGeneric("time<-")) {setGeneric("time<-", function(x, ..., value) standardGeneric("time<-"))} if (!isGeneric("timeInfo")) {setGeneric("timeInfo", function(x,...) standardGeneric("timeInfo"))} if (!isGeneric("nlyr")) { setGeneric("nlyr", function(x) standardGeneric("nlyr")) } if (!isGeneric("nlyr<-")) { setGeneric("nlyr<-", function(x, ..., value) standardGeneric("nlyr<-")) } if (!isGeneric("linearUnits")) {setGeneric("linearUnits", function(x, ...) standardGeneric("linearUnits"))} if (!isGeneric("units")) {setGeneric("units", function(x) standardGeneric("units"))} if (!isGeneric("units<-")) {setGeneric("units<-", function(x,value) standardGeneric("units<-"))} if (!isGeneric("vect") ) { setGeneric("vect", function(x, ...) standardGeneric("vect")) } if (!isGeneric("writeCDF")) {setGeneric("writeCDF", function(x, filename, ...) standardGeneric("writeCDF"))} if (!isGeneric("writeVector")) {setGeneric("writeVector", function(x, filename, ...) standardGeneric("writeVector"))} ## shared with "raster" if (!isGeneric("%in%")) { setGeneric("%in%", function(x, table) standardGeneric("%in%")) } if (!isGeneric("adjacent")) {setGeneric("adjacent", function(x, ...) standardGeneric("adjacent"))} if (!isGeneric("animate")) { setGeneric("animate", function(x, ...) standardGeneric("animate")) } if (!isGeneric("approximate")) {setGeneric("approximate", function(x, ...) standardGeneric("approximate"))} if (!isGeneric("as.data.frame")) { setGeneric("as.data.frame", function(x, row.names = NULL, optional = FALSE, ...) standardGeneric("as.data.frame")) } if (!isGeneric("as.list")) { setGeneric("as.list", function(x, ...) standardGeneric("as.list"))} if (!isGeneric("as.factor")) {setGeneric("as.factor", function(x) standardGeneric("as.factor"))} if (!isGeneric("atan2")) { setGeneric("atan2", function(y, x) standardGeneric("atan2"))} if (!isGeneric("atan_2")) { setGeneric("atan_2", function(y, x, ...) standardGeneric("atan_2"))} if (!isGeneric("barplot")) {setGeneric("barplot", function(height,...) standardGeneric("barplot"))} #if (!isGeneric("bndbox")) {setGeneric("bndbox", function(obj) standardGeneric("bndbox"))} if (!isGeneric("boundaries")) { setGeneric("boundaries", function(x, ...) standardGeneric("boundaries"))} if (!isGeneric("boxplot")) { setGeneric("boxplot", function(x, ...) standardGeneric("boxplot"))} if (!isGeneric("buffer")) {setGeneric("buffer", function(x, ...) standardGeneric("buffer"))} if (!isGeneric("clamp")) { setGeneric("clamp", function(x, ...) standardGeneric("clamp")) } if (!isGeneric("clamp_ts")) { setGeneric("clamp_ts", function(x, ...) standardGeneric("clamp_ts")) } if (!isGeneric("click")) {setGeneric("click", function(x, ...)standardGeneric("click"))} if (!isGeneric("contour")) { setGeneric("contour", function(x,...) standardGeneric("contour"))} if (!isGeneric("cover")) {setGeneric("cover", function(x, y, ...) standardGeneric("cover"))} if (!isGeneric("crop")) { setGeneric("crop", function(x, y, ...) standardGeneric("crop")) } if (!isGeneric("crs")) { setGeneric("crs", function(x, ...) standardGeneric("crs")) } if (!isGeneric("crs<-")) { setGeneric("crs<-", function(x, ..., value) standardGeneric("crs<-")) } if (!isGeneric("density")) { setGeneric("density", function(x, ...) standardGeneric("density"))} if (!isGeneric("aggregate")) {setGeneric("aggregate", function(x, ...) standardGeneric("aggregate"))} if (!isGeneric("disagg")) {setGeneric("disagg", function(x, ...) standardGeneric("disagg"))} if (!isGeneric("costDist")) {setGeneric("costDist", function(x, ...)standardGeneric("costDist"))} if (!isGeneric("gridDist")) {setGeneric("gridDist", function(x, ...)standardGeneric("gridDist"))} if (!isGeneric("distance")) {setGeneric("distance", function(x, y, ...)standardGeneric("distance"))} if (!isGeneric("direction")) {setGeneric("direction", function(x, ...)standardGeneric("direction"))} if (!isGeneric("extract")) { setGeneric("extract", function(x, y, ...) standardGeneric("extract"))} if (!isGeneric("extend")) {setGeneric("extend", function(x, y, ...) standardGeneric("extend"))} if (!isGeneric("flip")) {setGeneric("flip", function(x, ...) standardGeneric("flip")) } if (!isGeneric("focal")) { setGeneric("focal", function(x, ...) standardGeneric("focal")) } if (!isGeneric("focalValues")) { setGeneric("focalValues", function(x, ...) standardGeneric("focalValues")) } if (!isGeneric("freq")) { setGeneric("freq", function(x, ...) standardGeneric("freq")) } if (!isGeneric("geom")) { setGeneric("geom", function(x,...) standardGeneric("geom"))} if (!isGeneric("hasValues")) {setGeneric("hasValues", function(x, ...) standardGeneric("hasValues")) } if (!isGeneric("head")) { setGeneric("head", function(x, ...) standardGeneric("head"))} if (!isGeneric("ifel")) {setGeneric("ifel", function(test, ...) standardGeneric("ifel"))} if (!isGeneric("image")) {setGeneric("image", function(x, ...)standardGeneric("image"))} if (!isGeneric("init")) {setGeneric("init", function(x, ...) standardGeneric("init"))} if (!isGeneric("inset")) {setGeneric("inset", function(x, ...) standardGeneric("inset"))} if (!isGeneric("inext")) {setGeneric("inext", function(x, ...) standardGeneric("inext"))} if (!isGeneric("interpolate")) { setGeneric("interpolate", function(object, ...) standardGeneric("interpolate"))} if (!isGeneric("is.factor")) {setGeneric("is.factor", function(x) standardGeneric("is.factor"))} if (!isGeneric("is.lonlat")) { setGeneric("is.lonlat", function(x, ...) standardGeneric("is.lonlat"))} if (!isGeneric("mask")) { setGeneric("mask", function(x, mask, ...) standardGeneric("mask")) } if (!isGeneric("match")) { setGeneric("match", function(x, table, nomatch=NA_integer_, incomparables=NULL) standardGeneric("match"))} if (!isGeneric("modal")) {setGeneric("modal", function(x, ...) standardGeneric("modal"))} if (!isGeneric("mosaic")) {setGeneric("mosaic", function(x, y, ...) standardGeneric("mosaic"))} if (!isGeneric("ncell")) { setGeneric("ncell", function(x) standardGeneric("ncell")) } if (!isGeneric("nrow")) { setGeneric("nrow", function(x) standardGeneric("nrow")) } if (!isGeneric("ncol")) { setGeneric("nrow", function(x) standardGeneric("nrow")) } if (!isGeneric("ncol<-")) { setGeneric("ncol<-", function(x, ..., value) standardGeneric("ncol<-")) } if (!isGeneric("nrow<-")) { setGeneric("nrow<-", function(x, ..., value) standardGeneric("nrow<-")) } if (!isGeneric("origin")) { setGeneric("origin", function(x, ...) standardGeneric("origin")) } if (!isGeneric("origin<-")) {setGeneric("origin<-", function(x, value) standardGeneric("origin<-"))} if (!isGeneric("pairs")) { setGeneric("pairs", function(x, ...) standardGeneric("pairs"))} if (!isGeneric("patches")) {setGeneric("patches", function(x, ...) standardGeneric("patches"))} if (!isGeneric("persp")) { setGeneric("persp", function(x,...) standardGeneric("persp")) } if (!isGeneric("plot")) { setGeneric("plot", function(x, y,...) standardGeneric("plot"))} if (!isGeneric("plotRGB")) { setGeneric("plotRGB", function(x, ...)standardGeneric("plotRGB"))} if (!isGeneric("predict")) {setGeneric("predict", function(object, ...) standardGeneric("predict"))} if (!isGeneric("quantile")) {setGeneric("quantile", function(x, ...)standardGeneric("quantile"))} if (!isGeneric("rasterize")) {setGeneric("rasterize", function(x, y, ...) standardGeneric("rasterize"))} if (!isGeneric("rasterizeGeom")) {setGeneric("rasterizeGeom", function(x, y, ...) standardGeneric("rasterizeGeom"))} if (!isGeneric("readStart")) {setGeneric("readStart", function(x, ...) standardGeneric("readStart"))} if (!isGeneric("readStop")) {setGeneric("readStop", function(x) standardGeneric("readStop"))} if (!isGeneric("toMemory")) {setGeneric("toMemory", function(x, ...) standardGeneric("toMemory"))} if (!isGeneric("res")) { setGeneric("res", function(x) standardGeneric("res")) } if (!isGeneric("res<-")) { setGeneric("res<-", function(x, value) standardGeneric("res<-")) } if (!isGeneric("rectify")) {setGeneric("rectify", function(x, ...) standardGeneric("rectify"))} if (!isGeneric("resample")) { setGeneric("resample", function(x, y, ...) standardGeneric("resample"))} if (!isGeneric("spin")) {setGeneric("spin", function(x, ...) standardGeneric("spin"))} if (!isGeneric("rotate")) {setGeneric("rotate", function(x, ...) standardGeneric("rotate"))} if (!isGeneric("rescale")) {setGeneric("rescale", function(x, ...) standardGeneric("rescale"))} #if (!isGeneric("select")) {setGeneric("select", function(x, ...) standardGeneric("select"))} if (!isGeneric("setMinMax")) {setGeneric("setMinMax", function(x, ...) standardGeneric("setMinMax"))} if (!isGeneric("scale")) {setGeneric("scale", function(x, center=TRUE, scale=TRUE) standardGeneric("scale"))} if (!isGeneric("scale_linear")) { setGeneric("scale_linear", function(x, ...) standardGeneric("scale_linear"))} if (!isGeneric("shift")) {setGeneric("shift", function(x, ...) standardGeneric("shift"))} if (!isGeneric("stdev")) { setGeneric("stdev", function(x, ...) standardGeneric("stdev")) } if (!isGeneric("subset")) {setGeneric("subset", function(x, ...) standardGeneric("subset")) } if (!isGeneric("summary")) {setGeneric("summary", function(object, ...) standardGeneric("summary")) } if (!isGeneric("t")) { setGeneric("t", function(x) standardGeneric("t"))} if (!isGeneric("tail")) { setGeneric("tail", function(x, ...) standardGeneric("tail"))} if (!isGeneric("text")) { setGeneric("text", function(x, ...) standardGeneric("text")) } if (!isGeneric("trans")) { setGeneric("trans", function(x, ...) standardGeneric("trans"))} if (!isGeneric("trim")) { setGeneric("trim", function(x, ...) standardGeneric("trim")) } if (!isGeneric("xres")) { setGeneric("xres", function(x) standardGeneric("xres")) } if (!isGeneric("yres")) { setGeneric("yres", function(x) standardGeneric("yres")) } if (!isGeneric("zonal")) {setGeneric("zonal", function(x, z, ...) standardGeneric("zonal"))} if (!isGeneric("rcl")) { setGeneric("rcl", function(x, ...) standardGeneric("rcl")) } if (!isGeneric("yFromRow")) { setGeneric("yFromRow", function(object, row) standardGeneric("yFromRow")) } if (!isGeneric("xFromCol")) { setGeneric("xFromCol", function(object, col) standardGeneric("xFromCol")) } if (!isGeneric("colFromX")) { setGeneric("colFromX", function(object, x) standardGeneric("colFromX")) } if (!isGeneric("rowFromY")) { setGeneric("rowFromY", function(object, y) standardGeneric("rowFromY")) } if (!isGeneric("cellFromXY")) { setGeneric("cellFromXY", function(object, xy) standardGeneric("cellFromXY")) } if (!isGeneric("cellFromRowCol")) { setGeneric("cellFromRowCol", function(object, row, col, ...) standardGeneric("cellFromRowCol")) } if (!isGeneric("rowColCombine")) { setGeneric("rowColCombine", function(object, row, col, ...) standardGeneric("rowColCombine")) } if (!isGeneric("cellFromRowColCombine")) { setGeneric("cellFromRowColCombine", function(object, row, col, ...) standardGeneric("cellFromRowColCombine")) } if (!isGeneric("xyFromCell")) { setGeneric("xyFromCell", function(object, cell, ...) standardGeneric("xyFromCell")) } if (!isGeneric("yFromCell")) { setGeneric("yFromCell", function(object, cell) standardGeneric("yFromCell")) } if (!isGeneric("xFromCell")) { setGeneric("xFromCell", function(object, cell) standardGeneric("xFromCell")) } if (!isGeneric("rowColFromCell")) { setGeneric("rowColFromCell", function(object, cell) standardGeneric("rowColFromCell")) } if (!isGeneric("rowFromCell")) { setGeneric("rowFromCell", function(object, cell) standardGeneric("rowFromCell")) } if (!isGeneric("colFromCell")) { setGeneric("colFromCell", function(object, cell) standardGeneric("colFromCell")) } if (!isGeneric("readStart")) { setGeneric("readStart", function(x, ...) standardGeneric("readStart")) } if (!isGeneric("readValues")) { setGeneric("readValues", function(x, ...) standardGeneric("readValues")) } if (!isGeneric("readStop")) { setGeneric("readStop", function(x, ...) standardGeneric("readStop")) } if (!isGeneric("setMinMax")) {setGeneric("setMinMax", function(x, ...) standardGeneric("setMinMax")) } if (!isGeneric("stretch")) {setGeneric("stretch", function(x, ...) standardGeneric("stretch")) } if (!isGeneric("union")) {setGeneric("union", function(x, y)standardGeneric("union"))} if (!isGeneric("unique")) { setGeneric("unique", function(x, incomparables=FALSE, ...) standardGeneric("unique")) } if (!isGeneric("values")) { setGeneric("values", function(x, ...) standardGeneric("values")) } if (!isGeneric("values<-")) { setGeneric("values<-", function(x, value) standardGeneric("values<-"))} if (!isGeneric("where.max")) {setGeneric("where.max", function(x, ...) standardGeneric("where.max"))} if (!isGeneric("where.min")) {setGeneric("where.min", function(x, ...) standardGeneric("where.min"))} if (!isGeneric("which.max")) {setGeneric("which.max", function(x) standardGeneric("which.max"))} if (!isGeneric("which.min")) {setGeneric("which.min", function(x) standardGeneric("which.min"))} if (!isGeneric("which.lyr")) {setGeneric("which.lyr", function(x) standardGeneric("which.lyr"))} if (!isGeneric("writeStart")) { setGeneric("writeStart", function(x, filename, ...) standardGeneric("writeStart")) } if (!isGeneric("writeStop")) { setGeneric("writeStop", function(x, ...) standardGeneric("writeStop")) } if (!isGeneric("writeValues")) { setGeneric("writeValues", function(x, v, ...) standardGeneric("writeValues")) } if (!isGeneric("writeRaster")) {setGeneric("writeRaster", function(x, filename, ...) standardGeneric("writeRaster"))} if (!isGeneric("xmin")) {setGeneric("xmin", function(x) standardGeneric("xmin"))} if (!isGeneric("xmax")) {setGeneric("xmax", function(x) standardGeneric("xmax"))} if (!isGeneric("ymin")) {setGeneric("ymin", function(x) standardGeneric("ymin"))} if (!isGeneric("ymax")) {setGeneric("ymax", function(x) standardGeneric("ymax"))} if (!isGeneric("xmin<-")) { setGeneric("xmin<-", function(x, ..., value) standardGeneric("xmin<-"))} if (!isGeneric("xmax<-")) { setGeneric("xmax<-", function(x, ..., value) standardGeneric("xmax<-"))} if (!isGeneric("ymin<-")) { setGeneric("ymin<-", function(x, ..., value) standardGeneric("ymin<-"))} if (!isGeneric("ymax<-")) { setGeneric("ymax<-", function(x, ..., value) standardGeneric("ymax<-"))} if (!isGeneric("zoom")) {setGeneric("zoom", function(x, ...)standardGeneric("zoom"))} terra/R/autocor.R0000644000176200001440000001321214731053441013370 0ustar liggesusers# Author: Robert J. Hijmans # Date : April 2011 / Jan 2021 # Version 1.0 # License GPL v3 .checkngb <- function(ngb, mustBeOdd=FALSE) { ngb <- as.integer(round(ngb)) if (length(ngb) == 1) { ngb <- c(ngb, ngb) } else if (length(ngb) > 2) { error("autocor", "ngb should be a single value or two values") } if (min(ngb) < 1) { stop("ngb should be larger than 1") } if (mustBeOdd) { if (any(ngb %% 2 == 0)) { error("autocor", "neighborhood size must be an odd number") } } return(ngb) } .getFilter <- function(w, warn=TRUE) { if (!is.matrix(w)) { w <- .checkngb(w) w <- matrix(1, nrow=w[1], ncol=(w[2])) w[ceiling(dim(w)[1]/2), ceiling(dim(w)[2]/2)] <- 0 } else { if (w[ceiling(dim(w)[1]/2), ceiling(dim(w)[2]/2)] != 0) { if (warn) { warning('central cell of weights matrix (filter) was set to zero') } w[ceiling(dim(w)[1]/2), ceiling(dim(w)[2]/2)] <- 0 } stopifnot(all(w >= 0)) } if (min(dim(w) %% 2)==0) { stop('dimensions of weights matrix (filter) must be uneven') } w } setMethod("autocor", signature(x="numeric"), function(x, w, method="moran") { method <- match.arg(tolower(method), c("moran", "geary", "gi", "gi*", "mean", "locmor")) if (all(is.na(x))) { error("autocor", "all values are NA") } if (any(is.na(w))) { error("autocor", "NA value(s) in the weight matrix") } d <- dim(w) n <- length(x) if ((d[1] != d[2]) || (d[1] != n)) { error("autocor", "w must be a square matrix with sides the size of x") } if (method %in% c("moran", "geary", "locmor", "gi")) { if (any(as.numeric(diag(w)) != 0)) { warn("autocor", paste("it is unexpected that a weight matrix for", method, "has diagonal values that are not zero")) } } else if (method %in% c("gi*")) { if (any(as.numeric(diag(w)) == 0)) { warn("autocor", paste("it is unexpected that a weight matrix for", method, "has diagonal values that are zero")) } } if (method == "moran") { dx <- x - mean(x, na.rm=TRUE) pm <- matrix(rep(dx, each=n) * dx, ncol=n) (n / sum(dx^2)) * sum(pm * w) / sum(w) } else if (method == "geary") { # geary dx <- x - mean(x, na.rm=TRUE) pm <- matrix(rep(dx, each=n) - dx, ncol=n)^2 ((n-1)/sum((dx)^2)) * sum(w * pm) / (2 * sum(w)) } else if (method == "gi") { if (any(as.numeric(diag(w)) != 0)) { warn("autocor", "it is unexpected that a weight matrix for Gi has diagonal values that are not zero") } diag(w) <- 0 sumxminx <- sum(x, na.rm=TRUE) - x Gi <- colSums(x * w) / sumxminx Ei <- rowSums(w) / (n-1) # variance following spdep::localG xibar <- sumxminx/(n - 1) si2 <- (sum(x^2) - x^2)/(n - 1) - xibar^2 VG <- si2 * (((n - 1) * rowSums(w^2) - rowSums(w)^2)/(n - 2)) VG <- VG/((sumxminx)^2) (Gi-Ei)/sqrt(VG) } else if (method == "gi*") { if (any(as.numeric(diag(w)) == 0)) { warn("autocor", "it is unexpected that a weight matrix for Gi* has diagonal values that are zero") } Gi <- colSums(x * w) / sum(x) Ei <- rowSums(w) / n # variance following spdep::localG si2 <- sum(scale(x, scale = FALSE)^2)/n VG <- (si2 * ((n * rowSums(w^2) - rowSums(w)^2)/(n - 1))) / (sum(x)^2) (Gi-Ei)/sqrt(VG) } else if (method == "locmor") { if (any(as.numeric(diag(w)) != 0)) { warn("autocor", "it is unexpected that a weight matrix for local Moran has diagonal values that are not zero") } z <- x - mean(x, na.rm=TRUE) mp <- z / ( (sum(z^2, na.rm=TRUE) / length(x)) ) mp * apply(w, 1, function(i) { sum(z * i, na.rm=TRUE) } ) } else if (method == "mean") { j <- is.na(x) x[j] <- 0 w[j,j] <- 0 m <- apply(w, 1, function(i) { sum(x * i) / sum(i)} ) m[j] <- NA m } } ) setMethod("autocor", signature(x="SpatRaster"), function(x, w=matrix(c(1,1,1,1,0,1,1,1,1),3), method="moran", global=TRUE) { method <- match.arg(tolower(method), c("moran", "geary")) if (nlyr(x) > 1) { warn("autocor", "only the first layer of x is used") x <- x[[1]] } if (global) { if (method == "moran") { z <- x - unlist(global(x, "mean", na.rm=TRUE)) wZiZj <- focal(z, w=w, fun="sum", na.rm=TRUE) wZiZj <- wZiZj * z wZiZj <- unlist(global(wZiZj, "sum", na.rm=TRUE)) z2 <- unlist(global(z*z, "sum", na.rm=TRUE)) n <- ncell(z) - unlist(global(z, "isNA")) zz <- ifel(is.na(x), NA, 1) W <- focal( zz, w=w, fun="sum", na.rm = TRUE, na.policy="omit") NS0 <- n / unlist(global(W, "sum", na.rm=TRUE)) m <- NS0 * wZiZj / z2 names(m) <- names(x) m } else { # geary w <- .getFilter(w, warn=FALSE) i <- trunc(length(w)/2)+1 n <- ncell(x) - unlist(global(x, "isNA")) fun <- function(x,...) sum((x-x[i])^2, ...) f <- focal(x, w=dim(w), fun=fun, na.rm=TRUE) Eij <- unlist(global(f, "sum", na.rm=TRUE)) xx <- ifel(is.na(x), NA ,1) W <- focal(xx, w=w, na.rm=TRUE ) z <- 2 * unlist(global(W, "sum", na.rm=TRUE)) * unlist(global((x - unlist(global(x, "mean", na.rm=TRUE)))^2, "sum", na.rm=TRUE)) g <- (n-1)*Eij/z names(g) <- names(x) g } } else { # local if (method == "moran") { z <- x - unlist(global(x, "mean", na.rm=TRUE)) zz <- ifel(is.na(x), NA, 1) W <- focal(zz, w=w, na.rm=TRUE) lz <- focal(z, w=w, na.rm=TRUE) / W ##n <- ncell(x) - unlist(global(is.na(x), "sum")) s2 <- unlist(global(x, "sd", na.rm=TRUE)^2) m <- (z / s2) * lz names(m) <- names(x) m } else { w <- .getFilter(w) i <- trunc(length(w)/2)+1 fun <- function(x,...) sum((x-x[i])^2, ...) Eij <- focal(x, w=dim(w), fun=fun, na.rm=TRUE) s2 <- unlist(global(x, "sd", na.rm=TRUE))^2 ##n <- ncell(x) - unlist(global(is.na(x), "sum")) g <- Eij / s2 names(g) <- names(x) g } } } ) terra/R/Zdeprecated.R0000644000176200001440000000412114744562717014164 0ustar liggesusers if (!isGeneric("area")) {setGeneric("area", function(x, ...) standardGeneric("area"))} setMethod ("area", "SpatRaster", function (x, ...) { error("area", "this method was removed. Use 'expanse' or 'cellSize'") } ) if (!isGeneric("area")) {setGeneric("area", function(x, ...) standardGeneric("area"))} setMethod ("area", "SpatVector", function (x, ...) { error("area", "this method was removed. Use 'expanse'") } ) if (!isGeneric("gridDistance")) {setGeneric("gridDistance", function(x, ...) standardGeneric("gridDistance"))} setMethod("gridDistance", signature(x="SpatRaster"), function(x, ...) { error("gridDistance", "'terra::gridDistance' was renamed to 'gridDist'") } ) setMethod("convHull", signature(x="SpatVector"), function(x, by="") { # warn("convHull", "method is deprecated, please use 'hull(type='convex')'") hull(x, type="convex", by=by) } ) setMethod("minCircle", signature(x="SpatVector"), function(x, by="") { # warn("minCircle", "method is deprecated, please use 'hull(type='circle')'") hull(x, "circle", by) } ) setMethod("minRect", signature(x="SpatVector"), function(x, by="") { # warn("minRect", "method is deprecated, please use 'hull(type='circle')'") hull(x, "rectangle", by) } ) #if (!isGeneric("setCats")) { setGeneric("setCats", function(x, ...) standardGeneric("setCats")) } #setMethod ("setCats" , "SpatRaster", # function (x, ...) { # warn("setCats", "this function will be removed. Please can use 'levels<-' or 'set.cats' instead") # set.cats(x, ...) # } #) #setMethod("costDistance", signature(x="SpatRaster"), # function(x, target=0, scale=1, maxiter=50, filename="", ...) { # warn("costDistance", "'costDistance' was renamed to 'costDist'. 'costDistance' will be removed in a #future version") # costDist(x, target=target, scale=scale, maxiter=maxiter, filename=filename, ...) # } #) #if (!isGeneric("focalCor")) { setGeneric("focalCor", function(x, ...) standardGeneric("focalCor")) } #setMethod("focalCor", signature(x="SpatRaster"), # function(x, ...) { # error("focalCor", "'focalCor' was renamed to 'focalPairs'") # # focalPairs(x, ...) # } #) terra/R/ifelse.R0000644000176200001440000000235514536376240013201 0ustar liggesusers# Author: Robert J. Hijmans # Date : May 2019 # Version 1.0 # License GPL v3 setMethod("ifel", signature(test="SpatRaster"), function(test, yes, no, filename="", ...) { no_num <- FALSE yes_num <- FALSE if (!inherits(no, "SpatRaster")) { # logical includes default NA if (!(is.numeric(no) || is.logical(no))) { error("ifel", "argument 'no' must be a SpatRaster, numeric or logical") } if (length(no) > 1) warn("ifel", 'only the first element of "no" is used') no <- no[1] no_num <- TRUE } if (!inherits(yes, "SpatRaster")) { if (!(is.numeric(yes) || is.logical(yes))) { error("ifel", "argument 'yes' must be a SpatRaster, numeric or logical") } if (length(yes) > 1) warn("ifel", 'only the first element of "yes" is used') yes <- yes[1] yes_num <- TRUE } test <- as.logical(test) if (no_num & yes_num) { return (classify(test, rbind(c(1, yes), c(0, no)), filename=filename, ...)) } if (no_num) { no <- classify(test, rbind(c(0, no), c(1, NA))) } else { no <- mask(no, test, maskvalues=TRUE) } if (yes_num) { yes <- classify(test, rbind(c(1, yes), c(0, NA))) } else { yes <- mask(yes, test, maskvalues=FALSE) } cover(no, yes, values=NA, filename=filename, ...) } ) terra/R/plot_2rasters.R0000644000176200001440000001131414536376240014530 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2019 # Version 1.0 # License GPL v3 .scatterPlotRaster <- function(x, y, maxcell=100000, warn=TRUE, cex, xlab, ylab, nc, nr, maxnl=16, main, add=FALSE, smooth=FALSE, gridded=FALSE, ncol=25, nrow=25, asp=NA, colramp=grDevices::colorRampPalette(c("white", grDevices::blues9)), ...) { compareGeom(x, y, lyrs=FALSE, crs=FALSE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE) nlx <- nlyr(x) nly <- nlyr(y) maxnl <- max(1, round(maxnl)) nl <- min(max(nlx, nly), maxnl) if (nl > maxnl) { nl <- maxnl if (nlx > maxnl) { x <- x[[1:maxnl]] nlx <- maxnl } if (nly > maxnl) { y <- y[[1:maxnl]] nly <- maxnl } } if (nlx < nly) { x <- x[[rep_len(1:nlx, nly)]] nlx <- nly } else if (nly < nlx) { y <- y[[rep_len(1:nly, nlx)]] nly <- nlx } if (missing(main)) { main <- "" } if (missing(xlab)) { ln1 <- names(x) } else { ln1 <- xlab if (length(ln1) == 1) { ln1 <- rep(ln1, nlx) } } if (missing(ylab)) { ln2 <- names(y) } else { ln2 <- ylab if (length(ln1) == 1) { ln2 <- rep(ln2, nly) } } cells <- ncell(x) if (gridded | smooth) { # if ((ncell(x) * (nlx + nly)) < .maxmemory()) { if ((ncell(x) * (nlx + nly)) < 1000000) { maxcell <- ncell(x) } if (smooth) { dots <- list(...) if (!is.null(dots$col)) { colramp <- grDevices::colorRampPalette(dots$col) } } } x <- as.matrix(spatSample(c(x,y), size=maxcell, method="regular", as.raster=FALSE, warn=FALSE)) # y <- as.matrix(spatSample(y, size=maxcell, method="regular", as.raster=FALSE)) y <- x[,c((nlx+1):ncol(x))] x <- x[,1:nlx] if (warn & (NROW(x) < cells)) { warn("plot", 'plot used a sample of ', round(100*NROW(x)/cells, 1), '% of the cells. You can use "maxcell" to increase the sample)') } if (missing(cex)) { if (NROW(x) < 100) { cex <- 1 } else if (NROW(x) < 1000) { cex <- 0.5 } else { cex <- 0.2 } } if (nlx != nly) { # recycling d <- cbind(as.vector(x), as.vector(y)) x <- matrix(d[,1], ncol=nl) y <- matrix(d[,2], ncol=nl) lab <- vector(length=nl) lab[] <- ln1 ln1 <- lab lab[] <- ln2 ln2 <- lab } if (nl > 1) { old.par <- graphics::par(no.readonly = TRUE) on.exit(graphics::par(old.par)) px <- trunc(sqrt(nl)) py <- ceiling(nl / px) graphics::par(mfrow=c(px, py), mar=c(3, 3, 1, 1)) if (smooth) { for (i in 1:nl) { graphics::smoothScatter(x[,i], y[,i], main=main[i], xlab=ln1[i], ylab=ln2[i], add=add, asp=asp, colramp=colramp, ...) } } else if (gridded) { for (i in 1:nl) { .plotdens(x[,i], y[,i], nc=ncol, nr=nrow, main=main[i], xlab=ln1[i], ylab=ln2[i], add=add, asp=asp, ...) } } else { if (add) { for (i in 1:nl) { graphics::points(x[,i], y[,i], cex=cex, ...) } } else { for (i in 1:nl) { plot(x[,i], y[,i], cex=cex, xlab=ln1[i], ylab=ln2[i], main=main[i], asp=asp, ...) } } } } else { if (smooth) { graphics::smoothScatter(x, y, main=main[1], xlab=ln1[1], ylab=ln2[1], add=add, asp=asp, colramp=colramp, ...) } else if (gridded) { .plotdens(x, y, nc=ncol, nr=nrow, main=main[1], xlab=ln1[1], ylab=ln2[1], add=add, asp=asp, ...) } else { if (add) { graphics::points(x, y, cex=cex, ...) } else { plot(x, y, cex=cex, xlab=ln1[1], ylab=ln2[1], main=main[1], asp=asp, ...) } } } } setMethod("plot", signature(x="SpatRaster", y="SpatRaster"), function(x, y, maxcell=100000, warn=TRUE, nc, nr, maxnl=16, smooth=FALSE, gridded=FALSE, ncol=25, nrow=25, ...) { nl <- max(nlyr(x), nlyr(y)) if (missing(nc)) { nc <- ceiling(sqrt(nl)) } else { nc <- max(1, min(nl, round(nc))) } if (missing(nr)) { nr <- ceiling(nl / nc) } else { nr <- max(1, min(nl, round(nr))) nc <- ceiling(nl / nr) } .scatterPlotRaster(x, y, maxcell=maxcell, warn=warn, nc=nc, nr=nr, maxnl=maxnl, gridded=gridded, smooth=smooth, ncol=ncol, nrow=nrow, ...) } ) .plotdens <- function(x, y, nc, nr, xlim=NULL, ylim=NULL, asp=NULL, ...) { xy <- stats::na.omit(cbind(x,y)) if (nrow(xy) == 0) { error("plot (density)", "only NA values (in this sample?)") } r <- apply(xy, 2, range) rx <- r[,1] if (rx[1] == rx[2]) { rx[1] <- rx[1] - 0.5 rx[2] <- rx[2] + 0.5 } ry <- r[,2] if (ry[1] == ry[2]) { ry[1] <- ry[1] - 0.5 ry[2] <- ry[2] + 0.5 } out <- rast(xmin=rx[1], xmax=rx[2], ymin=ry[1], ymax=ry[2], ncol=nc, nrow=nr, crs="+proj=utm +zone=1 +datum=WGS84") colnames(xy) <- c("x", "y") out <- rasterize(vect(xy), out, fun=function(x, ...) length(x), background=NA) if (!is.null(xlim) | !is.null(ylim)) { if (is.null(xlim)) xlim <- c(xmin(x), xmax(x)) if (is.null(ylim)) ylim <- c(ymin(x), ymax(x)) e <- extent(xlim, ylim) out <- extend(crop(out, e), e, value=0) } plot(out, maxcell=nc*nr, asp=asp, ...) } terra/R/time.R0000644000176200001440000002106614753763672012702 0ustar liggesusers# Author: Robert J. Hijmans # Date: October 2018 # Version 1.0 # License GPL v3 format_ym <- function(x) { y <- floor(x) m <- round((x-y) * 12 + 1) m <- month.abb[m] paste(y, m, sep="-") } yearweek <- function(d) { y <- as.integer(strftime(d, format = "%Y")) w <- strftime(d, format = "%V") m <- strftime(d, format = "%m") i <- w > "51" & m=="01" y[i] <- y[i] - 1 i <- w=="01" & m=="12" y[i] <- y[i] + 1 yy <- as.character(y) i <- nchar(yy) < 4 yy[i] <- formatC(y[i], width=4, flag="0") paste0(yy, w) } setMethod("has.time", signature(x="SpatRaster"), function(x) { x@pntr$hasTime } ) setMethod("timeInfo", signature(x="SpatRaster"), function(x) { time <- x@pntr$hasTime if (time) { step <- x@pntr$timestep if (step == "seconds") { data.frame(time=time, step=step, zone=x@pntr$timezone) } else { data.frame(time=time, step=step, zone="") } } else { data.frame(time=time, step="", zone="") } } ) setMethod("timeInfo", signature(x="SpatRasterDataset"), function(x) { t(sapply(x, timeInfo)) } ) time_as_seconds <- function(x) { d <- x@pntr$time d <- strptime("1970-01-01", "%Y-%m-%d", tz="UTC") + d tz <- x@pntr$timezone if (!(tz %in% c("", "UTC"))) { attr(d, "tzone") = tz } d } #setMethod("time", signature(x="SpatVector"), # function(x, format="") { # cls <- sapply(values(x[1,]), function(i) { a = class(i); a[length(a)] }) # i <- which(cls %in% c("Date", "POSIXt"))[1] # if (is.na(i)) { # return(rep(NA, nrow(x))) # } else { # d <- x[,i,drop=TRUE][,,drop=TRUE] # if (format != "") { # steps <- c("seconds", "days", "months", "years", "yearmonths") # format <- match.arg(tolower(format), steps) # if (!(format %in% steps)) { # error("time", "not a valid time format") # } # tstep <- ifelse(cls[i]=="Date", "days", "seconds") # if (format == "seconds") { # if (tstep != "seconds") { # error("time", "cannot extract seconds from Dates") # } # d # } else if (format == "days") { # as.Date(d) # } else if (format == "yearmonths") { # y <- as.integer(format(d, "%Y")) # y + (as.integer(format(d, "%m"))-1)/12 # } else if (format == "months") { # as.integer(format(d, "%m")) # } else if (format == "years") { # as.integer(format(d, "%Y")) # } # } else { # d # } # } # } #) setMethod("time", signature(x="SpatRaster"), function(x, format="") { if (!x@pntr$hasTime) { return(rep(NA, nlyr(x))) } d <- x@pntr$time tstep <- x@pntr$timestep if (format != "") { steps <- c("seconds", "days", "months", "years", "yearmonths") format <- match.arg(tolower(format), steps) if ((format == "months") && (tstep == "years")) { error("time", "cannot extract months from years-time") } else if ((format == "years") && (tstep %in% c("months"))) { error("time", "cannot extract years from months-time") } else if ((format == "yearmonths") && (tstep %in% c("months", "years"))) { error("time", "cannot extract yearmonths from this type of time data") } else if ((format == "seconds") && (tstep != "seconds")) { error("time", "cannot extract seconds from this type of time data") } else if ((format == "days") && (!(tstep %in% c("seconds", "days")))) { error("time", "cannot extract days from this type of time data") } tstep <- format } else if (tstep == "raw") { return(d) } d <- strptime("1970-01-01", "%Y-%m-%d", tz="UTC") + d if (tstep == "seconds") { tz <- x@pntr$timezone if (!(tz %in% c("", "UTC"))) { attr(d, "tzone") = tz } d } else if (tstep == "days") { as.Date(d) } else if (tstep == "yearmonths") { y <- as.integer(format(d, "%Y")) y + (as.integer(format(d, "%m"))-1)/12 } else if (tstep == "months") { as.integer(format(d, "%m")) } else if (tstep == "years") { as.integer(format(d, "%Y")) # } else if (tstep == "yearweeks") { # yearweek(as.Date(d)) } else { # ??? d } } ) setMethod("time", signature(x="SpatRasterDataset"), function(x, format="") { lapply(x,time, format=format) } ) posix_from_ym <- function(y, m) { y <- floor(y) i <- ((y < 0) | (y > 9999)) if (any(i)) { d <- paste(paste(rep("1900", length(y)), m, "15", sep="-"), "12:00:00") d[!i] <- paste(paste(y[!i], m, "15", sep="-"), "12:00:00") d <- as.POSIXlt(d, format="%Y-%m-%d %H:%M:%S", tz="UTC") for (j in i) { d$year[j] = y[j] - 1900 } d } else { d <- paste(paste(y, m, "15", sep="-"), "12:00:00") as.POSIXlt(d, format="%Y-%m-%d %H:%M:%S", tz="UTC") } } setMethod("time<-", signature(x="SpatRaster"), function(x, tstep="", value) { if (missing(value)) { value <- tstep tstep <- "" } x@pntr <- x@pntr$deepcopy() if (is.null(value)) { x@pntr$setTime(0[0], "remove", "") return(x) } if (inherits(value, "character")) { error("time<-", "value cannot be a character type") } if (length(value) != nlyr(x)) { error("time<-", "length(value) != nlyr(x)") } if (tstep != "") { tstep = match.arg(as.character(tstep), c("seconds", "days", "months", "years", "yearmonths", "raw")) } ## may not be necessary if (tstep == "seconds") tstep = "" tzone <- "UTC" stept <- "" if (inherits(value, "Date")) { value <- as.POSIXlt(value) if (tstep == "") stept <- "days" } else if (inherits(value, "POSIXt")) { if (tstep == "") stept <- "seconds" tzone <- attr(value, "tzone")[1] if (is.null(tzone)) tzone = "UTC" } else if (inherits(value, "yearmon")) { value <- as.numeric(value) year <- floor(value) month <- round(12 * (value - year) + 1) value <- posix_from_ym(value, month) if (tstep == "") stept <- "yearmonths" } if (stept == "") { stept = tstep if (tstep == "years") { if (is.numeric(value)) { value <- posix_from_ym(value, "6") } else { value <- as.integer(strftime(value, format = "%Y", tz=tzone)) value <- posix_from_ym(value, "6") } } else if (tstep == "months") { if (is.numeric(value)) { value <- floor(value) } else { value <- as.integer(strftime(value, format = "%m", tz=tzone)) } if (!all(value %in% 1:12)) { error("date<-", "months should be between 1 and 12") } value <- posix_from_ym(1970, value) } else if (tstep == "yearmonths") { if (is.numeric(value)) { y <- as.integer(substr(value, 1, 4)) m <- value - (y * 100) } else { y <- as.integer(strftime(value, format = "%Y", tz=tzone)) m <- as.integer(strftime(value, format = "%m", tz=tzone)) } if (!all(m %in% 1:12)) { error("date<-", "months should be between 1 and 12") } value <- posix_from_ym(y, m) #} else if (tstep == "days") { # print(value) # value <- as.Date(value) # stept = tstep } else if (tstep == "") { stept <- "raw" } } if (!x@pntr$setTime(as.numeric(value), stept, tzone)) { error("time<-", "cannot set these values") } return(x) } ) setMethod("time<-", signature(x="SpatRasterDataset"), function(x, tstep="", value) { if (missing(value)) { value <- tstep tstep <- "" } tstep <- rep_len(tstep, length(x)) if (is.list(value)) { if (length(x) != length(value)) { error("time<-", "the list should have the same length as 'x'") } z <- lapply(1:length(x), function(i) { time(x[i], tstep=tstep[i]) <- value[[i]] }) } else { if (length(unique(nlyr(x))) > 1) { error("time<-", "not all SpatRasters have the same number of layers") } z <- lapply(1:length(x), function(i) { time(x[i], tstep=tstep[i]) <- value }) } x } ) setMethod("depth", signature(x="SpatRaster"), function(x) { x@pntr$depth } ) setMethod("depth<-", signature(x="SpatRaster"), function(x, value) { if (is.null(value)) { x@pntr$setDepth(0[0]) return(x) } value <- as.numeric(value) if (! x@pntr$setDepth(value)) { error("depth<-", "cannot set these values") } return(x) } ) setMethod("linearUnits", signature(x="SpatRaster"), function(x) { .getLinearUnits(crs(x)) } ) setMethod("linearUnits", signature(x="SpatVector"), function(x) { .getLinearUnits(crs(x)) } ) setMethod("units", signature(x="SpatRaster"), function(x) { x@pntr$units } ) setMethod("units<-", signature(x="SpatRaster"), function(x, value) { if (is.null(value) || all(is.na(value))) { value <- "" } else { value <- as.character(value) } if (! x@pntr$set_units(value)) { error("units<-", "cannot set these values") } return(x) } ) setMethod("units", signature(x="SpatRasterDataset"), function(x) { x@pntr$units } ) setMethod("units<-", signature(x="SpatRasterDataset"), function(x, value) { value <- as.character(value) x@pntr$units <- value return(x) } ) terra/R/names.R0000644000176200001440000001302114726700274013024 0ustar liggesusers# Author: Robert J. Hijmans # Date: October 2018 # Version 1.0 # License GPL v3 setMethod("names", signature(x="SpatRaster"), function(x) { nms <- x@pntr$names Encoding(nms) <- "UTF-8" nms } ) setMethod("names<-", signature(x="SpatRaster"), function(x, value) { if (is.null(value)) { value <- rep("", nlyr(x)) } else { value <- enc2utf8(as.character(value)) if (length(value) != nlyr(x)) { error("names<-", "incorrect number of names") } } x@pntr <- x@pntr$deepcopy() if (! x@pntr$setNames(value, FALSE)) { error("names<-", "cannot set these names") } return(x) } ) .names_check <- function(x, value, index, validate, lengthfx) { value <- enc2utf8(as.character(value)) if (!all(index == 1:lengthfx(x))) { n <- names(x) n[index] <- value value <- n } if (length(value) != lengthfx(x)) { error("names<-", "incorrect number of names") } if (validate) { value <- make.names(value, unique = TRUE) } value } setMethod("set.names", signature(x="SpatRaster"), function(x, value, index=1:nlyr(x), validate=FALSE) { value <- .names_check(x, value, index, validate, nlyr) if (!x@pntr$setNames(value, FALSE)) { error("set.names", "cannot set these names") } invisible(TRUE) } ) setMethod("names", signature(x="SpatRasterCollection"), function(x) { nms <- x@pntr$names Encoding(nms) <- "UTF-8" nms } ) setMethod("names<-", signature(x="SpatRasterCollection"), function(x, value) { x@pntr <- x@pntr$deepcopy() if (is.null(value)) { value <- rep("", length(x)) } x@pntr$names <- enc2utf8(as.character(value)) x } ) setMethod("set.names", signature(x="SpatRasterCollection"), function(x, value, index=1:length(x), validate=FALSE) { value <- .names_check(x, value, index, validate, length) x@pntr$names <- value invisible(TRUE) } ) setMethod("names", signature(x="SpatRasterDataset"), function(x) { nms <- x@pntr$names Encoding(nms) <- "UTF-8" nms } ) setMethod("names<-", signature(x="SpatRasterDataset"), function(x, value) { x@pntr <- x@pntr$deepcopy() if (is.null(value)) { value <- rep("", length(x)) } if (is.list(value)) { nl <- nlyr(x) if (length(value) == 1) { if (length(unique(nl)) > 1) { error("names<-", "the number of layers varies between datasets") } x@pntr$set_layernames(enc2utf8(as.character(value[[1]])), -1) } else { if (length(value) != length(x)) { error("names<-", "the number of list elements does not match the number of datasets") } for (i in seq_along(length(x))) x@pntr$set_layernames(enc2utf8(as.character(value[[i]])), i-1) } } else { x@pntr$names <- enc2utf8(as.character(value)) } messages(x, "names<-") } ) setMethod("set.names", signature(x="SpatRasterDataset"), function(x, value, index=1:length(x), validate=FALSE) { value <- .names_check(x, value, index, validate, length) x@pntr$names <- value invisible(TRUE) } ) setMethod("varnames", signature(x="SpatRasterDataset"), function(x) { nms <- x@pntr$names Encoding(nms) <- "UTF-8" nms } ) setMethod("varnames<-", signature(x="SpatRasterDataset"), function(x, value) { value <- enc2utf8(as.character(value)) x@pntr <- x@pntr$deepcopy() x@pntr$names <- value x } ) setMethod("names", signature(x="SpatVector"), function(x) { nms <- x@pntr$names Encoding(nms) <- "UTF-8" nms } ) setMethod("names", signature(x="SpatVectorProxy"), function(x) { nms <- x@pntr$v$names Encoding(nms) <- "UTF-8" nms } ) setMethod("names<-", signature(x="SpatVector"), function(x, value) { if (length(value) != ncol(x)) { error("names<-,SpatVector", "incorrect number of names") } value <- enc2utf8(as.character(value)) x@pntr <- x@pntr$deepcopy() x@pntr$names <- value if (any(names(x) != value)) { warn("names<-", "some names were changed to make them valid and/or unique") } return(x) } ) setMethod("set.names", signature(x="SpatVector"), function(x, value, index=1:ncol(x), validate=FALSE) { value <- .names_check(x, value, index, validate, ncol) x@pntr$names <- value invisible(TRUE) } ) setMethod("varnames", signature(x="SpatRaster"), function(x) { nms <- x@pntr$get_sourcenames() Encoding(nms) <- "UTF-8" nms } ) setMethod("varnames<-", signature(x="SpatRaster"), function(x, value) { value <- enc2utf8(as.character(value)) x@pntr <- x@pntr$deepcopy() if (!x@pntr$set_sourcenames(value)) { error("varnames<-,SpatRaster", "cannot set these names") } return(x) } ) setMethod("longnames", signature(x="SpatRasterDataset"), function(x) { nms <- x@pntr$long_names Encoding(nms) <- "UTF-8" nms } ) setMethod("longnames", signature(x="SpatRaster"), function(x) { nms <- x@pntr$get_sourcenames_long() Encoding(nms) <- "UTF-8" nms } ) setMethod("longnames<-", signature(x="SpatRasterDataset"), function(x, value) { x@pntr <- x@pntr$deepcopy() x@pntr$long_names <- enc2utf8(as.character(value)) return(x) } ) setMethod("longnames<-", signature(x="SpatRaster"), function(x, value) { x@pntr <- x@pntr$deepcopy() value <- enc2utf8(as.character(value)) if (!x@pntr$set_sourcenames_long(value)) { error("longnames<-,SpatRaster", "cannot set these names") } return(x) } ) setMethod("names", signature(x="SpatVectorCollection"), function(x) { nms <- x@pntr$names Encoding(nms) <- "UTF-8" nms } ) setMethod("names<-", signature(x="SpatVectorCollection"), function(x, value) { x@pntr <- x@pntr$deepcopy() if (is.null(value)) { value <- rep("", length(x)) } x@pntr$setNames(enc2utf8(as.character(value)), FALSE) x } ) terra/R/focal.R0000644000176200001440000004666414726700274013030 0ustar liggesusers# Author: Robert J. Hijmans # Date : December 2017 # Version 1.0 # License GPL v3 setMethod("focal", signature(x="SpatRaster"), function(x, w=3, fun="sum", ..., na.policy="all", fillvalue=NA, expand=FALSE, silent=TRUE, filename="", overwrite=FALSE, wopt=list()) { na.only <- list(...)$na.only if (!is.null(na.only)) { warn("focal", "use 'na.policy' instead of 'na.only'") na.policy <- "only" } na.policy <- match.arg(tolower(na.policy), c("all", "only", "omit")) na.only <- na.policy == "only" na.omit <- na.policy == "omit" if (!is.numeric(w)) { error("focal", "w should be numeric vector or matrix") } txtfun <- .makeTextFun(fun) if (is.matrix(w)) { m <- as.vector(t(w)) #if (!all(m %in% c(0, 1, NA))) { #if (isTRUE(list(...)$na.rm)) { # if (txtfun != "sum") { # error("focal", 'with "na.rm=TRUE" and weights other than 0, 1, or NA, only fun="sum" is allowed') # } #} #} w <- dim(w) } else { w <- rep_len(w, 2) stopifnot(all(w > 0)) m <- rep(1, prod(w)) } cpp <- FALSE if (is.character(txtfun)) { if (is.null(wopt$names)) { wopt$names <- paste0("focal_", txtfun) } opt <- spatOptions(filename, overwrite, wopt=wopt) if (na.only) { narm <- TRUE } else { narm <- isTRUE(list(...)$na.rm) } x@pntr <- x@pntr$focal(w, m, fillvalue, narm, na.only, na.omit, txtfun, expand, opt) messages(x, "focal") return(x) } else { if (expand) { warn("focal", "expand is ignored for functions that are not 'built-in'") } checkNA <- na.only || na.omit msz <- prod(w) dow <- !isTRUE(all(m == 1)) if (any(is.na(m))) { k <- !is.na(m) mm <- m[k] msz <- sum(k) } v <- focalValues(x, w, trunc(nrow(x)/2), 1)[ncol(x)/2, ,drop=FALSE] if (dow) { if (any(is.na(m))) { v <- v[,k,drop=FALSE] * mm } else { v <- v * m } } test <- try(apply(v, 1, fun, ...), silent=silent) if (inherits(test, "try-error")) { error("focal", "test failed") } readStart(x) on.exit(readStop(x)) nl <- nlyr(x) outnl <- nl * length(test) out <- rast(x, nlyr=outnl) transp <- FALSE nms <- NULL if (isTRUE(nrow(test) > 1)) { transp <- TRUE nms <- rownames(test) if (nl > 1) { nms <- paste0(rep(names(x), each=nl), "_", rep(nms, nl)) } } else if (isTRUE(ncol(test) > 1)) { nms <- colnames(test) if (nl > 1) { nms <- paste0(rep(names(x), each=nl), "_", rep(nms, nl)) } } else { nms <- names(x) if (nl > 1) { nms <- paste0(rep(names(x), each=nl), "_", rep(1:length(test), nl)) } } if (length(nms) == nlyr(out)) { names(out) <- nms } b <- writeStart(out, filename, overwrite, n=msz+2, sources=sources(x), wopt=wopt) opt <- spatOptions() for (i in 1:b$n) { vv <- NULL for (j in 1:nl) { if (nl > 1) { v <- x[[j]]@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt) } else { v <- x@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt) } if (dow) { if (any(is.na(m))) { v <- v[k] * mm } else { v <- v * m } } v <- matrix(v, ncol=msz, byrow=TRUE) v <- apply(v, 1, fun, ...) if (transp) { v <- t(v) } if (checkNA) { if (nl > 1) { mv <- readValues(x[[j]], b$row[i], b$nrows[i]) } else { mv <- readValues(x, b$row[i], b$nrows[i]) } if (na.only) { k <- !is.na(mv) } else { k <- is.na(mv) } v[k] <- mv[k] } if (nl > 1) { if (outnl > 1) { vv <- cbind(vv, v) } else { vv <- c(vv, v) } } } #if (bip) { # v <- matrix(as.vector(v), ncol=ncol(v), byrow=TRUE) #} if (nl > 1) { writeValues(out, vv, b$row[i], b$nrows[i]) } else { writeValues(out, v, b$row[i], b$nrows[i]) } } out <- writeStop(out) return(out) } } ) setMethod("focal3D", signature(x="SpatRaster"), function(x, w=3, fun=mean, ..., na.policy="all", fillvalue=NA, pad=FALSE, padvalue=fillvalue, expand=FALSE, silent=TRUE, filename="", overwrite=FALSE, wopt=list()) { na.policy <- match.arg(tolower(na.policy), c("all", "only", "omit")) na.only <- na.policy == "only" na.omit <- na.policy == "omit" checkNA <- na.only || na.omit if (!(inherits(w, "numeric") || inherits(w, "array"))) { error("focal3D", "w should be numeric vector or array") } if (is.array(w)) { if (length(dim(w)) != 3) { error("focal3D", "the weights array must have three dimensions") } m <- as.vector(w) w <- dim(w) } else { w <- rep_len(w, 3) stopifnot(all(w > 0)) m <- rep(1, prod(w)) } if (w[3] > nlyr(x)) { error("focal3D", "the third weights dimension is larger than nlyr(x)") } if (any((w %% 2) == 0)) { error("focal3D", "w must be odd sized in all dimensions") } msz <- prod(w) dow <- !isTRUE(all(m == 1)) rna <- FALSE if (any(is.na(m))) { rna <- TRUE kna <- !is.na(m) m <- m[kna] msz <- sum(kna) } opt <- spatOptions() halfway <- floor(w[3]/2) v <- lapply(1:w[3], function(i) focalValues(x[[i]], w[1:2], trunc(nrow(x)/2), 1)[ncol(x)/2, ,drop=FALSE]) v <- t(do.call(cbind, v)) if (dow) { if (rna) { v <- v[kna,,drop=FALSE] * m } else { v <- v * m } } vout <- try(apply(v, 2, fun, ...), silent=silent) if (inherits(vout, "try-error")) { error("focal", "test failed") } readStart(x) on.exit(readStop(x)) nl <- nlyr(x) transp <- FALSE nms <- NULL if (isTRUE(nrow(vout) > 1)) { transp <- TRUE nms <- rownames(vout) } else if (isTRUE(ncol(vout) > 1)) { nms <- colnames(vout) } if (pad || expand) { startlyr = 1; endlyr = nl; outnl <- nl * length(vout) } else { startlyr = halfway+1; endlyr = nl-halfway; outnl <- (1+endlyr-startlyr) * length(vout) } out <- rast(x, nlyr=outnl) if (!is.null(nms)) { if (length(nms) <= outnl) { names(out) <- rep_len(nms, outnl) } } b <- writeStart(out, filename, overwrite, n=msz+2, sources=sources(x), wopt=wopt) nread <- prod(w[1:2]) for (i in 1:b$n) { nc <- b$nrows[i]*ncol(x) vv <- NULL if (expand) { v <- list(matrix(x[[1]]@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt), ncol=nc)) v <- do.call(rbind, rep(v, halfway+1)) for (k in 2:(1+halfway)) { v <- rbind(v, matrix(x[[k]]@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt), ncol=nc)) } } else if (pad) { v <- matrix(padvalue, ncol=b$nrows[i]*ncol(x), nrow=nread*halfway) for (k in 1:(1+halfway)) { v <- rbind(v, matrix(x[[k]]@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt), ncol=nc)) } } else { v <- lapply(1:w[3], function(k) { y <- x[[k]] z <- y@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt) y <- messages(y, "focal3D") matrix(z, ncol=nc) }) v <- do.call(rbind, v) } for (j in startlyr:endlyr) { if (j > startlyr) { v <- v[-c(1:nread), ] k <- j + halfway if (k > nl) { if (pad) { v <- rbind(v, matrix(padvalue, nrow=nread, ncol=ncol(v))) } else { v <- rbind(v, v[(nrow(v)-nread):nrow(v), ]) } } else { v <- rbind(v, matrix(x[[k]]@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt), ncol=ncol(v))) } } if (dow) { if (rna) { vout <- apply(v[kna,] * m, 2, fun, ...) } else { vout <- apply(v * m, 2, fun, ...) } } else { vout <- apply(v, 2, fun,...) } if (transp) { vout <- t(vout) } if (checkNA) { mv <- readValues(x[[j]], b$row[i], b$nrows[i]) if (na.only) { k <- !is.na(mv) } else { k <- is.na(mv) } vout[k] <- mv[k] } vv <- c(vv, as.vector(vout)) } writeValues(out, vv, b$row[i], b$nrows[i]) } out <- writeStop(out) return(out) } ) setMethod("focalCpp", signature(x="SpatRaster"), function(x, w=3, fun, ..., fillvalue=NA, silent=TRUE, filename="", overwrite=FALSE, wopt=list()) { if (!(all(c("ni", "nw") %in% names(formals(fun))))) { error("focalRaw", 'fun must have an argument "ni"') } if (!is.numeric(w)) { error("focal", "w should be numeric vector or matrix") } if (is.matrix(w)) { m <- as.vector(t(w)) w <- dim(w) } else { w <- rep_len(w, 2) stopifnot(all(w > 0)) m <- rep(1, prod(w)) } msz <- prod(w) readStart(x) on.exit(readStop(x)) dow <- !isTRUE(all(m == 1)) if (any(is.na(m))) { k <- !is.na(m) mm <- m[k] msz <- sum(k) } opt <- spatOptions() nl <- nlyr(x) v <- x@pntr$focalValues(w, fillvalue, max(0, trunc(nrow(x)/2)), 1, opt)[1:prod(w)] if (dow) { if (any(is.na(m))) { v <- v[k] * mm } else { v <- v * m } } test <- try(fun(v, ..., ni=1, nw=msz), silent=silent) if (inherits(test, "try-error")) { error("focalCpp", "test failed") } outnl <- nl * length(test) if (is.null(wopt$names )) { wopt$names <- colnames(test) } out <- rast(x, nlyr=outnl) b <- writeStart(out, filename, overwrite, n=msz+2, sources=sources(x), wopt=wopt) nc <- ncol(out) for (i in 1:b$n) { vv <- NULL for (j in 1:nl) { if (nl > 1) { v <- x[[j]]@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt) } else { v <- x@pntr$focalValues(w, fillvalue, b$row[i]-1, b$nrows[i], opt) } sst <- messages(x) if (dow) { if (any(is.na(m))) { v <- v[k] * mm } else { v <- v * m } } v <- fun(v, ..., ni=b$nrows[i]*nc, nw=msz) if (nl > 1) { if (outnl > 1) { vv <- rbind(vv, v) } else { vv <- c(vv, v) } } } if (nl > 1) { writeValues(out, vv, b$row[i], b$nrows[i]) } else { writeValues(out, v, b$row[i], b$nrows[i]) } } writeStop(out) } ) .getRegFun <- function(fun, weighted=FALSE, wopt, nmsx, nl, na.rm=FALSE, intercept=TRUE, ...) { ols <- function(x, y, ...) { if (any(is.na(x)) || any(is.na(y)) || (NROW(y) < (NCOL(x) + 1))) { return(rep(NA, NCOL(x)+1)) } stats::.lm.fit(cbind(1, x), y)$coefficients } ols_noi <- function(x, y, ...) { if (any(is.na(x)) || any(is.na(y)) || (NROW(y) < (NCOL(x)))) { return(rep(NA, NCOL(x))) } stats::.lm.fit(as.matrix(x), y)$coefficients } ols_narm <- function(x, y, ...) { v <- stats::na.omit(cbind(y, x)) if (nrow(v) < (NCOL(x) + 1)) { return( cbind(rep(NA, NCOL(x)+1)) ) } stats::.lm.fit(cbind(1, v[,-1]), v[,1])$coefficients } ols_noi_narm <- function(x, y, ...) { v <- stats::na.omit(cbind(y, x)) if (nrow(v) < (NCOL(x))) { return( cbind(rep(NA, NCOL(x))) ) } stats::.lm.fit(v[,-1,drop=FALSE], v[,1])$coefficients } weighted_ols <- function(x, y, weights, ...) { if (any(is.na(x)) || any(is.na(y)) || any(is.na(weights)) || (NROW(y) < (NCOL(x) + 1))) { return(rep(NA, NCOL(x)+1)) } stats::lm.wfit(cbind(1, x), y, weights)$coefficients } weighted_ols_noi <- function(x, y, weights, ...) { if (any(is.na(x)) || any(is.na(y)) || any(is.na(weights)) || (NROW(y) < (NCOL(x) + 1))) { return(rep(NA, NCOL(x))) } stats::lm.wfit(as.matrix(x), y, weights)$coefficients } weighted_ols_narm <- function(x, y, weights, ...) { v <- stats::na.omit(cbind(y, weights, x)) if (nrow(v) < (NCOL(x) + 1)) { return(rep(NA, NCOL(x)+1)) } stats::lm.wfit(cbind(1, v[,-c(1:2)]), v[,1], v[,2])$coefficients } weighted_ols_noi_narm <- function(x, y, weights, ...) { v <- stats::na.omit(cbind(y, weights, x)) if (nrow(v) < (NCOL(x))) { return(rep(NA, NCOL(x))) } stats::lm.wfit(v[,-c(1:2), drop=FALSE], v[,1], v[,2])$coefficients } fun <- tolower(fun[1]) if (fun != "ols") { return(list(fun=fun, wopt=wopt)) } intercept <- isTRUE(intercept) if (intercept) { if (weighted) { if (na.rm) { fun <- weighted_ols_narm } else { fun <- weighted_ols } } else { if (na.rm) { fun = ols_narm } else { fun = ols } } if (is.null(wopt$names )) { wopt$names <- c("intercept", nmsx[-1]) } } else { if (weighted) { if (na.rm) { fun <- weighted_ols_noi_narm } else { fun <- weighted_ols_noi } } else { if (na.rm) { fun = ols_noi_narm } else { fun = ols_noi } } if (is.null(wopt$names )) { wopt$names <- nmsx[-1] } nl = nl-1 } list(fun=fun, wopt=wopt, nl=nl, intercept=intercept, na.rm=na.rm) } setMethod("focalReg", signature(x="SpatRaster"), function(x, w=3, fun="ols", ..., fillvalue=NA, filename="", overwrite=FALSE, wopt=list()) { nl <- nlyr(x) if (nl < 2) error("focalReg", "x must have at least 2 layers") if (!is.numeric(w)) { error("focalReg", "w should be numeric vector or matrix") } weighted <- FALSE if (is.matrix(w)) { m <- as.vector(t(w)) m[m==0] <- NA test <- stats::na.omit(m) if (length(test) == 0) { error("focalReg", "all values in w are NA and/or zero") } if (any(test != 1)) { weighted <- TRUE message("the focal values are used as weights") } w <- dim(w) } else { w <- rep_len(w, 2) stopifnot(all(w > 0)) m <- rep(1, prod(w)) } msz <- prod(w) if (msz < 2) { error("the effective weight matrix must have positive dimensions, and at least one must be > 1") } hasnam <- FALSE if (any(is.na(m))) { hasnam <- TRUE k <- !is.na(m) msz <- sum(k) weights <- m[k] } else if (weighted) { weights <- m } if (is.character(fun)) { funopt <- .getRegFun(fun, weighted, wopt, names(x), nlyr(x), ...) fun <- funopt$fun wopt <- funopt$wopt outnl <- funopt$nl } else { # need to test X <- matrix(sample(msz * (nl-1), replace=TRUE), ncol=nl-1) out <- fun(1:msz, X) outnl <- length(out) if (is.null(wopt$names) && (length(names(out)) == outnl)) { wopt$names <- names(out) } } out <- rast(x, nlyr=outnl) b <- writeStart(out, filename, n=msz+2, sources=sources(x), wopt=wopt) ry <- x[[1]] rx <- x[[-1]] if (nl == 2) { for (i in 1:b$n) { Y <- focalValues(ry, w, b$row[i], b$nrows[i], fillvalue) X <- focalValues(rx, w, b$row[i], b$nrows[i], fillvalue) if (hasnam) { Y <- Y[,k,drop=FALSE] X <- X[,k,drop=FALSE] } if (weighted) { v <- t(sapply(1:nrow(Y), function(i) fun(X[i,], Y[i,], weights, ...))) } else { v <- t(sapply(1:nrow(Y), function(i) fun(X[i,], Y[i,], ...))) } writeValues(out, v, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { Y <- focalValues(ry, w, b$row[i], b$nrows[i], fillvalue) if (hasnam) { Y <- Y[,k,drop=FALSE] } X <- list() for (j in 1:(nl-1)) { X[[j]] <- focalValues(rx[[j]], w, b$row[i], b$nrows[i], fillvalue) if (hasnam) { X[[j]] <- X[[j]][,k] } } v <- list() for (p in 1:nrow(Y)) { xlst <- list() for (j in 1:(nl-1)) { xlst[[j]] <- X[[j]][p,] } pX <- do.call(cbind, xlst) if (weighted) { v[[p]] <- fun(pX, Y[p,], weights) } else { v[[p]] <- fun(pX, Y[p,]) } } v <- t(do.call(cbind, v)) writeValues(out, v, b$row[i], b$nrows[i]) } } out <- writeStop(out) return(out) } ) setMethod("focalPairs", signature(x="SpatRaster"), function(x, w=3, fun, ..., fillvalue=NA, filename="", overwrite=FALSE, wopt=list()) { pearson <- function(x, y, ...) { .pearson(x, y, FALSE) } pearson_narm <- function(x, y, ...) { .pearson(x, y, TRUE) } weighted_pearson <- function(x, y, weights, ...) { .weighted_pearson(x, y, weights, FALSE) } weighted_pearson_narm <- function(x, y, weights, ...) { .weighted_pearson(x, y, weights, TRUE) } nl <- nlyr(x) if (nl < 2) error("focalPairs", "x must have at least 2 layers") if (!is.numeric(w)) { error("focalPairs", "w should be numeric vector or matrix") } weighted <- FALSE if (is.matrix(w)) { m <- as.vector(t(w)) m[m==0] <- NA test <- stats::na.omit(m) if (length(test) == 0) { error("focalPairs", "all values in w are NA and/or zero") } if (any(test != 1)) { weighted <- TRUE message("the focal values are used as weights") } w <- dim(w) } else { w <- rep_len(w, 2) stopifnot(all(w > 0)) m <- rep(1, prod(w)) } msz <- prod(w) hasnam <- FALSE if (any(is.na(m))) { hasnam <- TRUE k <- !is.na(m) msz <- sum(k) weights <- m[k] } else if (weighted) { weights <- m } if (msz < 2) { error("the effective weight matrix must have positive dimensions, and at least one must be > 1") } if (is.character(fun)) { narm <- isTRUE(list(...)$na.rm) fun <- tolower(fun[1]) if (fun == "pearson") { if (weighted) { if (narm) { fun = weighted_pearson_narm } else { fun = weighted_pearson } } else { if (narm) { fun = pearson_narm } else { fun = pearson } } } } if (weighted) { test <- try(do.call(fun, list(1:prod(w), prod(w):1, weights=rep(1, prod(w)), ...))) if (inherits(test, "try-error")) { error("focalPairs", "'fun' does not work. Does it have a 'weights' argument?") } } else { test <- try(do.call(fun, list(1:prod(w), prod(w):1, ...))) if (inherits(test, "try-error")) { error("focalPairs", "'fun' does not work. Does it have two arguments (one for each layer)") } } if (is.null(wopt$names )) { wopt$names <- colnames(test) } outnl <- (nlyr(x) - 1) * length(test) out <- rast(x, nlyr=outnl) b <- writeStart(out, filename, n=msz+2, sources=sources(x), wopt=wopt) for (i in 1:b$n) { v <- list() Y <- focalValues(x[[1]], w, b$row[i], b$nrows[i], fillvalue) if (hasnam) { Y <- Y[,k,drop=FALSE] } for (j in 2:nlyr(x)) { X <- Y Y <- focalValues(x[[j]], w, b$row[i], b$nrows[i], fillvalue) if (hasnam) { Y <- Y[,k,drop=FALSE] } if (weighted) { v[[j-1]] <- t(sapply(1:nrow(Y), function(i) fun(X[i,], Y[i,], weights=weights, ...))) } else { v[[j-1]] <- t(sapply(1:nrow(Y), function(i) fun(X[i,], Y[i,], ...))) } } v <- do.call(cbind, v) writeValues(out, v, b$row[i], b$nrows[i]) } out <- writeStop(out) return(out) } ) # ..ols <- function(x, y, ...) { # v <- cbind(y, x) # if (any(is.na(v))) return( cbind(rep(NA, NCOL(x)+1)) ) # X <- cbind(1, v[,-1]) # XtX <- t(X) %*% X # if (det(XtX) == 0) { # return(rep(NA, NCOL(y)+1)) # } # invXtX <- solve(XtX) %*% t(X) # invXtX %*% v[,1] # } # ..ols_noi <- function(x, y, ...) { # v <- cbind(y, x) # if (any(is.na(v))) return( cbind (rep(NA, NCOL(x))) ) # X <- v[,-1,drop=FALSE] # XtX <- t(X) %*% X # if (det(XtX) == 0) { # return(rep(NA, ncol(y)+1)) # } # invXtX <- solve(XtX) %*% t(X) # invXtX %*% v[,1] # } # ..ols_narm <- function(x, y, ...) { # v <- na.omit(cbind(y, x)) # if (nrow(v) < (NCOL(x) + 1)) { # return( cbind(rep(NA, NCOL(x)+1)) ) # } # X <- cbind(1, v[,-1]) # XtX <- t(X) %*% X # if (det(XtX) == 0) { # return(NA) # } # invXtX <- solve(XtX) %*% t(X) # invXtX %*% v[,1] # } # ..ols_noi_narm <- function(x, y, ...) { # v <- na.omit(cbind(y, x)) # if (nrow(v) < NCOL(x)) { # return( cbind(rep(NA, NCOL(y))) ) # } # X <- v[,-1,drop=FALSE] # XtX <- t(X) %*% X # if (det(XtX) == 0) { # return(NA) # } # invXtX <- solve(XtX) %*% t(X) # invXtX %*% v[,1] # } # ..weighted_ols <- function(x, y, weights, ...) { # if (any(is.na(x)) || any(is.na(y))) { # return(rep(NA, NCOL(x)+1)) # } # stats::coefficients(stats::glm(y~x, weights=weights)) # } # ..weighted_ols_noi <- function(x, y, weights, ...) { # if (any(is.na(x)) || any(is.na(y))) { # return(rep(NA, NCOL(x))) # } # stats::coefficients(stats::glm(y ~ -1 + ., weights=weights)) # } # ..weighted_ols_narm <- function(x, y, weights, ...) { # v <- na.omit(data.frame(y=y, x, weights=weights)) # if (nrow(v) < (NCOL(x) + 1)) { # return(rep(NA, NCOL(x)+1)) # } # weights <- v$weights # v$weights <- NULL # stats::coefficients(stats::glm(y ~ ., data=v, weights=weights)) # } # ..weighted_ols_noi_narm <- function(x, y, weights, ...) { # v <- na.omit(data.frame(y=y, x, weights=weights)) # if (nrow(v) < (NCOL(x))) { # return(rep(NA, NCOL(x))) # } # weights <- v$weights # v$weights <- NULL # stats::coefficients(stats::glm(y ~ -1 + ., data=v, weights=weights)) # } terra/R/tapp.R0000644000176200001440000001250514726700274012673 0ustar liggesusers setMethod("tapp", signature(x="SpatRaster"), function(x, index, fun, ..., cores=1, filename="", overwrite=FALSE, wopt=list()) { stopifnot(!any(is.na(index))) prename <- "" out_time <- double() out_tstep <- "" out_tz <- "UTC" if (length(index) == 1) { if (is.character(index)) { choices <- c("years", "months", "dekads", "weeks", "days", "doy", "yearmonths", "yeardekads", "yearweeks", "7days", "10days", "15days") i <- pmatch(tolower(index), choices) if (is.na(i)) { error("tapp", paste("invalid time step. Use one of:", paste(choices, collapse=", "))) } if (!x@pntr$hasTime) { error("tapp", "x has no time data") } choice <- choices[i] if (choice == "doy") { # or POSIXlt$yday index <- format(time(x, "days"), "%j") prename <- "doy_" } else if (choice == "dekads") { index <- floor(as.integer(format(time(x, "days"), "%j")) / 10) + 1 prename <- "dekad_" } else if (choice == "yeardekads") { year <- time(res, "years") year <- formatC(year, width=4, flag = "0") dekad <- floor(as.integer(format(time(x, "days"), "%j")) / 10) + 1 index <- paste0(year, dekad) prename <- "yd_" } else if (choice == "weeks") { index <- strftime(time(x, "days"), format = "%V") prename <- "week_" } else if (choice == "yearweeks") { index <- yearweek(time(x, "days")) prename <- "yw_" } else if (choice == "7days") { index <- as.integer(format(time(x, "days"), "%j")) index <- as.character((index-1) %/% 7 + 1) prename <- "d7_" } else if (choice == "10days") { index <- as.integer(format(time(x, "days"), "%j")) index <- as.character((index-1) %/% 10 + 1) prename <- "d10_" } else if (choice == "15days") { index <- as.integer(format(time(x, "days"), "%j")) index <- as.character((index-1) %/% 15 + 1) prename <- "d15_" } else { index <- time(x, choice) out_time <- time_as_seconds(x)[!duplicated(index)] out_tstep <- choice out_tz <- attr(index, "tzone") if (is.null(out_tz)) out_tz = "UTC" if (choice == "yearmonths") { year <- trunc(index) month <- 12 * (index - year) + 1 year <- formatC(year, width=4, flag = "0") month <- formatC(month, width=2, flag = "0") index <- paste0(year, month) prename <- "ym_" } else { index <- as.character(index) if (choice == "months") { prename <- "m_" } else if (choice == "days") { prename <- "d_" } else if (choice == "years") { prename <- "y_" } } } } else if (is.function(index)) { index <- as.character(index(time(x))) } } nl <- nlyr(x) if (length(index) > nl) { error("tapp", "length(index) > nlyr(x)") } else if (length(unique(index)) == 1) { warn("tapp", "it is not sensible to a single value as index (use app instead)") } index <- rep_len(index, nl) if (!is.factor(index)) { index <- factor(index, levels=unique(index)) } nms <- paste0(prename, as.character(index)) ind <- as.integer(index) d <- unique(data.frame(nms, ind, stringsAsFactors=FALSE)) uin <- d[,2] nms <- make.names(d[,1]) nms <- nms[uin] txtfun <- .makeTextFun(fun) if (inherits(txtfun, "character")) { if (txtfun %in% .cpp_funs) { opt <- spatOptions(filename, overwrite, wopt=wopt) narm <- isTRUE(list(...)$na.rm) x@pntr <- x@pntr$apply(index, txtfun, narm, nms, out_time, out_tstep, out_tz, opt) return(messages(x, "tapp")) } } fun <- match.fun(fun) readStart(x) on.exit(readStop(x), add=TRUE) testnc <- min(ncol(x), 11) v <- readValues(x, 1, 1, 1, testnc, TRUE) if (any(is.factor(x))) { warn("app", "factors are coerced to numeric") } test <- apply(v, 1, FUN=fun, ...) transpose = FALSE nlout <- 1 if (NCOL(test) > 1) { if (ncol(test) == testnc) { transpose = TRUE nlout <- nrow(test) addnms <- rownames(test) } else { nlout <- ncol(test) addnms <- colnames(test) } nms <- paste(rep(nms, each=length(addnms)), rep(addnms, length(nms)), sep="_") } out <- rast(x) nlyr(out) <- nlout * length(uin) names(out) <- nms if (out_tstep != "") { time(out, out_tstep) <- out_time } doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores)) } b <- writeStart(out, filename, overwrite, sources=sources(x), wopt=wopt) if (doclust) { export_args(cores, ..., caller="tapp") pfun <- function(x, ...) apply(x, 1, FUN=fun, ...) parallel::clusterExport(cores, "pfun", environment()) for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, ncol(out), TRUE) v <- lapply(uin, function(i) v[, ind==i, drop=FALSE]) v <- parallel::parLapply(cores, v, pfun, ...) if (transpose) { v <- t(do.call(rbind, v)) } else { v <- do.call(cbind, v) } writeValues(out, v, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, ncol(out), TRUE) # like this, na.rm is not passed to FUN # v <- lapply(uin, function(j, ...) apply(v[, ind==uin[j], drop=FALSE], 1, FUN=fun, ...)) # like this it works v <- lapply(uin, function(j) apply(v[, ind==uin[j], drop=FALSE], 1, FUN=fun, ...)) if (transpose) { v <- t(do.call(rbind, v)) } else { v <- do.call(cbind, v) } writeValues(out, v, b$row[i], b$nrows[i]) } } out <- writeStop(out) return(out) } ) terra/R/click.R0000644000176200001440000000620414732342353013010 0ustar liggesusers# Author: Robert J. Hijmans # Date : January 2009 - December 2011 # Version 1.0 # License GPL v3 #.getClicks <- function(...) { # res <- list() # while(TRUE) { # loc <- graphics::locator(1, ...) # if (is.null(loc)) break # res <- c(res, loc) # } # matrix(res, ncol=2, byrow=TRUE) #} RStudio_warning <- function() { if (.terra_environment$RStudio_warned) return() if (Sys.getenv("RSTUDIO_USER_IDENTITY") != "") { warn("'click', 'draw', and 'sel' may not work properly\nwith the default RStudio plotting window. See ?click") } .terra_environment$RStudio_warned <- TRUE } .getCellFromClick <- function(x, n, type, id, ...) { #loc <- graphics::locator(n, type, ...) #xyCoords <- cbind(x=loc$x, y=loc$y) xyCoords <- RS_locator(n, type, ...) if (id) { text(xyCoords, labels=1:n) } cells <- cellFromXY(x, xyCoords) cells <- unique(stats::na.omit(cells)) if (length(cells) == 0 ) { error("click", "no valid cells selected") } cells } do_click <- function(type="p", id=FALSE, i=1, pch=20, ...) { p <- graphics::locator(1) if (is.null(p)) return(p) # ESC points(p$x, p$y, type=type, pch=pch, ...) if (id) { text(p$x, p$y, labels=i, pos=4, ...) } cbind(x=p$x, y=p$y) } setMethod("click", signature(x="missing"), function(x, n=10, id=FALSE, type="p", show=TRUE, ...) { RStudio_warning() #loc <- graphics::locator(n, type, ...) #cbind(x=loc$x, y=loc$y) n <- max(1, round(n)) X <- NULL if (show) { on.exit(return(invisible(X))) } else { on.exit(return(X)) } for (i in 1:n) { x <- do_click(type=type, id=id, i=i, ...) if (is.null(x)) break X <- rbind(X, x) if (show) { rownames(x) <- i print(x); utils::flush.console() } } } ) setMethod("click", signature(x="SpatRaster"), function(x, n=10, id=FALSE, xy=FALSE, cell=FALSE, type="p", show=TRUE, ...) { RStudio_warning() n <- max(round(n), 1) values <- NULL if (show) { on.exit(return(invisible(values))) } else { on.exit(return(values)) } for (i in 1:n) { p <- do_click(type=type, id=id, i=i, ...) if (is.null(p)) break celln <- cellFromXY(x, p) if (is.na(celln)) next value <- x[celln] if (cell) { value <- data.frame(cell=celln, value) } if (xy) { p <- xyFromCell(x, celln) colnames(p) <- c("x", "y") value <- data.frame(p, value) } if (show) { rownames(value) <- i print(value) utils::flush.console() } # if (is.null(dim(value))) { # value <- matrix(value) # colnames(value) <- names(x) # } values <- rbind(values, value) } }) setMethod("click", signature(x="SpatVector"), function(x, n=10, id=FALSE, xy=FALSE, type="p", show=TRUE, ...) { RStudio_warning() n <- max(round(n), 1) values <- xys <- NULL if (show) { on.exit(return(invisible(values))) } else { on.exit(return(values)) } for (i in 1:n) { p <- do_click(type=type, id=id, i=i, ...) if (is.null(p)) break e <- extract(x, vect(p)) if (xy) { e <- cbind(e[,1], x=p$x, y=p$y, e[,-1,drop=FALSE]) } names(e)[1] <- "ID" if (show) { rownames(e) <- i if (!id) { print(e[,-1]) } else { print(e) } utils::flush.console() } values <- rbind(values, e) } } ) terra/R/plotRGB.R0000644000176200001440000000154714536376240013245 0ustar liggesusers# Author: Robert J. Hijmans # Date : April 2010 # Version 0.9 # License GPL v3 # ..linStretch <- function (x) { # v <- stats::quantile(x, c(0.02, 0.98), na.rm = TRUE) # temp <- (255 * (x - v[1]))/(v[2] - v[1]) # temp[temp < 0] <- 0 # temp[temp > 255] <- 255 # return(temp) # } # # Histogram equalization stretch # ..eqStretch <- function(x){ # ecdfun <- stats::ecdf(x) # ecdfun(x)*255 # } # ..rgbstretch <- function(RGB, stretch, caller="") { # stretch = tolower(stretch) # if (stretch == 'lin') { # RGB[,1] <- ..linStretch(RGB[,1]) # RGB[,2] <- ..linStretch(RGB[,2]) # RGB[,3] <- ..linStretch(RGB[,3]) # } else if (stretch == 'hist') { # RGB[,1] <- ..eqStretch(RGB[,1]) # RGB[,2] <- ..eqStretch(RGB[,2]) # RGB[,3] <- ..eqStretch(RGB[,3]) # } else if (stretch != '') { # warn(caller, "invalid stretch value") # } # RGB # } terra/R/zoom.R0000644000176200001440000000173314750560571012715 0ustar liggesusers# Author: Robert J. Hijmans # Date : September 2009 # Version 0.9 # License GPL v3 setMethod("zoom", signature(x="SpatRaster"), function(x, e=draw(), maxcell=100000, layer=1, new=FALSE, ...) { if (grDevices::dev.cur() == 1) { if (!is.null(RGB(x))) { plot(x, maxcell=maxcell, ...) } else { plot(x, layer, maxcell=maxcell, ...) } } if (is.function(e)) { # force to start with drawing before creating a new graphics device e <- e } else if (!inherits(e, "SpatExtent")) { e <- ext(e) } if (new) { grDevices::dev.new() } window(x) <- e plot(x, maxcell=maxcell, ...) return(invisible(e)) } ) setMethod("zoom", signature(x="SpatVector"), function(x, e=draw(), new=FALSE, ...) { if (grDevices::dev.cur() == 1) { plot(x, ...) } if (is.function(e)) { e <- e } else if (!inherits(e, "SpatExtent")) { e <- ext(e) } if (new) { grDevices::dev.new() } x <- crop(x, e) plot(x, ext=e, ...) return(invisible(e)) } ) terra/R/watershed.R0000644000176200001440000000230214726700274013707 0ustar liggesusers# Author: Emanuele Cordano # Date : October 2023 # Version 1.0 # License GPL v3 setMethod("watershed", signature(x="SpatRaster"), function(x, pourpoint, filename="", ...) { opt <- spatOptions(filename, ...) cell <- cellFromXY(x, pourpoint) if (is.na(cell)) error("watershed", "pourpoint not on raster") x@pntr <- x@pntr$watershed2(as.integer(cell-1), opt) messages(x, "watershed") ## EC 20210318 } ) setMethod("pitfinder", signature(x="SpatRaster"), function(x, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$pitfinder2(opt) messages(x, "pitfinder") ## EC 20210318 } ) setMethod("NIDP", signature(x="SpatRaster"), function(x, filename="", ...) { opt <- spatOptions(filename, ...) x@pntr <- x@pntr$NIDP2(opt) messages(x, "NIDP") ## EC 20231031 } ) setMethod("flowAccumulation", signature(x="SpatRaster"), function(x, weight=NULL, filename="", ...) { opt <- spatOptions(filename, ...) if (is.null(weight)) { x@pntr <- x@pntr$flowAccu2(opt) } else { x@pntr <- x@pntr$flowAccu2_weight(weight@pntr, opt) } messages(x, "flowAccumulation") } ) terra/R/clean.R0000644000176200001440000000216314536376240013011 0ustar liggesusers ..gaps <- function(x) { p <- as.polygons(floor(ext(x)+1), crs=crs(x)) e <- disagg(erase(p, x)) if (nrow(e) > 1) { xmin = ext(p)[1] i <- sapply(1:nrow(e), function(i) ext(e[i])[1] > xmin) e <- e[i] x <- rbind(x, e) } x } clean_further <- function(x, tolerance=0.0001) { out <- as.lines(x) out <- snap(out, tolerance) out <- makeNodes(out) out <- mergeLines(out) as.polygons(out) } clean <- function(x) { g <- gaps(x) out <- erase(x) out <- rbind(out, g) g <- gaps(out) rbind(out, g) } mergebyborder <- function(x, field) { i <- is.na(x[[field, drop=TRUE]]) if (!any(i)) return(x) s <- sharedPaths(x) s$length <- perim(s) from <- x[i] x <- x[!i] for (i in 1:nrow(from)) { } } centerline <- function(p) { v <- as.points(voronoi(p, tolerance=0)) v <- intersect(v, p) v } #library(terra); messages = terra:::messages #p <- vect(system.file("ex/lux.shp", package="terra")) #h <- convHull(p[-12], "NAME_1") #x <- clean(h) #y <- clean_further(x) #hh <- rbind(h, h) #e <- erase(hh) #g <- gaps(e) #v1 = as.polygons(ext(0,1,0,1)) #v2 = as.polygons(ext(1.01,2,0,1)) #v <- rbind(v1, v2) #s = snap(v) terra/R/animate.R0000644000176200001440000000134114734155361013341 0ustar liggesusers# comment setMethod("animate", signature(x="SpatRaster"), function(x, pause=0.25, main, range, maxcell=50000, n=1, ...) { if (missing(main)) { main <- names(x) } # x <- spatSample(x, size=maxcell, method="regular", as.raster=TRUE, warn=FALSE) x <- sampleRaster(x, maxcell, method="regular", replace=FALSE, ext=NULL, warn=FALSE, overview=TRUE) if (missing(range)) { mnmx <- minmax(x) range <- c(min(mnmx[1,]), max(mnmx[2,])) } nl <- nlyr(x) n <- max(1, round(n)) i <- 1 reps <- 0 while (reps < n) { plot(x[[i]], main = main[i], range=range, maxcell=Inf, ...) grDevices::dev.flush() Sys.sleep(pause) i <- i + 1 if (i > nl) { i <- 1 reps <- reps+1 } } } ) terra/R/dimensions.R0000644000176200001440000000715014726700274014077 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2017 # Version 0.9 # License GPL v3 setMethod("dim", signature(x="SpatRaster"), function(x){ return(c(nrow(x), ncol(x), nlyr(x))) } ) setMethod("dim", signature(x="SpatRasterDataset"), function(x) { c(x@pntr$nrow(), x@pntr$ncol()) } ) setMethod("dim", signature(x="SpatRasterCollection"), function(x) { m <- matrix(x@pntr$dims(), ncol=3) colnames(m) <- c("nrow", "ncol", "nlyr") m } ) setMethod("nrow", signature(x="SpatRasterCollection"), function(x) { dim(x)[,1] } ) setMethod("ncol", signature(x="SpatRasterCollection"), function(x) { dim(x)[,2] } ) setMethod("nlyr", signature(x="SpatRasterCollection"), function(x) { dim(x)[,3] } ) setMethod("nrow", signature(x="SpatRaster"), function(x){ return(x@pntr$nrow())} ) setMethod("nrow", signature(x="SpatRasterDataset"), function(x){ return(x[1]@pntr$nrow())} ) setMethod("nrow", signature(x="SpatVector"), function(x){ return(x@pntr$nrow())} ) setMethod("ncol", signature(x="SpatRaster"), function(x){ return(x@pntr$ncol()) } ) setMethod("ncol", signature(x="SpatRasterDataset"), function(x){ return(x[1]@pntr$ncol())} ) setMethod("ncol", signature(x="SpatVector"), function(x){ return(x@pntr$ncol())} ) setMethod("dim<-", signature(x="SpatRaster"), function(x, value) { if (length(value) == 1) { value <- c(value, ncol(x), nlyr(x)) } else if (length(value) == 2) { value <- c(value, nlyr(x)) } else if (length(value) > 3) { warn("dim<-", "value should have length 1, 2, or 3. Additional values ignored") value <- value[1:3] } value <- as.integer(pmax(round(value), c(1,1,1))) #here we lose all attributes rast(nrows=value[1], ncols=value[2], nlyrs=value[3], extent=ext(x), crs=crs(x)) } ) setMethod("ncell", signature(x="SpatRaster"), function(x) { return(as.numeric(ncol(x)) * nrow(x)) } ) setMethod("ncell", signature(x="SpatRasterDataset"), function(x) { ncell(x[1]) } ) setMethod("ncell", signature(x="ANY"), function(x) { NROW(x) * NCOL(x) } ) setMethod("size", signature(x="SpatRaster"), function(x) { x@pntr$size() } ) setMethod("nlyr", signature(x="SpatRaster"), function(x){ return(x@pntr$nlyr() ) } ) setMethod("nlyr", signature(x="SpatRasterDataset"), function(x){ return(x@pntr$nlyr() ) } ) setMethod("nsrc", signature(x="SpatRaster"), function(x){ return(x@pntr$nsrc() ) } ) .nlyrBySource <- function(x) { x@pntr$nlyrBySource(); } setMethod("ncol<-", signature("SpatRaster", "numeric"), function(x, value) { dim(x) <- c(nrow(x), value) return(x) } ) setMethod("nrow<-", signature("SpatRaster", "numeric"), function(x, value) { dim(x) <- c(value, ncol(x)) return(x) } ) setMethod("nlyr<-", signature("SpatRaster", "numeric"), function(x, value) { dim(x) <- c(nrow(x), ncol(x), value) return(x) } ) setMethod("res", signature(x="SpatRaster"), function(x) { x@pntr$res } ) setMethod("res", signature(x="SpatRasterDataset"), function(x) { x@pntr$res() } ) setMethod("res<-", signature(x="SpatRaster"), function(x, value) { if (length(value) == 1) { value <- c(value, value) } else if (length(value) > 2) { warn("res<-", "value should have length 1 or 2. Additional values ignored") } x@pntr <- x@pntr$set_resolution(value[1], value[2]) messages(x, "resolution") } ) setMethod("xres", signature(x="SpatRaster"), function(x) { res(x)[1] } ) setMethod("yres", signature(x="SpatRaster"), function(x) { res(x)[2] } ) setMethod("datatype", signature(x="SpatRaster"), function(x, bylyr=TRUE){ d <- x@pntr$getDataType(FALSE, FALSE); if (bylyr) { d <- rep(d, sources(x, TRUE)$nlyr) } d } ) terra/R/messages.R0000644000176200001440000000336414744467670013553 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2018 # Version 1.0 # License GPL v3 error <- function(f, emsg="", ...) { stop("[", f, "] ", emsg, ..., call.=FALSE) } warn <- function(f, wmsg="", ...) { warning("[", f, "] ", wmsg, ..., call.=FALSE) } messages <- function(x, f="") { #g <- gc(verbose=FALSE) if (methods::.hasSlot(x, "pntr")) { if (x@pntr$has_warning()) { warn(f, paste(unique(x@pntr$getWarnings()), collapse="\n")) } if (x@pntr$has_error()) { error(f, x@pntr$getError()) } } else { if (x$has_warning()) { warn(f, paste(unique(x$getWarnings()), collapse="\n")) } if (x$has_error()) { error(f, x$getError()) } } x } mem_info <- function(x, n=1, print=TRUE) { #print=TRUE n <- max(0,n) opt <- spatOptions() opt$ncopies = n; v <- x@pntr$mem_needs(opt) gb <- 1024^3 / 8 # v[1:2] <- v[1:2] / gb memmin <- opt$memmin memmax <- opt$memmax if (print) { cat("\n------------------------") cat("\nMemory (GB) ") cat("\n------------------------") cat(paste("\ncheck threshold :", opt$memmin / gb, "(memmin)")) if (memmax > 0) { cat(paste("\navailable :", round(v[2], 2), "(memmax)")) } else { cat(paste("\navailable :", round(v[2], 2))) } cat(paste0("\nallowed (", round(100* v[3]) , "%) : ", round(v[3] * v[2], 2))) cat(paste0("\nneeded (n=", n, ") ", ifelse(n<10, " : ", ": "), round(v[1], 2))) cat("\n------------------------") cat(paste("\nproc in memory :", round(v[5]) != 0)) cat(paste("\nnr chunks :", ceiling(nrow(x)/v[4]))) cat("\n------------------------\n") } names(v) <- c("needed", "available", "memfrac", "chunk_rows", "fits_mem") invisible(v) } free_RAM <- function() { opt <- spatOptions() x <- rast() v <- x@pntr$mem_needs(opt) v[2] / 128 } terra/R/rapp.R0000644000176200001440000000431714726700274012673 0ustar liggesusers setMethod("rapp", signature(x="SpatRaster"), function(x, first, last, fun, ..., allyrs=FALSE, fill=NA, clamp=FALSE, circular=FALSE, filename="", overwrite=FALSE, wopt=list()) { stopifnot(hasValues(x)) firstval <- lastval <- NA if (inherits(first, "SpatRaster")) { first <- first[[1]] stopifnot(hasValues(first)) } else { if (!is.numeric(first)) { error("rapp", "argument `first` should be numeric or SpatRaster") } firstval <- first stopifnot(first %in% 1:nlyr(x)) } if (inherits(last, "SpatRaster")) { last <- last[[1]] stopifnot(hasValues(last)) } else { if (!is.numeric(last)) { error("rapp", "argument `last` should be numeric or SpatRaster") } lastval <- last stopifnot(last %in% 1:nlyr(x)) } if (!(is.na(firstval)) && (!(is.na(lastval)))) { error("rapp", "argument `first` or `last` must be a SpatRaster. Or use `app`") } if (!is.na(firstval)) { index <- last; } else if (!is.na(lastval)) { index <- first } else { index <- c(first, last) } compareGeom(x, index, lyrs=FALSE, crs=FALSE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE) if (!allyrs) { txtfun <- .makeTextFun(match.fun(fun)) if (inherits(txtfun, "character")) { if (txtfun %in% .cpp_funs) { opt <- spatOptions(filename, overwrite, wopt=wopt) na.rm <- isTRUE(list(...)$na.rm) x@pntr <- x@pntr$rapply(index@pntr, firstval, lastval, txtfun, clamp, na.rm, circular, opt) return(messages(x, "rapp")) } } } out <- rast(x) v <- x@pntr$rappvals(index@pntr, firstval, lastval, clamp, allyrs, fill, 0, 1, circular) v <- sapply(v, fun, ...) if (is.list(v)) { error("rapp", "values returned by 'fun' do not have the same length for each cell") } nc <- ncol(out) trans = FALSE if (NCOL(v) == nc) { trans = TRUE nlyr(out) <- nrow(v) } else if (NROW(v) == nc) { nlyr(out) <- NCOL(v) } else if (length(v) == nc) { nlyr(out) <- 1 } b <- writeStart(out, filename, overwrite, sources=sources(x), wopt=wopt, n=nlyr(x)*3) for (i in 1:b$n) { v <- x@pntr$rappvals(index@pntr, firstval, lastval, clamp, allyrs, fill, b$row[i]-1, b$nrows[i], circular) v <- sapply(v, fun, ...) if (trans) v = t(v) writeValues(out, as.vector(v), b$row[i], b$nrows[i]) } out <- writeStop(out) return(out) } ) terra/R/polygons.R0000644000176200001440000000000014536376240013565 0ustar liggesusersterra/R/makeVRT.R0000644000176200001440000000746414536376240013251 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2010, January 2022 # Version 1.0 # Licence GPL v3 gdalDType <- function(dtype) { dps <- c("INT2S", "INT4S", "INT1U", "INT2U", "INT4U", "FLT4S", "FLT8S") if (!(dtype %in% dps)) { stop(paste(dtype, "is not a valid data type. Should be one of:", paste(dps, collapse=", "))) } bytesize <- as.integer(substr(dtype, 4, 4)) size <- bytesize * 8 type <- substr(dtype, 1, 3) if (type == "INT") { type <- "Int" if (size == 64) { size <- 32 warning("8 byte integer values not supported by GDAL, changed to 4 byte integer values") } if (substr(dtype, 5, 5) == "U") { if (size == 8) { return(c("Byte", 1)) } else { type <- paste("U", type, sep="") } } } else { type <- "Float" } return(c(paste0(type, size), bytesize)) } makeVRT <- function(filename, nrow, ncol, nlyr=1, extent, xmin, ymin, xres, yres=xres, xycenter=TRUE, crs="+proj=longlat", lyrnms="", datatype, NAflag=NA, bandorder="BIL", byteorder="LSB", toptobottom=TRUE, offset=0, scale=1) { stopifnot(length(filename)==1) stopifnot(file.exists(filename)) if (tolower(tools::file_ext(filename)) == "vrt") { stop("cannot (over)write a vrt header for a vrt file") } lyrnms <- rep(lyrnms, length.out=nlyr) fvrt <- paste0(filename, ".vrt") if (missing(datatype)) { bytes <- file.info(filename)$size / (3601 * 3601) if (bytes == 1) { datatype <- "INT1U" } else if (bytes == 2) { datatype <- "INT2U" } else if (bytes == 4) { datatype <- "FLT4S" } else if (bytes == 8) { datatype <- "FLT8S" } } gd <- gdalDType(datatype[1]) datatype <- gd[1] pixsize <- as.integer(gd[2]) if (bandorder[1] == "BIL") { pixoff <- pixsize lineoff <- pixsize * ncol * nlyr imgoff <- ((1:nlyr)-1) * ncol * pixsize } else if (bandorder[1] == "BSQ") { pixoff <- pixsize lineoff <- pixsize * ncol imgoff <- ((1:nlyr)-1) * nrow*ncol * pixsize } else if (bandorder[1] == "BIP") { pixoff <- pixsize * nlyr lineoff <- pixsize * ncol * nlyr imgoff <- (1:nlyr)-1 } else { stop("unknown bandorder") } stopifnot(byteorder[1] %in% c("LSB", "MSB")) if (toptobottom[1]) { rotation <- 0 } else { rotation <- 180 } res <- abs(c(xres, yres)) if (missing(extent)) { if (xycenter) { xmin <- xmin - res[1]/2 ymin <- ymin - res[2]/2 } ymax <- ymin + nrow * res[2] } else { xmin <- xmin(extent) ymax <- ymax(extent) } f <- file(fvrt, "w") cat('\n' , sep = "", file = f) cat('', xmin, ', ', res[1], ', ', rotation, ', ', ymax, ', ', 0.0, ', ', -1*res[2], '\n', sep = "", file = f) if (! is.na(crs) ) { cat('', crs ,'\n', sep = "", file = f) } for (i in nlyr) { cat('\t\n', sep = "" , file = f) cat('\t\t', lyrnms[i], '\n', sep = "", file = f) cat('\t\t', basename(filename), '\n', sep = "", file = f) cat('\t\t', imgoff[i], '\n', sep = "", file = f) cat('\t\t', pixoff, '\n', sep = "", file = f) cat('\t\t', lineoff, '\n', sep = "", file = f) cat('\t\t', byteorder, '\n', sep = "", file = f) if (!is.na(NAflag)) { cat('\t\t', NAflag, '\n', sep = "", file = f) } if (isTRUE(offset != 0) || isTRUE(scale != 1)) { cat('\t\t', offset, '\n', sep = "", file = f) cat('\t\t', scale, '\n', sep = "", file = f) } cat('\t\n', sep = "", file = f) } cat('\n', sep = "", file = f) close(f) return(fvrt) } # a = makeVRT(ff[1], 3601, 3601, 1, xmin=37, ymin=37, xres=1/3600, lyrnms="aspect", datatype="INT2U", byteorder="MSB") terra/R/crs.R0000644000176200001440000001772614726701261012525 0ustar liggesusers# Author: Robert J. Hijmans # Date : January 2009 # Version 0.9 # License GPL v3 character_crs <- function(x, caller="") { if (!inherits(x, "character")) { if (is.atomic(x)) { # for logical NA x <- as.character(x) } else { x <- crs(x) } } if (is.na(x)) { "" } else { if (tolower(x) == "local") { x <- 'LOCAL_CS["Cartesian (Meter)", LOCAL_DATUM["Local Datum",0], UNIT["Meter",1.0], AXIS["X",EAST], AXIS["Y",NORTH]]' } else if (tolower(x) == "lonlat") { x <- "+proj=longlat" } x } } is.proj <- function(crs) { substr(crs, 1, 6) == "+proj=" } .check_proj4_datum <- function(crs) { crs <- trimws(tolower(crs)) if (!is.proj(crs)) return() x <- trimws(unlist(strsplit(crs, "\\+"))) d <- grep("datum=", x, value=TRUE) if (length(d) > 0) { d <- gsub("datum=", "", d) if (!(d %in% c("wgs84", "nad83", "nad27"))) { warn("crs<-", "Only the WGS84, NAD83 and NAD27 datums can be used with a PROJ.4 string. Use WKT2, authority:code, or +towgs84= instead") } } #d <- grep("towgs84=", x, value=TRUE) #if (length(d) > 0) { # warn("crs<-", "+towgs84 parameters in a PROJ4 string are ignored") #} } .proj4 <- function(x) { x@pntr$get_crs("proj4") } .name_from_wkt <- function(wkt) { s = strsplit(wkt, ",")[[1]][1] strsplit(s, "\"")[[1]][[2]] } .name_or_proj4 <- function(x) { if (inherits(x, "SpatVectorProxy")) { tptr <- x@pntr$v } else if (inherits(x, "Rcpp_SpatRaster")) { tptr <- x } else { tptr <- x@pntr } wkt <- tptr$get_crs("wkt") d <- .srs_describe(wkt) r <- tptr$get_crs("proj4") if (!(d$name %in% c(NA, "unknown", "unnamed"))) { if (substr(r, 1, 13) == "+proj=longlat") { r <- paste("lon/lat", d$name) } else { r <- d$name } if (!is.na(d$code)) { r <- paste0(r, " (", d$authority, ":", d$code, ")") } } if (r == "") { rr <- try(.name_from_wkt(wkt), silent=TRUE) if (!inherits(rr, "try-error")) { r <- rr } } r } .srs_describe <- function(srs) { info <- .SRSinfo(srs) names(info) <- c("name", "authority", "code", "area", "extent") d <- data.frame(t(info), stringsAsFactors=FALSE) d$area <- gsub("\\.$", "", d$area) d[d == ""] <- NA if (is.na(d$extent)) { d$extent <- list(c(NA, NA, NA, NA)) } else { d$extent <- list(as.numeric(unlist(strsplit(d$extent, ",")))) } d } .get_CRS <- function(x, proj=FALSE, describe=FALSE, parse=FALSE) { if (describe) { d <- .srs_describe(x@pntr$get_crs("wkt")) if (proj) { d$proj <- x@pntr$get_crs("proj4") } d } else if (proj) { x@pntr$get_crs("proj4") } else { r <- x@pntr$get_crs("wkt") if (parse) { unlist(strsplit(r, "\n")) } else { r } } } setMethod("crs", signature("character"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { x <- rast(crs=x) .get_CRS(x, proj=proj, describe=describe, parse=parse) } ) setMethod("crs", signature("SpatExtent"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { return("") } ) setMethod("crs", signature("SpatRaster"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { .get_CRS(x, proj=proj, describe=describe, parse=parse) } ) setMethod("crs", signature("SpatRasterDataset"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { if (length(x) > 0) { .get_CRS(x[[1]], proj=proj, describe=describe, parse=parse) } else { NULL } } ) .txtCRS <- function(x, warn=TRUE) { if (inherits(x, "SpatVector") | inherits(x, "SpatRaster")) { x <- crs(x) } if (is.null(x) || is.na(x)) { x <- "" } else if (inherits(x, "CRS")) { if (warn) warn("crs", "expected a character string, not a CRS object") y <- attr(x, "comment") if (is.null(y)) { y <- x@projargs if (is.na(y)) y <- "" } x <- y } else if (is.character(x)) { x <- x[1] lowx <- tolower(x) if (lowx == "local") { x = 'LOCAL_CS["Cartesian (Meter)", LOCAL_DATUM["Local Datum",0], UNIT["Meter",1.0], AXIS["X",EAST], AXIS["Y",NORTH]]' } else if (lowx == "lonlat") { x <- "+proj=longlat" } } else { error("crs", "I do not know what to do with this argument (expected a character string)") } .check_proj4_datum(x) x } setMethod("crs<-", signature("SpatRaster", "ANY"), function(x, warn=FALSE, value) { if (missing(value)) { value <- warn warn <- FALSE } value <- .txtCRS(value) if (warn && (crs(x) != "") && (value != "")) { message("Assigning a new crs. Use 'project' to transform a SpatRaster to a new crs") } x@pntr <- x@pntr$deepcopy() x@pntr$set_crs(value) messages(x, "crs<-") } ) setMethod("set.crs", signature("SpatRaster"), function(x, value) { value <- .txtCRS(value) x@pntr$set_crs(value) messages(x, "set_crs") invisible(TRUE) } ) #setMethod("crs<-", signature("SpatRaster", "character"), # function(x, ..., value) { # x@pntr$set_crs(value[1]) # messages(x, "crs<-") # } #) setMethod("crs", signature("SpatVector"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { .get_CRS(x, proj=proj, describe=describe, parse=parse) } ) setMethod("crs", signature("SpatVectorProxy"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { v <- vect() v@pntr <- x@pntr$v .get_CRS(v, proj=proj, describe=describe, parse=parse) } ) setMethod("crs", signature("SpatVectorCollection"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { if (length(x) > 0) { .get_CRS(x[[1]], proj=proj, describe=describe, parse=parse) } else { NULL } } ) setMethod("crs", signature("sf"), function(x, proj=FALSE, describe=FALSE, parse=FALSE) { xcrs <- attr(x[[ attr(x, "sf_column") ]], "crs")$wkt x <- vect(cbind(0,0), crs=xcrs) .get_CRS(x, proj=proj, describe=describe, parse=parse) } ) setMethod("crs<-", signature("SpatVector", "ANY"), function(x, warn=FALSE, value) { if (missing(value)) { value <- warn warn <- FALSE } value <- .txtCRS(value) if (warn && (crs(x) != "") && (value != "")) { message("Assigning a new crs. Use 'project' to transform a SpatVector to a new crs") } x@pntr <- x@pntr$deepcopy() x@pntr$set_crs(value) messages(x, "crs<-") } ) setMethod("set.crs", signature("SpatVector"), function(x, value) { value <- .txtCRS(value) x@pntr$set_crs(value) messages(x, "set_crs") } ) setMethod("is.lonlat", signature("SpatRaster"), function(x, perhaps=FALSE, warn=TRUE, global=FALSE) { if (perhaps) { ok <- x@pntr$isLonLat() if (ok) { messages(x, "is.lonlat") if (global) { return(x@pntr$isGlobalLonLat()) } else { return(ok) } } ok <- x@pntr$couldBeLonLat() if (ok) { messages(x, "is.lonlat") if (global) { ok <- x@pntr$isGlobalLonLat() } } if (ok && warn) { warn("is.lonlat", "assuming lon/lat crs") } } else { ok <- x@pntr$isLonLat() if (ok) { messages(x, "is.lonlat") if (global) { ok <- x@pntr$isGlobalLonLat() } } else if (crs(x) == "") { ok <- NA warn("is.lonlat", "unknown crs") } } ok } ) setMethod("is.lonlat", signature("SpatVector"), function(x, perhaps=FALSE, warn=TRUE) { if (perhaps) { ok <- x@pntr$isLonLat() if (ok) { messages(x, "is.lonlat") return(ok) } ok <- x@pntr$couldBeLonLat() if (ok) { messages(x, "is.lonlat") } if (ok && warn) { warn("is.lonlat", "assuming lon/lat crs") } } else { ok <- x@pntr$isLonLat() if (ok) { messages(x, "is.lonlat") } else if (crs(x) == "") { ok <- NA warn("is.lonlat", "unknown crs") } } ok } ) setMethod("is.lonlat", signature("character"), function(x, perhaps=FALSE, warn=TRUE) { x <- rast(crs=x) is.lonlat(x, perhaps=perhaps, warn=warn) } ) same.crs <- function(x, y) { if (!is.character(x)) { x <- crs(x) } if (!is.character(y)) { y <- crs(y) } if (inherits(x, "CRS")) { if (!is.null(comment(x))) { x <- comment(x) } else { x <- x@projargs } } if (inherits(y, "CRS")) { if (!is.null(comment(y))) { y <- comment(y) } else { y <- y@projargs } } if (is.na(x)) x <- "" if (is.na(y)) x <- "" if (!is.character(x)) { x <- as.character(x) } if (!is.character(y)) { y <- as.character(y) } .sameSRS(x, y) } terra/R/tiles.R0000644000176200001440000000753314735447263013062 0ustar liggesusers setMethod("makeTiles", signature(x="SpatRaster"), function(x, y, filename="tile_.tif", extend=FALSE, na.rm=FALSE, buffer=0, overwrite=FALSE, ...) { filename <- trimws(filename[1]) filename <- filename[!is.na(filename)] if (filename == "") error("makeTiles", "filename cannot be empty") opt <- spatOptions(filename="", overwrite=overwrite, ...) if (inherits(y, "SpatRaster")) { ff <- x@pntr$make_tiles(y@pntr, extend[1], buffer, na.rm[1], filename, opt) } else if (inherits(y, "SpatVector")) { ff <- x@pntr$make_tiles_vect(y@pntr, extend[1], buffer, na.rm[1], filename, opt) } else if (is.numeric(y)) { if (length(y) > 2) { error("makeTiles", "expected one or two numbers") } y <- rep_len(y, 2) y <- aggregate(rast(x), y) ff <- x@pntr$make_tiles(y@pntr, extend[1], buffer, na.rm[1], filename, opt) } else { error("makeTiles", "y must be numeric or a SpatRaster or SpatVector") } messages(x, "makeTiles") ff } ) setMethod("getTileExtents", signature(x="SpatRaster"), function(x, y, extend=FALSE, buffer=0) { opt <- spatOptions(filename="") if (inherits(y, "SpatRaster")) { e <- x@pntr$get_tiles_ext(y@pntr, extend[1], buffer) } else if (inherits(y, "SpatVector")) { e <- x@pntr$get_tiles_ext_vect(y@pntr, extend[1], buffer) } else if (is.numeric(y)) { if (length(y) > 2) { error("getTileExtents", "expected one or two numbers") } y <- rep_len(y, 2) y <- aggregate(rast(x), y) e <- x@pntr$get_tiles_ext(y@pntr, extend[1], buffer) } else { error("getTileExtents", "y must be numeric or a SpatRaster or SpatVector") } messages(x, "getTileExtents") e <- matrix(e, ncol=4, byrow=FALSE) colnames(e) <- c("xmin", "xmax", "ymin", "ymax") e } ) # if (!hasValues(x)) error("makeTiles", "x has no values") # y <- rast(y)[[1]] # if (expand) y <- expand(y, ext(x), snap="out") # y <- crop(rast(y)[[1]], x, snap="out") # d <- 1:ncell(y) # if (length(filename) == 0) error("tiler", "no valid filename supplied") # e <- paste0(".", tools::file_ext(filename)) # f <- tools::file_path_sans_ext(filename) # ff <- paste0(f, d, e) # for (i in d) { # crop(x, y[i,drop=FALSE], filename=ff[i], ...) # } # ff[file.exists(ff)] # } #) setMethod("vrt", signature(x="character"), function(x, filename="", options=NULL, overwrite=FALSE, set_names=FALSE, return_filename=FALSE) { opt <- spatOptions(filename, overwrite=overwrite) r <- rast() if (is.null(options)) { options=""[0] } f <- r@pntr$make_vrt(x, options, opt) messages(r, "vrt") messages(opt, "vrt") if (set_names) { v <- readLines(f) nms <- names(rast(x[1])) i <- grep("band=", v) if (length(i) == length(nms)) { nms <- paste0("", nms, "") v[i] <- paste(v[i], nms) writeLines(v, f) } } if (return_filename) { f } else { rast(f) } } ) setMethod("vrt", signature(x="SpatRasterCollection"), function(x, filename="", options=NULL, overwrite=FALSE, return_filename=FALSE) { opt <- spatOptions(filename, overwrite=overwrite) if (is.null(options)) { options=""[0] } f <- x@pntr$make_vrt(options, FALSE, opt) messages(x, "vrt") if (return_filename) { f } else { rast(f) } } ) vrt_tiles <- function(x) { if (inherits(x, "SpatRaster")) { x <- sources(x) } if (!inherits(x, "character")) { error("vrt_sources", "x must be a filename (character) or SpatRaster)") } x <- grep(".vrt$", x, ignore.case =TRUE, value=TRUE) if (length(x) == 0) { error("vrt_sources", 'no filenames with extension ".vrt"') } tiles <- lapply(x, function(f) { v <- readLines(f) v <- v[grep("SourceFilename", v)] s <- strsplit(v, "\"") rel <- sapply(s, function(x) x[2]) ff <- strsplit(sapply(s, function(x) x[3]), "<") ff <- gsub(">", "", sapply(ff, function(x) x[1])) ff[rel=="1"] <- file.path(dirname(f), ff[rel=="1"]) ff }) unlist(tiles) } terra/R/k_means.R0000644000176200001440000000366114741601752013345 0ustar liggesusers setMethod("k_means", signature(x="ANY"), function(x, centers=3, ...) { stats::kmeans(x, centers=centers, ...) } ) setMethod("k_means", signature(x="SpatRaster"), function(x, centers=3, ..., maxcell=1000000, filename="", overwrite=FALSE, wopt=list()) { stopifnot(maxcell > 0) if (ncell(x) <= maxcell) { v <- na.omit(values(x)) omit <- as.vector(attr(v, "na.action")) km <- stats::kmeans(v, centers=centers, ...) out <- rast(x, nlyr=1) if (is.null(omit)) { values(out) <- km$cluster } else { out[-omit] <- km$cluster } if (filename != "") { out <- writeRaster(out, filename=filename, overwrite=overwrite, wopt=wopt) } } else { #pkmeans = function(x, newdata) { # apply(newdata, 1, function(i) which.min(colSums((t(x$centers) - i)^2))) #} pkmeans <- function(x, newdata) { vec <- integer(nrow(newdata)) newdata <- as.matrix(newdata) for (i in seq_len(nrow(newdata))) { vec[i] <- which.min(colSums((t(x) - newdata[i, ])^2)) } vec } v <- unique(na.omit(spatSample(x, maxcell, "regular"))) km <- stats::kmeans(v, centers=centers, ...)$centers out <- predict(x, km, fun=pkmeans, na.rm=TRUE, filename=filename, overwrite=overwrite, wopt=wopt) } out } ) h_clust <- function(x, ngroups, dist_metric="euclidean", clust_method="complete", agfun=mean, matchfun="squared", ..., maxcell=10000, filename="", overwrite=FALSE, wopt=list()) { stopifnot(maxcell > 0) stopifnot(ngroups > 0) stopifnot(ngroups < maxcell) d <- na.omit(spatSample(x, maxcell, "regular")) dd <- stats::dist(d, dist_metric) hc <- stats::hclust(dd, clust_method) th <- sort(hc$height, TRUE)[ngroups] cls <- stats::cutree(hc, h = th) hc <- cut(stats::as.dendrogram(hc), h=th)$upper d <- aggregate(d, list(cls=cls), agfun) cls <- d$cls d$cls <- NULL b <- bestMatch(x, d, fun=matchfun, ..., filename=filename, overwrite=overwrite, wopt=wopt) return(list(clusters=b, dendrogram=hc)) } terra/R/merge.R0000644000176200001440000000407214735571636013036 0ustar liggesusers# Author: Robert J. Hijmans # Date : June 2019 # Version 1.0 # License GPL v3 setMethod("merge", signature(x="SpatVector", y="data.frame"), function(x, y, ...) { v <- values(x) v$unique_nique_ique_que_e <- 1:nrow(v) m <- merge(v, y, ...) m <- m[order(m$unique_nique_ique_que_e), ] x <- x[stats::na.omit(m$unique_nique_ique_que_e), ] m$unique_nique_ique_que_e <- NULL if (nrow(m) > nrow(x)) { error("merge", "using 'all.y=TRUE' is not allowed. Should it be?") } values(x) <- m x } ) setMethod("merge", signature(x="SpatVector", y="SpatVector"), function(x, y, ...) { merge(x, data.frame(y), ...) } ) setMethod("merge", signature(x="SpatRasterCollection", "missing"), function(x, first=TRUE, na.rm=TRUE, algo=1, method=NULL, filename="", ...) { opt <- spatOptions(filename, ...) out <- rast() if (is.null(method)) method = "" out@pntr <- x@pntr$merge(first[1], na.rm, algo, method, opt) if (algo == 3) { messages(opt, "merge") } messages(x, "merge") messages(out, "merge") } ) setMethod("merge", signature(x="SpatRaster", y="SpatRaster"), function(x, y, ..., first=TRUE, na.rm=TRUE, algo=1, method=NULL, filename="", overwrite=FALSE, wopt=list()) { rc <- sprc(x, y, ...) merge(rc, first=first, na.rm=na.rm, algo=algo, method=method, filename=filename, overwrite=overwrite, wopt=wopt) } ) setMethod("mosaic", signature(x="SpatRaster", y="SpatRaster"), function(x, y, ..., fun="mean", filename="", overwrite=FALSE, wopt=list()) { fun <- .makeTextFun(fun) if (!inherits(fun, "character")) { error("mosaic", "function 'fun' is not valid") } opt <- spatOptions(filename, overwrite, wopt=wopt) rc <- sprc(x, y, ...) x@pntr <- rc@pntr$mosaic(fun, opt) messages(x, "mosaic") } ) setMethod("mosaic", signature(x="SpatRasterCollection", "missing"), function(x, fun="mean", filename="", ...) { opt <- spatOptions(filename, ...) out <- rast() fun <- .makeTextFun(fun) if (!inherits(fun, "character")) { error("mosaic", "function 'fun' is not valid") } out@pntr <- x@pntr$mosaic(fun, opt) messages(out, "mosaic") } ) terra/R/extent.R0000644000176200001440000001373614753770106013246 0ustar liggesusers# Author: Robert J. Hijmans # Date : October 2017 # Version 0.9 # License GPL v3 setMethod("ext", signature(x="SpatExtent"), function(x){ x@pntr <- x@pntr$deepcopy() x } ) setMethod("ext", signature(x="SpatRasterCollection"), function(x){ e <- methods::new("SpatExtent") e@pntr <- x@pntr$extent() e } ) setMethod("ext", signature(x="sf"), function(x){ sfi <- attr(x, "sf_column") geom <- x[[sfi]] e <- attr(geom, "bbox") ext(e[c(1,3,2,4)]) } ) setMethod("ext", signature(x="missing"), function(x){ e <- methods::new("SpatExtent") e@pntr <- SpatExtent$new() e } ) setMethod("ext", signature(x="numeric"), function(x, ..., xy=FALSE){ dots <- as.vector(unlist(list(...))) x <- c(x, dots) n <- length(x) if (n != 4) { error("ext", "expected four numbers") } names(x) <- NULL e <- methods::new("SpatExtent") if (xy) { e@pntr <- SpatExtent$new(x[1], x[3], x[2], x[4]) } else { e@pntr <- SpatExtent$new(x[1], x[2], x[3], x[4]) } if (!e@pntr$valid) { error("ext", "invalid extent") } e } ) setMethod("ext", signature(x="matrix"), function(x){ if ((ncol(x) == 2) && (nrow(x) > 2)) { x <- apply(x, 2, range, na.rm=TRUE) } ext(as.vector(x)) } ) setMethod("ext", signature(x="bbox"), function(x){ ext(x[c(1,3,2,4)]) } ) setMethod("ext", signature(x="SpatRaster"), function(x, cells=NULL){ if (!is.null(cells)) { cells <- stats::na.omit(unique(round(cells))) cells <- cells[cells > 0 & cells <= ncell(x)] if (length(cells) < 1) { stop("no valid cells") } r <- res(x) dx <- r[1] * c(-0.5, 0.5) dy <- r[2] * c(-0.5, 0.5) ext(range(xFromCell(x, cells)) + dx, range(yFromCell(x, cells)) + dy) } else { e <- methods::new("SpatExtent") e@pntr <- x@pntr$extent return(e) } } ) setMethod("ext", signature(x="SpatRasterDataset"), function(x){ e <- methods::new("SpatExtent") e@pntr <- x@pntr$ext() return(e) } ) setMethod("ext<-", signature("SpatRaster", "SpatExtent"), function(x, value) { x@pntr <- x@pntr$deepcopy() x@pntr$extent <- value@pntr messages(x, "ext<-") } ) setMethod("ext<-", signature("SpatRaster", "numeric"), function(x, value) { e <- ext(value) x@pntr <- x@pntr$deepcopy() x@pntr$extent <- e@pntr messages(x, "ext<-") } ) setMethod("set.ext", signature("SpatRaster"), function(x, value) { e <- ext(value) x@pntr$extent <- e@pntr messages(x, "set_ext") invisible(TRUE) } ) setMethod("ext", signature(x="SpatVector"), function(x) { e <- methods::new("SpatExtent") e@pntr <- x@pntr$extent() e } ) setMethod("ext", signature(x="SpatVectorCollection"), function(x) { e <- sapply(x, function(e) as.vector(ext(e))) ext(min(e[1,]), max(e[2,]), min(e[3,]), max(e[4,])) } ) setMethod("ext", signature(x="SpatVectorProxy"), function(x) { e <- methods::new("SpatExtent") e@pntr <- x@pntr$v$extent() e } ) setMethod("ext", signature(x="Extent"), function(x) { ext(as.vector(x)) } ) setMethod("ext", signature(x="Raster"), function(x) { ext(x@extent) } ) setMethod("ext", signature(x="Spatial"), function(x) { ext(as.vector(t(x@bbox))) } ) setMethod("xmin", signature(x="SpatExtent"), function(x){ x@pntr$vector[1] } ) setMethod("xmax", signature(x="SpatExtent"), function(x){ x@pntr$vector[2] } ) setMethod("ymin", signature(x="SpatExtent"), function(x){ x@pntr$vector[3] } ) setMethod("ymax", signature(x="SpatExtent"), function(x){ x@pntr$vector[4] } ) setMethod("xmin<-", signature("SpatExtent", "numeric"), function(x, value){ v <- as.vector(x) v[1] <- value ext(v) } ) setMethod("xmax<-", signature("SpatExtent", "numeric"), function(x, value){ v <- as.vector(x) v[2] <- value ext(v) } ) setMethod("ymin<-", signature("SpatExtent", "numeric"), function(x, value){ v <- as.vector(x) v[3] <- value ext(v) } ) setMethod("ymax<-", signature("SpatExtent", "numeric"), function(x, value){ v <- as.vector(x) v[4] <- value ext(v) } ) setMethod("xmin", signature(x="SpatRaster"), function(x){ xmin(ext(x)) } ) setMethod("xmax", signature(x="SpatRaster"), function(x){ xmax(ext(x)) } ) setMethod("ymin", signature(x="SpatRaster"), function(x){ ymin(ext(x)) } ) setMethod("ymax", signature(x="SpatRaster"), function(x){ ymax(ext(x)) } ) setMethod("xmin<-", signature("SpatRaster", "numeric"), function(x, value){ v <- as.vector(ext(x)) v[1] <- value x@pntr <- x@pntr$deepcopy() ext(x) <- ext(v) x } ) setMethod("xmax<-", signature("SpatRaster", "numeric"), function(x, value){ v <- as.vector(ext(x)) v[2] <- value x@pntr <- x@pntr$deepcopy() ext(x) <- ext(v) x } ) setMethod("ymin<-", signature("SpatRaster", "numeric"), function(x, value){ v <- as.vector(ext(x)) v[3] <- value x@pntr <- x@pntr$deepcopy() ext(x) <- ext(v) x } ) setMethod("ymax<-", signature("SpatRaster", "numeric"), function(x, value){ v <- as.vector(ext(x)) v[4] <- value x@pntr <- x@pntr$deepcopy() ext(x) <- ext(v) x } ) setMethod("xmin", signature(x="SpatVector"), function(x){ xmin(ext(x)) } ) setMethod("xmax", signature(x="SpatVector"), function(x){ xmax(ext(x)) } ) setMethod("ymin", signature(x="SpatVector"), function(x){ ymin(ext(x)) } ) setMethod("ymax", signature(x="SpatVector"), function(x){ ymax(ext(x)) } ) setMethod("$", "SpatExtent", function(x, name) { as.vector(x)[name] } ) setMethod("$<-", "SpatExtent", function(x, name, value) { e <- as.vector(x) e[name] <- value ext(e) } ) setMethod("[", c("SpatExtent", "missing", "missing"), function(x, i, j) { as.vector(x) } ) setMethod("[", c("SpatExtent", "numeric", "missing"), function(x, i, j) { x <- as.vector(x) x[i] } ) setReplaceMethod("[", c("SpatExtent", "numeric", "missing"), function(x, i, j, value) { e <- as.vector(x) stopifnot(all(i %in% 1:4)) e[i] <- value ext(e) } ) setMethod("is.valid", signature(x="SpatExtent"), function(x) { x@pntr$valid #x@pntr$valid_notempty } ) setMethod("is.empty", signature(x="SpatExtent"), function(x) { x@pntr$empty } ) terra/R/gdal.R0000644000176200001440000000763714756505507012655 0ustar liggesusers fileBlocksize <- function(x) { v <- x@pntr$getFileBlocksize() m <- matrix(v, ncol=2) colnames(m) <- c("rows", "cols") m } clearVSIcache <- function() { .clearVSIcache(TRUE) } gdalCache <- function(size=NA) { vsi <- FALSE # vsi not working if (is.null(size) || is.na(size)) { .getGDALCacheSizeMB(vsi) } else if (size > 0) { .setGDALCacheSizeMB(size, vsi) } } getGDALconfig <- function(option) { sapply(option, .gdal_getconfig) } setGDALconfig <- function(option, value="") { value <- rep_len(value, length(option)) for (i in 1:length(option)) { if (grepl("=", option[i])) { opt <- trimws(unlist(strsplit(option[i], "="))[1:2]) .gdal_setconfig(opt[1], opt[2]) } else { .gdal_setconfig(trimws(option[i]), trimws(value[i])) } } } libVersion <- function(lib="all", parse=FALSE) { lib <- tolower(lib) if (lib=="gdal") { out <- .gdal_version() } else if (lib=="proj") { out <- proj_version() } else if (lib=="geos") { out <- .geos_version() } else { out <- c(gdal=.gdal_version(), proj=proj_version(), geos=.geos_version()) } if (parse) { nms <- names(out) out <- data.frame(matrix(as.numeric(unlist(strsplit(out, "\\."))), ncol=3, byrow=TRUE), row.names=nms) names(out) <- c("major", "minor", "sub") } out } gdal <- function(warn=NA, drivers=FALSE, ...) { if (!is.na(warn)) { warn <- as.integer(warn) stopifnot(warn %in% (1:4)) .set_gdal_warnings(warn) } else if (drivers) { x <- .gdaldrivers() x <- do.call(cbind, x) x <- data.frame(x) x[,2] = c(FALSE, TRUE)[as.integer(x[,2])+1] x[,3] = c(FALSE, TRUE)[as.integer(x[,3])+1] x[,4] = c("read", "read/write", "read/write")[as.integer(x[,4])+1] colnames(x) <- c("name", "raster", "vector", "can", "vsi", "long.name") x[,5] <- x[,5] == 1 x <- x[order(x$name), ] rownames(x) <- NULL x } else { dots <- list(...) if (length(dots) > 0) { libVersion(dots[1]) } else { libVersion("gdal") } } } .describe_sds <- function(x, print=FALSE) { x <- .sdinfo(x) if (length(x[[1]]) == 1 & length(x[[2]]) == 0) { error("gdal (sds)", x[[1]]) } names(x) <- c("name", "var", "desc", "nrow", "ncol", "nlyr") m <- do.call(cbind, x) m <- data.frame(id=1:nrow(m), m, stringsAsFactors=FALSE) ii <- which(colnames(m) %in% c("nrow", "ncol", "nlyr")) for (i in ii) m[,i] <- as.integer(m[,i]) if (print) { print(m) invisible(m) } else { m } } .meta_sds <- function(x, parse=FALSE, ...) { if (parse) { m <- .parsedsdsmetadata(x) m <- do.call(cbind, m) if (nrow(m) > 0) { m <- data.frame(1:nrow(m), m, stringsAsFactors=FALSE) } else { m <- data.frame(0[0], m, stringsAsFactors=FALSE) } for (i in 5:7) m[,i] <- as.integer(m[,i]) colnames(m) <- c("id", "name", "var", "desc", "nrow", "ncol", "nlyr") } else { m <- .sdsmetadata(x) } m } setMethod("describe", signature(x="character"), function(x, sds=FALSE, meta=FALSE, parse=FALSE, options="", print=FALSE, open_opt="") { #x <- .fullFilename(x[1], FALSE) x <- x[1] if (meta) { if (sds) { return(.meta_sds(x, parse)) } else { return(.metadata(x)) } } if (sds) { return(.describe_sds(x, print=print)) } options <- unique(trimws(options)) options <- options[options != ""] if (length(options) > 0) { options <- paste0("-", options) options <- gsub("^--", "-", options) } open_opt <- unique(trimws(open_opt)) open_opt <- open_opt[open_opt != ""] g <- .gdalinfo(x, options, open_opt) if (g == "") { add <- ifelse(!file.exists(x), "\n", "\nThe file does not exist\n") x <- paste0("GDAL cannot open: ", x, add) } y <- unlist(strsplit(g, "\n")) if (print) { cat(g, "\n") invisible(y) } else { return(y) } } ) setMethod("describe", signature(x="SpatRaster"), function(x, source=1, ...) { if (!hasValues(x)) return(NULL) source <- round(source) if ((source < 1) || (source > nsrc(x))) { error("describe", "source should be >= 1 and <= nsrc()") } describe(sources(x)[source]) } ) terra/R/app.R0000644000176200001440000002025414726700273012506 0ustar liggesusers .cpp_funs <- c("sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first") setMethod("sapp", signature(x="SpatRaster"), function(x, fun, ..., filename="", overwrite=FALSE, wopt=list()) { x <- lapply(x, function(r) fun(r, ...)) x <- rast(x) if (filename[1] != "") { writeRaster(x, filename, overwrite, wopt=wopt) } else { tighten(x) } } ) setMethod("sapp", signature(x="SpatRasterDataset"), function(x, fun, ..., filename="", overwrite=FALSE, wopt=list()) { x <- lapply(as.list(x), function(r) app(r, fun, ...)) x <- rast(x) if (filename != "") { writeRaster(x, filename, overwrite, wopt=wopt) } else { tighten(x) } } ) export_args <- function(cores, ..., caller="app") { vals <- list(...) if (length(vals) < 1) return(NULL) nms <- names(vals) if (any(nms == "")) { error(caller, "additional arguments must be named when using multiple cores") } for (i in seq_along(vals)) { assign(nms[i], force(vals[i])) } parallel::clusterExport(cores, nms, envir=environment()) } ## similar from predict # dots <- list(...) # if (length(dots) > 0) { # nms <- names(dots) # dotsenv <- new.env() # lapply(1:length(dots), function(i) assign(nms[i], dots[[i]], envir=dotsenv)) # parallel::clusterExport(cls, nms, dotsenv) # } setMethod("app", signature(x="SpatRaster"), function(x, fun, ..., cores=1, filename="", overwrite=FALSE, wopt=list()) { txtfun <- .makeTextFun(fun) if (inherits(txtfun, "character")) { if (txtfun %in% .cpp_funs) { opt <- spatOptions(filename, overwrite, wopt=wopt) na.rm <- isTRUE(list(...)$na.rm) x@pntr <- x@pntr$summary(txtfun, na.rm, opt) return(messages(x, "app")) } } fun <- match.fun(fun) out <- rast(x) nlyr(out) <- 1 nc <- ncol(x) readStart(x) on.exit(readStop(x)) nl <- nlyr(x) dots <- list(...) if (length(dots) > 0) { test <- any(sapply(dots, function(i) inherits(i, "SpatRaster"))) if (test) { error("app", "additional arguments cannot be a SpatRaster") } } if (any(is.factor(x))) { warn("app", "factors are coerced to numeric") } # figure out the shape of the output by testing with up to 13 cells teststart <- max(1, 0.5 * nc - 6) testend <- min(teststart + 12, nc) ntest <- 1 + testend - teststart v <- readValues(x, round(0.51*nrow(x)), 1, teststart, ntest, mat=TRUE) usefun <- FALSE if (nl==1) { r <- fun(v, ...) usefun <- TRUE } else { r <- try(apply(v, 1, fun, ...), silent=TRUE) if (inherits(r, "try-error")) { rr <- try(fun(v, ...), silent=TRUE) if (inherits(rr, "try-error")) { error("app", paste0("cannot use this function\n", attr(r, "condition"))) } else { usefun <- TRUE r <- rr } } } if (is.list(r)) { if (length(unique(sapply(r, length))) > 1) { error("app", "'fun' returns a list (should be numeric or matrix).\nPerhaps because returned values have different lengths due to NAs in input?") } else { error("app", "'fun' returns a list (should be numeric or matrix)") } } trans <- FALSE if (NCOL(r) > 1) { #? if ((ncol(r) %% ntest) == 0) { if (ncol(r) == ntest) { nlyr(out) <- nrow(r) trans <- TRUE nms <- rownames(r) } else if (nrow(r) == ntest) { nlyr(out) <- ncol(r) nms <- colnames(r) } else { error("app", "the number of values returned by 'fun' is not appropriate\n(it should be the product of the number of cells and and a positive integer)") } if (is.null(wopt$names)) { wopt$names <- nms } } else { if ((length(r) %% ntest) != 0) { error("app", "the number of values returned by 'fun' is not appropriate") } else { nlyr(out) <- length(r) / ntest } } doclust <- FALSE if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } ncops <- nlyr(x) / nlyr(out) ncops <- ifelse(ncops > 1, ceiling(ncops), 1) * 4 b <- writeStart(out, filename, overwrite, wopt=wopt, n=ncops, sources=sources(x)) if (doclust) { ncores <- length(cores) export_args(cores, ...) for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) icsz <- max(min(100, ceiling(b$nrows[i] / ncores)), b$nrows[i]) r <- parallel::parRapply(cores, v, fun, ..., chunk.size=icsz) if (nlyr(out) > 1) { r <- matrix(r, ncol=nlyr(out), byrow=TRUE) } writeValues(out, r, b$row[i], b$nrows[i]) } } else { if (usefun) { for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) r <- fun(v, ...) if (trans) { r <- t(r) } writeValues(out, r, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { v <- readValues(x, b$row[i], b$nrows[i], 1, nc, TRUE) r <- apply(v, 1, fun, ...) if (trans) { r <- t(r) #r <- as.vector(r) } writeValues(out, r, b$row[i], b$nrows[i]) } } } writeStop(out) } ) .app_test_stack <- function(v, fun, ncols, ...) { # figure out the shape of the output nms = "" nr <- nrow(v[[1]]) v <- lapply(v, as.vector) v <- do.call(cbind, v) r <- apply(v, 1, fun, ...) if (inherits(r, "try-error")) { nl <- -1 } trans <- FALSE if (NCOL(r) > 1) { #? if ((ncol(r) %% nc) == 0) { if (ncol(r) == ncols) { nl <- nrow(r) trans <- TRUE } else if (nrow(r) == ncols) { nl <- ncol(r) } else { error("app", "cannot handle 'fun'") } } else if (length(r) >= nr) { if ((length(r) %% nr) == 0) { nl <- length(r) / nr } else { nl <- -1 } } else { nl <- -1 } if (is.matrix(r)) { nms <- colnames(r) } list(nl=nl, trans=trans, names=nms) } .app_test_stack <- function(v, fun, ncols, ...) { # figure out the shape of the output nms = "" nr <- nrow(v[[1]]) v <- lapply(v, as.vector) v <- do.call(cbind, v) r <- apply(v, 1, fun, ...) if (inherits(r, "try-error")) { nl <- -1 } trans <- FALSE if (NCOL(r) > 1) { #? if ((ncol(r) %% nc) == 0) { if (ncol(r) == ncols) { nl <- nrow(r) trans <- TRUE } else if (nrow(r) == ncols) { nl <- ncol(r) } else { error("app", "'fun' is not appropriate") } } else if (length(r) >= nr) { if ((length(r) %% nr) == 0) { nl <- length(r) / nr } else { nl <- -1 } } else { nl <- -1 } if (is.matrix(r)) { nms <- colnames(r) } list(nl=nl, trans=trans, names=nms) } setMethod("app", signature(x="SpatRasterDataset"), function(x, fun, ..., cores=1, filename="", overwrite=FALSE, wopt=list()) { txtfun <- .makeTextFun(match.fun(fun)) if (inherits(txtfun, "character")) { if (txtfun %in% .cpp_funs) { opt <- spatOptions(filename, overwrite, wopt=wopt) narm <- isTRUE(list(...)$na.rm) r <- rast() r@pntr <- x@pntr$summary(txtfun, narm, opt) return (messages(r, "app") ) } } if (missing(fun)) error("app", "'fun' is missing") ncx <- ncol(x[1]) nrx <- nrow(x[1]) readStart(x) on.exit(readStop(x)) v <- lapply(1:length(x), function(i) readValues(x[i], round(0.51*nrx), 1, 1, ncx, mat=TRUE)) test <- .app_test_stack(v, fun, ncx, ...) if (test$nl < 1) error("app", "cannot find 'fun'") out <- rast(x[1], nlyrs=test$nl) if (length(test$names == test$nl)) { if (is.null(wopt$names)) wopt$names <- test$names } nc <- (nlyr(x[1]) * length(x)) / nlyr(out) nc <- ifelse(nc > 1, ceiling(nc), 1) * 3 b <- writeStart(out, filename, overwrite, wopt=wopt, n=nc, sources=unlist(sources(x))) if (inherits(cores, "cluster")) { doclust <- TRUE } else if (cores > 1) { doclust <- TRUE cores <- parallel::makeCluster(cores) on.exit(parallel::stopCluster(cores), add=TRUE) } else { doclust <- FALSE } if (doclust) { ncores <- length(cores) export_args(cores, ...) for (i in 1:b$n) { v <- lapply(1:length(x), function(s) as.vector(readValues(x[s], b$row[i], b$nrows[i], 1, ncx, mat=TRUE))) v <- do.call(cbind, v) icsz <- max(min(100, ceiling(b$nrows[i] / ncores)), b$nrows[i]) r <- parallel::parRapply(cores, v, fun, ..., chunk.size=icsz) if (test$trans) { r <- t(r) } writeValues(out, r, b$row[i], b$nrows[i]) } } else { for (i in 1:b$n) { v <- lapply(1:length(x), function(s) as.vector(readValues(x[s], b$row[i], b$nrows[i], 1, ncx, mat=TRUE))) r <- apply(do.call(cbind, v), 1, fun, ...) if (test$trans) { r <- t(r) } writeValues(out, r, b$row[i], b$nrows[i]) } } #readStop(x) writeStop(out) } ) terra/R/lines.R0000644000176200001440000001030214726700274013032 0ustar liggesusers setMethod("lines", signature(x="SpatRaster"), function(x, mx=10000, ...) { reset.clip() if(prod(dim(x)) > mx) { error("lines", "too many lines (you can increase the value of mx or use as.polygons)") } v <- as.polygons(x[[1]], dissolve=FALSE, values=FALSE) lines(v, ...) } ) setMethod("points", signature(x="SpatRaster"), function(x, ...) { reset.clip() p <- as.points(x[[1]]) points(p, ...) } ) setMethod("polys", signature(x="SpatRaster"), function(x, mx=10000, dissolve=TRUE, ...) { reset.clip() if(prod(dim(x)) > mx) { error("lines", "too many lines (you can increase the value of mx or use as.polygons)") } p <- as.polygons(x[[1]], dissolve=dissolve) polys(p, ...) } ) setMethod("lines", signature(x="SpatVector"), function(x, y=NULL, col, lwd=1, lty=1, arrows=FALSE, alpha=1, ...) { reset.clip() n <- nrow(x) if (n == 0) return(invisible(NULL)) gtype <- geomtype(x) if (missing(col)) col <- "black" if (!is.null(y)) { stopifnot(inherits(y, "SpatVector")) ytype <- geomtype(y) if ((ytype != "points") || (gtype != "points")) { error("lines", "when supplying two SpatVectors, both must have point geometry") } stopifnot(nrow(x) == nrow(y)) p1 <- geom(x)[, c("x", "y"), drop=FALSE] p2 <- geom(y)[, c("x", "y"), drop=FALSE] if (arrows) { arrows(p1[,1], p1[,2], p2[,1], p2[,2], col=col, lwd=lwd, lty=lty, ...) } else { a <- as.vector(t(cbind(p1[,1], p2[,1], NA))) b <- as.vector(t(cbind(p1[,2], p2[,2], NA))) lines(cbind(a, b), col=col, lwd=lwd, lty=lty, ...) } } else { if (gtype != "polygons") { x <- as.lines(x) } if ((length(col) == 1) && (length(lty)==1) && (length(lwd)==1)) { col <- .getCols(1, col, alpha) g <- x@pntr$linesNA() names(g) <- c("x", "y") graphics::plot.xy(g, type="l", lty=lty, col=col, lwd=lwd, ...) } else { col <- .getCols(n, col, alpha) lwd <- rep_len(lwd, n) lty <- rep_len(lty, n) # g <- lapply(x@pntr$linesList(), function(i) { names(i)=c("x", "y"); i } ) g <- x@pntr$linesList() for (i in 1:n) { if (length(g[[i]]) > 0) { names(g[[i]]) = c("x", "y") graphics::plot.xy(g[[i]], type="l", lty=lty[i], col=col[i], lwd=lwd[i]) } } } #g <- geom(x, df=TRUE) #g <- split(g, g[,1]) #if (gtype == "polygons") { # g <- lapply(g, function(x) split(x, x[,c(2,5)])) #} else { # g <- lapply(g, function(x) split(x, x[,2])) #} #for (i in 1:length(g)) { # for (j in 1:length(g[[i]])) { # lines(g[[i]][[j]][,3:4], col=col[i], lwd=lwd[i], lty=lty[i], ...) # } #} } } ) setMethod("points", signature(x="SpatVector"), function(x, col, cex=0.7, pch=16, alpha=1, ...) { reset.clip() n <- length(x) if (n == 0) return(invisible(NULL)) if (missing(col)) col <- "black" if ((length(col) == 1) && (length(cex)==1) && (length(pch)==1)) { col <- .getCols(1, col, alpha) #graphics::points(g[,3:4], col=col, pch=pch, cex=cex,...) g <- crds(x) graphics::plot.xy(list(x=g[,1], y=g[,2]), type="p", pch=pch, col=col, cex=cex, ...) } else { col <- .getCols(n, col, alpha) cex <- rep_len(cex, n) pch <- rep_len(pch, n) g <- geom(x, df=TRUE) if (nrow(g) > g[nrow(g), 1]) { g <- split(g[,3:4], g[,1]) for (i in 1:n) { #graphics::points(g[[i]], col=col[i], pch=pch[i], cex=cex[i], ...) graphics::plot.xy(list(x=g[[i]][,1], y=g[[i]][,2]), type="p", pch=pch[i], col=col[i], cex=cex[i], ...) } } else { graphics::plot.xy(list(x=g[,3], y=g[,4]), type="p", pch=pch, col=col, cex=cex, ...) } } } ) setMethod("polys", signature(x="SpatVector"), function(x, col, border="black", lwd=1, lty=1, alpha=1, ...) { reset.clip() gtype <- geomtype(x) if (gtype != "polygons") { error("polys", "expecting polygons") } if (missing(col)) { col <- NULL } else { col <- .getCols(length(x), col, alpha) } out <- list(main_cols=col) out$leg$border <- border p <- .plotPolygons(x, out, lwd=lwd, lty=lty, ...) } ) setMethod("points", signature(x="sf"), function(x, ...) { points(vect(x), ...) } ) setMethod("lines", signature(x="sf"), function(x, ...) { lines(vect(x), ...) } ) setMethod("polys", signature(x="sf"), function(x, ...) { polys(vect(x), ...) } ) terra/cleanup0000755000176200001440000000011614757467215012764 0ustar liggesusers#!/bin/sh rm -fr src/Makevars config.log config.status rm -fr proj_conf_test* terra/src/0000755000176200001440000000000014757467212012175 5ustar liggesusersterra/src/geosphere.cpp0000644000176200001440000002607614752175705014673 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatVector.h" #include "geodesic.h" #include "recycle.h" #include "geosphere.h" #ifndef M_PI #define M_PI (3.1415926535897932384626433) #endif #ifndef M_2PI #define M_2PI (M_PI * 2.0) #endif #ifndef M_hPI #define M_hPI (M_PI / 2.0) #endif #ifndef WGS84_a #define WGS84_a 6378137.0 #endif #ifndef WGS84_f #define WGS84_f 1/298.257223563 #endif //#include "Rcpp.h" inline void normLon(double &lon) { lon = fmod(lon + 180, 360.) - 180; } inline void normLonRad(double &lon) { lon = fmod(lon + M_PI, M_2PI) - M_PI; } inline double get_sign(const double &x) { return (x > 0.0) ? 1.0 : (x < 0.0) ? -1.0 : 0; } double distance_geo(double lon1, double lat1, double lon2, double lat2) { double s12, azi1, azi2; struct geod_geodesic g; geod_init(&g, WGS84_a, WGS84_f); geod_inverse(&g, lat1, lon1, lat2, lon2, &s12, &azi1, &azi2); return s12; } inline double distance_cos_r(double lon1, double lat1, double lon2, double lat2, double r = 6378137.) { return r * acos((sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(lon1-lon2))); } inline double distance_hav_r(double lon1, double lat1, double lon2, double lat2, const double r = 6378137.) { double dLat = lat2-lat1; double dLon = lon2-lon1; double a = sin(dLat/2.) * sin(dLat/2.) + cos(lat1) * cos(lat2) * sin(dLon/2.) * sin(dLon/2.); return 2. * atan2(sqrt(a), sqrt(1. - a)) * 6378137.0; } /* double distance_cosdeg(double lon1, double lat1, double lon2, double lat2, double r = 6378137.) { deg2rad(lon1); deg2rad(lon2); deg2rad(lat1); deg2rad(lat2); return r * acos((sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(lon1-lon2))); } */ void dest_geo(double slon, double slat, double sazi, double dist, double &dlon, double &dlat, double &dazi) { struct geod_geodesic g; geod_init(&g, WGS84_a, WGS84_f); geod_direct(&g, slat, slon, sazi, dist, &dlat, &dlon, &dazi); } double direction_geo(double lon1, double lat1, double lon2, double lat2) { double s12, azi1, azi2; struct geod_geodesic g; geod_init(&g, WGS84_a, WGS84_f); geod_inverse(&g, lat1, lon1, lat2, lon2, &s12, &azi1, &azi2); return( azi1) ; } double direction_cos(double& lon1, double& lat1, double& lon2, double& lat2) { if ((lon1 == lon2) && (lat1 == lat2)) return 0; // NAN? double dLon = lon2 - lon1; double y = sin(dLon) * cos(lat2); double x = cos(lat1) * sin(lat2) - sin(lat1) * cos(lat2) * cos(dLon); double azm = atan2(y, x); azm = fmod(azm+M_PI, M_PI); return azm > M_PI ? -(M_PI - azm) : azm; } double dist2track_geo(double lon1, double lat1, double lon2, double lat2, double plon, double plat, bool sign, double r=6378137) { double a = 1; double f = 0; struct geod_geodesic geod; geod_init(&geod, a, f); double d, b2, b3, azi; geod_inverse(&geod, lat1, lon1, lat2, lon2, &d, &b2, &azi); geod_inverse(&geod, lat1, lon1, plat, plon, &d, &b3, &azi); double toRad = M_PI / 180.; b2 *= toRad; b3 *= toRad; double xtr = asin(sin(b3-b2) * sin(d)) * r; return sign ? xtr : fabs(xtr); } inline double dist2track_cos(double lon1, double lat1, double lon2, double lat2, double plon, double plat, bool sign, double r=6378137) { double b2 = direction_cos(lon1, lat1, lon2, lat2); double b3 = direction_cos(lon1, lat1, plon, plat); double d = distance_cos_r(lon1, lat1, plon, plat, 1); double xtr = asin(sin(b3-b2) * sin(d)) * r; return sign ? xtr : fabs(xtr); } inline double dist2track_hav(double lon1, double lat1, double lon2, double lat2, double plon, double plat, bool sign, double r=6378137) { double b2 = direction_cos(lon1, lat1, lon2, lat2); double b3 = direction_cos(lon1, lat1, plon, plat); double d = distance_hav_r(lon1, lat1, plon, plat, 1); double xtr = asin(sin(b3-b2) * sin(d)) * r; return sign ? xtr : fabs(xtr); } double alongTrackDistance_geo(double lon1, double lat1, double lon2, double lat2, double plon, double plat, double r=6378137) { double a = 1; double f = 0; struct geod_geodesic geod; geod_init(&geod, a, f); double d, b2, b3, azi; geod_inverse(&geod, lat1, lon1, lat2, lon2, &d, &b2, &azi); geod_inverse(&geod, lat1, lon1, plat, plon, &d, &b3, &azi); deg2rad(b2); deg2rad(b3); double xtr = asin(sin(b3-b2) * sin(d)); double bsign = get_sign(cos(b2-b3)); return fabs(bsign * acos(cos(d) / cos(xtr)) * r); } double alongTrackDistance_cos(double lon1, double lat1, double lon2, double lat2, double plon, double plat, double r=6378137) { double tc = direction_cos(lon1, lat1, lon2, lat2); // * toRad double tcp = direction_cos(lon1, lat1, plon, plat); // * toRad double dp = distance_cos_r(lon1, lat1, plon, plat, 1); double xtr = asin(sin(tcp-tc) * sin(dp)); // +1/-1 for ahead/behind [lat1,lon1] double bearing = get_sign(cos(tc - tcp)); double angle = cos(dp) / cos(xtr); // Fixing limits for the angle between [-1, 1] to avoid NaNs from acos angle = angle > 1 ? 1 : angle < -1 ? -1 : angle; double dist = bearing * acos(angle) * r; return fabs(dist); } double alongTrackDistance_hav(double lon1, double lat1, double lon2, double lat2, double plon, double plat, double r=6378137) { double tc = direction_cos(lon1, lat1, lon2, lat2); // * toRad double tcp = direction_cos(lon1, lat1, plon, plat); // * toRad double dp = distance_hav_r(lon1, lat1, plon, plat, 1); double xtr = asin(sin(tcp-tc) * sin(dp)); // +1/-1 for ahead/behind [lat1,lon1] double bearing = get_sign(cos(tc - tcp)); double angle = cos(dp) / cos(xtr); // Fixing limits for the angle between [-1, 1] to avoid NaNs from acos angle = angle > 1 ? 1 : angle < -1 ? -1 : angle; double dist = bearing * acos(angle) * r; return fabs(dist); } // the alongTrackDistance is the length of the path along the great circle to the point of intersection // there are two, depending on which node you start // we want to use the min, but the max needs to be < segment length double dist2segment_geo(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double notused) { double seglength = distance_geo(lon1, lat1, lon2, lat2); double trackdist1 = alongTrackDistance_geo(lon1, lat1, lon2, lat2, plon, plat); double trackdist2 = alongTrackDistance_geo(lon2, lat2, lon1, lat1, plon, plat); if ((trackdist1 >= seglength) || (trackdist2 >= seglength)) { double d1 = distance_geo(lon1, lat1, plon, plat); double d2 = distance_geo(lon2, lat2, plon, plat); return d1 < d2 ? d1 : d2; } return dist2track_geo(lon1, lat1, lon2, lat2, plon, plat, false); } double dist2segment_cos(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double r) { double seglength = distance_cos_r(lon1, lat1, lon2, lat2, r); double trackdist1 = alongTrackDistance_cos(lon1, lat1, lon2, lat2, plon, plat, r); double trackdist2 = alongTrackDistance_cos(lon2, lat2, lon1, lat1, plon, plat, r); if ((trackdist1 >= seglength) || (trackdist2 >= seglength)) { double d1 = distance_cos_r(lon1, lat1, plon, plat, r); double d2 = distance_cos_r(lon2, lat2, plon, plat, r); return d1 < d2 ? d1 : d2; } return dist2track_cos(lon1, lat1, lon2, lat2, plon, plat, false, r); } double dist2segment_hav(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double r) { double seglength = distance_hav_r(lon1, lat1, lon2, lat2, r); double trackdist1 = alongTrackDistance_hav(lon1, lat1, lon2, lat2, plon, plat, r); double trackdist2 = alongTrackDistance_hav(lon2, lat2, lon1, lat1, plon, plat, r); if ((trackdist1 >= seglength) || (trackdist2 >= seglength)) { double d1 = distance_hav_r(lon1, lat1, plon, plat, r); double d2 = distance_hav_r(lon2, lat2, plon, plat, r); return d1 < d2 ? d1 : d2; } return dist2track_hav(lon1, lat1, lon2, lat2, plon, plat, false, r); } // [[Rcpp::export]] double dist2segmentPoint_geo(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double &ilon, double &ilat) { double seglength = distance_geo(lon1, lat1, lon2, lat2); double trackdist1 = alongTrackDistance_geo(lon1, lat1, lon2, lat2, plon, plat); double trackdist2 = alongTrackDistance_geo(lon2, lat2, lon1, lat1, plon, plat); if ((trackdist1 >= seglength) || (trackdist2 >= seglength)) { double d1 = distance_geo(lon1, lat1, plon, plat); double d2 = distance_geo(lat2, lat2, plon, plat); if (d1 < d2) { ilon = lon1; ilat = lat1; return d1; } else { ilon = lon2; ilat = lat2; return d2; } } double azi; double crossd = dist2track_geo(lon1, lat1, lon2, lat2, plon, plat, false); if (trackdist1 < trackdist2) { double bear = direction_geo(lon1, lat1, lon2, lat2); dest_geo(lon1, lat1, bear, trackdist1, ilon, ilat, azi); } else { double bear = direction_geo(lon2, lat2, lon1, lat1); dest_geo(lon2, lat2, bear, trackdist2, ilon, ilat, azi); } return crossd; } // [[Rcpp::export(name = "intermediate")]] std::vector> intermediate(double lon1, double lat1, double lon2, double lat2, int n, double distance) { double a = 6378137.0; double f = 1/298.257223563; struct geod_geodesic geod; geod_init(&geod, a, f); double d, azi1, azi2; std::vector> out(2); if (n <= 0) { if (distance <= 0) { out[0] = {lon1, lon2}; out[1] = {lon1, lon2}; return out; } else { geod_inverse(&geod, lat1, lon1, lat2, lon2, &d, &azi1, &azi2); n = std::round(d / distance); if (n < 2) { out[0] = {lon1, lon2}; out[1] = {lon1, lon2}; return out; } distance = d / n; } } else if (n == 1) { out[0] = {lon1, lon2}; out[1] = {lon1, lon2}; return out; } else { geod_inverse(&geod, lat1, lon1, lat2, lon2, &d, &azi1, &azi2); //distance = d / n; } out[0].resize(n+1); out[1].resize(n+1); out[0][0] = lon1; out[1][0] = lat1; for (int i=1; i antipodal(std::vector lon1, std::vector lat1, std::vector lon2, std::vector lat2, double tol=1e-9) { recycle(lon1, lon2); recycle(lat1, lat2); std::vector out; out.reserve(lon1.size()); double Pi180 = M_PI / 180.; for (size_t i=0; i &lon, std::vector &lat) { size_t n=lon.size(); for (size_t i=0; i. #include #include template class NA { public: static constexpr T value = std::is_floating_point::value ? NAN : std::numeric_limits::min(); }; // bool has no NA template <> class NA { public: static constexpr unsigned value = false; }; template struct is_string { static const bool value = false; }; template struct is_string> { static const bool value = true; }; /* template <> class NAvalue { public: static constexpr unsigned value = std::numeric_limits::max(); }; */ template bool is_NA(const T v) { if (std::is_floating_point::value) { return std::isnan(v); } else { bool b = v == (NA::value); return b; } } template <> class NA { public: static constexpr unsigned value = std::numeric_limits::max(); }; template void set_NA(std::vector &v, double naflag) { if (!std::isnan(naflag)) { T flag = naflag; T navalue = NA::value; std::replace(v.begin(), v.end(), flag, navalue); } } /* class NA_long { public: static constexpr long value = std::numeric_limits::min(); }; class NA_unsigned { public: static constexpr unsigned value = std::numeric_limits::max(); }; class NA_double { public: static constexpr double value = NAN; }; class NA_float { public: static constexpr float value = NAN; }; bool is_NAN(unsigned v) { return (v == NA_unsigned::value); } bool is_NAN(long v) { return (v == NA_long::value); } bool is_NAN(double v) { return std::isnan(v); } bool is_NAN(float v) { return std::isnan(v); } */ terra/src/sample.cpp0000644000176200001440000005546514734405300014162 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include "spatRaster.h" #include "distance.h" #include "recycle.h" #include #include #include "string_utils.h" void get_nx_ny(double size, size_t &nx, size_t &ny) { double nxy = nx * ny; if (std::isfinite(size) && (!std::isnan(size)) && (size < nxy)) { double f = sqrt(size / nxy ); double fnx = nx * f; double fny = ny * f; double s = fnx * fny; f = size / s; nx = std::max((size_t)1, (size_t) std::ceil(fnx * f)); ny = std::max((size_t)1, (size_t) std::ceil(fny * f)); } } void getSampleRowCol(std::vector &oldrow, std::vector &oldcol, size_t nrows, size_t ncols, size_t snrow, size_t sncol) { double rf = nrows / (double)(snrow); double cf = ncols / (double)(sncol); //double rstart = std::floor(0.5 * rf); //double cstart = std::floor(0.5 * cf); double rstart = 0.5 * rf; double cstart = 0.5 * cf; oldcol.reserve(sncol); for (size_t i =0; i SpatRaster::readSample(size_t src, size_t srows, size_t scols) { size_t nl = source[src].nlyr; std::vector oldcol, oldrow; std::vector out; getSampleRowCol(oldrow, oldcol, nrow(), ncol(), srows, scols); out.reserve(srows*scols); if (source[src].hasWindow) { size_t offrow = source[src].window.off_row; size_t offcol = source[src].window.off_col; size_t fncol = source[src].window.full_ncol; size_t oldnc = fncol * source[src].window.full_nrow; for (size_t lyr=0; lyr= ncell()) { return( *this ); } if (size < 0.5) { SpatRaster out; out.setError("sample size must be > 0"); return out; } double f = std::min(1.0, sqrt(size / ncell())); size_t nr = std::min((size_t)ceil(nrow() * f), nrow()); size_t nc = std::min((size_t)ceil(ncol() * f), ncol()); if ((nc == ncol()) && (nr == nrow())) { return( *this ); } SpatRaster out = geometry(nlyr(), true); out.source[0].nrow = nr; out.source[0].ncol = nc; std::vector vt = getValueType(true); if (vt.size() == 1) { out.setValueType(vt[0]); } if (!source[0].hasValues) return (out); std::vector v; for (size_t src=0; src 0"); } if (nr > nrow()) { if (warn) out.addWarning("number of rows cannot be larger than nrow(x)"); nr = nrow(); } if (nc > ncol()) { if (warn) out.addWarning("number of rows cannot be larger than nrow(x)"); nc = ncol(); } if ((nc == ncol()) && (nr == nrow())) { return( *this ); } out.source[0].nrow = nr; out.source[0].ncol = nc; std::vector vt = getValueType(true); if (vt.size() == 1) { out.setValueType(vt[0]); } if (!source[0].hasValues) return (out); std::vector v; for (size_t src=0; src> SpatRaster::sampleRegularValues(double size, SpatOptions &opt) { std::vector> out; if (!source[0].hasValues) return (out); size_t nr = nrow(); size_t nc = ncol(); get_nx_ny(size, nc, nr); /* if (size < ncell()) { double f = sqrt(size / ncell()); double nr1 = nrow() * f; double nc1 = ncol() * f; double s = nr1 * nc1; f = size / s; nr = std::max((size_t)1, (size_t) std::ceil(nr1 * f)); nc = std::max((size_t)1, (size_t) std::ceil(nc1 * f)); } */ size_t nsize = nc * nr; std::vector v; if ((size >= ncell()) || ((nc == ncol()) && (nr == nrow()))) { v = getValues(-1, opt) ; if (hasError()) return out; for (size_t i=0; i vv(v.begin()+offset, v.begin()+offset+nsize); out.push_back(vv); } return out; } for (size_t src=0; src vv(v.begin()+offset, v.begin()+offset+nsize); out.push_back(vv); } } return out; } std::vector> SpatRaster::sampleRowColValues(size_t nr, size_t nc, SpatOptions &opt) { std::vector> out; if (!source[0].hasValues) return (out); if ((nr == 0) || (nc ==0)) { return(out); } nr = std::min(nr, nrow()); nc = std::min(nc, ncol()); size_t nsize = nc * nr; std::vector v; if ((nc == ncol()) && (nr == nrow())) { v = getValues(-1, opt) ; if (hasError()) return out; for (size_t i=0; i vv(v.begin()+offset, v.begin()+offset+nsize); out.push_back(vv); } return out; } for (size_t src=0; src vv(v.begin()+offset, v.begin()+offset+nsize); out.push_back(vv); } } return out; } std::vector sample_replace(size_t size, size_t N, unsigned seed){ std::default_random_engine gen(seed); std::uniform_int_distribution<> U(0, N-1); std::vector sample; sample.reserve(size); for (size_t i=0; i sample_replace_weights(size_t size, size_t N, std::vector prob, unsigned seed){ std::discrete_distribution dist(std::begin(prob), std::end(prob)); std::mt19937 gen; gen.seed(seed); std::vector sample(size); for(auto & i: sample) i = dist(gen); return sample; } std::vector sample_no_replace(size_t size, size_t N, unsigned seed){ size_t one = 1; size = std::max(one, std::min(size, N)); std::vector sample; if (size == N) { sample.resize(size); std::iota(sample.begin(), sample.end(), 0); return sample; } std::default_random_engine gen(seed); if (size >= .66 * N) { sample.resize(N); std::iota(std::begin(sample), std::end(sample), 0); std::shuffle(sample.begin(), sample.end(), gen); if (size < N) { sample.erase(sample.begin()+size, sample.end()); } return sample; } std::uniform_real_distribution<> U( 0, std::nextafter(1.0, std::numeric_limits::max() ) ); sample.reserve(size); for (size_t i=0; i sample_no_replace_weights(size_t size, size_t N, std::vector prob, unsigned seed){ size_t one = 1; size = std::max(one, std::min(size, N)); std::vector sample; std::default_random_engine gen(seed); if (size == N) { sample.resize(size); std::iota(sample.begin(), sample.end(), 0); std::shuffle(sample.begin(), sample.end(), gen); return sample; } std::uniform_int_distribution<> U(0, std::numeric_limits::max()); std::unordered_set sampleset; size_t isize = size; if (size > (0.8 * N)) { isize = N - size; for (double &d : prob) d = 1-d; size_t ssize = isize * (1.1 + isize / N); size_t cnt=0; while (sampleset.size() < isize) { seed = U(gen); std::vector s = sample_replace_weights(ssize, N, prob, seed); for (size_t i=0; i 10) break; } std::vector invsamp; invsamp.insert(invsamp.begin(), sampleset.begin(), sampleset.end()); std::sort(invsamp.begin(), invsamp.end()); invsamp.push_back(N+1); size_t j=0; sample.reserve(size); for (size_t i=0; i s = sample_replace_weights(ssize, N, prob, seed); for (size_t i=0; i 10) break; } sample.insert(sample.begin(), sampleset.begin(), sampleset.end()); if (sample.size() > size) { sample.resize(size); }; } return(sample); } std::vector sample(size_t size, size_t N, bool replace, std::vector prob, unsigned seed){ if ((size == 0) || (N == 0)) { std::vector s; return s; } bool w = prob.size() == N; if (replace) { if (N == 1) { std::vector s(size,0); return s; } if (w) { return sample_replace_weights(size, N, prob, seed); } else { return sample_replace(size, N, seed); } } else { if (N == 1) { std::vector s(1,0); return s; } if (w) { return sample_no_replace_weights(size, N, prob, seed); } else { return sample_no_replace(size, N, seed); } } } std::vector> SpatRaster::sampleRandomValues(double size, bool replace, unsigned seed) { double nc = ncell(); std::vector cells; std::vector w; if (replace) { cells = sample((size_t)size, nc, false, w, seed); } else { cells = sample((size_t)size, nc, true, w, seed); } std::vector dcells(cells.begin(), cells.end()); std::vector> d = extractCell(dcells); return d; } SpatRaster SpatRaster::sampleRandomRaster(double size, bool replace, unsigned seed) { unsigned nsize; unsigned nr = nrow(); unsigned nc = ncol(); if (size < ncell()) { double f = sqrt(size / ncell()); nr = std::ceil(nrow() * f); nc = std::ceil(ncol() * f); } SpatRaster out = geometry(nlyr(), true); out.source[0].nrow = nr; out.source[0].ncol = nc; if (!source[0].hasValues) return (out); nsize = nr * nc; std::vector> vv = sampleRandomValues(nsize, replace, seed); for (size_t i=0; i SpatExtent::test_sample(size_t size, size_t N, bool replace, std::vector w, unsigned seed) { return sample(size, N, replace, w, seed); } std::vector> SpatExtent::sampleRandom(size_t size, bool lonlat, unsigned seed){ std::vector> out(2); if (size == 0) return out; std::default_random_engine gen(seed); if (lonlat) { double d = (ymax - ymin) / 1000.0; std::vector r = seq(ymin, ymax, d); std::vector w; w.reserve(r.size()); for (size_t i=0; i x = sample(size, r.size(), true, w, seed); std::vector lat, lon; lat.reserve(size); lon.reserve(size); std::uniform_real_distribution<> U1(-0.5, 0.5); double dx = 0.5 * d; for (size_t i=0; i U2(xmin, xmax); for (size_t i=0; i x, y; x.reserve(size); y.reserve(size); std::uniform_real_distribution<> runifx(xmin, xmax); std::uniform_real_distribution<> runify(ymin, ymax); for (size_t i=0; i> SpatExtent::sampleRegular(size_t size, bool lonlat) { std::vector> out(2); if (size == 0) return out; double r1 = xmax - xmin; double r2 = ymax - ymin; if (lonlat) { double halfy = ymin + r2/2; // beware that -180 is the same as 180; and that latitude can only go from -90:90 therefore: double dx = distance_lonlat(xmin, halfy, xmin + 1, halfy) * std::min(180.0, r1); double dy = distance_lonlat(0, ymin, 0, ymax); double ratio = dy/dx; double n = sqrt(size); double ny = n * ratio; double nx = n / ratio; double s = nx * ny; ratio = size / s; ny = std::max((size_t)1, (size_t) std::ceil(ny * ratio)); nx = std::max((size_t)1, (size_t) std::ceil(nx * ratio)); double x_i = r1 / nx; double y_i = r2 / ny; std::vector lat, lon, w, xi; lat.reserve(ny); lat.push_back(ymin+0.5*y_i); for (size_t i=1; i 355; // needs refinement if (global) { xmax -= 0.000001; for (size_t i=0; i x = seq(xmin+0.5*step, xmax, step); std::vector y(x.size(), lat[i]); out[0].insert(out[0].end(), x.begin(), x.end()); out[1].insert(out[1].end(), y.begin(), y.end()); } } else { double halfx = xmin + (xmax - xmin)/2; for (size_t i=0; i x = seq(halfx, xmax, xi[i]); double start = halfx-xi[i]; if (start > xmin) { std::vector x2 = seq(start, xmin, -xi[i]); x.insert(x.end(), x2.begin(), x2.end()); } std::vector y(x.size(), lat[i]); out[0].insert(out[0].end(), x.begin(), x.end()); out[1].insert(out[1].end(), y.begin(), y.end()); } } } else { double ratio = r1/r2; double ny = sqrt(size / ratio); double nx = size / ny; double s = nx * ny; ratio = size / s; ny = std::max((size_t)1, (size_t) std::ceil(ny * ratio)); nx = std::max((size_t)1, (size_t) std::ceil(nx * ratio)); double x_i = r1 / nx; double y_i = r2 / ny; std::vector x, y; x.reserve(nx); y.reserve(ny); x.push_back(xmin+0.5*x_i); for (size_t i=1; i SpatRaster::sampleCells(double size, std::string method, bool replace, unsigned seed) { std::default_random_engine gen(seed); std::vector out; if ((size >= ncell()) & (!replace)) { out.resize(ncell()); std::iota(out.begin(), out.end(), 0); if (method == "random") { std::shuffle(out.begin(), out.end(), gen); } return out; } if (method == "random") { } else if (method == "regular") { } else { //method == "stratified" } // else "Cluster" return out; } SpatVector SpatVector::sample(unsigned n, std::string method, unsigned seed) { std::string gt = type(); SpatVector out; if (gt != "polygons") { out.setError("only implemented for polygons"); return out; } if (n == 0) { out.srs = srs; return out; } /* if (strata != "") { // should use // SpatVector a = aggregate(strata, false); // but get nasty self-intersection precision probs. int i = where_in_vector(strata, get_names()); if (i < 0) { out.setError("cannot find field"); return out; } SpatDataFrame uv; std::vector idx = df.getIndex(i, uv); for (size_t i=0; i g; g.resize(0); for (size_t j=0; j a = area("m", true, {}); if (hasError()) { out.setError(getError()); return out; } double suma = accumulate(a.begin(), a.end(), 0.0); /* if (by_geom) { std::vector pa; pa.reserve(a.size()); for (size_t i=0; i> pxy(2); std::vector nsamp(size()); for (size_t i=0; i 0) { SpatGeom g = getGeom(i); SpatVector ve(g.extent, ""); ve.srs = srs; double vea = ve.area()[0]; if (random) { double m = vea / a[i]; m = std::max(2.0, std::min(m*m, 100.0)); size_t ssize = pa[i] * n * m; pxy = g.extent.sampleRandom(ssize, lonlat, seed); } else { size_t ssize = std::round(pa[i] * n * vea / a[i]); pxy = g.extent.sampleRegular(ssize, lonlat); } SpatVector vpnt(pxy[0], pxy[1], points, ""); SpatVector vpol(g); vpnt = vpnt.intersect(vpol); if (random) { size_t psize = pa[i] * n; if (vpnt.size() > psize) { std::vector rows(psize); std::iota(rows.begin(), rows.end(), 0); vpnt = vpnt.subset_rows(rows); } } nsamp[i] = vpnt.size(); if (out.size() == 0) { out = vpnt; } else { out = out.append(vpnt, true); } } } std::vector id(size()); std::iota(id.begin(), id.end(), 1); rep_each_vect(id, nsamp); SpatDataFrame df; df.add_column(id, "pol.id"); out.df = df; } else { */ std::vector> pxy(2); SpatVector ve(extent, ""); ve.srs = srs; double vea = ve.area("m", true, {})[0]; if (random) { double m = vea / suma; // the larger the sample size, the fewer extra samples needed double smx = sqrt(std::max(9.0, 100.0 - n)); m = std::max(smx, std::min(m*m, 100.0)); size_t ssize = n * m; pxy = extent.sampleRandom(ssize, lonlat, seed); } else { size_t ssize = std::round(n * vea / suma); pxy = extent.sampleRegular(ssize, lonlat); } out = SpatVector(pxy[0], pxy[1], points, ""); out = intersect(out, true); if (random) { if (out.size() > n) { std::vector rows(out.size()); std::iota(rows.begin(), rows.end(), 0); std::default_random_engine gen(seed); std::shuffle(rows.begin(), rows.end(), gen); rows.resize(n); out = out.subset_rows(rows); } } //std::vector id(out.size(), 1); //SpatDataFrame df; //df.add_column(id, "pol.id"); //out.df = df; // } out.srs = srs; return out; } SpatVector SpatVector::sample_geom(std::vector n, std::string method, unsigned seed) { SpatVector out; if (n.size() != size()) { out.setError("length of samples does not match number of geoms"); return out; } if (n.empty()) { out.srs = srs; return out; } for (size_t i=0; i sample(size_t size, size_t N, bool replace, std::vector prob, unsigned seed){ // Sample "size" elements from [1, N] std::vector result; std::default_random_engine gen(seed); bool weights = false; if (prob.size() == N) { weights = true; // should check for neg numbers double minw = *min_element(prob.begin(),prob.end()); double maxw = *max_element(prob.begin(),prob.end()) - minw; for (double& d : prob) d = (d - minw) / maxw; } if (replace) { //std::vector samples; result.reserve(size); std::uniform_int_distribution<> distribution(0, N-1); if (weights) { std::uniform_real_distribution<> wdist(0, 1); size_t cnt = 0; while (cnt < size) { double w = wdist(gen); double v = distribution(gen); if (prob[v] >= w) { result.push_back(v); cnt++; } } } else { for (size_t i=0; i distribution(1, N); std::unordered_set samples; if (weights) { std::uniform_int_distribution<> wdist(0, N-1); size_t cnt = 0; size_t r = 0; while (cnt < size) { double w = wdist(gen)/N; double v = distribution(gen); if (prob[v] >= w) { if (!samples.insert(v).second) { samples.insert(r); cnt++; } } r++; r = r%(N-1); } } else { for (size_t r = N - size; r < N; ++r) { unsigned v = distribution(gen) - 1; if (!samples.insert(v).second) samples.insert(r); } } result = std::vector(samples.begin(), samples.end()); std::shuffle(result.begin(), result.end(), gen); } return result; } */ terra/src/distValueRaster.cpp0000644000176200001440000002616014745242323016016 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "distance.h" #include "geodesic.h" #include "sort.h" #include "geosphere.h" void dist_bounds_values(const std::vector& vx, const std::vector& vy, const std::vector& v, const std::vector& rx, const double& ry, size_t& first, size_t& last, const bool& lonlat, const std::string &method, std::vector &d, std::vector &dv) { d = std::vector(rx.size(), std::numeric_limits::max()); dv = std::vector(rx.size(), NAN); size_t oldfirst = first; first = vx.size(); last = 0; if (lonlat) { std::function dfun; if (method == "haversine") { dfun = distance_hav; } else if (method == "cosine") { dfun = distance_cos; } else { dfun = distance_geo; } for (size_t i=0; i &d, std::vector &dv, const std::vector& vx, const std::vector& vy, const std::vector& vv, const std::vector& rx, const std::vector& ry, const size_t& first, const size_t& last, const bool& lonlat, const std::vector& dlast, const std::vector& dvlast, bool skip, const std::vector& v, const std::string& method, bool setNA) { size_t rxs = rx.size(); d.reserve(rxs + dlast.size()); dv.reserve(rxs + dlast.size()); double inf = std::numeric_limits::infinity(); if (lonlat) { if (method == "geo") { double dd, azi1, azi2; struct geod_geodesic g; // get a and f from crs? double a = 6378137.0; double f = 1/298.257223563; geod_init(&g, a, f); if (skip) { for (size_t i=0; i dfun; if (method == "haversine") { dfun = distance_hav; } else if (method == "cosine") { dfun = distance_cos; } if (skip) { for (size_t i=0; i::max(); for (size_t i=0; i< v.size(); i++) { if (v[i] == mxval) { d[i] = NAN; dv[i] = NAN; } } } } } SpatRaster SpatRaster::distance_crds_vals(std::vector& x, std::vector& y, const std::vector& v, const std::string& method, bool skip, bool setNA, std::string unit, double maxdist, SpatOptions &opt) { SpatRaster out = geometry(); if (x.empty()) { out.setError("no locations to compute distance from"); return(out); } const double toRad = 0.0174532925199433; std::vector pm = sort_order_d(y); permute(x, pm); permute(y, pm); bool lonlat = is_lonlat(); double m=1; if (!source[0].srs.m_dist(m, lonlat, unit)) { out.setError("invalid unit"); return(out); } unsigned nc = ncol(); if (nrow() > 1000) { opt.steps = std::max(opt.steps, (size_t) 4); opt.progress = opt.progress * 1.5; } if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector cells; std::vector dlast, dvlast; std::vector cols; cols.resize(ncol()); std::iota(cols.begin(), cols.end(), 0); std::vector tox = xFromCol(cols); if (lonlat && (method != "geo")) { for (double &d : x) d *= toRad; for (double &d : y) d *= toRad; for (double &d : tox) d *= toRad; } double oldfirst = 0; size_t first = 0; size_t last = x.size(); std::vector rv; if (skip) { if (!readStart()) { out.setError(getError()); return(out); } for (size_t i = 0; i < out.bs.n; i++) { cells.resize((out.bs.nrows[i] -1) * nc) ; std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); std::vector> rxy = xyFromCell(cells); double toy = yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1); if (lonlat && (method != "geo")) { toy *= toRad; for (double &d : rxy[0]) d *= toRad; for (double &d : rxy[1]) d *= toRad; } readBlock(rv, out.bs, i); dist_bounds_values(x, y, v, tox, toy, first, last, lonlat, method, dlast, dvlast); std::vector d, dv; dist_only_vals(d, dv, x, y, v, rxy[0], rxy[1], oldfirst, last, lonlat, dlast, dvlast, true, rv, method, setNA); oldfirst = first; if (maxdist > 0) { if (m != 1) { for (size_t j=0; j maxdist) dv[j] = NAN; } } else { for (size_t j=0; j maxdist) dv[j] = NAN; } } } if (!out.writeBlock(dv, i)) return out; } readStop(); } else { for (size_t i = 0; i < out.bs.n; i++) { double toy = yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1); cells.resize((out.bs.nrows[i] -1) * nc) ; std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); std::vector> rxy = xyFromCell(cells); if (lonlat && (method != "geo")) { toy *= toRad; for (double &d : rxy[0]) d *= toRad; for (double &d : rxy[1]) d *= toRad; } dist_bounds_values(x, y, v, tox, toy, first, last, lonlat, method, dlast, dvlast); std::vector d, dv; dist_only_vals(d, dv, x, y, v, rxy[0], rxy[1], oldfirst, last, lonlat, dlast, dvlast, false, rv, method, setNA); oldfirst = first; if (maxdist > 0) { if (m != 1) { for (size_t j=0; j maxdist) dv[j] = NAN; } } else { for (size_t j=0; j maxdist) dv[j] = NAN; } } } if (!out.writeBlock(dv, i)) return out; } } out.writeStop(); return(out); } /* SpatRaster SpatRaster::distanceValues(double target, double exclude, bool keepNA, bool remove_zero, const std::string method, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { out.setError("SpatRaster has no values"); return out; } std::vector v; SpatOptions ops(opt); size_t nl = nlyr(); if (nl > 1) { std::vector nms = getNames(); if (ops.names.size() == nms.size()) { nms = opt.names; } out.source.resize(nl); for (size_t i=0; i lyr = {i}; SpatRaster r = subset(lyr, ops); ops.names = {nms[i]}; r = r.distanceValues(target, exclude, keepNA, remove_zero, method, ops); out.source[i] = r.source[0]; } if (!opt.get_filename().empty()) { out = out.writeRaster(opt); } return out; } bool setNA = false; std::vector> p; if (!std::isnan(exclude)) { SpatRaster x; if (std::isnan(target)) { x = replaceValues({exclude}, {target}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 1, ops); p = x.as_points_value(1, ops); if (p.empty()) { return out.init({0}, opt); } std::vector> vv = extractXY(p[0], p[1], "", false); return distance_crds_vals(p[0], p[1], vv[0], method, true, setNA, unit, opt); } else { x = replaceValues({exclude, target}, {NAN, NAN}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 1, ops); p = x.as_points_value(1, ops); out = replaceValues({NAN, exclude, target}, {target, NAN, NAN}, 1, false, NAN, false, ops); } } else if (!std::isnan(target)) { SpatRaster x = replaceValues({target}, {NAN}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 0, ops); p = x.as_points_value(1, ops); out = replaceValues({NAN, target}, {std::numeric_limits::max(), NAN}, 1, false, NAN, false, ops); setNA = true; } else { out = edges(false, "inner", 8, 0, ops); p = out.as_points_value(1, ops); std::vector> vv = extractXY(p[0], p[1], "", false); return distance_crds_vals(p[0], p[1], vv[0], method, true, setNA, unit, opt); } if (p.empty()) { return out.init({0}, opt); } std::vector> vv = extractXY(p[0], p[1], "", false); return out.distance_crds_vals(p[0], p[1], vv[0], method, true, setNA, unit, opt); } */ terra/src/write_gdal.cpp0000644000176200001440000010351014744007102015002 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "math_utils.h" #include "string_utils.h" #include "file_utils.h" #include "vecmath.h" #include "recycle.h" #include #include #include "gdal_priv.h" #include "cpl_conv.h" // for CPLMalloc() #include "cpl_string.h" #include "ogr_spatialref.h" #include "gdal_rat.h" #include "gdalio.h" /* void add_quotes(std::vector &s) { for (size_t i=0; i< s.size(); i++) { s[i] = "\"" + s[i] + "\""; } } */ std::string quoted_csv(const std::vector &s) { std::string ss; if (s.empty()) { ss = ""; return ss; } ss = "\"" + s[0] + "\""; for (size_t i=1; i< s.size(); i++) { ss += ",\"" + s[i] + "\""; } return ss; } bool SpatRaster::write_aux_json(std::string filename) { filename += ".aux.json"; std::ofstream f; bool wunits = hasUnit(); bool wtime = hasTime(); if (wunits || wtime) { f.open(filename); if (f.is_open()) { f << "{" << std::endl; if (wtime) { std::vector tstr = getTimeStr(false, " "); std::string ss = quoted_csv(tstr); f << "\"time\":[" << ss << "]," << std::endl; f << "\"timestep\":\"" << source[0].timestep << "\""; if (wunits) f << ","; f << std::endl; } if (wunits) { std::vector units = getUnit(); std::string ss = quoted_csv(units); f << "\"unit\":[" << ss << "]" << std::endl; } f << "}" << std::endl; } else { f.close(); return false; } f.close(); return true; } return true; } bool setRat(GDALRasterBand *poBand, SpatDataFrame &d) { size_t nr = d.nrow(); if (nr == 0) return true; // GDALRasterAttributeTable *pRat = poBand->GetDefaultRAT(); GDALDefaultRasterAttributeTable *pRat = new GDALDefaultRasterAttributeTable(); for (size_t i=0; iCreateColumn(fn, GFT_Real, GFU_Generic) != CE_None) { return false; }; } else if (d.itype[i] == 1) { if (pRat->CreateColumn(fn, GFT_Integer, GFU_Generic) != CE_None) { return false; } } else { if (pRat->CreateColumn(fn, GFT_String, GFU_Generic) != CE_None) { return false; } } } pRat->SetRowCount(nr); for (size_t i=0; i v = d.dv[d.iplace[i]]; if( pRat->ValuesIO(GF_Write, i, 0, nr, &v[0]) != CE_None ) { return false; } } else if (d.itype[i] == 1) { std::vector v = d.iv[d.iplace[i]]; for (size_t j=0; jSetValue(j, i, (int)v[j]); } } else { std::vector v = d.sv[d.iplace[i]]; for (size_t j=0; jSetValue(j, i, v[j].c_str()); } } } CPLErr err = poBand->SetDefaultRAT(pRat); delete pRat; return (err == CE_None); } bool is_rat(SpatDataFrame &d) { if (d.nrow() == 0) return false; if (d.ncol() > 2) return true; if (d.itype[0] == 1) { long dmin = vmin(d.iv[0], true); long dmax = vmax(d.iv[0], true); if (dmin >= 0 && dmax <= 255) { return false; } } else if (d.itype[0] == 0) { double dmin = vmin(d.dv[0], true); double dmax = vmax(d.dv[0], true); if (dmin >= 0 && dmax <= 255) { return false; } } return true; } bool is_ratct(SpatDataFrame &d) { std::vector ss = {"red", "green", "blue", "r", "g", "b"}; std::vector nms = d.names; size_t cnt = 0; for (size_t i=0; i= 0) { cnt++; } } return (cnt >= 3); } /* bool setCats(GDALRasterBand *poBand, std::vector &labels) { char **labs = NULL; for (size_t i = 0; i < labels.size(); i++) { labs = CSLAddString(labs, labels[i].c_str()); } CPLErr err = poBand->SetCategoryNames(labs); return (err == CE_None); } */ bool setBandCategories(GDALRasterBand *poBand, std::vector value, std::vector labs) { if (labs.size() != value.size()) return false; if (vmin(value, false) < 0) return false; if (vmax(value, false) > 255) return false; std::vector s(256, ""); for (size_t i=0; iSetCategoryNames(slabs); return (err == CE_None); } bool setCT(GDALRasterBand *poBand, SpatDataFrame &d) { if (d.ncol() < 5) return false; if (d.itype[0] != 1) return false; if (d.itype[1] != 1) return false; if (d.itype[2] != 1) return false; if (d.itype[3] != 1) return false; if (d.itype[4] != 1) return false; long dmin = vmin(d.iv[0], true); long dmax = vmax(d.iv[0], true); if (dmin < 0 || dmax > 255) { return false; } SpatDataFrame s; s.add_column(1, "red"); s.add_column(1, "green"); s.add_column(1, "blue"); s.add_column(1, "alpha"); s.resize_rows(256); for (size_t i=0; iSetColorInterpretation(GCI_PaletteIndex); if (err != CE_None) { return false; } GDALColorTable *poCT = new GDALColorTable(GPI_RGB); GDALColorEntry col; for (size_t j=0; j< s.nrow(); j++) { if (s.iv[3][j] == 0) { // maintain transparency in gtiff col.c1 = 255; col.c2 = 255; col.c3 = 255; col.c4 = 0; } else { col.c1 = (short)s.iv[0][j]; col.c2 = (short)s.iv[1][j]; col.c3 = (short)s.iv[2][j]; col.c4 = (short)s.iv[3][j]; } poCT->SetColorEntry(j, &col); } err = poBand->SetColorTable(poCT); delete poCT; return (err == CE_None); } SpatDataFrame grayColorTable() { SpatDataFrame coltab; std::vector col(256); std::iota(col.begin(), col.end(), 0); coltab.add_column(col, "red"); coltab.add_column(col, "green"); coltab.add_column(col, "blue"); std::fill(col.begin(), col.end(), 255); coltab.add_column(col, "alpha"); return coltab; } bool checkFormatRequirements(const std::string &driver, std::string &filename, std::string &msg) { if (driver == "SAGA") { std::string ext = getFileExt(filename); if (ext != ".sdat") { msg = "SAGA filenames must end on '.sdat'"; return false; } } else if (driver == "VRT") { msg = "Cannot directly write to VRT (see '?vrt')"; return false; } return true; } void stat_options(int sstat, bool &compute_stats, bool &gdal_stats, bool &gdal_minmax, bool &gdal_approx) { compute_stats = true; gdal_stats = true; gdal_minmax = false; if (sstat == 1) { gdal_stats = false; } else if (sstat == 2) { gdal_stats = true; gdal_approx = true; } else if (sstat == 3) { gdal_stats = true; gdal_approx = false; } else if (sstat == 4) { gdal_minmax = true; gdal_approx = true; } else if (sstat == 5) { gdal_minmax = true; gdal_approx = false; } else { compute_stats = false; } } void removeVatJson(std::string filename) { std::vector exts = {".vat.dbf", ".vat.cpg", ".json"}; for (size_t i=0; i &srcnames) { std::string filename = opt.get_filename(); if (filename.empty()) { setError("empty filename"); return(false); } // assure filename won't be used again opt.set_filenames({""}); std::string driver = opt.get_filetype(); getGDALdriver(filename, driver); if (driver.empty()) { setError("cannot guess file type from filename"); return(false); } GDALDriver *poDriver; poDriver = GetGDALDriverManager()->GetDriverByName(driver.c_str()); if(poDriver == NULL) { setError("invalid driver"); return (false); } if (driver == "GTiff") { if (nlyr() > 65535) { setError("cannot write more than 65535 layers"); return(false); } } char **papszMetadata; papszMetadata = poDriver->GetMetadata(); if (!CSLFetchBoolean( papszMetadata, GDAL_DCAP_RASTER, FALSE)) { setError(driver + " is not a raster format"); return false; } std::string datatype = opt.get_datatype(); bool writeRGB = (rgb && nlyr() == 3 && rgblyrs.size() == 3); //if (writeRGB) { // datatype = "INT1U"; //} std::string errmsg; if (!checkFormatRequirements(driver, filename, errmsg)) { setError(errmsg); return false; } std::string appstr = "APPEND_SUBDATASET=YES"; bool append = std::find(opt.gdal_options.begin(), opt.gdal_options.end(), appstr) != opt.gdal_options.end(); if (append && (!CSLFetchBoolean( papszMetadata, GDAL_DMD_SUBDATASETS, FALSE))) { setError("cannot append datasets with this file format"); return false; } if (append && opt.get_overwrite()) { setError("cannot append and overwrite at the same time"); return false; } if (!append) { std::string msg; if (!can_write({filename}, srcnames, opt.get_overwrite(), msg)) { setError(msg); return false; } } removeVatJson(filename); // what if append=true? std::string auxf = filename + ".aux.xml"; remove(auxf.c_str()); auxf = filename + ".aux.json"; remove(auxf.c_str()); std::vector hasCT = hasColors(); std::vector hasCats = hasCategories(); std::vector ct = getColors(); bool cat = hasCats[0]; bool warnCT = true; bool rat = cat ? is_rat(source[0].cats[0].d) : false; if (rat) { // needs redesign. Is CT also part of RAT? // other layers affected? etc. warnCT = false; if (hasCT[0]) { if (is_ratct(source[0].cats[0].d)) { std::fill(hasCT.begin(), hasCT.end(), false); } else if (ct[0].nrow() < 256) { if (opt.datatype_set && (datatype != "INT1U")) { addWarning("change datatype to INT1U to write the color-table"); } else { datatype = "INT1U"; } } } else { //if (opt.datatype_set) { // std::string sdt = opt.get_datatype().substr(0, 3); // if (sdt != "INT") { // addWarning("change datatype to an INT type to write the categories"); // } //} else { // datatype = "INT4S"; //} if (!opt.datatype_set && (driver != "GPKG")) { datatype = "INT4S"; } } } else if (hasCT[0]) { if (opt.datatype_set && (datatype != "INT1U")) { addWarning("change datatype to INT1U to write the color-table"); } else { datatype = "INT1U"; } } else if (datatype != "INT1U") { std::fill(hasCT.begin(), hasCT.end(), false); } //if (opt.datatype_set) { // if (datatype != opt.get_datatype()) { // addWarning("changed datatype to " + datatype); // } //} GDALDataType gdt; if (!getGDALDataType(datatype, gdt)) { setError("invalid datatype"); return false; } int dsize = std::stoi(datatype.substr(3,1)); GIntBig diskNeeded = ncell() * nlyr() * dsize; std::string dname = dirname(filename); GIntBig diskAvailable = VSIGetDiskFreeSpace(dname.c_str()); if ((diskAvailable > -1) && (diskAvailable < diskNeeded)) { long gb = 1073741824; std::string msg = "Estimated disk space needed without compression: " + std::to_string(diskNeeded/gb) + "GB. Available: " + std::to_string(diskAvailable/gb) + " GB."; // was an error, but actual file size is not known addWarning(msg); } stat_options(opt.get_statistics(), compute_stats, gdal_stats, gdal_minmax, gdal_approx); char **papszOptions = set_GDAL_options(driver, diskNeeded, writeRGB, opt.gdal_options); /* if (driver == "GTiff") { GDAL_tiff_options(diskNeeded > 4194304000, writeRGB, opt); } for (size_t i=0; i gopt = strsplit(opt.gdal_options[i], "="); if (gopt.size() == 2) { papszOptions = CSLSetNameValue( papszOptions, gopt[0].c_str(), gopt[1].c_str() ); } } if (writeRGB) { papszOptions = CSLSetNameValue( papszOptions, "PHOTOMETRIC", "RGB"); } */ //bool isncdf = ((driver == "netCDF" && opt.get_ncdfcopy())); GDALDataset *poDS; if (CSLFetchBoolean( papszMetadata, GDAL_DCAP_CREATE, FALSE)) { poDS = poDriver->Create(filename.c_str(), ncol(), nrow(), nlyr(), gdt, papszOptions); } else if (CSLFetchBoolean( papszMetadata, GDAL_DCAP_CREATECOPY, FALSE)) { copy_driver = driver; gdal_options = opt.gdal_options; if (canProcessInMemory(opt)) { poDriver = GetGDALDriverManager()->GetDriverByName("MEM"); poDS = poDriver->Create("", ncol(), nrow(), nlyr(), gdt, papszOptions); } else { //std::string driver = opt.get_filetype(); //std::string f = tempFile(opt.get_tempdir(), opt.pid, ""); //getGDALdriver(f, driver); //if (driver == "") { // setError("invalid default temp filetype"); // return(false); //} std::string f, driver; if (!getTempFile(f, driver, opt)) { return false; } //std::string f = tempFile(opt.get_tempdir(), opt.pid, ".tif"); copy_filename = f; GDALDriver *poDriver; //poDriver = GetGDALDriverManager()->GetDriverByName("GTiff"); poDriver = GetGDALDriverManager()->GetDriverByName(driver.c_str()); if(poDriver == NULL) { setError("invalid driver"); return false; } poDS = poDriver->Create(f.c_str(), ncol(), nrow(), nlyr(), gdt, papszOptions); } } else { setError("cannot write this format: "+ driver); CSLDestroy( papszOptions ); return false; } CSLDestroy( papszOptions ); if (poDS == NULL) { //if (!filepath_exists(filename)) { // setError("failed writing "+ driver + " file. Path does not exist:\n " + filename); //} else { setError("failed writing "+ driver + " file"); //} GDALClose( (GDALDatasetH) poDS ); return false; } #ifdef useRcpp if (opt.verbose) { double gb = 1073741824; char **filelist = poDS->GetFileList(); std::vector files; if (filelist != NULL) { for (size_t i=0; filelist[i] != NULL; i++) { std::string thefile = filelist[i]; std::replace( thefile.begin(), thefile.end(), '\\', '/'); files.push_back(thefile); } } CSLDestroy( filelist ); for (size_t i=0; i 0) { Rcpp::Rcout<< "disk available: " << roundn(diskAvailable / gb, 1) << " GB" << std::endl; } Rcpp::Rcout<< "disk needed : " << roundn(diskNeeded / gb, 1) << " GB" << std::endl; } #endif if (opt.names.size() == nlyr()) { setNames(opt.names); } GDALRasterBand *poBand; std::vector nms = getNames(); double naflag=NAN; bool hasNAflag = opt.has_NAflag(naflag); // if (driver == "AAIGrid" && std::isnan(naflag)) { // avoid nan as flag // naflag = -3.40282347E+38; // hasNAflag = true; // set opt.NAflag? // } if (writeRGB) nms = {"red", "green", "blue"}; std::vector scale = opt.get_scale(); std::vector offset = opt.get_offset(); size_t nl = nlyr(); if (((scale.size() > 1) || (offset.size())) || ((scale[0] != 1) || (offset[0] != 0))) { recycle(scale, nl); recycle(offset, nl); } bool scoff = false; for (size_t i=0; i(nl, false); scoff = true; } source[0].has_scale_offset[i] = true; } } if (scoff) { source[0].scale = scale; source[0].offset = offset; } bool scoffwarning = false; // if (driver == "GTiff") { std::vector m = getTags(); if (m.size() > 0) { for (size_t i=0; iSetMetadataItem(m[i].c_str(), m[i+1].c_str(), "USER_TAGS"); } } // } std::vector tstr, ustr; bool wtime = false; bool have_date_time=false; std::string tstep = getTimeStep(); if (hasTime()) { tstr = getTimeStr(false, "T"); wtime = true; have_date_time = true; // have_date_time = (tstep == "seconds") || (tstep == "days") || (tstep == "years") || (tstep == "yearmonths"); } bool wunit = false; if (hasUnit()) { ustr = getUnit(); wunit = true; } for (size_t i=0; i < nlyr(); i++) { poBand = poDS->GetRasterBand(i+1); if ((i==0) && hasCT[i]) { if (!setCT(poBand, ct[i])) { if (warnCT) { addWarning("could not write the color table"); } } } if (hasCats[i]) { if (is_rat(source[0].cats[i].d)) { if (!setRat(poBand, source[0].cats[i].d)) { addWarning("could not write attribute table"); } } else { SpatCategories lyrcats = getLayerCategories(i); if (lyrcats.d.ncol() == 2) { std::vector labs = getLabels(i); std::vector ind = lyrcats.d.as_long(0); if (!setBandCategories(poBand, ind, labs)) { addWarning("could not write categories"); } } } } /* if (isncdf) { std::string opt = "NETCDF_VARNAME"; char ** papszMetadata; papszMetadata = CSLSetNameValue( papszOptions, opt.c_str(), nms[i].c_str() ); poBand->SetMetadata(papszMetadata); } else { */ poBand->SetDescription(nms[i].c_str()); // if (driver == "GTiff") { std::vector m = getLyrTags({i}); if (m.size() > 0) { for (size_t j=0; jSetMetadataItem(m[j+1].c_str(), m[j+2].c_str(), "USER_TAGS"); } } if (wtime) { if (have_date_time) { poBand->SetMetadataItem("DATE_TIME", tstr[i].c_str()); } else { poBand->SetMetadataItem("TIMESTAMP", tstr[i].c_str()); poBand->SetMetadataItem("TIMEUNIT", tstep.c_str()); } } if (wunit) { poBand->SetMetadataItem("UNIT", ustr[i].c_str()); } // } if ((i==0) || (driver != "GTiff")) { // to avoid "Setting nodata to nan on band 2, but band 1 has nodata at nan." if (hasNAflag) { poBand->SetNoDataValue(naflag); } else if (datatype == "INT4S") { poBand->SetNoDataValue(INT32_MIN); //-2147483648; } else if (datatype == "INT2S") { poBand->SetNoDataValue(INT16_MIN); } else if (datatype == "INT4U") { poBand->SetNoDataValue(UINT32_MAX); } else if (datatype == "INT2U") { //double na = (double)INT16_MAX * 2 - 1; poBand->SetNoDataValue(UINT16_MAX); } else if (datatype == "INT1U") { poBand->SetNoDataValue(255); } else if (datatype == "INT1S") { poBand->SetNoDataValue(-128); //GDT_Int8 #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 5 // no Int64 #else } else if (datatype == "INT8S") { //INT64_MIN == -9223372036854775808; if (poBand->SetNoDataValueAsInt64(INT64_MIN) != CE_None) { addWarning("no data problem"); } } else if (datatype == "INT8U") { if (poBand->SetNoDataValueAsUInt64(UINT64_MAX-1101) != CE_None) { addWarning("no data problem"); } #endif } else { poBand->SetNoDataValue(NAN); } } if (writeRGB) { if (rgblyrs[i]==0) { poBand->SetColorInterpretation(GCI_RedBand); } else if (rgblyrs[i]==1) { poBand->SetColorInterpretation(GCI_GreenBand); } else if (rgblyrs[i]==2) { poBand->SetColorInterpretation(GCI_BlueBand); } } if (scoff) { if (source[0].has_scale_offset[i]) { bool failed = (poBand->SetScale(scale[i])) != CE_None; if (!failed) { failed = (poBand->SetOffset(offset[i])) != CE_None; } if (failed) { source[0].has_scale_offset[i] = false; source[0].scale[i] = 1; source[0].offset[i] = 0; scoffwarning = true; } } } } if (scoffwarning) { addWarning("could not set offset"); } std::vector rs = resolution(); SpatExtent extent = getExtent(); double adfGeoTransform[6] = { extent.xmin, rs[0], 0, extent.ymax, 0, -1 * rs[1] }; poDS->SetGeoTransform(adfGeoTransform); std::string crs = source[0].srs.wkt; OGRSpatialReference oSRS; OGRErr erro = oSRS.SetFromUserInput(&crs[0]); if (erro == 4) { setError("CRS failure"); GDALClose( (GDALDatasetH) poDS ); return false ; } char *pszSRS_WKT = NULL; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; oSRS.exportToWkt(&pszSRS_WKT, options); #else oSRS.exportToWkt(&pszSRS_WKT); #endif poDS->SetProjection(pszSRS_WKT); CPLFree(pszSRS_WKT); // destroySRS(oSRS) ? source[0].resize(nlyr()); source[0].nlyrfile = nlyr(); source[0].dtype = datatype; for (size_t i =0; i::max(); source[0].range_max[i] = NAN; //std::numeric_limits::lowest(); } source[0].driver = "gdal" ; source[0].filename = filename; source[0].memory = false; if (driver != "GTiff") write_aux_json(filename); /* if (append) { GDALClose( (GDALDatasetH) poDS ); std::vector ops; poDS = openGDAL(filename, GDAL_OF_RASTER | GDAL_OF_UPDATE, ops); std::vector subds; char **metadata = poDS->GetMetadata("SUBDATASETS"); if (metadata != NULL) { for (size_t i=0; metadata[i] != NULL; i++) { subds.push_back(metadata[i]); } std::vector> s = parse_metadata_sds(subds); GDALClose( (GDALDatasetH) poDS ); filename = s[0].back(); poDS = openGDAL(filename, GDAL_OF_RASTER | GDAL_OF_UPDATE, ops); } } */ source[0].gdalconnection = poDS; return true; } /* void min_max_na(std::vector &vals, const double &na, const double &mn, const double &mx) { for (double &v : vals) { v = std::isnan(v) ? na : (v < mn ? na : (v > mx ? na : v)); } } */ template void tmp_min_max_na(std::vector &out, const std::vector &v, const double &na, const double &mn, const double &mx) { size_t n = v.size(); out.reserve(n); for (size_t i=0; i mx ? na : v[i]))); } } template void minmaxlim(Iterator start, Iterator end, double &vmin, double &vmax, const double &lmin, const double &lmax, bool& outrange) { vmin = std::numeric_limits::max(); vmax = std::numeric_limits::lowest(); bool none = true; for (Iterator v = start; v !=end; ++v) { if (!std::isnan(*v)) { if (*v >= lmin && *v <= lmax) { if (*v > vmax) { vmax = *v; none = false; } if (*v < vmin) { vmin = *v; } } else { outrange = true; } } } if (none) { vmin = NAN; vmax = NAN; } vmin = std::trunc(vmin); vmax = std::trunc(vmax); } bool SpatRaster::writeValuesGDAL(std::vector &vals, size_t startrow, size_t nrows, size_t startcol, size_t ncols){ CPLErr err = CE_None; double vmin, vmax; size_t nc = nrows * ncols; size_t nl = nlyr(); std::string datatype = source[0].dtype; size_t n = vals.size() / nl; for (size_t i=0; iGetRasterBand(1)->GetNoDataValue(&hasNA); if ((datatype == "FLT8S") || (datatype == "FLT4S")) { if (hasNA) { size_t n = vals.size(); for (size_t i=0; iRasterIO(GF_Write, startcol, startrow, ncols, nrows, &vals[0], ncols, nrows, GDT_Float64, nl, NULL, 0, 0, 0, NULL ); } else { if (datatype == "INT8S") { #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 5 setError("cannot write INT8S values with GDAL < 3.5"); GDALClose( source[0].gdalconnection ); return false; #else std::vector vv; tmp_min_max_na(vv, vals, na, (double)INT64_MIN, (double)INT64_MAX); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_Int64, nl, NULL, 0, 0, 0, NULL ); #endif } else if (datatype == "INT4S") { //min_max_na(vals, na, (double)INT32_MIN, (double)INT32_MAX); //std::vector vv(vals.begin(), vals.end()); std::vector vv; tmp_min_max_na(vv, vals, na, (double)INT32_MIN, (double)INT32_MAX); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_Int32, nl, NULL, 0, 0, 0, NULL ); } else if (datatype == "INT2S") { //min_max_na(vals, na, (double)INT16_MIN, (double)INT16_MAX); //std::vector vv(vals.begin(), vals.end()); std::vector vv; tmp_min_max_na(vv, vals, na, (double)INT16_MIN, (double)INT16_MAX); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_Int16, nl, NULL, 0, 0, 0, NULL ); } else if (datatype == "INT1S") { #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 7 setError("cannot write INT1S values with GDAL < 3.7"); GDALClose( source[0].gdalconnection ); return false; #else std::vector vv; tmp_min_max_na(vv, vals, na, -127.0, 128.0); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_Int8, nl, NULL, 0, 0, 0, NULL ); #endif } else if (datatype == "INT8U") { #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 5 setError("cannot write INT8U values with GDAL < 3.5"); GDALClose( source[0].gdalconnection ); return false; #else std::vector vv; tmp_min_max_na(vv, vals, na, 0, (double)UINT64_MAX); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_UInt64, nl, NULL, 0, 0, 0, NULL ); #endif } else if (datatype == "INT4U") { //min_max_na(vals, na, 0, (double)INT32_MAX * 2 - 1); //std::vector vv(vals.begin(), vals.end()); std::vector vv; tmp_min_max_na(vv, vals, na, 0, (double)UINT32_MAX); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_UInt32, nl, NULL, 0, 0, 0, NULL ); } else if (datatype == "INT2U") { //min_max_na(vals, na, 0, (double)INT16_MAX * 2 - 1); //std::vector vv(vals.begin(), vals.end()); std::vector vv; tmp_min_max_na(vv, vals, na, 0, (double)UINT16_MAX); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_UInt16, nl, NULL, 0, 0, 0, NULL ); } else if (datatype == "INT1U") { //min_max_na(vals, na, 0, 255); //std::vector vv(vals.begin(), vals.end()); std::vector vv; tmp_min_max_na(vv, vals, na, 0, 255); err = source[0].gdalconnection->RasterIO(GF_Write, startcol, startrow, ncols, nrows, &vv[0], ncols, nrows, GDT_Byte, nl, NULL, 0, 0, 0, NULL ); } else { setError("bad datatype"); GDALClose( source[0].gdalconnection ); return false; } } if (err != CE_None ) { setError("cannot write values (err: " + std::to_string(err) +")"); GDALClose( source[0].gdalconnection ); return false; } return true; } bool SpatRaster::writeStopGDAL() { GDALRasterBand *poBand; source[0].hasRange.resize(nlyr()); std::string datatype = source[0].dtype; for (size_t i=0; i < nlyr(); i++) { poBand = source[0].gdalconnection->GetRasterBand(i+1); if (compute_stats) { if (gdal_stats) { double mn, mx, av=-9999, sd=-9999; //int approx = gdal_approx; if (gdal_minmax) { double adfMinMax[2]; poBand->ComputeRasterMinMax(gdal_approx, adfMinMax); mn = adfMinMax[0]; mx = adfMinMax[1]; } else { poBand->ComputeStatistics(gdal_approx, &mn, &mx, &av, &sd, NULL, NULL); } poBand->SetStatistics(mn, mx, av, sd); } else { if (datatype.substr(0,3) == "INT") { source[0].range_min[i] = trunc(source[0].range_min[i]); source[0].range_max[i] = trunc(source[0].range_max[i]); } else if (datatype == "FLT4S") { // match precision source[0].range_min[i] = (float) source[0].range_min[i]; source[0].range_max[i] = (float) source[0].range_max[i]; } poBand->SetStatistics(source[0].range_min[i], source[0].range_max[i], -9999., -9999.); } source[0].hasRange[i] = true; } else { source[0].hasRange[i] = false; } } if (copy_driver.empty()) { GDALClose( (GDALDatasetH) source[0].gdalconnection ); } else { GDALDataset *newDS; GDALDriver *poDriver; char **papszOptions = set_GDAL_options(copy_driver, 0.0, false, gdal_options); poDriver = GetGDALDriverManager()->GetDriverByName(copy_driver.c_str()); if (copy_filename.empty()) { newDS = poDriver->CreateCopy(source[0].filename.c_str(), source[0].gdalconnection, FALSE, papszOptions, NULL, NULL); if( newDS == NULL ) { setError("mem copy create failed for "+ copy_driver); copy_driver = ""; GDALClose( (GDALDatasetH) newDS ); GDALClose( (GDALDatasetH) source[0].gdalconnection ); return false; } copy_driver = ""; GDALClose( (GDALDatasetH) newDS ); GDALClose( (GDALDatasetH) source[0].gdalconnection ); } else { GDALClose( (GDALDatasetH) source[0].gdalconnection ); GDALDataset *oldDS = openGDAL(copy_filename.c_str(), GDAL_OF_RASTER | GDAL_OF_READONLY, source[0].open_drivers, source[0].open_ops); if( oldDS == NULL ) { setError("file copy create failed for "+ copy_driver); copy_driver = ""; copy_filename = ""; GDALClose( (GDALDatasetH) oldDS ); return false; } newDS = poDriver->CreateCopy(source[0].filename.c_str(), oldDS, FALSE, papszOptions, NULL, NULL); if( newDS == NULL ) { setError("copy create failed for "+ copy_driver); copy_driver = ""; copy_filename = ""; GDALClose( (GDALDatasetH) oldDS ); GDALClose( (GDALDatasetH) newDS ); return false; } copy_driver = ""; copy_filename = ""; GDALClose( (GDALDatasetH) oldDS ); GDALClose( (GDALDatasetH) newDS ); } CSLDestroy(papszOptions); } source[0].hasValues = true; return true; } bool SpatRaster::fillValuesGDAL(double fillvalue) { CPLErr err = CE_None; GDALRasterBand *poBand; int hasNA; for (size_t i=0; i < nlyr(); i++) { poBand = source[0].gdalconnection->GetRasterBand(i+1); if (std::isnan(fillvalue)) { double naflag = poBand->GetNoDataValue(&hasNA); if (hasNA) { err = poBand->Fill(naflag); } else { err = poBand->Fill(fillvalue); } } else { err = poBand->Fill(fillvalue); } } if (err != CE_None ) { setError("cannot fill values"); return false; } return true; } bool SpatRaster::update_meta(bool names, bool crs, bool ext, SpatOptions &opt) { if ((!names) & (!crs) & (!ext)) { addWarning("nothing to do"); return false; } GDALDatasetH hDS; size_t n=0; for (size_t i=0; i= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; oSRS.exportToWkt(&pszSRS_WKT, options); #else oSRS.exportToWkt(&pszSRS_WKT); #endif GDALSetProjection(hDS, pszSRS_WKT); CPLFree(pszSRS_WKT); } if (ext) { std::vector rs = resolution(); SpatExtent extent = getExtent(); double adfGeoTransform[6] = { extent.xmin, rs[0], 0, extent.ymax, 0, -1 * rs[1] }; GDALSetGeoTransform(hDS, adfGeoTransform); } GDALClose(hDS); } if (n == 0) { addWarning("no sources on disk"); return false; } return true; } terra/src/spatVector2.cpp0000644000176200001440000000556214720502767015120 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . /* #include "spatVector.h" #include "spatVector2.h" SpatVector2::SpatVector2() {} SpatVector SpatVector2::to_old() { SpatVector out; out.srs = srs; size_t ng = ngeoms(); for (size_t i=0; i x = {X.begin() + P[j], X.begin() + P[j+1]}; std::vector y = {Y.begin() + P[j], Y.begin() + P[j+1]}; if (gtype == polygons) { if (H[j] >= 0) { geom.parts[geom.parts.size()-1].addHole(x, y); } else { SpatPart prt(x, y); geom.addPart(prt); } } else { SpatPart prt(x, y); geom.addPart(prt); } } out.addGeom(geom); } return out; } SpatVector2 SpatVector2::from_old(SpatVector x) { SpatVector2 out; out.srs = x.srs; if (!x.empty()) out.gtype = x.geoms[0].gtype; size_t nxy = x.nxy(); out.X.reserve(nxy); out.Y.reserve(nxy); size_t ng = x.size(); out.G.reserve(ng); size_t np = x.nparts(true); out.P.reserve(np); if (x.type() == "polygons") { out.H.reserve(ng); } size_t pcnt = 0; size_t gcnt = 0; out.G.push_back(0); // so that we can use (j to j+1) for the first part out.P.push_back(0); // so that we can use (j to j+1) for the first part for (size_t i=0; i do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // proj_version std::string proj_version(); RcppExport SEXP _terra_proj_version() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = Rcpp::wrap(proj_version()); return rcpp_result_gen; END_RCPP } // hex2rgb std::vector hex2rgb(std::string s); RcppExport SEXP _terra_hex2rgb(SEXP sSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type s(sSEXP); rcpp_result_gen = Rcpp::wrap(hex2rgb(s)); return rcpp_result_gen; END_RCPP } // rgb2hex std::string rgb2hex(std::vector x); RcppExport SEXP _terra_rgb2hex(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::vector >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(rgb2hex(x)); return rcpp_result_gen; END_RCPP } // sameSRS bool sameSRS(std::string x, std::string y); RcppExport SEXP _terra_sameSRS(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type x(xSEXP); Rcpp::traits::input_parameter< std::string >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(sameSRS(x, y)); return rcpp_result_gen; END_RCPP } // getCRSname std::vector getCRSname(std::string s); RcppExport SEXP _terra_getCRSname(SEXP sSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type s(sSEXP); rcpp_result_gen = Rcpp::wrap(getCRSname(s)); return rcpp_result_gen; END_RCPP } // getLinearUnits double getLinearUnits(std::string s); RcppExport SEXP _terra_getLinearUnits(SEXP sSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type s(sSEXP); rcpp_result_gen = Rcpp::wrap(getLinearUnits(s)); return rcpp_result_gen; END_RCPP } // geotransform std::vector geotransform(std::string fname); RcppExport SEXP _terra_geotransform(SEXP fnameSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type fname(fnameSEXP); rcpp_result_gen = Rcpp::wrap(geotransform(fname)); return rcpp_result_gen; END_RCPP } // gdal_setconfig void gdal_setconfig(std::string option, std::string value); RcppExport SEXP _terra_gdal_setconfig(SEXP optionSEXP, SEXP valueSEXP) { BEGIN_RCPP Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type option(optionSEXP); Rcpp::traits::input_parameter< std::string >::type value(valueSEXP); gdal_setconfig(option, value); return R_NilValue; END_RCPP } // gdal_getconfig std::string gdal_getconfig(std::string option); RcppExport SEXP _terra_gdal_getconfig(SEXP optionSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type option(optionSEXP); rcpp_result_gen = Rcpp::wrap(gdal_getconfig(option)); return rcpp_result_gen; END_RCPP } // ginfo std::string ginfo(std::string filename, std::vector options, std::vector oo); RcppExport SEXP _terra_ginfo(SEXP filenameSEXP, SEXP optionsSEXP, SEXP ooSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type filename(filenameSEXP); Rcpp::traits::input_parameter< std::vector >::type options(optionsSEXP); Rcpp::traits::input_parameter< std::vector >::type oo(ooSEXP); rcpp_result_gen = Rcpp::wrap(ginfo(filename, options, oo)); return rcpp_result_gen; END_RCPP } // sd_info std::vector> sd_info(std::string filename); RcppExport SEXP _terra_sd_info(SEXP filenameSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type filename(filenameSEXP); rcpp_result_gen = Rcpp::wrap(sd_info(filename)); return rcpp_result_gen; END_RCPP } // gdal_version std::string gdal_version(); RcppExport SEXP _terra_gdal_version() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = Rcpp::wrap(gdal_version()); return rcpp_result_gen; END_RCPP } // geos_version std::string geos_version(bool runtime, bool capi); RcppExport SEXP _terra_geos_version(SEXP runtimeSEXP, SEXP capiSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< bool >::type runtime(runtimeSEXP); Rcpp::traits::input_parameter< bool >::type capi(capiSEXP); rcpp_result_gen = Rcpp::wrap(geos_version(runtime, capi)); return rcpp_result_gen; END_RCPP } // metatdata std::vector metatdata(std::string filename); RcppExport SEXP _terra_metatdata(SEXP filenameSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type filename(filenameSEXP); rcpp_result_gen = Rcpp::wrap(metatdata(filename)); return rcpp_result_gen; END_RCPP } // sdsmetatdata std::vector sdsmetatdata(std::string filename); RcppExport SEXP _terra_sdsmetatdata(SEXP filenameSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type filename(filenameSEXP); rcpp_result_gen = Rcpp::wrap(sdsmetatdata(filename)); return rcpp_result_gen; END_RCPP } // sdsmetatdataparsed std::vector> sdsmetatdataparsed(std::string filename); RcppExport SEXP _terra_sdsmetatdataparsed(SEXP filenameSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type filename(filenameSEXP); rcpp_result_gen = Rcpp::wrap(sdsmetatdataparsed(filename)); return rcpp_result_gen; END_RCPP } // gdal_drivers std::vector> gdal_drivers(); RcppExport SEXP _terra_gdal_drivers() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = Rcpp::wrap(gdal_drivers()); return rcpp_result_gen; END_RCPP } // set_gdal_warnings void set_gdal_warnings(int level); RcppExport SEXP _terra_set_gdal_warnings(SEXP levelSEXP) { BEGIN_RCPP Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< int >::type level(levelSEXP); set_gdal_warnings(level); return R_NilValue; END_RCPP } // seed_init void seed_init(uint32_t seed_val); RcppExport SEXP _terra_seed_init(SEXP seed_valSEXP) { BEGIN_RCPP Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< uint32_t >::type seed_val(seed_valSEXP); seed_init(seed_val); return R_NilValue; END_RCPP } // gdal_init void gdal_init(std::string projpath, std::string datapath); RcppExport SEXP _terra_gdal_init(SEXP projpathSEXP, SEXP datapathSEXP) { BEGIN_RCPP Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::string >::type projpath(projpathSEXP); Rcpp::traits::input_parameter< std::string >::type datapath(datapathSEXP); gdal_init(projpath, datapath); return R_NilValue; END_RCPP } // percRank std::vector percRank(std::vector x, std::vector y, double minc, double maxc, int tail); RcppExport SEXP _terra_percRank(SEXP xSEXP, SEXP ySEXP, SEXP mincSEXP, SEXP maxcSEXP, SEXP tailSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::vector >::type x(xSEXP); Rcpp::traits::input_parameter< std::vector >::type y(ySEXP); Rcpp::traits::input_parameter< double >::type minc(mincSEXP); Rcpp::traits::input_parameter< double >::type maxc(maxcSEXP); Rcpp::traits::input_parameter< int >::type tail(tailSEXP); rcpp_result_gen = Rcpp::wrap(percRank(x, y, minc, maxc, tail)); return rcpp_result_gen; END_RCPP } // clearVSIcache void clearVSIcache(bool vsi); RcppExport SEXP _terra_clearVSIcache(SEXP vsiSEXP) { BEGIN_RCPP Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< bool >::type vsi(vsiSEXP); clearVSIcache(vsi); return R_NilValue; END_RCPP } // setGDALCacheSizeMB void setGDALCacheSizeMB(double x, bool vsi); RcppExport SEXP _terra_setGDALCacheSizeMB(SEXP xSEXP, SEXP vsiSEXP) { BEGIN_RCPP Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type x(xSEXP); Rcpp::traits::input_parameter< bool >::type vsi(vsiSEXP); setGDALCacheSizeMB(x, vsi); return R_NilValue; END_RCPP } // getGDALCacheSizeMB double getGDALCacheSizeMB(bool vsi); RcppExport SEXP _terra_getGDALCacheSizeMB(SEXP vsiSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< bool >::type vsi(vsiSEXP); rcpp_result_gen = Rcpp::wrap(getGDALCacheSizeMB(vsi)); return rcpp_result_gen; END_RCPP } // get_proj_search_paths std::vector get_proj_search_paths(); RcppExport SEXP _terra_get_proj_search_paths() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = Rcpp::wrap(get_proj_search_paths()); return rcpp_result_gen; END_RCPP } // set_proj_search_paths bool set_proj_search_paths(std::vector paths); RcppExport SEXP _terra_set_proj_search_paths(SEXP pathsSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::vector >::type paths(pathsSEXP); rcpp_result_gen = Rcpp::wrap(set_proj_search_paths(paths)); return rcpp_result_gen; END_RCPP } // PROJ_network std::string PROJ_network(bool enable, std::string url); RcppExport SEXP _terra_PROJ_network(SEXP enableSEXP, SEXP urlSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< bool >::type enable(enableSEXP); Rcpp::traits::input_parameter< std::string >::type url(urlSEXP); rcpp_result_gen = Rcpp::wrap(PROJ_network(enable, url)); return rcpp_result_gen; END_RCPP } // pearson_cor double pearson_cor(std::vector x, std::vector y, bool narm); RcppExport SEXP _terra_pearson_cor(SEXP xSEXP, SEXP ySEXP, SEXP narmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::vector >::type x(xSEXP); Rcpp::traits::input_parameter< std::vector >::type y(ySEXP); Rcpp::traits::input_parameter< bool >::type narm(narmSEXP); rcpp_result_gen = Rcpp::wrap(pearson_cor(x, y, narm)); return rcpp_result_gen; END_RCPP } // weighted_pearson_cor double weighted_pearson_cor(std::vector x, std::vector y, std::vector weights, bool narm); RcppExport SEXP _terra_weighted_pearson_cor(SEXP xSEXP, SEXP ySEXP, SEXP weightsSEXP, SEXP narmSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::vector >::type x(xSEXP); Rcpp::traits::input_parameter< std::vector >::type y(ySEXP); Rcpp::traits::input_parameter< std::vector >::type weights(weightsSEXP); Rcpp::traits::input_parameter< bool >::type narm(narmSEXP); rcpp_result_gen = Rcpp::wrap(weighted_pearson_cor(x, y, weights, narm)); return rcpp_result_gen; END_RCPP } // uniqueSymmetricRows Rcpp::IntegerMatrix uniqueSymmetricRows(std::vector x, std::vector y); RcppExport SEXP _terra_uniqueSymmetricRows(SEXP xSEXP, SEXP ySEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< std::vector >::type x(xSEXP); Rcpp::traits::input_parameter< std::vector >::type y(ySEXP); rcpp_result_gen = Rcpp::wrap(uniqueSymmetricRows(x, y)); return rcpp_result_gen; END_RCPP } // dist2segmentPoint_geo double dist2segmentPoint_geo(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double& ilon, double& ilat); RcppExport SEXP _terra_dist2segmentPoint_geo(SEXP plonSEXP, SEXP platSEXP, SEXP lon1SEXP, SEXP lat1SEXP, SEXP lon2SEXP, SEXP lat2SEXP, SEXP ilonSEXP, SEXP ilatSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type plon(plonSEXP); Rcpp::traits::input_parameter< double >::type plat(platSEXP); Rcpp::traits::input_parameter< double >::type lon1(lon1SEXP); Rcpp::traits::input_parameter< double >::type lat1(lat1SEXP); Rcpp::traits::input_parameter< double >::type lon2(lon2SEXP); Rcpp::traits::input_parameter< double >::type lat2(lat2SEXP); Rcpp::traits::input_parameter< double& >::type ilon(ilonSEXP); Rcpp::traits::input_parameter< double& >::type ilat(ilatSEXP); rcpp_result_gen = Rcpp::wrap(dist2segmentPoint_geo(plon, plat, lon1, lat1, lon2, lat2, ilon, ilat)); return rcpp_result_gen; END_RCPP } // intermediate std::vector> intermediate(double lon1, double lat1, double lon2, double lat2, int n, double distance); RcppExport SEXP _terra_intermediate(SEXP lon1SEXP, SEXP lat1SEXP, SEXP lon2SEXP, SEXP lat2SEXP, SEXP nSEXP, SEXP distanceSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< double >::type lon1(lon1SEXP); Rcpp::traits::input_parameter< double >::type lat1(lat1SEXP); Rcpp::traits::input_parameter< double >::type lon2(lon2SEXP); Rcpp::traits::input_parameter< double >::type lat2(lat2SEXP); Rcpp::traits::input_parameter< int >::type n(nSEXP); Rcpp::traits::input_parameter< double >::type distance(distanceSEXP); rcpp_result_gen = Rcpp::wrap(intermediate(lon1, lat1, lon2, lat2, n, distance)); return rcpp_result_gen; END_RCPP } RcppExport SEXP _rcpp_module_boot_spat(); static const R_CallMethodDef CallEntries[] = { {"_terra_proj_version", (DL_FUNC) &_terra_proj_version, 0}, {"_terra_hex2rgb", (DL_FUNC) &_terra_hex2rgb, 1}, {"_terra_rgb2hex", (DL_FUNC) &_terra_rgb2hex, 1}, {"_terra_sameSRS", (DL_FUNC) &_terra_sameSRS, 2}, {"_terra_getCRSname", (DL_FUNC) &_terra_getCRSname, 1}, {"_terra_getLinearUnits", (DL_FUNC) &_terra_getLinearUnits, 1}, {"_terra_geotransform", (DL_FUNC) &_terra_geotransform, 1}, {"_terra_gdal_setconfig", (DL_FUNC) &_terra_gdal_setconfig, 2}, {"_terra_gdal_getconfig", (DL_FUNC) &_terra_gdal_getconfig, 1}, {"_terra_ginfo", (DL_FUNC) &_terra_ginfo, 3}, {"_terra_sd_info", (DL_FUNC) &_terra_sd_info, 1}, {"_terra_gdal_version", (DL_FUNC) &_terra_gdal_version, 0}, {"_terra_geos_version", (DL_FUNC) &_terra_geos_version, 2}, {"_terra_metatdata", (DL_FUNC) &_terra_metatdata, 1}, {"_terra_sdsmetatdata", (DL_FUNC) &_terra_sdsmetatdata, 1}, {"_terra_sdsmetatdataparsed", (DL_FUNC) &_terra_sdsmetatdataparsed, 1}, {"_terra_gdal_drivers", (DL_FUNC) &_terra_gdal_drivers, 0}, {"_terra_set_gdal_warnings", (DL_FUNC) &_terra_set_gdal_warnings, 1}, {"_terra_seed_init", (DL_FUNC) &_terra_seed_init, 1}, {"_terra_gdal_init", (DL_FUNC) &_terra_gdal_init, 2}, {"_terra_percRank", (DL_FUNC) &_terra_percRank, 5}, {"_terra_clearVSIcache", (DL_FUNC) &_terra_clearVSIcache, 1}, {"_terra_setGDALCacheSizeMB", (DL_FUNC) &_terra_setGDALCacheSizeMB, 2}, {"_terra_getGDALCacheSizeMB", (DL_FUNC) &_terra_getGDALCacheSizeMB, 1}, {"_terra_get_proj_search_paths", (DL_FUNC) &_terra_get_proj_search_paths, 0}, {"_terra_set_proj_search_paths", (DL_FUNC) &_terra_set_proj_search_paths, 1}, {"_terra_PROJ_network", (DL_FUNC) &_terra_PROJ_network, 2}, {"_terra_pearson_cor", (DL_FUNC) &_terra_pearson_cor, 3}, {"_terra_weighted_pearson_cor", (DL_FUNC) &_terra_weighted_pearson_cor, 4}, {"_terra_uniqueSymmetricRows", (DL_FUNC) &_terra_uniqueSymmetricRows, 2}, {"_terra_dist2segmentPoint_geo", (DL_FUNC) &_terra_dist2segmentPoint_geo, 8}, {"_terra_intermediate", (DL_FUNC) &_terra_intermediate, 6}, {"_rcpp_module_boot_spat", (DL_FUNC) &_rcpp_module_boot_spat, 0}, {NULL, NULL, 0} }; RcppExport void R_init_terra(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } terra/src/math_utils.cpp0000644000176200001440000001245314720502767015052 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include #include #include #include /* std::vector mean2d(const std::vector> &x) { size_t n = x[0].size(); size_t nn = x.size(); std::vector out(n, NAN); size_t d; double v; for (size_t i=0; i 0) { out[i] = v / d; } } return out; } */ void na_omit(std::vector &x) { x.erase(std::remove_if(std::begin(x), std::end(x), [](const double& value) { return std::isnan(value); }), std::end(x)); } void vector_minmax(std::vector v, double &min, int &imin, double &max, int &imax) { std::vector::size_type p=0; imax = -1; imin=-1; min = std::numeric_limits::max(); max = std::numeric_limits::lowest(); for (auto &val : v) { if (!std::isnan(val)) { if (val > max) { imax = p; max = val; } if (val < min) { imin = p; min = val; } } p++; } if (imax == -1) { max = NAN; min = NAN; } } double roundn(double x, int n){ double d = pow(10.0, n); return std::round(x * d) / d; } double signif(double x, unsigned n) { double b = x; unsigned i; for (i = 0; b >= 1; ++i) { b = b / 10; } int d = n-i; return roundn(x, d); } bool is_equal(double a, double b, double tolerance=10.0) { double tol = std::max(tolerance, std::abs(std::min(a,b))) * std::numeric_limits::epsilon(); return ((a==b) || (std::abs(a-b) < tol) ); } bool about_equal(double a, double b, double tolerance) { return ((a==b) || (std::abs(a-b) < tolerance)); } bool is_equal_relative(double a, double b, double tolerance) { tolerance = std::max(fabs(a), fabs(b)) * tolerance; return about_equal(a, b, tolerance); } bool is_equal_range(double x, double y, double range, double tolerance) { return (fabs(x - y) / range) < tolerance ; } double median(const std::vector& v) { size_t n = v.size(); std::vector vv; vv.reserve(n); for (size_t i=0; i movingMedian(const std::vector &x, size_t n) { std::vector out(x.size()); std::vector d(n, NAN); size_t half = (n/2); size_t half1 = half+1; // fill left side for (size_t i=0; i v; for (size_t i=half; i(x.begin()+i-half, x.begin()+i+half1); out[i] = median(v); } // right side int j=0; for (size_t i=maxn; i values, unsigned ties, bool narm, std::default_random_engine rgen, std::uniform_real_distribution dist) { if (narm) { na_omit(values); } size_t n = values.size(); if (n == 0) return (NAN); if (n == 1) return (values[0]); std::vector counts(n, 0); if (ties < 3) { std::sort(values.begin(), values.end()); } for (size_t i=0; i counts[maxCount]) { maxCount = i; } } // last } else if (ties == 1) { for (size_t i = 1; i < n; ++i) { if (counts[i] >= counts[maxCount]) { maxCount = i; } } // dont care (first, but not sorted) } else if (ties == 2) { for (size_t i = 1; i < n; ++i) { if (counts[i] > counts[maxCount]) { maxCount = i; } } // random } else if (ties == 3) { size_t tieCount = 1; for (size_t i = 1; i < n; ++i) { if (counts[i] > counts[maxCount]) { maxCount = i; tieCount = 1; } else if (counts[i] == counts[maxCount]) { tieCount++; double randnr = dist(rgen); if (randnr < (1 / tieCount)) { maxCount = i; } } } } else { size_t tieCount = 1; for (size_t i = 1; i < n; ++i) { if (counts[i] > counts[maxCount]) { maxCount = i; tieCount = 1; } else if (counts[i] == counts[maxCount]) { tieCount++; } } if (tieCount > 1 ) { return(NAN); } } return values[maxCount]; } terra/src/spatRasterMultiple.cpp0000644000176200001440000003434314735443250016544 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRasterMultiple.h" #include "string_utils.h" #include "file_utils.h" SpatRasterCollection SpatRasterCollection::deepCopy() { return *this; } SpatRasterCollection::SpatRasterCollection(size_t n) { ds.resize(n); }; size_t SpatRasterCollection::size() { return ds.size(); } bool SpatRasterCollection::empty() { return ds.empty(); } void SpatRasterCollection::resize(size_t n) { ds.resize(n); } void SpatRasterCollection::push_back(SpatRaster r, std::string name) { /* if (ds.size() == 0) { extent = r.getExtent(); } else { extent.unite(r.getExtent()); } */ ds.push_back(r); names.push_back(name); } SpatExtent SpatRasterCollection::getExtent() { SpatExtent e; if (ds.empty()) { e = SpatExtent(); } else { e = ds[0].getExtent(); for (size_t i=1; i SpatRasterCollection::getValueType(bool unique) { std::vector d; for (size_t i=0; i dd = ds[i].getValueType(false); d.insert(d.end(), dd.begin(), dd.end()); } if (unique) { std::sort(d.begin(), d.end()); d.erase(std::unique(d.begin(), d.end()), d.end()); } return(d); } /* void SpatRasterCollection::setExtent() { if (ds.size() == 0) { extent = SpatExtent(); return; } else { extent = ds[0].getExtent(); } for (size_t i=1; i options, bool reverse, SpatOptions &opt) { std::string outfile = opt.get_filename(); if (outfile.empty()) { outfile = tempFile(opt.get_tempdir(), opt.tmpfile, ".vrt"); } else if (file_exists(outfile) && (!opt.get_overwrite())) { setError("output file exists. You can use 'overwrite=TRUE' to overwrite it"); return(""); } opt.set_filenames({outfile}); std::vector ff; ff.reserve(size()); SpatOptions xopt(opt); for (size_t i=0; i f = ds[i].filenames(); if ((ds[i].nsrc() == 1) && f[0] != "") { ff.push_back(f[0]); } else { std::string tmpf = tempFile(xopt.get_tempdir(), xopt.tmpfile, "_temp_raster.tif"); xopt.set_filenames({tmpf}); SpatRaster out = ds[i].writeRaster(xopt); if (out.hasError()) { setError(out.getError()); return ""; } ff.push_back(tmpf); } } SpatRaster tmp; if (reverse) std::reverse(ff.begin(), ff.end()); return tmp.make_vrt(ff, options, opt); } void SpatRasterCollection::readBlock(SpatRaster &r, std::vector> &v, BlockSize bs, size_t i, std::vector use, SpatOptions opt){ if ((bs.row[i] + bs.nrows[i]) > r.nrow()) { setError("invalid rows/columns"); return; } if (bs.nrows[i]==0) { return; } SpatExtent re = r.getExtent(); double yres = r.yres(); double ymx = re.ymax - bs.row[i] * yres; double ymn = re.ymax - (bs.row[i] + bs.nrows[i]) * yres; SpatExtent e = {re.xmin, re.xmax, ymn, ymx}; SpatRasterCollection x = crop(e, "near", true, use, opt); if (x.hasError()) { setError(x.getError()); return; } v.resize(x.size()); for (size_t i=0; i< x.size(); i++) { x.ds[i].readValues(v[i], 0, x.ds[i].nrow(), 0, x.ds[i].ncol()); } } SpatRasterCollection SpatRasterCollection::crop(SpatExtent e, std::string snap, bool expand, std::vector use, SpatOptions &opt) { SpatRasterCollection out; if ( !e.valid() ) { out.setError("invalid extent"); return out; } if (!e.valid_notempty()) { out.setError("cannot crop with an empty extent"); return out; } SpatOptions ops(opt); if (use.empty()) { for (size_t i=0; i use, SpatOptions &opt) { SpatRasterCollection out; SpatExtent e = v.extent; if ( !e.valid() ) { out.setError("invalid extent"); return out; } if ((e.xmin == e.xmax) && (e.ymin == e.ymax)) { out.setError("cannot crop with an empty extent"); return out; } SpatOptions ops(opt); if (use.empty()) { for (size_t i=0; i SpatRasterCollection::dims() { size_t n = ds.size(); size_t n2 = 2 * n; std::vector out(n * 3); for (size_t i=0; i SpatRasterCollection::get_names() { return names; }; void SpatRasterCollection::set_names(std::vector nms) { if (nms.size() == ds.size()) { names = nms; } } std::vector SpatRasterCollection::filenames() { size_t n =0; for (size_t i=0; i names; names.reserve(n); for (size_t i=0; i n = ds[i].filenames(); names.insert(names.end(), n.begin(), n.end()); } return names; }; bool SpatRasterCollection::addTag(std::string name, std::string value) { lrtrim(name); lrtrim(value); if (value == "") { return removeTag(name); } else if (name != "") { tags[name] = value; return true; } return false; } bool SpatRasterCollection::removeTag(std::string name) { std::map::iterator it = tags.find(name); if (it == tags.end()) return false; tags.erase(it); return true; } std::string SpatRasterCollection::getTag(std::string name) { std::map::iterator it = tags.find(name); if (it != tags.end()) return it->second; return ""; } std::vector SpatRasterCollection::getTags() { std::vector out; out.reserve(2 * tags.size()); for(auto e : tags) { out.push_back(e.first); out.push_back(e.second); } return out; } ///////////////////////////////////////////////// SpatRasterStack SpatRasterStack::deepCopy() { return *this; } SpatRasterStack::SpatRasterStack(SpatRaster r, std::string name, std::string longname, std::string unit, bool warn) { push_back(r, name, longname, unit, warn); }; std::vector SpatRasterStack::resolution() { if (ds.empty()) { return {NAN, NAN}; } else { return ds[0].resolution(); } } SpatExtent SpatRasterStack::getExtent() { if (ds.empty()) { return SpatExtent(); } else { return ds[0].getExtent(); } } std::vector SpatRasterStack::get_names() { return names; }; void SpatRasterStack::set_names(std::vector nms) { if (nms.size() == ds.size()) { names = nms; } } std::vector SpatRasterStack::get_longnames() { return long_names; }; void SpatRasterStack::set_longnames(std::vector nms) { if (nms.size() == ds.size()) { long_names = nms; } } std::vector SpatRasterStack::get_units() { return units; }; void SpatRasterStack::set_units(std::vector u) { if (u.size() == ds.size()) { units = u; } } void SpatRasterStack::set_layernames(std::vector nms, long id) { if (id < 0) { for (size_t i=0; i> SpatRasterStack::get_layernames() { size_t nd = ds.size(); std::vector> out(nd); for (size_t i = 0; i SpatRasterStack::filenames() { size_t n =0; for (size_t i=0; i names; names.reserve(n); for (size_t i=0; i n = ds[i].filenames(); names.insert(names.end(), n.begin(), n.end()); } return names; }; bool SpatRasterStack::readStart() { for (auto& x : ds) { if (!x.readStart()) return false; } return true; } bool SpatRasterStack::readStop() { for (auto& x : ds) { if (!x.readStop()) return false; } return true; } bool SpatRasterStack::readAll() { for (auto& x : ds) { if (!x.readAll()) return false; } return true; } unsigned SpatRasterStack::nsds() { return ds.size(); } unsigned SpatRasterStack::nrow() { if (ds.empty()) { return 0; } else { return ds[0].nrow(); } } unsigned SpatRasterStack::ncol() { if (ds.empty()) { return 0; } else { return ds[0].ncol(); } } std::vector SpatRasterStack::nlyr() { std::vector out; if (!ds.empty()) { out.reserve(ds.size()); for (size_t i=0; i x) { SpatRasterStack out; for (size_t i=0; i ff = opt.get_filenames(); if (ff.size() != ds.size()) { opt.set_filenames({""}); opt.ncopies *= ds.size(); } for (size_t i=0; i (ds.size()-1)) { setError("invalid index"); return; } if (ds.empty()) { setError("cannot replace on empty stack"); return; } if (!ds[0].compare_geom(x, false, false, true, true, false, false)) { setError("extent does not match"); return; } ds[i] = x; // for clause for #1604 if (setname) { names[i] = x.getNames()[0]; long_names[i] = x.getLongSourceNames()[0]; units[i] = x.getUnit()[0]; } } SpatRaster SpatRasterStack::collapse() { SpatRaster out; if (!ds.empty()) { out = ds[0]; for (size_t i=1; i::iterator it = tags.find(name); if (it == tags.end()) return false; tags.erase(it); return true; } std::string SpatRasterStack::getTag(std::string name) { std::map::iterator it = tags.find(name); if (it != tags.end()) return it->second; return ""; } std::vector SpatRasterStack::getTags() { std::vector out; out.reserve(2 * tags.size()); for(auto e : tags) { out.push_back(e.first); out.push_back(e.second); } return out; } terra/src/extract.cpp0000644000176200001440000013143314750563210014344 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include "spatRasterMultiple.h" #include "vecmath.h" #include "vecmathse.h" #include "geosphere.h" #include "sort.h" #include "math_utils.h" void SpatRaster::readRowColBlock(size_t src, std::vector> &out, size_t outstart, std::vector &rows, std::vector &cols) { std::vector> errout; if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return; } SpatRaster rs(source[src]); size_t nl = rs.nlyr(); size_t nc = rs.ncol(); size_t n = rows.size(); SpatOptions opt; BlockSize bs = getBlockSize(opt); /* std::vector> rowcol; rowcol.reserve(rows.size()); for (size_t i=0; i < rows.size(); i++) { rowcol.push_back(std::make_pair(rows[i], cols[i])); } std::vector pm = sort_order_a(rowcol); permute(rows, pm); permute(cols, pm); */ std::vector urows = vunique(rows); std::vector useblock(bs.n, false); size_t jj = 0; for (size_t i=0; i= st) && (urows[j] < ed)) { useblock[i] = true; bs.row[i] = urows[j]; for (size_t k=j; k ed) { jj = k; break; } else { bs.nrows[i] = k-jj+1; } } break; } } } bs.nrows[bs.n-1] = urows[urows.size()-1] - bs.row[bs.n-1] + 1; if (!rs.readStart()) { setError(getError()); return; } size_t outend = outstart + nl; // std::vector> out(nl, std::vector(n, NAN)); for (size_t k=outstart; k(n, NAN); } for (size_t i=0; i v; rs.readBlock(v, bs, i); int_64 rstart = bs.row[i]; int_64 rend = bs.row[i] + bs.nrows[i]; size_t off1 = bs.nrows[i] * nc; for (size_t j=0; j= rend) break; // if rows are sorted if ((rows[j] >= rstart) && (rows[j] < rend)) { size_t cell = (rows[j]-rstart) * nc + cols[j]; for (size_t lyr=0; lyr SpatRaster::readRowColBlockFlat(size_t src, std::vector &rows, std::vector &cols) { std::vector errout; if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return errout; } std::vector> v = readRowColBlock(src, rows, cols); size_t nr = v[0].size(); size_t nl = v.size(); std::vector out; out.reserve(nl * nr); for (size_t i=0; i circ_dist(double xres, double yres, double d, size_t nrows, size_t ncols, std::vector &dim, bool lonlat, double ymean) { size_t nx, ny; std::string crs; if (lonlat) { deg2rad(ymean); double xr = xres; double yr = yres; deg2rad(xr); deg2rad(yr); double dx = distance_cos(0, ymean, xr, ymean); double dy = distance_cos(0, ymean-0.5*yr, 0, ymean+0.5*yr); nx = 1 + 2 * floor(d/dx); ny = 1 + 2 * floor(d/dy); crs = "+proj=longlat"; } else { nx = 1 + 2 * floor(d/xres); ny = 1 + 2 * floor(d/yres); crs = "+proj=utm +zone=1"; } nx = std::min(nx, ncols); ny = std::min(ny, nrows); if ((nx == 1) || (ny == 1)) { dim = {1, 1}; std::vector out{1}; return out; } dim = {ny, nx}; SpatRaster x({ny, nx, 1}, {0., nx * xres, 0., ny * yres}, crs); std::vector v(nx*ny, NAN); v[v.size()/2] = 1; SpatOptions opt; x.setValues(v, opt); x = x.distance(NAN, NAN, false, "m", false, "cosine", false, -1, opt); std::vector out; x.getValuesSource(0, out); out[out.size()/2] = 1; /* for (size_t i=0; i> SpatRaster::extractBuffer(const std::vector &x, const std::vector &y, double b) { std::vector> out; if (!hasValues()) { setError("the raster has no values"); return out; } if (nlyr() > 1) { setError("can only use a search_radius for one layer at a time"); return out; } std::vector dim; std::vector cd; double ymean = 0; bool lonlat = is_lonlat(); if (lonlat) { ymean = vmean(y, true); } std::vector cb = circ_dist(xres(), yres(), b, nrow(), ncol(), dim, lonlat, ymean); bool docb = false; std::vector adj(cb.size(), false); if (cb.size() > 1) { cd.reserve(cb.size() * .67); for (size_t i=0; i cells = cellFromXY(x, y); std::vector> v = extractCell(cells); std::vector bestcell = cells; std::vector bestdist(cells.size()); std::vector pm = sort_order_a(cd); permute(cd, pm); if (docb) { size_t n = x.size(); for (size_t i=0; i acells = adjacentMat({cells[i]}, adj, dim, false); permute(acells, pm); std::vector> vv = extractCell(acells); // take the first nearest. Instead could average over the cells with same distance for (size_t j=0; j &out, const std::vector &x, const std::vector &y) { size_t n = x.size(); SpatExtent e = getExtent(); out.resize(0); out.reserve(4*n); double xmin = e.xmin; double xmax = e.xmax; double xr = xres(); double ymin = e.ymin; double ymax = e.ymax; double yr = yres(); double nc = ncol(); int_64 mxr = nrow()-1; int_64 mxc = ncol()-1; int_64 r1, r2, c1, c2; std::vector bad = {NAN, NAN, NAN, NAN}; for (size_t i = 0; i < n; i++) { if (y[i] < ymin || y[i] > ymax || x[i] < xmin || x[i] > xmax) { out.insert(out.end(), bad.begin(), bad.end()); continue; } if (y[i] == ymin) { r1 = mxr; r2 = mxr; } else { double p = (ymax - y[i]) / yr; r1 = trunc(p); if ((p - r1) > 0.5) { r2 = r1 == mxr ? mxr : r1 + 1; } else { r2 = r1; r1 = r1 == 0 ? 0 : r1 - 1; } } if (x[i] == xmax) { c1 = mxc; c2 = mxc; } else { double p = (x[i] - xmin) / xr; c1 = trunc(p); if ((p - c1) > 0.5) { c2 = c1 == mxc ? mxc : c1 + 1; } else { c2 = c1; c1 = c2 == 0 ? 0 : c2 - 1; } } out.push_back(r1 * nc + c1); out.push_back(r1 * nc + c2); out.push_back(r2 * nc + c1); out.push_back(r2 * nc + c2); } } std::vector return_NAN(bool weights) { if (weights) { return std::vector(4, NAN); } return std::vector(1, NAN); } std::vector bilinearInt(const double& x, const double& y, const double& x1, const double& x2, const double& y1, const double& y2, double& v11, double& v12, double& v21, double& v22, bool weights) { bool n1 = std::isnan(v11); bool n2 = std::isnan(v12); bool n3 = std::isnan(v21); bool n4 = std::isnan(v22); double dx = (x2 - x1); bool intx = dx > 0; double dy = (y1 - y2); bool inty = dy > 0; double w11, w12, w21, w22; if (std::isnan(x) || std::isnan(y) || (n1 && n2 && n3 && n4)) { return return_NAN(weights); } if (weights) { v11 = 1; v12 = 1; v21 = 1; v22 = 1; } if (intx && inty) { double d = dx * dy; if (!(n1 || n2 || n3 || n4)){ w11 = v11 * ((x2 - x) * (y - y2)) / d; w12 = v12 * ((x - x1) * (y - y2)) / d; w21 = v21 * ((x2 - x) * (y1 - y)) / d; w22 = v22 * ((x - x1) * (y1 - y)) / d; } else if (!(n1 || n2 || n3)){ w11 = v11 * ((x2 - x) * (y - y2)) / d; w12 = v12 * ((x - x1) * (y - y2)) / d; w21 = v21 * ((y1 - y)) / dy; w22 = 0; } else if (!(n1 || n2 || n4)){ w11 = v11 * ((x2 - x) * (y - y2)) / d; w12 = v12 * ((x - x1) * (y - y2)) / d; w21 = 0; w22 = v22 * ((y1 - y)) / dy; } else if (!(n1 || n2 || n3)){ w11 = v11 * ((x2 - x) * (y - y2)) / d; w12 = v12 * ((x - x1) * (y - y2)) / d; w21 = v21 * ((y1 - y)) / dy; w22 = 0; } else if (!(n1 || n3 || n4)){ w11 = v11 * ((y - y2)) / dy; w12 = 0; w21 = v21 * ((x2 - x) * (y1 - y)) / d; w22 = v22 * ((x - x1) * (y1 - y)) / d; } else if (!(n2 || n3 || n4)){ w11 = 0; w12 = v12 * ((y - y2)) / dy; w21 = v21 * ((x2 - x) * (y1 - y)) / d; w22 = v22 * ((x - x1) * (y1 - y)) / d; } else if (!(n1 || n2 )){ w11 = v11 * ((x2 - x)) / dx; w12 = v12 * ((x - x1)) / dx; w21 = 0; w22 = 0; } else if (!(n1 || n3)){ w11 = v11 * ((y - y2)) / dy; w12 = 0; w21 = v21 * ((y1 - y)) / dy; w22 = 0; } else if (!(n1 || n4)){ w11 = v11 * ((y - y2)) / dy; w12 = 0; w21 = 0; w22 = v22 * ((y1 - y)) / dy; } else if (!(n2 || n3)){ w11 = 0; w12 = v12 * ((y - y2)) / dy; w21 = v21 * ((y1 - y)) / dy; w22 = 0; } else if (!(n2 || n4)){ w11 = 0; w12 = v12 * ((y - y2)) / dy; w21 = 0; w22 = v22 * ((y1 - y)) / dy; } else if (!(n3 || n4)){ w11 = 0; w12 = 0; w21 = v21 * ((x2 - x)) / dx; w22 = v22 * ((x - x1)) / dx; } else if (!n1){ w11 = v11; w12 = 0; w21 = 0; w22 = 0; } else if (!n2){ w11 = 0; w12 = v12; w21 = 0; w22 = 0; } else if (!n3){ w11 = 0; w12 = 0; w21 = v21; w22 = 0; } else if (!n4){ w11 = 0; w12 = 0; w21 = 0; w22 = v22; } else { return return_NAN(weights); } } else if (intx) { w21 = 0.0; w22 = 0.0; if (!(n1 || n2)) { w11 = v11 * (x2 - x) / dx; w12 = v12 * (x - x1) / dx; } else if (!n1) { w11 = v11; w12 = 0.0; } else if (!n2){ w11 = 0.0; w12 = v12; } else { return return_NAN(weights); } } else if (inty) { w12 = 0.0; w22 = 0.0; if (!(n1 || n3)) { w11 = v11 * (y - y2) / dy; w21 = v21 * (y1 - y) / dy; } else if (!n1) { w11 = v11; w21 = 0; } else if (!n3) { w11 = 0; w21 = v21; } else{ return return_NAN(weights); } } else { w11 = v11; w21 = 0.0; w12 = 0.0; w22 = 0.0; } if (weights) { return std::vector{ w11, w12, w21, w22 }; } return std::vector{ w11 + w12 + w21 + w22 }; } void SpatRaster::bilinearValues(std::vector> &out, const std::vector &x, const std::vector &y) { std::vector four; fourCellsFromXY(four, x, y); std::vector> xy = xyFromCell(four); std::vector> v = extractCell(four); size_t n = x.size(); out.resize(nlyr(), std::vector(n)); for (size_t i=0; i value = bilinearInt(x[i], y[i], xy[0][ii], xy[0][ii+1], xy[1][ii], xy[1][ii+3], v[j][ii], v[j][ii+1], v[j][ii+2], v[j][ii+3], false); out[j][i] = value[0]; } } } std::vector SpatRaster::bilinearCells(const std::vector &x, const std::vector &y) { std::vector four; fourCellsFromXY(four, x, y); std::vector> xy = xyFromCell(four); // std::vector> v = extractCell(four); size_t n = x.size(); std::vector res; res.reserve(n * 8); double v1=1, v2=1, v3=1, v4=1; for (size_t i=0; i w = bilinearInt(x[i], y[i], xy[0][ii], xy[0][ii+1], xy[1][ii], xy[1][ii+3], v1, v2, v3, v4, true); res.insert(res.end(), four.begin()+ii, four.begin()+ii+4); res.insert(res.end(), w.begin(), w.end()); } return res; } double bilinear(const std::vector &v, const std::vector &e, const double &dxdy, const double &x, const double &y) { // values // v[0] v[1] // v[2] v[3] // coordinates // e[3] (ymax) // (xmin)e[0] e[1] (xmax) // e[2] (ymin) double dx1 = x - e[0]; double dx2 = e[1] - x; double dy1 = y - e[2]; double dy2 = e[3] - y; return (v[2] * dx2 * dy2 + v[3] * dx1 * dy2 + v[0] * dx2 * dy1 + v[1] * dx1 * dy1) / dxdy; } std::vector SpatRaster::line_cells(SpatGeom& g) { unsigned nrows = nrow(); unsigned ncols = ncol(); SpatExtent extent = getExtent(); double xmin = extent.xmin; double ymax = extent.ymax; double rx = xres(); double ry = yres(); std::vector out; unsigned np = g.size(); for (size_t prt=0; prt nrows || maxrow < 0) { return(out); } size_t startrow = minrow < 0 ? 0 : minrow; size_t endrow = maxrow >= nrows ? (nrows-1) : maxrow; unsigned n = p.x.size(); out.reserve(2*(startrow-endrow+1)); for (size_t row=startrow; row= y)) || ((p.y[j] < y) && (p.y[i] >= y))) { double col = ((p.x[i] - xmin + (y-p.y[i])/(p.y[j]-p.y[i]) * (p.x[j]-p.x[i])) + 0.5 * rx ) / rx; if ((col >= 0) & (col < ncols)) { out.push_back(rowcell + col); } } } } } return(out); } std::vector SpatRaster::polygon_cells(SpatGeom& g) { // does not deal with holes yet. unsigned nrows = nrow(); unsigned ncols = ncol(); SpatExtent extent = getExtent(); double xmin = extent.xmin; double ymax = extent.ymax; double rx = xres(); double ry = yres(); std::vector out; unsigned np = g.size(); for (size_t prt=0; prt nrows || maxrow < 0) { return(out); } size_t startrow = minrow < 0 ? 0 : minrow; size_t endrow = maxrow >= nrows ? (nrows-1) : maxrow; unsigned n = p.x.size(); out.reserve(5*(startrow-endrow+1)); std::vector nCol(n); for (size_t row=0; row= y)) || ((p.y[j] < y) && (p.y[i] >= y))) { // nCol[nodes++]=(int) (((pX[i] - xmin + (y-pY[i])/(pY[j]-pY[i]) * (pX[j]-pX[i])) + 0.5 * rx ) / rx); double nds = ((p.x[i] - xmin + (y-p.y[i])/(p.y[j]-p.y[i]) * (p.x[j]-p.x[i])) + 0.5 * rx ) / rx; nds = nds < 0 ? 0 : nds; nds = nds > ncols ? ncols : nds; nCol[nodes] = (unsigned) nds; nodes++; } j = i; } // now remove the holes? std::sort(nCol.begin(), nCol.begin()+nodes); unsigned rowcell = ncols * row; // fill cells between node pairs. for (size_t i=0; i < nodes; i+=2) { if (nCol[i+1] > 0 && nCol[i] < ncols) { // surely should be >= 0? for (size_t col = nCol[i]; col < nCol[i+1]; col++) { out.push_back(col + rowcell); } } } } } return(out); } /* idw bool lonlat = could_be_lonlat(); //bool globalLonLat = is_global_lonlat(); //size_t n = x.size(); if (method == "idw") { std::function(std::vector&,std::vector&,double,double)> distFun; // std::vector distance_plane(std::vector &x1, std::vector &y1, std::vector &x2, std::vector &y2); if (lonlat) { distFun = distance_lonlat_vd; } else { distFun = distance_plane_vd; } */ /* cxy = xyFromCell(cells); d = distFun(cxy[0], cxy[1], x[i], y[i]); v = extractCell(cells); double a=0, b=0; for (size_t j=0; j<4; j++) { a += v[j] * d[j]; b += d[j]; } out[i] = a / b; */ // > std::vector> SpatRaster::extractXY(const std::vector &x, const std::vector &y, const std::string &method, const bool &cells) { unsigned nl = nlyr(); unsigned np = x.size(); if (!hasValues()) { std::vector> out(nl+cells, std::vector(np, NAN)); return out; } std::vector> out; if (method == "bilinear") { bilinearValues(out, x, y); if (cells) { std::vector cell = cellFromXY(x, y); out.push_back(cell); } } else { std::vector cell = cellFromXY(x, y); out = extractCell(cell); if (cells) { out.push_back(cell); } } return out; } std::vector SpatRaster::extractXYFlat(const std::vector &x, const std::vector &y, const std::string & method, const bool &cells) { // > std::vector> e = extractXY(x, y, method, cells); std::vector out = e[0]; for (size_t i=1; i std::vector flatten(const std::vector>& v) { std::size_t total_size = 0; for (const auto& sub : v) total_size += sub.size(); std::vector result; result.reserve(total_size); for (const auto& sub : v) result.insert(result.end(), sub.begin(), sub.end()); return result; } */ /* std::vector SpatRaster::extractXYFlat(const std::vector &x, const std::vector &y, const std::string & method, const bool &cells) { unsigned nl = nlyr(); unsigned np = x.size(); if (!hasValues()) { std::vector out(nl * np, NAN); return out; } std::vector out; if (method == "bilinear") { std::vector> bil = bilinearValues(x, y); if (cells) { std::vector cell = cellFromXY(x, y); bil.push_back(cell); } out = flatten(bil); } else { std::vector cell = cellFromXY(x, y); if (cells) { std::vector> xout; xout = extractCell(cell); xout.push_back(cell); out = flatten(xout); } else { out = extractCellFlat(cell); } } return out; } */ // >> std::vector>> SpatRaster::extractVector(SpatVector v, bool touches, bool small, std::string method, bool cells, bool xy, bool weights, bool exact, SpatOptions &opt) { if (!source[0].srs.is_same(v.srs, true)) { v = v.project(getSRS("wkt"), false); addWarning("transforming vector data to the CRS of the raster"); } std::string gtype = v.type(); if (gtype == "points") weights = false; if (exact) weights = false; unsigned nl = nlyr(); unsigned ng = v.size(); std::vector>> out(ng, std::vector>(nl + cells + 2*xy + (weights || exact))); if (!hasValues()) { setError("raster has no values"); return out; } /* #if GDAL_VERSION_MAJOR < 3 if (weights) { setError("extract with weights not supported for your GDAL version"); return out; } #endif */ std::vector> srcout; if (gtype == "points") { if (method != "bilinear") method = "simple"; SpatDataFrame vd = v.getGeometryDF(); if (vd.nrow() == ng) { // single point geometry std::vector x = vd.getD(0); std::vector y = vd.getD(1); srcout = extractXY(x, y, method, cells); for (size_t i=0; i x = vd.getD(0); std::vector y = vd.getD(1); //srcout = extractXY(x, y, method, cells); /* for (size_t j=0; j feats(1, 1) ; for (size_t i=0; i cell, wgt; if (weights) { if (gtype == "lines") { rasterizeLinesLength(cell, wgt, p, opt); } else { rasterizeCellsWeights(cell, wgt, p, opt); } } else if (exact) { if (gtype == "lines") { rasterizeLinesLength(cell, wgt, p, opt); } else { rasterizeCellsExact(cell, wgt, p, opt); } } else { cell = rasterizeCells(p, touches, small, opt); } srcout = extractCell(cell); for (size_t j=0; j> crds = xyFromCell(cell); out[i][nl+cells] = crds[0]; out[i][nl+cells+1] = crds[1]; } if (weights || exact) { out[i][nl + cells + 2*xy] = wgt; } } } return out; } /* std::vector SpatRaster::extractVectorFlat(SpatVector v, std::string fun, bool narm, bool touches, std::string method, bool cells, bool xy, bool weights, bool exact, SpatOptions &opt) { std::vector flat; std::string gtype = v.type(); if (gtype == "points") { weights = false; exact = false; } if (exact) weights = false; unsigned nl = nlyr(); unsigned ng = v.size(); if (!hasValues()) { setError("raster has no values"); return flat; } std::vector>> out; if (gtype != "points") { out.resize(ng, std::vector>(nl + cells + 2*xy + (weights||exact))); } std::vector> srcout; if (gtype == "points") { if (method != "bilinear") method = "simple"; SpatDataFrame vd = v.getGeometryDF(); //if (vd.nrow() == ng) { // single point geometry std::vector x = vd.getD(0); std::vector y = vd.getD(1); std::vector> xycells; if (xy) { std::vector cellxy = cellFromXY(x, y); xycells = xyFromCell(cellxy); } if (!cells & !xy) { return( extractXYFlat(x, y, method, cells)); } else { srcout = extractXY(x, y, method, cells); nl += cells; flat.reserve(ng * nl); for (size_t i=0; i x = vd.getD(0); std::vector y = vd.getD(1); if (!cells & !xy & !weights) { return( extractXYFlat(x, y, method, cells)); } for (size_t i=0; i x = vd.getD(0); std::vector y = vd.getD(1); srcout = extractXY(x, y, method, cells); out.push_back(srcout); if (cells) { out[i][nl] = srcout[nl]; } if (xy) { out[i][nl+cells] = x; out[i][nl+cells+1] = y; } } } */ /* } else { SpatRaster r = geometry(1); //std::vector feats(1, 1) ; for (size_t i=0; i cell, wgt; if (weights) { if (gtype == "lines") { rasterizeLinesLength(cell, wgt, p, opt); } else { rasterizeCellsWeights(cell, wgt, p, opt); } } else if (exact) { if (gtype == "lines") { rasterizeLinesLength(cell, wgt, p, opt); } else { rasterizeCellsExact(cell, wgt, p, opt); } } else { cell = rasterizeCells(p, touches, opt); } srcout = extractCell(cell); for (size_t j=0; j> crds = xyFromCell(cell); out[i][nl+cells] = crds[0]; out[i][nl+cells+1] = crds[1]; } if (weights || exact) { out[i][nl + cells + 2*xy] = wgt; } } } size_t fsize = 0; for (size_t i=0; i SpatRaster::extractVectorFlat(SpatVector v, std::vector funs, bool narm, bool touches, bool small, std::string method, bool cells, bool xy, bool weights, bool exact, SpatOptions &opt) { if (!source[0].srs.is_same(v.srs, true)) { v = v.project(getSRS("wkt"), false); addWarning("transforming vector data to the CRS of the raster"); // addWarning("CRS of raster and vector data do not match"); } std::vector flat; std::string gtype = v.type(); if (gtype == "points") { weights = false; exact = false; } if (exact) weights = false; unsigned nl = nlyr(); unsigned ng = v.size(); if (!hasValues()) { setError("raster has no values"); return flat; } if (gtype == "points") { if (method != "bilinear") method = "simple"; SpatDataFrame vd = v.getGeometryDF(); //if (vd.nrow() == ng) { // single point geometry std::vector x = vd.getD(0); std::vector y = vd.getD(1); std::vector> xycells; if (xy) { std::vector cellxy = cellFromXY(x, y); xycells = xyFromCell(cellxy); } if (!cells & !xy) { return( extractXYFlat(x, y, method, cells)); } else { std::vector> srcout = extractXY(x, y, method, cells); nl += cells; flat.reserve(ng * nl); for (size_t i=0; i x = vd.getD(0); std::vector y = vd.getD(1); if (!cells & !xy & !weights) { return( extractXYFlat(x, y, method, cells)); } for (size_t i=0; i x = vd.getD(0); std::vector y = vd.getD(1); srcout = extractXY(x, y, method, cells); out.push_back(srcout); if (cells) { out[i][nl] = srcout[nl]; } if (xy) { out[i][nl+cells] = x; out[i][nl+cells+1] = y; } } } */ } std::vector>> out; SpatRaster r = geometry(1); //std::vector feats(1, 1) ; std::vector&, size_t, size_t)>> efuns; std::vector&, std::vector&, size_t, size_t)>> wfuns; bool havefun = false; if (!funs[0].empty()) { if (weights | exact) { wfuns.resize(funs.size()); for (size_t i=0; i cell, wgt; if (weights) { if (gtype == "lines") { rasterizeLinesLength(cell, wgt, p, opt); } else { rasterizeCellsWeights(cell, wgt, p, opt); } } else if (exact) { if (gtype == "lines") { rasterizeLinesLength(cell, wgt, p, opt); } else { rasterizeCellsExact(cell, wgt, p, opt); } } else { cell = rasterizeCells(p, touches, small, opt); } if (havefun) { std::vector> cvals = extractCell(cell); if (weights | exact) { for (size_t j=0; j> crds = xyFromCell(cell); out[i].push_back(crds[0]); out[i].push_back(crds[1]); } if (weights || exact) { out[i].push_back(wgt); } } } if (havefun) return flat; size_t fsize = 0; for (size_t i=0; i> SpatRaster::extractCell(std::vector &cell) { std::vector wcell; std::vector> rc, wrc; rc = rowColFromCell(cell); size_t n = cell.size(); if (!hasValues()) { std::vector> out(nlyr(), std::vector(n, NAN)); return out; } unsigned ns = nsrc(); unsigned lyr = 0; size_t nc; std::vector> out(nlyr()); for (size_t src=0; src(n, NAN); size_t j = i * nc; if (win) { for (size_t k=0; k= 0 && wcell[k] < nc) { out[lyr][k] = source[src].values[j + wcell[k]]; } } } else { for (size_t k=0; k= 0 && cell[k] < nc) { out[lyr][k] = source[src].values[j + cell[k]]; } } } lyr++; } } else { #ifdef useGDAL size_t pos = source[src].filename.find("https://"); if ((pos != std::string::npos) && (rc[0].size() > 200)) { if (win) { readRowColBlock(src, out, lyr, wrc[0], wrc[1]); } else { readRowColBlock(src, out, lyr, rc[0], rc[1]); } } else { if (win) { readRowColGDAL(src, out, lyr, wrc[0], wrc[1]); } else { readRowColGDAL(src, out, lyr, rc[0], rc[1]); } if (hasError()) return out; } lyr += slyrs; #else out.resize(slyrs); for (size_t i=0; i(n, NAN); } #endif if (hasError()) return out; } } return out; } //std::vector> SpatRaster::extractRowCol(std::vector &row, std::vector &col) { /* std::vector SpatRaster::extractCellFlat(std::vector &cell) { std::vector wcell; std::vector> rc, wrc; rc = rowColFromCell(cell); size_t n = cell.size(); std::vector out(nlyr() * n, NAN); unsigned ns = nsrc(); // unsigned lyr = 0; size_t nc; size_t off = 0; for (size_t src=0; src= 0 && wcell[k] < nc) { out[off2+k] = source[src].values[j + wcell[k]] ; } } } else { for (size_t k=0; k= 0 && cell[k] < nc) { out[off2+k] = source[src].values[j + cell[k]]; } } } //lyr++; } } else { //if (source[0].driver == "raster") { // srcout = readCellsBinary(src, cell); //} else { #ifdef useGDAL std::vector g; size_t pos = source[0].filename.find("https://"); if ((pos != std::string::npos) && (rc[0].size() > 200)) { if (win) { g = readRowColBlockFlat(src, wrc[0], wrc[1]); } else { g = readRowColBlockFlat(src, rc[0], rc[1]); } } else { if (win) { g = readRowColGDALFlat(src, wrc[0], wrc[1]); } else { g = readRowColGDALFlat(src, rc[0], rc[1]); } } for (size_t i=0; i SpatRaster::vectCells(SpatVector v, bool touches, bool small, std::string method, bool weights, bool exact, SpatOptions &opt) { std::string gtype = v.type(); if (gtype != "polygons") weights = false; std::vector out, cells, wghts; if (gtype == "points") { SpatDataFrame vd = v.getGeometryDF(); //std::vector id = vd.getI(0); if (method == "bilinear") { return bilinearCells(vd.getD(0), vd.getD(1)); } else { return cellFromXY(vd.getD(0), vd.getD(1)); //cells = cellFromXY(vd.getD(0), vd.getD(1)); //out.insert(out.end(), id.begin(), id.end()); //out.insert(out.end(), cells.begin(), cells.end()); } } else { unsigned ng = v.size(); SpatRaster r = geometry(1); std::vector feats(1, 1) ; for (size_t i=0; i cnr, wght; rasterizeCellsWeights(cnr, wght, p, opt); std::vector id(cnr.size(), i); out.insert(out.end(), id.begin(), id.end()); cells.insert(cells.end(), cnr.begin(), cnr.end()); wghts.insert(wghts.end(), wght.begin(), wght.end()); } else if (exact) { std::vector cnr, wght; rasterizeCellsExact(cnr, wght, p, opt); std::vector id(cnr.size(), i); out.insert(out.end(), id.begin(), id.end()); cells.insert(cells.end(), cnr.begin(), cnr.end()); wghts.insert(wghts.end(), wght.begin(), wght.end()); } else { std::vector geomc = rasterizeCells(p, touches, small, opt); std::vector id(geomc.size(), i); out.insert(out.end(), id.begin(), id.end()); cells.insert(cells.end(), geomc.begin(), geomc.end()); } } if (weights || exact) { out.insert(out.end(), cells.begin(), cells.end()); out.insert(out.end(), wghts.begin(), wghts.end()); } else { out.insert(out.end(), cells.begin(), cells.end()); } } return out; } std::vector SpatRaster::extCells(SpatExtent ext) { std::vector out; ext = align(ext, "near"); ext = ext.intersect(getExtent()); if (!ext.valid()) { return(out); } double resx = xres() / 2; double resy = yres() / 2; std::vector e = ext.asVector(); e[0] += resx; e[1] -= resx; e[2] += resy; e[3] -= resy; std::vector ex = {e[0], e[1]}; std::vector ey = {e[3], e[2]}; std::vector r = rowFromY(ey); std::vector c = colFromX(ex); int_64 nc = ncol(); out.reserve((r[1]-r[0]) * (c[1]-c[0])); for (int_64 i=r[0]; i <= r[1]; i++) { for (int_64 j=c[0]; j <= c[1]; j++) { out.push_back(i*nc+j); } } return out; } std::vector>> SpatRasterStack::extractXY(std::vector &x, std::vector &y, std::string method) { unsigned ns = nsds(); std::vector>> out(ns); bool cells = false; for (size_t i=0; i>> SpatRasterStack::extractCell(std::vector &cell) { unsigned ns = nsds(); std::vector>> out(ns); for (size_t i=0; i>>> SpatRasterStack::extractVector(SpatVector v, bool touches, bool small, std::string method, SpatOptions &opt) { unsigned ns = nsds(); std::vector>>> out(ns); for (size_t i=0; i f = {2,2}; SpatRaster gd = g.disaggregate(f, opt); double dyrs = gd.yres(); double dxrs = gd.xres(); std::vector d, cells(4); std::vector > cxy; std::vector rc(4); unsigned nr = nrow(); unsigned nc = ncol(); unsigned mnr = nr-1; unsigned mnc = nc-1; // needs row-wise adjustment for lonlat double dxdy = xres() * yres(); for (size_t i=0; i mnr)) { continue; } double row2 = (rq == 0) ? row1-1 : row1+1; row2 = row2 < 0 ? row1+1 : row2==nr ? row1-1 : row2; double col2; if (globalLonLat) { if ((col1 < -1) | (col1 > nc)) { continue; } col1 = col1 < 0 ? mnc : col1 > mnc ? 0 : col1; col2 = (cq == 0) ? col1-1 : col1 + 1; col2 = col2 < 0 ? mnc : col2 > mnc ? 0 : col2; } else { if ((col1 < 0) | (col1 > mnc)) { continue; } col2 = (cq == 0) ? col1-1 : col1 + 1; col2 = col2 < 0 ? col1+1 : col2 == nc ? col1-1 : col2; } cells[0] = nc * row1 + col1; cells[1] = nc * row1 + col2; cells[2] = nc * row2 + col1; cells[3] = nc * row2 + col2; std::sort(cells.begin(), cells.end()); std::vector> xy = xyFromCell(cells); std::vector> v = extractCell(cells); std::vector e = {xy[0][0], xy[0][1], xy[1][2], xy[1][0]}; for (size_t j=0; j SpatRaster::extractCell(std::vector &cell) { unsigned n = cell.size(); unsigned nc = ncell(); std::vector out; if (!hasValues()) { out = std::vector(n * nlyr(), NAN) return out; } unsigned ns = nsrc(); for (size_t src=0; src srcout; if (source[src].memory) { srcout = std::vector(n * slyrs, NAN) std::vector off1(slyrs); std::vector off2(slyrs); for (size_t i=0; i= 0 && cell[i] < nc) { for (size_t j=0; j> rc = rowColFromCell(cell); srcout = readRowColGDAL(src, rc[0], rc[1]); #endif if (hasError()) return out; //} } out.insert(out.end(), srcout.begin(), srcout.end()); } return out; } */ /* double distInt(double d, double pd1, double pd2, double v1, double v2) { double result = (v2 * pd1 + v1 * pd2) / d; return result; } inline double rowColToCell(unsigned ncols, unsigned row, unsigned col) { return row * ncols + col; } double linearInt(const double& d, const double& x, const double& x1, const double& x2, const double& v1, const double& v2) { double result = (v2 * (x - x1) + v1 * (x2 - x)) / d; return result; } // ok but cannot handle NA double bilinearInt(const double& x, const double& y, const double& x1, const double& x2, const double& y1, const double& y2, const double& v11, const double& v21, const double& v12, const double& v22) { double d = x2-x1; double h1 = linearInt(d, x, x1, x2, v11, v21); double h2 = linearInt(d, x, x1, x2, v12, v22); d = y2-y1; double v = linearInt(d, y, y1, y2, h1, h2); return v; } double bilinearIntold(const double& x, const double& y, const double& x1, const double& x2, const double& y1, const double& y2, const double& v11, const double& v21, const double& v12, const double& v22) { double d = x2-x1; double h1=NAN; double h2=NAN; if (!std::isnan(v11) && !std::isnan(v21)) { h1 = linearInt(d, x, x1, x2, v11, v21); } else if (!std::isnan(v11)) { h1 = v11; } else if (!std::isnan(v21)) { h1 = v21; } if (!std::isnan(v12) && !std::isnan(v22)) { h2 = linearInt(d, x, x1, x2, v12, v22); } else if (!std::isnan(v12)) { h2 = v12; } else if (!std::isnan(v22)) { h2 = v22; } if (!std::isnan(h1) && !std::isnan(h2)) { d = y2-y1; double v = linearInt(d, y, y1, y2, h1, h2); return v; } else if (!std::isnan(h1)) { return h1; } else if (!std::isnan(h2)) { return h2; } return NAN; } double bilinear_geo(double x, double y, double x1, double x2, double y1, double y2, double halfyres, std::vector vv) { double a = 6378137.0; double f = 1/298.257223563; double hy = y1 - halfyres; double d = distance_lonlat(x1, hy, x2, hy, a, f); std::vector dist(4); double pd1 = distance_lonlat(x, hy, x1, hy, a, f); double pd2 = distance_lonlat(x, hy, x2, hy, a, f); double h1 = distInt(d, pd1, pd2, vv[0], vv[1]); double h2 = distInt(d, pd1, pd2, vv[2], vv[3]); d = y2 - y1; double v = linearInt(d, y, y1, y2, h1, h2); return v; } */ terra/src/read_gdal.cpp0000644000176200001440000020711614756155246014612 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include #include #include //#include //#include "spatRaster.h" #include "spatRasterMultiple.h" #include "vecmath.h" #include "file_utils.h" #include "string_utils.h" #include "spatTime.h" #include "recycle.h" #include "gdalio.h" //#include "NA.h" #include "gdal_priv.h" #include "cpl_conv.h" // for CPLMalloc() #include "cpl_string.h" #include "ogr_spatialref.h" #include "gdal_rat.h" //#include "hdr.h" #if GDAL_VERSION_MAJOR >= 3 #include "proj.h" #endif void SpatRaster::gdalogrproj_init(std::string path) { GDALAllRegister(); OGRRegisterAll(); //GDALregistred = true; #if GDAL_VERSION_MAJOR >= 3 #ifdef PROJ_6 if (!path.empty()) { const char *cp = path.c_str(); proj_context_set_search_paths(PJ_DEFAULT_CTX, 1, &cp); } #endif #ifdef PROJ_71 #ifndef __EMSCRIPTEN__ proj_context_set_enable_network(PJ_DEFAULT_CTX, 1); #endif #endif #endif } /* bool GetTime(std::string filename, std::vector &time, std::string ×tep, size_t nl) { filename += ".time"; if (!file_exists(filename)) { return false; } std::vector s = read_text(filename); if (nl != (s.size()-1)) return false; time.reserve(nl); timestep = s[0]; for (size_t i=0; i &units, size_t nl) { filename += ".unit"; if (!file_exists(filename)) { return false; } units = read_text(filename); if (nl != units.size()) return false; return true; } */ bool read_aux_json(std::string filename, std::vector &time, std::string ×tep, std::vector &units, size_t nlyr) { filename += ".aux.json"; if (!file_exists(filename)) return false; std::vector s = read_text(filename); int itime=-1, istep=-1, iunit=-1; for (size_t i=0; i x = strsplit_first(s[i], ":"); if (x.size() != 2) continue; x[0].erase(std::remove(x[0].begin(), x[0].end(), '\"'), x[0].end()); if (x[0] == "time") itime = i; if (x[0] == "timestep") istep = i; if (x[0] == "unit") iunit = i; } if (itime >= 0) { std::vector x = strsplit_first(s[itime], "["); if (x.size() == 2) { x = strsplit(x[1], "]"); x = strsplit(x[0], ","); std::vector tm; for (size_t i=0; i= 0) && !time.empty()) { std::vector x = strsplit_first(s[istep], ":"); if (x.size() == 2) { x = strsplit(x[1], ","); unquote(x[0]); timestep = x[0]; } } } if (iunit >= 0) { std::vector x = strsplit_first(s[iunit], "["); if (x.size() == 2) { x = strsplit(x[1], "]"); x = strsplit(x[0], ","); if (x.size() == nlyr) { for (size_t i=0; i< x.size(); i++) { unquote(x[i]); } units = x; } } } return false; } bool GetRAT(GDALRasterAttributeTable *pRAT, SpatCategories &cats, const std::string &driver) { /* const char *GFU_type_string[] = {"GFT_Integer", "GFT_Real","GFT_String"}; const char *GFU_usage_string[] = {"GFU_Generic", "GFU_PixelCount", "GFU_Name", "GFU_Min", "GFU_Max", "GFU_MinMax", "GFU_Red", "GFU_Green", "GFU_Blue", "GFU_Alpha", "GFU_RedMin", "GFU_GreenMin", "GFU_BlueMin", "GFU_AlphaMin", "GFU_RedMax", "GFU_GreenMax", "GFU_BlueMax", "GFU_AlphaMax", "GFU_MaxCount"}; std::vector GFT_type; std::vector GFT_usage; */ size_t nc = (int) pRAT->GetColumnCount(); size_t nr = (int) pRAT->GetRowCount(); std::vector ss = {"histogram", "count", "red", "green", "blue", "alpha", "opacity", "r", "g", "b", "a"}; std::vector ratnms; std::vector id, id2; bool hasvalue=false; for (size_t i=0; iGetNameOfCol(i); ratnms.push_back(name); lowercase(name); if (!hasvalue && ((name == "value") || (name == "id") || (name == "ids"))) { id.insert(id.begin(), i); hasvalue = true; } else { int k = where_in_vector(name, ss, false); if (k >= 0) { id2.push_back(i); } else { id.push_back(i); } } } bool good_rat = true; size_t sid = id.size(); // Rcpp::Rcout << hasvalue << " " << sid << std::endl; if ((hasvalue && sid == 1) || ((!hasvalue) && sid == 0)) { // #790 avoid having just "count" or "histogram" good_rat = false; } id.insert(id.end(), id2.begin(), id2.end()); if (driver == "AIG") { std::vector compnms = {"ID", "VALUE", "COUNT"}; if ((id.size() == 3) && (ratnms == compnms)) { cats.index = -1; return false; } } if (!hasvalue) { std::vector vid(nr); std::iota(vid.begin(), vid.end(), 0); cats.d.add_column(vid, "value"); } int first_string = -1; for (size_t k=0; kGetNameOfCol(i); GDALRATFieldType nc_type = pRAT->GetTypeOfCol(i); // GFT_type.push_back(GFU_type_string[nc_types[i]]); // GDALRATFieldUsage nc_usage = pRAT->GetUsageOfCol(i); // GFT_usage.push_back(GFU_usage_string[nc_usages[i]]); if (nc_type == GFT_Integer) { std::vector d(nr); for (size_t j=0; jGetValueAsInt(j, i); } cats.d.add_column(d, name); } else if (nc_type == GFT_Real) { std::vector d(nr); for (size_t j=0; jGetValueAsDouble(j, i); } cats.d.add_column(d, name); } else if (nc_type == GFT_String) { std::vector d(nr); for (size_t j=0; jGetValueAsString(j, i); } if (first_string < 0) first_string = cats.d.ncol(); cats.d.add_column(d, name); } } if (cats.d.nrow() == 0) { return false; } cats.index = good_rat ? (first_string >= 0 ? first_string :(cats.d.ncol() > 1 ? 1 : 0)) : -1; return true; } bool GetVAT(std::string filename, SpatCategories &vat) { filename += ".vat.dbf"; if (!file_exists(filename)) { return false; } SpatVector v, fvct; std::vector fext; v.read(filename, "", "", fext, fvct, false, "", {}); if (v.df.nrow() == 0) return false; std::vector nms = v.df.get_names(); std::vector ss = {"count", "histogram"}; std::vector rng; rng.reserve(nms.size()); for (size_t i=0; i 1) { vat.d = v.df.subset_cols(rng); // vat.d.names[0] = "ID"; vat.index = 1; std::string sc = vat.d.names[1]; lowercase(sc); if (sc == "count") { if (rng.size() == 2) { return false; } else { vat.index = 2; } } return true; } return false; } SpatDataFrame GetCOLdf(GDALColorTable *pCT) { SpatDataFrame out; size_t nc = (int) pCT->GetColorEntryCount(); out.add_column(1, "value"); out.add_column(1, "red"); out.add_column(1, "green"); out.add_column(1, "blue"); out.add_column(1, "alpha"); out.reserve(nc); for (size_t i=0; iGetColorEntry(i); out.iv[0].push_back(i); out.iv[1].push_back(col->c1); out.iv[2].push_back(col->c2); out.iv[3].push_back(col->c3); out.iv[4].push_back(col->c4); } return(out); } bool getIntFromDoubleCol(std::vector & dv, std::vector &iv) { double dmn = vmin(dv, true); if (dmn < 0) return false; double dmx = vmax(dv, true); if (dmx > 255) { return false; } iv.resize(0); iv.reserve(dv.size()); if (dmx <= 1) { for (size_t i=0; i iv; size_t j = d.iplace[k]; if (getIntFromDoubleCol(d.dv[j], iv)) { out.add_column(iv, name); } else { return false; } } else if (d.itype[k] == 1) { size_t j = d.iplace[k]; long dmn = vmin(d.iv[j], true); if (dmn < 0) return false; long dmx = vmax(d.iv[j], true); if (dmx > 255) return false; out.add_column(d.iv[j], name); } else { return false; } return true; } bool colsFromRat(SpatDataFrame &d, SpatDataFrame &out) { if ((d.nrow() == 0) || (d.ncol() == 0)) { return false; } std::vector ss = d.get_names(); for (size_t i=0; i= 0) { int k = 0; size_t j = d.iplace[k]; if (d.itype[k] == 1) { out.add_column(d.iv[j], "value"); } else if (d.itype[k] == 0) { std::vector x; x.reserve(d.nrow()); for (size_t i=0; i cols1 = {"red", "green", "blue"}; std::vector cols2 = {"r", "g", "b"}; for (size_t i=0; i<3; i++) { int k = where_in_vector(cols1[i], ss, true); if (k >= 0) { if (!setIntCol(d, out, k, cols1[i])) return false; } else { int k = where_in_vector(cols2[i], ss, true); if (k >= 0) { if (!setIntCol(d, out, k, cols1[i])) return false; } else { return false; } } } k = where_in_vector("alpha", ss, true); if (k >= 0) { setIntCol(d, out, k, "alpha"); } else { int k = where_in_vector("transparency", ss, true); if (k >= 0) { setIntCol(d, out, k, "alpha"); } else { int k = where_in_vector("opacity", ss, true); if (k >= 0) { setIntCol(d, out, k, "alpha"); } else { std::vector a(out.nrow(), 255); out.add_column(a, "alpha"); } } } return true; } /* SpatDataFrame GetColFromRAT(SpatDataFrame &rat) { SpatDataFrame out; size_t nr = rat.nrow(); if (nr > 256) return out; std::vector nms = rat.get_names(); int red = where_in_vector("red", nms, false); int green = where_in_vector("green", nms, false); int blue = where_in_vector("blue", nms, false); int alpha = where_in_vector("alpha", nms, true); std::vector r {(unsigned)red, (unsigned)green, (unsigned)blue}; if (alpha >= 0) { r.push_back(alpha); } out = rat.subset_cols(r); if (alpha < 0) { std::vector a(nr, 255); out.add_column(a, "alpha"); } out.names = {"red", "green", "blue", "alpha"}; return out; } */ SpatCategories GetCategories(char **pCat, std::string name) { long n = CSLCount(pCat); SpatCategories scat; std::vector id; std::vector nms; id.reserve(n); nms.reserve(n); for (long i = 0; i= 3 const OGRSpatialReference *srs = poDataset->GetSpatialRef(); if (srs == NULL) return wkt; char *cp; const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OGRErr err = srs->exportToWkt(&cp, options); if (err == OGRERR_NONE) { wkt = std::string(cp); } CPLFree(cp); #else if (poDataset->GetProjectionRef() != NULL) { char *cp; OGRSpatialReference oSRS(poDataset->GetProjectionRef()); #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=NO", "FORMAT=WKT2", NULL }; OGRErr err = oSRS.exportToWkt(&cp, options); #else OGRErr err = oSRS.exportToWkt(&cp); #endif if (err == OGRERR_NONE) { wkt = std::string(cp); } CPLFree(cp); } #endif return wkt; } std::string getDsPRJ(GDALDataset *poDataset) { std::string prj = ""; #if GDAL_VERSION_MAJOR >= 3 const OGRSpatialReference *srs = poDataset->GetSpatialRef(); if (srs == NULL) return prj; char *cp; OGRErr err = srs->exportToProj4(&cp); if (err == OGRERR_NONE) { prj = std::string(cp); } CPLFree(cp); #else if( poDataset->GetProjectionRef() != NULL ) { OGRSpatialReference oSRS(poDataset->GetProjectionRef()); char *pszPRJ = NULL; oSRS.exportToProj4(&pszPRJ); prj = pszPRJ; } #endif return prj; } inline std::string dtypename(const std::string &d) { if (d == "Float64") return "FLT8S"; if (d == "Float32") return "FLT4S"; if (d == "Int64") return "INT8S"; if (d == "Int32") return "INT4S"; if (d == "Int16") return "INT2S"; if (d == "Int8") return "INT1S"; if (d == "UInt64") return "INT8U"; if (d == "UInt32") return "INT4U"; if (d == "UInt16") return "INT2U"; if (d == "Byte") return "INT1U"; return "FLT4S"; } void get_tags(std::vector meta, std::string prefix, std::vector &name, std::vector &value) { if (!meta.empty()) { for (size_t i=0; i get_metadata(std::string filename, std::vector options) { std::vector metadata; GDALDataset *poDataset = openGDAL(filename, GDAL_OF_RASTER | GDAL_OF_READONLY | GDAL_OF_VERBOSE_ERROR, {}, options); if( poDataset == NULL ) { return metadata; } char **m = poDataset->GetMetadata(); if (m) { while (*m != nullptr) { metadata.push_back(*m++); } } GDALClose( (GDALDatasetH) poDataset ); return metadata; } SpatRasterStack::SpatRasterStack(std::string fname, std::vector ids, bool useids, std::vector options) { GDALDataset *poDataset = openGDAL(fname, GDAL_OF_RASTER | GDAL_OF_READONLY | GDAL_OF_VERBOSE_ERROR, {}, {}); if( poDataset == NULL ) { if (!file_exists(fname)) { setError("file does not exist: " + fname); } else { setError("cannot read from " + fname ); } return; } std::string delim = "NAME="; char **metadata = poDataset->GetMetadata("SUBDATASETS"); if (metadata == NULL) { setError("file has no subdatasets"); GDALClose( (GDALDatasetH) poDataset ); return; } std::vector meta; for (size_t i=0; metadata[i] != NULL; i++) { meta.push_back(metadata[i]); } if (!useids) { ids.resize(meta.size()); std::iota(ids.begin(), ids.end(), 0); } int idssz = ids.size(); int metsz = meta.size(); if (metsz == 0) { setError("file does not consist of subdatasets"); } else { for (int i=0; i= metsz)) { continue; } std::string s = meta[ids[i]*2]; size_t pos = s.find(delim); if (pos != std::string::npos) { s.erase(0, pos + delim.length()); SpatRaster sub; if (sub.constructFromFile(s, {-1}, {""}, {}, options, false)) { std::string sname = sub.source[0].source_name.empty() ? basename_sds(s) : sub.source[0].source_name; if (!push_back(sub, sname, sub.source[0].source_name_long, sub.source[0].unit[0], true)) { addWarning("skipped (different geometry): " + s); } } else { addWarning("skipped (fail): " + s); } } } } meta.resize(0); char **m = poDataset->GetMetadata(); if (m) { while (*m != nullptr) { meta.push_back(*m++); } } GDALClose( (GDALDatasetH) poDataset ); std::vector tagnames, tagvalues; // get_tags(meta, "NC_GLOBAL#TAG_", tagnames, tagvalues); get_tags(meta, "NC_GLOBAL#", tagnames, tagvalues); for (size_t i=0; i ids, bool useids, std::vector options) { // std::vector ops; GDALDataset *poDataset = openGDAL(fname, GDAL_OF_RASTER | GDAL_OF_READONLY | GDAL_OF_VERBOSE_ERROR, {}, {}); if( poDataset == NULL ) { if (!file_exists(fname)) { setError("file does not exist: " + fname); } else { setError("cannot read from " + fname ); } return; } std::string delim = "NAME="; char **metadata = poDataset->GetMetadata("SUBDATASETS"); if (metadata == NULL) { setError("file has no subdatasets"); GDALClose( (GDALDatasetH) poDataset ); return; } std::vector meta; for (size_t i=0; metadata[i] != NULL; i++) { meta.push_back(metadata[i]); } if (!useids) { ids.resize(meta.size()); std::iota(ids.begin(), ids.end(), 0); } int idssz = ids.size(); int metsz = meta.size(); if (metsz == 0) { setError("file does not consist of subdatasets"); } else { for (int i=0; i= metsz)) { continue; } std::string s = meta[ids[i]*2]; size_t pos = s.find(delim); if (pos != std::string::npos) { s.erase(0, pos + delim.length()); SpatRaster sub; if (sub.constructFromFile(s, {-1}, {""}, {}, options, false)) { push_back(sub, basename_sds(s)); } else { addWarning("skipped (fail): " + s); } } } } meta.resize(0); char **m = poDataset->GetMetadata(); if (m) { while (*m != nullptr) { meta.push_back(*m++); } } GDALClose( (GDALDatasetH) poDataset ); std::vector tagnames, tagvalues; // get_tags(meta, "NC_GLOBAL#TAG_", tagnames, tagvalues); get_tags(meta, "NC_GLOBAL#", tagnames, tagvalues); for (size_t i=0; i fname, std::vector subds, std::vector subdsname, std::vector drivers, std::vector options) { SpatRaster out; out.constructFromFile(fname[0], subds, subdsname, options); if (out.hasError()) return out; SpatOptions opt; for (size_t i=1; iGetGCPCount(); // Rcpp::Rcout << "n GCP " << n << std::endl; if (n == 0) return false; const GDAL_GCP *gcp; gcp = poDataset->GetGCPs(); double adfGeoTransform[6]; if (GDALGCPsToGeoTransform(n, gcp, adfGeoTransform, true)) { //for (size_t i=0; i<6; i++) { // Rcpp::Rcout << adfGeoTransform[i] << " "; //} //Rcpp::Rcout << std::endl; double xmin = adfGeoTransform[0]; /* left x */ double xmax = xmin + adfGeoTransform[1] * s.ncol; /* w-e resolution */ if (xmin > xmax) { std::swap(xmin, xmax); } double ymax = adfGeoTransform[3]; // top y double ymin = ymax + s.nrow * adfGeoTransform[5]; if (adfGeoTransform[5] > 0) { s.flipped = true; std::swap(ymin, ymax); } SpatExtent e(xmin, xmax, ymin, ymax); s.extent = e; if (adfGeoTransform[2] != 0 || adfGeoTransform[4] != 0) { s.rotated = true; } return true; } return false; } bool SpatRaster::constructFromFile(std::string fname, std::vector subds, std::vector subdsname, std::vector drivers, std::vector options, bool noflip) { if (fname == "WCS:") { // for https://github.com/rspatial/terra/issues/1505 setError("no raster data in WCS:"); return false; } std::vector clean_ops = options; bool app_so = true; size_t opsz = options.size(); if (opsz > 0) { if (options[opsz-1] == "so=false") { app_so = false; clean_ops.resize(opsz-1); } } GDALDataset *poDataset = openGDAL(fname, GDAL_OF_RASTER | GDAL_OF_READONLY | GDAL_OF_VERBOSE_ERROR, drivers, clean_ops); if( poDataset == NULL ) { if (!file_exists(fname)) { setError("file does not exist: " + fname); } else { setError("cannot open this file as a SpatRaster: " + fname); } return false; } int nl = poDataset->GetRasterCount(); std::string gdrv = poDataset->GetDriver()->GetDescription(); char **metasds = poDataset->GetMetadata("SUBDATASETS"); if (metasds != NULL) { std::vector meta; for (size_t i=0; metasds[i] != NULL; i++) { meta.push_back(metasds[i]); } GDALClose( (GDALDatasetH) poDataset ); return constructFromSDS(fname, meta, subds, subdsname, options, gdrv, noflip); } else if (nl==0) { setError("no raster data in " + fname); return false; } char **meterra = poDataset->GetMetadata("USER_TAGS"); if (meterra != NULL) { std::vector meta; for (size_t i=0; meterra[i] != NULL; i++) { std::string s = meterra[i]; size_t pos = s.find("="); if (pos != std::string::npos) { std::string name = s.substr(0, pos); std::string value = s.substr(pos+1); addTag(name, value); } } } SpatRasterSource s; char **metasrc = poDataset->GetMetadata(); while (metasrc != nullptr && *metasrc != nullptr) { s.smdata.push_back(*metasrc++); } s.ncol = poDataset->GetRasterXSize(); s.nrow = poDataset->GetRasterYSize(); s.nlyr = nl; s.nlyrfile = nl; s.resize(nl); s.flipped = false; s.rotated = false; double adfGeoTransform[6]; bool hasExtent = true; if( poDataset->GetGeoTransform( adfGeoTransform ) == CE_None ) { double xmin = adfGeoTransform[0]; /* left x */ double xmax = xmin + adfGeoTransform[1] * s.ncol; /* w-e resolution */ //xmax = roundn(xmax, 9); double ymax = adfGeoTransform[3]; // top y double ymin = ymax + s.nrow * adfGeoTransform[5]; //ymin = roundn(ymin, 9); if (adfGeoTransform[5] > 0) { std::swap(ymin, ymax); } SpatExtent e(xmin, xmax, ymin, ymax); s.extent = e; if (adfGeoTransform[2] != 0 || adfGeoTransform[4] != 0) { s.rotated = true; addWarning("the data in this file are rotated. Use 'rectify' to fix that"); } } else if (getGCPs(poDataset, s)) { if (s.rotated) { addWarning("the data in this file are rotated. Use 'rectify' to fix that"); } } else { bool warn=true; hasExtent = false; if (adfGeoTransform[5] > 0) { if (noflip) { warn = false; s.extset = true; } else { s.flipped = true; } } SpatExtent e(0, s.ncol, 0, s.nrow); s.extent = e; if ((gdrv=="netCDF") || (gdrv == "HDF5")) { #ifndef standalone setMessage("ncdf extent"); #else addWarning("unknown extent. Cells not equally spaced?"); #endif } else if (warn) { addWarning("unknown extent"); } // seems to cause more harm then benefit #1627 //try { // s.flipped = adfGeoTransform[5] > 0; //} catch(...) {} } s.memory = false; s.filename = fname; s.open_ops = options; //s.open_drivers = {gdrv}; // failed for some hdf s.open_drivers = drivers; //s.driver = "gdal"; /* if( poDataset->GetProjectionRef() != NULL ) { OGRSpatialReference oSRS(poDataset->GetProjectionRef()); char *pszPRJ = NULL; oSRS.exportToProj4(&pszPRJ); s.crs = pszPRJ; } else { s.crs = ""; } */ std::string crs = getDsWKT(poDataset); if (crs.empty()) { if (hasExtent && s.extent.xmin >= -180 && s.extent.xmax <= 360 && s.extent.ymin >= -90 && s.extent.ymax <= 90) { crs = "OGC:CRS84"; s.parameters_changed = true; } } std::string msg; if (!s.srs.set(crs, msg)) { addWarning(msg); } GDALRasterBand *poBand; //int nBlockXSize, nBlockYSize; double adfMinMax[2]; int bGotMin, bGotMax; // s.layers.resize(1); // std::string unit = ""; s.source_name = basename_noext(fname); std::vector> bandmeta(s.nlyr); bool getCols = s.nlyr == 3; std::vector rgb_lyrs(3, -99); s.hasUnit = true; s.hasTime = true; std::vector datm, unts; datm.reserve(s.nlyr); unts.reserve(s.nlyr); int bs1, bs2; for (size_t i = 0; i < s.nlyr; i++) { poBand = poDataset->GetRasterBand(i+1); if (s.hasTime) { const char* dtm = poBand->GetMetadataItem("DATE_TIME"); if (dtm != NULL) { datm.push_back(dtm); } else { s.hasTime = false; } } if (s.hasUnit) { const char* ut = poBand->GetMetadataItem("UNIT"); if (ut != NULL) { unts.push_back(ut); } else { s.hasUnit = false; } } // if ((gdrv=="netCDF") || (gdrv == "HDF5") || (gdrv == "GRIB") || (gdrv == "GTiff")) { char **m = poBand->GetMetadata(); while (m != nullptr && *m != nullptr) { bandmeta[i].push_back(*m++); } //for (size_t j = 0; jGetMetadata("USER_TAGS"); if (meterra != NULL) { // std::vector meta; for (size_t j=0; meterra[j] != NULL; j++) { std::string ms = meterra[j]; size_t pos = ms.find("="); if (pos != std::string::npos) { std::string name = ms.substr(0, pos); std::string value = ms.substr(pos+1); s.addLyrTag(i, name, value); } } } // } int success; // double naflag = poBand->GetNoDataValue(&success); // if (success) { // s.NAflag = naflag; // } else { // s.NAflag = NAN; // } s.has_scale_offset[i] = false; if (app_so) { double offset = poBand->GetOffset(&success); if (success) { if (offset != 0) { s.offset[i] = offset; s.has_scale_offset[i] = true; } } double scale = poBand->GetScale(&success); if (success) { if (scale != 1) { s.scale[i] = scale; s.has_scale_offset[i] = true; } } } poBand->GetBlockSize(&bs1, &bs2); s.blockcols[i] = bs1; s.blockrows[i] = bs2; s.dtype = dtypename(GDALGetDataTypeName(poBand->GetRasterDataType())); adfMinMax[0] = poBand->GetMinimum( &bGotMin ); adfMinMax[1] = poBand->GetMaximum( &bGotMax ); if( (bGotMin && bGotMax) ) { s.hasRange[i] = true; s.range_min[i] = adfMinMax[0]; s.range_max[i] = adfMinMax[1]; } //if( poBand->GetOverviewCount() > 0 ) printf( "Band has %d overviews.\n", poBand->GetOverviewCount() ); if (getCols) { if (poBand->GetColorInterpretation() == GCI_RedBand) { rgb_lyrs[0] = i; } else if (poBand->GetColorInterpretation() == GCI_GreenBand) { rgb_lyrs[1] = i; } else if (poBand->GetColorInterpretation() == GCI_BlueBand) { rgb_lyrs[2] = i; } } GDALColorTable *ct = poBand->GetColorTable(); if( ct != NULL ) { s.hasColors[i] = true; s.cols[i] = GetCOLdf(ct); } std::string bandname = poBand->GetDescription(); char **cat = poBand->GetCategoryNames(); if( cat != NULL ) { SpatCategories scat = GetCategories(cat, bandname); s.cats[i] = scat; s.hasCategories[i] = true; } SpatCategories crat; bool found_rat = false; if (!s.hasCategories[i]) { GDALRasterAttributeTable *rat = poBand->GetDefaultRAT(); if (rat != NULL) { found_rat = GetRAT(rat, crat, gdrv); if (crat.d.nrow() > 0) { s.cats[i] = crat; s.hasCategories[i] = true; } else { found_rat = false; } } } // } else { // s.cats[i].d.cbind(crat.d); // needs more checking. // } else { if (!s.hasCategories[i]) { if (GetVAT(fname, crat)) { s.cats[i] = crat; s.hasCategories[i] = true; found_rat = true; } } if ((!s.hasColors[i]) && (found_rat)) { SpatDataFrame ratcols; if (colsFromRat(crat.d, ratcols)) { s.hasColors[i] = true; s.cols[i] = ratcols; } } std::string nm = ""; if (s.hasCategories[i]) { if ((s.cats[i].index >= 0) && (s.cats[i].index < (int)s.cats[i].d.ncol())) { std::vector nms = s.cats[i].d.get_names(); nm = nms[s.cats[i].index]; } } if (nm.empty()) { if (!bandname.empty()) { nm = bandname; } else if (s.nlyr > 1) { nm = s.source_name + "_" + std::to_string(i+1); } else { nm = basename_noext(fname) ; } } std::string dtype = GDALGetDataTypeName(poBand->GetRasterDataType()); if ((!s.has_scale_offset[i]) && (in_string(dtype, "Int") || (dtype == "Byte"))) { s.valueType[i] = 1; } s.names[i] = nm; } if (s.hasTime) { if (datm[0].find('T') != std::string::npos) { s.timestep = "seconds"; } else { // backwards compatibility if (datm[0].length() == 4) { s.timestep = "years"; } else if (datm[0].length() == 7) { if (datm[0].substr(0, 5) == "0000-") { s.timestep = "months"; } else { s.timestep = "yearmonths"; } } else if (datm[0].length() == 10) { // current formats, always xxxx-xx-xx where possible if (datm[0].substr(7, 3) == "-00") { if (datm[0].substr(4, 3) == "-00") { s.timestep = "years"; } else if (datm[0].substr(0, 4) == "0000") { s.timestep = "months"; } else { s.timestep = "yearmonths"; } } else { s.timestep = "days"; } } } for (size_t i=0; i timestamps; std::string timestep="raw"; //std::vector units; try { read_aux_json(fname, timestamps, timestep, unts, s.nlyr); } catch(...) { unts.resize(0); addWarning("could not parse aux.json"); } if (!unts.empty()) { s.hasUnit = true; } } else { std::vector timestamps; std::string timestep="raw"; // std::vector units; if (unts.empty()) { try { read_aux_json(fname, timestamps, timestep, unts, s.nlyr); } catch(...) { timestamps.resize(0); unts.resize(0); addWarning("could not parse aux.json"); } if (!timestamps.empty()) { s.time = timestamps; s.timestep = timestep; s.hasTime = true; } if (!unts.empty()) { s.hasUnit = true; } } } if (s.hasUnit) { s.unit = unts; } msg = ""; std::vector metadata; if ((gdrv=="netCDF") || (gdrv == "HDF5")) { char **m = poDataset->GetMetadata(); if (m) { while (*m != nullptr) { metadata.push_back(*m++); } } s.set_names_time_ncdf(metadata, bandmeta, msg); if (s.srs.is_empty()) { bool lat = false; bool lon = false; for (size_t i=0; i 1) { addWarning(msg); } GDALClose( (GDALDatasetH) poDataset ); s.hasValues = true; setSource(s); if ((!metadata.empty())) { std::vector tagnames, tagvalues; // std::string stag = s.source_name + "#TAG_"; std::string stag = s.source_name + "#"; get_tags(metadata, stag, tagnames, tagvalues); for (size_t i=0; i &d, size_t n, const std::vector &flags, const std::vector &scale, const std::vector &offset, const std::vector &haveso, const bool haveUserNAflag, const double userNAflag){ size_t nl = flags.size(); double na = NAN; for (size_t i=0; i &v, const size_t &ncell, const size_t &nrows, const size_t &ncols, const size_t &nl) { for (size_t i=0; i r(v.begin()+d1, v.begin()+d1+ncols); std::copy(v.begin()+d2, v.begin()+d2+ncols, v.begin()+d1); std::copy(r.begin(), r.end(), v.begin()+d2); } } } void SpatRaster::readChunkGDAL(std::vector &data, size_t src, size_t row, size_t nrows, size_t col, size_t ncols) { if (source[src].flipped) { row = nrow() - row - nrows; } if (source[src].multidim) { readValuesMulti(data, src, row, nrows, col, ncols); return; } if (source[src].hasWindow) { // ignoring the expanded case. row = row + source[src].window.off_row; col = col + source[src].window.off_col; } std::vector errout; if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return; } if (!(source[src].open_read || source[src].open_write)) { setError("the file is not open for reading"); return; } size_t ncell = ncols * nrows; size_t nl = source[src].nlyr; std::vector out(ncell * nl); int hasNA; std::vector naflags(nl, NAN); CPLErr err = CE_None; std::vector panBandMap; if (!source[src].in_order()) { panBandMap.reserve(nl); for (size_t i=0; i < nl; i++) { panBandMap.push_back(source[src].layers[i]+1); } } if (panBandMap.empty()) { err = source[src].gdalconnection->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], ncols, nrows, GDT_Float64, nl, NULL, 0, 0, 0, NULL); } else { err = source[src].gdalconnection->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], ncols, nrows, GDT_Float64, nl, &panBandMap[0], 0, 0, 0, NULL); } GDALRasterBand *poBand; if (err == CE_None ) { for (size_t i=0; iGetRasterBand(source[src].layers[i]+1); double naflag = poBand->GetNoDataValue(&hasNA); if (hasNA) naflags[i] = naflag; } NAso(out, ncell, naflags, source[src].scale, source[src].offset, source[src].has_scale_offset, source[src].hasNAflag, source[src].NAflag); } /* for (size_t i=0; i < nl; i++) { cell = ncell * i; poBand = source[src].gdalconnection->GetRasterBand(source[src].layers[i] + 1); double naflag = poBand->GetNoDataValue(&hasNA); if (!hasNA) { naflag = NAN; } GDALDataType gdtype = poBand->GetRasterDataType(); if (gdtype == GDT_Float64) { err = poBand->RasterIO(GF_Read, col, row, ncols, nrows, &out[cell], ncols, nrows, gdtype, 0, 0); if (err != CE_None ) { break; } set_NA(out, naflag); } } */ if (err != CE_None ) { setError("cannot read values"); return; } if (source[src].flipped) { vflip(out, ncell, nrows, ncols, nl); } data.insert(data.end(), out.begin(), out.end()); } std::vector SpatRaster::readValuesGDAL(size_t src, size_t row, size_t nrows, size_t col, size_t ncols, int lyr) { std::vector errout; if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return errout; } if (source[src].flipped) { row = nrow() - row - nrows; } if (source[src].hasWindow) { // ignoring the expanded case. row = row + source[src].window.off_row; col = col + source[src].window.off_col; } GDALDataset *poDataset = openGDAL(source[src].filename, GDAL_OF_RASTER | GDAL_OF_READONLY, source[src].open_drivers, source[src].open_ops); if( poDataset == NULL ) { if (!file_exists(source[src].filename )) { setError("file does not exist: " + source[src].filename); } else { setError("cannot read from " + source[src].filename ); } return errout; } GDALRasterBand *poBand; unsigned ncell = ncols * nrows; unsigned nl; std::vector panBandMap; if (lyr < 0) { nl = source[src].nlyr; if (!source[src].in_order()) { panBandMap.reserve(nl); for (size_t i=0; i < nl; i++) { panBandMap.push_back(source[src].layers[i]+1); } } } else { nl = 1; panBandMap.push_back(source[src].layers[lyr]+1); } std::vector out(ncell*nl); int hasNA; std::vector naflags(nl, NAN); CPLErr err = CE_None; if (panBandMap.empty()) { err = poDataset->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], ncols, nrows, GDT_Float64, nl, NULL, 0, 0, 0, NULL); } else { err = poDataset->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], ncols, nrows, GDT_Float64, nl, &panBandMap[0], 0, 0, 0, NULL); } if (err == CE_None ) { for (size_t i=0; iGetRasterBand(source[src].layers[i]+1); double naf = poBand->GetNoDataValue(&hasNA); if (hasNA) naflags[i] = naf; } NAso(out, ncell, naflags, source[src].scale, source[src].offset, source[src].has_scale_offset, source[src].hasNAflag, source[src].NAflag); } GDALClose((GDALDatasetH) poDataset); if (err != CE_None ) { setError("cannot read values"); return errout; } if (source[src].flipped) { vflip(out, ncell, nrows, ncols, nl); } return out; } std::vector SpatRaster::readGDALsample(size_t src, size_t srows, size_t scols, bool overview) { std::vector errout; if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return errout; } size_t row =0, col=0, nrows=nrow(), ncols=ncol(); if (source[src].hasWindow) { row = row + source[0].window.off_row; col = col + source[0].window.off_col; srows = std::min(srows, nrows); scols = std::min(scols, ncols); } std::vector openops = source[src].open_ops; #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 3 // do nothing #else if (!overview) { openops.push_back("OVERVIEW_LEVEL=NONE"); } #endif GDALDataset *poDataset = openGDAL(source[src].filename, GDAL_OF_RASTER | GDAL_OF_READONLY, source[src].open_drivers, openops); if( poDataset == NULL ) { if (!file_exists(source[src].filename )) { setError("file does not exist: " + source[src].filename); } else { setError("cannot read from " + source[src].filename ); } return errout; } size_t ncell = scols * srows; size_t nl = source[src].nlyr; std::vector out(ncell*nl); int hasNA; CPLErr err = CE_None; std::vector naflags(nl, NAN); std::vector panBandMap; if (!source[src].in_order()) { panBandMap.reserve(nl); for (size_t i=0; i < nl; i++) { panBandMap.push_back(source[src].layers[i]+1); } } /* if (panBandMap.size() > 0) { err = poDataset->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], scols, srows, GDT_Float64, nl, &panBandMap[0], 0, 0, 0, NULL); } else { err = poDataset->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], scols, srows, GDT_Float64, nl, NULL, 0, 0, 0, NULL); } */ if (panBandMap.empty()) { err = poDataset->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], scols, srows, GDT_Float64, nl, NULL, 0, 0, 0, NULL); } else { err = poDataset->RasterIO(GF_Read, col, row, ncols, nrows, &out[0], scols, srows, GDT_Float64, nl, &panBandMap[0], 0, 0, 0, NULL); } if (err == CE_None ) { GDALRasterBand *poBand; for (size_t i=0; iGetRasterBand(source[src].layers[i]+1); double naflag = poBand->GetNoDataValue(&hasNA); if (hasNA) naflags[i] = naflag; } NAso(out, ncell, naflags, source[src].scale, source[src].offset, source[src].has_scale_offset, source[src].hasNAflag, source[src].NAflag); } /* for (size_t i=0; i < nl; i++) { poBand = poDataset->GetRasterBand(source[src].layers[i] + 1); size_t off = i * ncell; err = poBand->RasterIO(GF_Read, 0, 0, ncol(), nrow(), &out[off], scols, srows, GDT_Float64, 0, 0); if (err != CE_None ) { break; } double naflag = poBand->GetNoDataValue(&hasNA); if (!hasNA) { naflag = NAN; } setNAso(out, off, ncell, naflag, source[src].scale[i], source[src].offset[i], source[src].has_scale_offset[i]); } */ GDALClose((GDALDatasetH) poDataset); if (err != CE_None ) { setError("cannot read values"); return errout; } if (source[src].flipped) { vflip(out, ncell, srows, scols, nl); } return out; } void SpatRaster::readRowColGDAL(size_t src, std::vector> &out, size_t outstart, std::vector &rows, const std::vector &cols) { if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return; } size_t n = rows.size(); if (n < 1) { addWarning("nothing to extract"); return; } GDALDataset *poDataset = openGDAL(source[src].filename, GDAL_OF_RASTER | GDAL_OF_READONLY, source[src].open_drivers, source[src].open_ops); if( poDataset == NULL ) { if (!file_exists(source[src].filename )) { setError("file does not exist: " + source[src].filename); } else { setError("cannot read from " + source[src].filename ); } return; } std::vector lyrs = source[src].layers; size_t nl = lyrs.size(); size_t outend = outstart + nl; size_t fnr = nrow() - 1; if (source[src].flipped) { for (size_t i=0; i panBandMap; if (!source[src].in_order()) { panBandMap.reserve(nl); for (size_t i=0; i < nl; i++) { panBandMap.push_back(lyrs[i]+1); } } for (size_t i=outstart; i (n, NAN); } int_64 nr1 = nrow()-1; int_64 nc1 = ncol()-1; CPLErr err = CE_None; std::vector value(nl); if (panBandMap.empty()) { for (size_t i=0; i < n; i++) { if ((cols[i] < 0) || (cols[i] > nc1) || (rows[i] < 0) || (rows[i] > nr1) ) continue; err = poDataset->RasterIO(GF_Read, cols[i], rows[i], 1, 1, &value[0], 1, 1, GDT_Float64, nl, NULL, 0, 0, 0, NULL); if (err == CE_None) { for (size_t j=0; jRasterIO(GF_Read, cols[i], rows[i], 1, 1, &value[0], 1, 1, GDT_Float64, nl, &panBandMap[0], 0, 0, 0, NULL); if (err == CE_None) { for (size_t j=0; j naflags(nl, NAN); if (err == CE_None) { int hasNA; GDALRasterBand *poBand; for (size_t i=0; iGetRasterBand(lyrs[i]+1); double naflag = poBand->GetNoDataValue(&hasNA); if (!hasNA) naflag = NAN; NAso(out[outstart+i], n, {naflag}, source[src].scale, source[src].offset, source[src].has_scale_offset, source[src].hasNAflag, source[src].NAflag); } } GDALClose((GDALDatasetH) poDataset); if (err != CE_None ) { setError("cannot read values"); return; } } /* std::vector> SpatRaster::readRowColGDAL(size_t src, std::vector &rows, const std::vector &cols) { std::vector> errout; if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return errout; } GDALDataset *poDataset = openGDAL(source[src].filename, GDAL_OF_RASTER | GDAL_OF_READONLY, source[src].open_drivers, source[src].open_ops); if( poDataset == NULL ) { if (!file_exists(source[src].filename )) { setError("file does not exist: " + source[src].filename); } else { setError("cannot read from " + source[src].filename ); } return errout; } GDALRasterBand *poBand; std::vector lyrs = source[src].layers; size_t nl = lyrs.size(); size_t n = rows.size(); size_t fnr = nrow() - 1; if (source[src].flipped) { for (size_t i=0; i panBandMap; if (!source[src].in_order()) { panBandMap.reserve(nl); for (size_t i=0; i < nl; i++) { panBandMap.push_back(lyrs[i]+1); } } std::vector out(n * nl, NAN); CPLErr err = CE_None; for (size_t i=0; i < n; i++) { if ((cols[i] < 0) || (rows[i] < 0)) continue; if (panBandMap.empty()) { err = poDataset->RasterIO(GF_Read, cols[i], rows[i], 1, 1, &out[i*nl], 1, 1, GDT_Float64, nl, NULL, 0, 0, 0, NULL); } else { err = poDataset->RasterIO(GF_Read, cols[i], rows[i], 1, 1, &out[i*nl], 1, 1, GDT_Float64, nl, &panBandMap[0], 0, 0, 0, NULL); } if (err != CE_None ) { break;x` } } if (err == CE_None ) { std::vector naflags(nl, NAN); int hasNA; for (size_t i=0; iGetRasterBand(lyrs[i]+1); double naflag = poBand->GetNoDataValue(&hasNA); if (hasNA) naflags[i] = naflag; } NAso(out, n, naflags, source[src].scale, source[src].offset, source[src].has_scale_offset, source[src].hasNAflag, source[src].NAflag); } GDALClose((GDALDatasetH) poDataset); if (err != CE_None ) { setError("cannot read values"); return errout; } size_t nr = rows.size(); std::vector> r(nl, std::vector (nr)); for (size_t i=0; i SpatRaster::readRowColGDALFlat(size_t src, std::vector &rows, const std::vector &cols) { std::vector errout; if (source[src].rotated) { setError("cannot read from rotated files. First use 'rectify'"); return errout; } GDALDataset *poDataset = openGDAL(source[src].filename, GDAL_OF_RASTER | GDAL_OF_READONLY, source[src].open_drivers, source[src].open_ops); if( poDataset == NULL ) { if (!file_exists(source[src].filename )) { setError("file does not exist: " + source[src].filename); } else { setError("cannot read from " + source[src].filename ); } return errout; } GDALRasterBand *poBand; std::vector lyrs = source[src].layers; size_t nl = lyrs.size(); size_t n = rows.size(); size_t fnr = nrow() - 1; if (source[src].flipped) { for (size_t i=0; i panBandMap; if (!source[src].in_order()) { panBandMap.reserve(nl); for (size_t i=0; i < nl; i++) { panBandMap.push_back(lyrs[i]+1); } } std::vector out(n * nl, NAN); CPLErr err = CE_None; for (size_t j=0; j < n; j++) { if ((cols[j] < 0) || (rows[j] < 0)) continue; if (panBandMap.empty()) { err = poDataset->RasterIO(GF_Read, cols[j], rows[j], 1, 1, &out[j*nl], 1, 1, GDT_Float64, nl, NULL, 0, 0, 0, NULL); } else { err = poDataset->RasterIO(GF_Read, cols[j], rows[j], 1, 1, &out[j*nl], 1, 1, GDT_Float64, nl, &panBandMap[0], 0, 0, 0, NULL); } if (err != CE_None ) { break; } } if (err == CE_None ) { std::vector naflags(nl, NAN); int hasNA; for (size_t i=0; iGetRasterBand(lyrs[i]+1); double naflag = poBand->GetNoDataValue(&hasNA); if (hasNA) naflags[i] = naflag; } NAso(out, n, naflags, source[src].scale, source[src].offset, source[src].has_scale_offset, source[src].hasNAflag, source[src].NAflag); } GDALClose((GDALDatasetH) poDataset); if (err != CE_None ) { setError("cannot read values"); return errout; } return out; } */ // ncdf bool ncdf_good_ends(std::string const &s) { std::vector end = {"_bnds", "_bounds", "lat", "lon", "longitude", "latitude"}; for (size_t i=0; i= end[i].length()) { if (s.compare(s.length() - end[i].length(), s.length(), end[i]) == 0) { return false; } } } if (s == "x" || s == "y" || s == "northing" || s == "easting") { return false; } return true; } void ncdf_pick_most(std::vector &sd, std::vector &varname, std::vector &longname, std::vector &dim1, std::vector &dim2) { if (sd.size() < 2) return; std::vector ud = dim1; std::sort(ud.begin(), ud.end()); ud.erase(std::unique(ud.begin(), ud.end()), ud.end()); if (ud.size() > 1) { std::vector tmpsd, tmpvarname, tmplongname; std::vector tmpdim1, tmpdim2; int mx = ud[ud.size()-1]; for (size_t i=0; i meta, std::vector subds, std::vector subdsname, std::vector options, std::string driver, bool noflip) { bool ncdf = driver =="netCDF"; bool gtiff = driver == "GTiff"; std::vector> info = parse_metadata_sds(meta); int n = info[0].size(); if (gtiff && (subds[0] < 0) && subdsname[0].empty()) { subds.resize(n); std::iota(subds.begin(), subds.end(), 0); } std::vector sd, varname, srcname; // std::vector varnl; // for selection based on nlyr if (info[0].empty()) { return false; } // select sds by index if ((!subds.empty() && (subds[0] >= 0))) { for (size_t i=0; i=0 && subds[i] < n) { sd.push_back(info[0][subds[i]]); varname.push_back(info[1][i]); } else { std::string emsg = std::to_string(subds[i]+1) + " is not valid. There are " + std::to_string(info[0].size()) + " subdatasets\n"; setError(emsg); return false; } } // select by name } else if (!subdsname.empty() && !subdsname[0].empty()) { for (size_t i=0; i= 0) { sd.push_back(info[0][w]); varname.push_back(info[1][w]); } else { std::string emsg = concatenate(info[1], ", "); emsg = subdsname[i] + " not found. Choose one of:\n" + emsg; setError(emsg); return false; } } // select all } else { // eliminate sources based on names like "*_bnds" and "lat" std::vector rows, cols; for (size_t i=0; i nl(n); for (size_t i=0; i srcnl; size_t cnt; for (cnt=0; cnt < sd.size(); cnt++) { if (constructFromFile(sd[cnt], {-1}, {""}, {}, options, noflip)) break; } // source[0].source_name = srcname[cnt]; std::vector skipped, used; srcnl.push_back(nlyr()); used.push_back(varname[0]); SpatRaster out; SpatOptions opt; for (size_t i=(cnt+1); i < sd.size(); i++) { // printf( "%s\n", sd[i].c_str() ); bool success = out.constructFromFile(sd[i], {-1}, {""}, {}, options, noflip); if (success) { if (out.compare_geom(*this, false, false, 0.1)) { // out.source [0].source_name = srcname[i]; addSource(out, false, opt); srcnl.push_back(out.nlyr()); used.push_back(varname[i]); } else { skipped.push_back(varname[i]); } } else { skipped.push_back(varname[i]); } } if (!skipped.empty()) { std::string s="skipped sub-datasets (see 'describe(sds=TRUE)'):\n" + skipped[0]; for (size_t i=1; i lyrnames; for (size_t i=0; i nms = { basename(used[i]) }; recycle(nms, srcnl[i]); make_unique_names(nms); lyrnames.insert(lyrnames.end(), nms.begin(), nms.end()); } if (!lyrnames.empty()) { setNames(lyrnames, false); } } std::vector metadata = get_metadata(filename, options); if (!metadata.empty()) { std::vector tagnames, tagvalues; // get_tags(metadata, "NC_GLOBAL#TAG_", tagnames, tagvalues); get_tags(metadata, "NC_GLOBAL#", tagnames, tagvalues); for (size_t i=0; i ncdf_str2int64v(std::string s, std::string delim) { std::vector out; size_t pos = 0; while ((pos = s.find(delim)) != std::string::npos) { std::string v = s.substr(0, pos); s.erase(0, pos + 1); out.push_back(std::stoll(v)); } out.push_back(std::stoll(s)); return out; } bool get_long(std::string input, long &output) { try { output = std::stol(input); return true; } catch (std::invalid_argument &e) { return false; } } bool get_double(std::string input, double &output) { try { output = std::stod(input); return true; } catch (std::invalid_argument &e) { return false; } } std::vector ncdf_time(const std::vector &metadata, std::vector vals, std::string &step, std::string &msg) { std::vector out, bad; if (vals.empty()) { step = ""; return out; } std::vector raw; raw.reserve(vals.size()); for (size_t i=0; i ymd = getymd(origin); if (hours) { hours = false; add = ymd[3] + ymd[4] / 60 + ymd[5] / 3600; } else if (minutes) { div = 1440; // 24 * 60 add = ymd[3] * 60 + ymd[4] + ymd[5] / 60; minutes = false; } else if (seconds) { div = 86400; // 24 * 3600 add = ymd[3] * 3600 + ymd[4] * 60 + ymd[5]; seconds = false; } for (size_t i=0; i ymd = getymd(origin); if (cal == "365") { for (size_t i=0; i ymd = getymd(origin); for (size_t i=0; i ymd = getymd(origin); for (size_t i=0; i ymd = getymd(origin); for (size_t i=0; i> ncdf_names(const std::vector> &m) { std::vector> out(3); if (m.empty()) return out; std::string vname, lname, units = ""; std::vector b = m[0]; for (size_t j=0; j metadata, std::vector> bandmeta, std::string &msg) { if (bandmeta.empty()) return; std::vector> nms = ncdf_names(bandmeta); if (!nms[1].empty()) { names = nms[1]; make_unique_names(names); } source_name = nms[2][0]; source_name_long = nms[2][1]; if (!hasUnit) { if (nms[2][2].empty()) { unit = {""}; hasUnit = false; } else { unit = {nms[2][2]}; hasUnit = true; } recycle(unit, nlyr); } if (!nms[0].empty()) { std::string step; std::vector x; try { x = ncdf_time(metadata, nms[0], step, msg); if (x.size() == nlyr) { time = x; timestep = step; hasTime = true; } } catch(...) { msg = "could not extract time scale"; } } } std::vector> grib_names(const std::vector> &m) { std::vector> out(4); if (m.empty()) return out; bool ft1 = false; bool ft2 = false; for (size_t i=0; i> bandmeta, std::string &msg) { if (bandmeta.empty()) return; std::vector> nms = grib_names(bandmeta); if (nms[0].size() != names.size()) return; for (size_t i=0; i tm; if (nms[2].size() == nms[0].size()) { hastime = true; int_64 tim; for (size_t i=0; i> tiff_names(const std::vector> &m) { std::vector> out(4); if (m.empty()) return out; for (size_t i=0; i> bandmeta, std::string &msg) { if (bandmeta.empty()) return; std::vector> nms = tiff_names(bandmeta); if (nms[1].size() == nlyr) { unit = {nms[0]}; } bool hastime = false; std::vector tm; if (nms[1].size() == nlyr) { hastime = true; int_64 tim; for (size_t i=0; i. #ifndef SPATTIME_GUARD #define SPATTIME_GUARD //#include //#include typedef long long SpatTime_t; class SpatTime_v { public: std::vector x; std::string zone; std::string step; size_t size() { return(x.size());} bool empty() { return(x.empty());} void resize(size_t n) {x.resize(n);} void resize(size_t n, SpatTime_t v) {x.resize(n, v);} void reserve(size_t n) {x.reserve(n);} void push_back(SpatTime_t v) {x.push_back(v);} }; /* class SpatTimeP { long year; short int month; short int day; short int hour; short int minute; short int second; }; class SpatTimeP_v { public: std::vector x; std::string zone; std::string step; size_t size() { return(x.size());} bool empty() { return(x.empty());} void resize(size_t n) {x.resize(n);} void resize(size_t n, SpatTimeP v) {x.resize(n, v);} void reserve(size_t n) {x.reserve(n);} void push_back(SpatTimeP v) {x.push_back(v);} }; */ SpatTime_t get_time(long year, unsigned month, unsigned day, int hr, int min, int sec); std::vector get_date(SpatTime_t x); std::vector getymd(std::string s); int getyear(std::string s); SpatTime_t get_time_string(std::string s); SpatTime_t get_time_noleap(int syear, int smonth, int sday, int shour, int smin, int ssec, double n, std::string step); //SpatTime_t time_from_day_noleap(int syear, int smonth, int sday, double ndays); SpatTime_t time_from_day(int syear, int smonth, int sday, double ndays); SpatTime_t time_from_day_360(int syear, int smonth, int sday, double ndays); SpatTime_t time_from_hour(int syear, int smonth, int sday, int shour, double nhours); void hours_to_time(std::vector &time, std::string origin); SpatTime_t parse_time(std::string x); #endif terra/src/vecmath.cpp0000644000176200001440000000463014720502767014326 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include #include #include #include "vecmath.h" bool haveFun(std::string fun) { std::vector f {"sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first", "expH"}; auto it = std::find(f.begin(), f.end(), fun); if (it == f.end()) { return false; } return true; } std::function&, bool)> getFun(std::string fun) { std::function&, bool)> theFun; if (fun == "mean") { theFun = vmean; } else if (fun == "sum") { theFun = vsum; } else if (fun == "sum2") { theFun = vsum2; } else if (fun == "min") { theFun = vmin; } else if (fun == "max") { theFun = vmax; } else if (fun == "median") { theFun = vmedian; } else if (fun == "modal") { theFun = vmodal; } else if (fun == "prod") { theFun = vprod; } else if (fun == "which") { theFun = vwhich; } else if (fun == "which.min") { theFun = vwhichmin; } else if (fun == "which.max") { theFun = vwhichmax; } else if (fun == "any") { theFun = vany; } else if (fun == "all") { theFun = vall; } else if (fun == "sd") { theFun = vsd; } else if (fun == "std") { theFun = vsdpop; } else if (fun == "first") { theFun = vfirst; } else { theFun = vmean; } return theFun; } bool ball(const std::vector& v) { for (size_t i=0; i& v) { for (size_t i=0; i. #include "spatVector.h" #include "string_utils.h" #include "vecmath.h" #include "recycle.h" #include "gdal_alg.h" #include "ogrsf_frmts.h" /* std::vector SpatVector::is_valid() { std::vector out; out.reserve(nrow()); GDALDataset* src; if (!write_ogr(src, "", "layer", "Memory", false, false, true, std::vector())) { if (src != NULL) GDALClose( src ); setError("cannot do it"); return false; } OGRLayer *inLayer = src->GetLayer(0); inLayer->ResetReading(); OGRFeature *inFeature; while( (inFeature = inLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = inFeature->GetGeometryRef(); out.push_back(poGeometry->IsValid()); OGRFeature::DestroyFeature( inFeature ); } return out; } SpatVector SpatVector::make_valid() { SpatVector out; GDALDataset* src = write_ogr("", "layer", "Memory", false, false, true, std::vector()); OGRLayer *inLayer = src->GetLayer(0); inLayer->ResetReading(); OGRFeature *inFeature; while( (inFeature = inLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = inFeature->GetGeometryRef(); //OGRGeometry *poGeom = poGeometry->MakeValid(); if (inFeature->SetGeometry( poGeometry ) != OGRERR_NONE) { out.setError("cannot set geometry"); return out; } if (inLayer->SetFeature( inFeature ) != OGRERR_NONE) { out.setError("cannot set feature"); return out; } OGRFeature::DestroyFeature( inFeature ); } std::vector fext; SpatVector fvct; out.read_ogr(src, "", "", fext, fvct, false, ""); GDALClose(src); return out; } */ SpatVector SpatVector::disaggregate(bool segments) { SpatVector out; out.srs = srs; out.df = df.skeleton(); if (nrow() == 0) { return out; } size_t n=0; for (size_t i=0; i sx = {g.parts[0].x[j], g.parts[0].x[j+1]}; std::vector sy = {g.parts[0].y[j], g.parts[0].y[j+1]}; SpatPart p(sx, sy); SpatGeom gg = SpatGeom(p, lines); x.addGeom(gg); if (!x.df.rbind(row)) { x.setError("cannot add row"); return x; } } } return x; } return out; } SpatVector SpatVector::aggregate(std::string field, bool dissolve) { SpatVector out; int i = where_in_vector(field, get_names(), false); if (i < 0) { out.setError("cannot find field: " + field); return out; } SpatDataFrame uv; std::vector idx = df.getIndex(i, uv); out.reserve(uv.nrow()); for (size_t i=0; i y1) { bearing = -M_PI / 2; } else { bearing = M_PI / 2; } } else { bearing = atan(dy/dx); } if (x2 > x1) { x2 += distance * cos(bearing); y2 += distance * sin(bearing); } else { x2 -= distance * cos(bearing); y2 -= distance * sin(bearing); } } } SpatVector SpatVector::elongate(double length, bool flat) { SpatVector out = *this; size_t n = size(); if (n == 0) { return out; } if (geoms[0].gtype != lines) { out.setError("you can only elongate lines"); return out; } if (length < 0) { out.setError("length must be > 0"); return out; } if (length == 0) { return out; } bool geo = (!flat) && is_lonlat(); for (size_t i=0; i idx = df.getIndex(i, uv); for (size_t i=0; i r; for (size_t j=0; j atts; for (size_t i=0; i size()) { out.setError("invalid index"); return out; } if (x.type() != "polygons") { out.setError("holes must be polygons"); return out; } if (out.geoms[i].size() > 1) { out.setError("selected object has multiple geometries"); } x = x.unaryunion(); SpatPart p = out.geoms[i].parts[0]; SpatGeom g = x.geoms[0]; for (size_t i=0; i geoms_from_ds(GDALDataset* src, int field, int value) { std::vector g; OGRLayer *poLayer = src->GetLayer(0); poLayer->ResetReading(); OGRFeature *poFeature; while( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); g.push_back(poGeometry); } return g; } // create output dataset GDALDataset* dst; // get unique values in field // loop over unique values // for value in uvalues std::vector gvec = geoms_from_ds(src, field, value); OGRGeometry *geom; geom = (OGRGeometry *) gvec.data(); OGRGeometry *gout; gout = geom->UnionCascaded(); // set geometry to output return dst; */ SpatVector SpatVector::shift(double x, double y) { SpatVector out = *this; for (size_t i=0; i < size(); i++) { for (size_t j=0; j < geoms[i].size(); j++) { for (size_t q=0; q < geoms[i].parts[j].x.size(); q++) { out.geoms[i].parts[j].x[q] += x; out.geoms[i].parts[j].y[q] += y; } if (geoms[i].parts[j].hasHoles()) { for (size_t k=0; k < geoms[i].parts[j].nHoles(); k++) { for (size_t q=0; q < geoms[i].parts[j].holes[k].x.size(); q++) { out.geoms[i].parts[j].holes[k].x[q] += x; out.geoms[i].parts[j].holes[k].y[q] += y; } out.geoms[i].parts[j].holes[k].extent.xmin += x; out.geoms[i].parts[j].holes[k].extent.xmax += x; out.geoms[i].parts[j].holes[k].extent.ymin += y; out.geoms[i].parts[j].holes[k].extent.ymax += y; } } out.geoms[i].parts[j].extent.xmin += x; out.geoms[i].parts[j].extent.xmax += x; out.geoms[i].parts[j].extent.ymin += y; out.geoms[i].parts[j].extent.ymax += y; } out.geoms[i].extent.xmin += x; out.geoms[i].extent.xmax += x; out.geoms[i].extent.ymin += y; out.geoms[i].extent.ymax += y; } out.extent.xmin += x; out.extent.xmax += x; out.extent.ymin += y; out.extent.ymax += y; return out; } void resc(double &value, const double &base, const double &f) { value = base + f * (value - base); } SpatVector SpatVector::rescale(double fx, double fy, double x0, double y0) { SpatVector out = *this; for (size_t i=0; i < size(); i++) { for (size_t j=0; j < geoms[i].size(); j++) { for (size_t q=0; q < geoms[i].parts[j].x.size(); q++) { resc(out.geoms[i].parts[j].x[q], x0, fx); resc(out.geoms[i].parts[j].y[q], y0, fy); } if (geoms[i].parts[j].hasHoles()) { for (size_t k=0; k < geoms[i].parts[j].nHoles(); k++) { for (size_t q=0; q < geoms[i].parts[j].holes[k].x.size(); q++) { resc(out.geoms[i].parts[j].holes[k].x[q], x0, fx); resc(out.geoms[i].parts[j].holes[k].y[q], y0, fy); } resc(out.geoms[i].parts[j].holes[k].extent.xmax, x0, fx); resc(out.geoms[i].parts[j].holes[k].extent.ymax, y0, fy); } } resc(out.geoms[i].parts[j].extent.xmin, x0, fx); resc(out.geoms[i].parts[j].extent.xmax, x0, fx); resc(out.geoms[i].parts[j].extent.ymin, y0, fy); resc(out.geoms[i].parts[j].extent.ymax, y0, fy); } resc(out.geoms[i].extent.xmin, x0, fx); resc(out.geoms[i].extent.xmax, x0, fx); resc(out.geoms[i].extent.ymin, y0, fy); resc(out.geoms[i].extent.ymax, y0, fy); } resc(out.extent.xmin, x0, fx); resc(out.extent.xmax, x0, fx); resc(out.extent.ymin, y0, fy); resc(out.extent.ymax, y0, fy); return out; } void dswap(double &a, double&b) { double tmp = a; a = b; b = tmp; } SpatVector SpatVector::transpose() { SpatVector out = *this; for (size_t i=0; i < size(); i++) { for (size_t j=0; j < geoms[i].size(); j++) { out.geoms[i].parts[j].x.swap(out.geoms[i].parts[j].y); if (geoms[i].parts[j].hasHoles()) { for (size_t k=0; k < geoms[i].parts[j].nHoles(); k++) { out.geoms[i].parts[j].holes[k].x.swap(out.geoms[i].parts[j].holes[k].y); dswap(out.geoms[i].parts[j].holes[k].extent.xmin, out.geoms[i].parts[j].holes[k].extent.ymin); dswap(out.geoms[i].parts[j].holes[k].extent.xmax, out.geoms[i].parts[j].holes[k].extent.ymax); } } dswap(out.geoms[i].parts[j].extent.xmin, out.geoms[i].parts[j].extent.ymin); dswap(out.geoms[i].parts[j].extent.xmax, out.geoms[i].parts[j].extent.ymax); } dswap(out.geoms[i].extent.xmin, out.geoms[i].extent.ymin); dswap(out.geoms[i].extent.xmax, out.geoms[i].extent.ymax); } dswap(out.extent.xmin, out.extent.ymin); dswap(out.extent.xmax, out.extent.ymax); return out; } void flipd(double &value, const double &base) { value = base - (value - base); } void flipv(std::vector &v, const double &base) { for (double &d : v) d = base - (d - base); } SpatVector SpatVector::flip(bool vertical) { double x0 = extent.xmin; double y0 = extent.ymin; SpatVector out = *this; bool horizontal = !vertical; for (size_t i=0; i < size(); i++) { for (size_t j=0; j < geoms[i].size(); j++) { if (horizontal) { flipv(out.geoms[i].parts[j].x, x0); flipd(out.geoms[i].parts[j].extent.xmin, x0); flipd(out.geoms[i].parts[j].extent.xmax, x0); dswap(out.geoms[i].parts[j].extent.xmin, out.geoms[i].parts[j].extent.xmax); } else { flipv(out.geoms[i].parts[j].y, y0); flipd(out.geoms[i].parts[j].extent.ymin, y0); flipd(out.geoms[i].parts[j].extent.ymax, y0); dswap(out.geoms[i].parts[j].extent.ymin, out.geoms[i].parts[j].extent.ymax); } if (geoms[i].parts[j].hasHoles()) { for (size_t k=0; k < geoms[i].parts[j].nHoles(); k++) { if (horizontal) { flipv(out.geoms[i].parts[j].holes[k].x, x0); flipd(out.geoms[i].parts[j].holes[k].extent.xmin, x0); flipd(out.geoms[i].parts[j].holes[k].extent.xmax, x0); dswap(out.geoms[i].parts[j].holes[k].extent.xmin, out.geoms[i].parts[j].holes[k].extent.xmax); } else { flipv(out.geoms[i].parts[j].holes[k].y, y0); flipd(out.geoms[i].parts[j].holes[k].extent.ymin, y0); flipd(out.geoms[i].parts[j].holes[k].extent.ymax, y0); dswap(out.geoms[i].parts[j].holes[k].extent.ymin, out.geoms[i].parts[j].holes[k].extent.ymax); } } } } if (horizontal) { flipd(out.geoms[i].extent.xmin, x0); flipd(out.geoms[i].extent.xmax, x0); dswap(out.geoms[i].extent.xmin, out.geoms[i].extent.xmax); } else { flipd(out.geoms[i].extent.ymin, y0); flipd(out.geoms[i].extent.ymax, y0); dswap(out.geoms[i].extent.ymin, out.geoms[i].extent.ymax); } } if (horizontal) { flipd(out.extent.xmin, x0); flipd(out.extent.xmax, x0); dswap(out.extent.xmin, out.extent.xmax); } else { flipd(out.extent.ymin, y0); flipd(out.extent.ymax, y0); dswap(out.extent.ymin, out.extent.ymax); } return out; } void rotit(std::vector &x, std::vector &y, const double &x0, const double &y0, const double &cos_angle, const double &sin_angle) { for (size_t i=0; i &lon, std::vector &lat, const double &lon0, const double &lat0, const double &angle, const double &angle2) { double a = 6378137.0; double f = 1/298.257223563; double s12, azi1, azi2; struct geod_geodesic g; geod_init(&g, a, f); double angle_rad = angle * 57.2957795130823 ; for (size_t i=0; i x0, std::vector y0) { angle = -M_PI * angle / 180; size_t n = size(); if (x0.empty() || y0.empty()) { SpatVector out; out.setError("no center of rotation provided"); return out; } bool multi = true; double ix0, iy0; if ((x0.size() == 1) && (y0.size() == 1)) { multi = false; ix0 = x0[0]; iy0 = y0[0]; } else { recycle(x0, n); recycle(y0, n); } double cos_angle, sin_angle; std::function&, std::vector&, const double&, const double&, const double&, const double&)> rotate_it; if (is_lonlat()) { cos_angle = angle; sin_angle = angle; rotate_it = rotit_geo; } else { cos_angle = cos(angle); sin_angle = sin(angle); rotate_it = rotit; } SpatVector out = *this; for (size_t i=0; i < n; i++) { if (multi) { ix0 = x0[i]; iy0 = y0[i]; } for (size_t j=0; j < geoms[i].size(); j++) { rotate_it(out.geoms[i].parts[j].x, out.geoms[i].parts[j].y, ix0, iy0, cos_angle, sin_angle); if (geoms[i].parts[j].hasHoles()) { for (size_t k=0; k < geoms[i].parts[j].nHoles(); k++) { rotate_it(out.geoms[i].parts[j].holes[k].x, out.geoms[i].parts[j].holes[k].y, ix0, iy0, cos_angle, sin_angle); out.geoms[i].parts[j].holes[k].extent.xmin = vmin(out.geoms[i].parts[j].holes[k].x, true); out.geoms[i].parts[j].holes[k].extent.xmax = vmax(out.geoms[i].parts[j].holes[k].x, true); out.geoms[i].parts[j].holes[k].extent.ymin = vmin(out.geoms[i].parts[j].holes[k].y, true); out.geoms[i].parts[j].holes[k].extent.ymax = vmax(out.geoms[i].parts[j].holes[k].y, true); } } out.geoms[i].parts[j].extent.xmin = vmin(out.geoms[i].parts[j].x, true); out.geoms[i].parts[j].extent.xmax = vmax(out.geoms[i].parts[j].x, true); out.geoms[i].parts[j].extent.ymin = vmin(out.geoms[i].parts[j].y, true); out.geoms[i].parts[j].extent.ymax = vmax(out.geoms[i].parts[j].y, true); if (j==0) { out.geoms[i].extent = out.geoms[i].parts[j].extent; } else { out.geoms[i].extent.unite(out.geoms[i].parts[j].extent); } } if (i==0) { out.extent = out.geoms[i].extent; } else { out.extent.unite(out.geoms[i].extent); } } return out; } inline double cartdist(const double& x1, const double& y1, const double &x2, const double &y2) { return sqrt(pow(x2-x1, 2) + pow(y2-y1, 2)); } bool thinnodes(std::vector &x, std::vector &y, const double &threshold, const size_t &mnsize) { std::vector xout, yout; size_t n = x.size(); xout.reserve(n); yout.reserve(n); n--; for (size_t i=0; i= mnsize) { x = std::move(xout); y = std::move(yout); return true; } return false; } SpatVector SpatVector::thin(double threshold) { SpatVector out; if (threshold < 0) { out.setError("threshold must be a positive number"); return out; } size_t mnode = 4; if (geoms[0].gtype == lines) { mnode = 3; } else if (geoms[0].gtype != polygons) { out.setError("can only thin lines or polygons"); return out; } out = *this; bool objext = false; for (size_t i=0; i < size(); i++) { bool geomext = false; for (size_t j=0; j < out.geoms[i].size(); j++) { if (thinnodes(out.geoms[i].parts[j].x, out.geoms[i].parts[j].y, threshold, mnode)) { geomext = true; } if (geoms[i].parts[j].hasHoles()) { for (size_t k=0; k < geoms[i].parts[j].nHoles(); k++) { thinnodes(geoms[i].parts[j].holes[k].x, geoms[i].parts[j].holes[k].y, threshold, mnode); } } } if (geomext) { objext = true; geoms[i].computeExtent(); } } if (objext) { computeExtent(); } return out; } /* SpatVector SpatVector::removeSlivers(double dthres, double athres, size_t n) { SpatVector out; if (geoms[0].gtype != polygons) { out.setError("can only remove slivers from polygons"); return out; } if ((dthres < 0) || (athres < 0)) { out.setError("thresholds must be a positive number"); return out; } if (n < 2)) { out.setError("n must be at least 2"); return out; } out = *this; bool objext = false; for (size_t i=0; i < size(); i++) { bool geomext = false; for (size_t j=0; j < out.geoms[i].size(); j++) { if (remove_slivers(out.geoms[i].parts[j].x, out.geoms[i].parts[j].y, threshold, mnode)) { geomext = true; } if (geoms[i].parts[j].hasHoles()) { for (size_t k=0; k < geoms[i].parts[j].nHoles(); k++) { remove_slivers(geoms[i].parts[j].holes[k].x, geoms[i].parts[j].holes[k].y, threshold, mnode); } } } if (geomext) { objext = true; geoms[i].computeExtent(); } } if (objext) { computeExtent(); } return out; } */ terra/src/Makevars.win0000644000176200001440000000167114536376240014465 0ustar liggesusersVERSION = 3.4.1 RWINLIB = ../windows/gdal3-$(VERSION) TARGET = lib$(subst gcc,,$(COMPILED_BY))$(R_ARCH) PKG_CPPFLAGS =\ -I$(RWINLIB)/include \ -DHAVE_PROJ_H PKG_LIBS = \ -L$(RWINLIB)/$(TARGET) \ -L$(RWINLIB)/lib$(R_ARCH) \ -lgdal -lsqlite3 -lspatialite -lproj -lgeos_c -lgeos \ -ljson-c -lnetcdf -lmariadbclient -lpq -lpgport -lpgcommon \ -lwebp -lcurl -lssh2 -lssl \ -lhdf5_hl -lhdf5 -lexpat -lfreexl -lcfitsio \ -lmfhdf -lhdf -lxdr -lpcre \ -lopenjp2 -ljasper -lpng -ljpeg -ltiff -lgeotiff -lgif -lxml2 -llzma -lz -lzstd \ -lodbc32 -lodbccp32 -liconv -lpsapi -lwldap32 -lsecur32 -lgdi32 -lnormaliz \ -lcrypto -lcrypt32 -lws2_32 -lshlwapi -lbcrypt CXX_STD = CXX all: clean winlibs winlibs: mkdir -p ../inst "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" --vanilla "../tools/winlibs.R" $(VERSION) cp -r "$(RWINLIB)/share/gdal" ../inst/ cp -r "$(RWINLIB)/share/proj" ../inst/ clean: rm -f $(SHLIB) $(OBJECTS) .PHONY: all winlibs clean terra/src/spatDataframe.cpp0000644000176200001440000007423314721435303015451 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatDataframe.h" #include #include #include #include "NA.h" #include "string_utils.h" #include "sort.h" SpatDataFrame::SpatDataFrame() {} SpatDataFrame SpatDataFrame::skeleton() { SpatDataFrame out; out.names = names; out.itype = itype; out.iplace = iplace; out.dv = std::vector>(dv.size()); out.iv = std::vector>(iv.size()); out.sv = std::vector>(sv.size()); out.bv = std::vector>(bv.size()); out.tv = std::vector(tv.size()); out.fv = std::vector(fv.size()); return out; } std::vector SpatDataFrame::getD(unsigned i) { unsigned j = iplace[i]; return dv[j]; } double SpatDataFrame::getDvalue(unsigned i, unsigned j) { j = iplace[j]; return dv[j][i]; } std::vector SpatDataFrame::getI(unsigned i) { unsigned j = iplace[i]; return iv[j]; } long SpatDataFrame::getIvalue(unsigned i, unsigned j) { j = iplace[j]; return iv[j][i]; } std::vector SpatDataFrame::getS(unsigned i) { unsigned j = iplace[i]; return sv[j]; } std::string SpatDataFrame::getSvalue(unsigned i, unsigned j) { j = iplace[j]; return sv[j][i]; } std::vector SpatDataFrame::getB(unsigned i) { unsigned j = iplace[i]; return bv[j]; } int8_t SpatDataFrame::getBvalue(unsigned i, unsigned j) { j = iplace[j]; return bv[j][i]; } SpatTime_v SpatDataFrame::getT(unsigned i) { unsigned j = iplace[i]; return tv[j]; } SpatTime_t SpatDataFrame::getTvalue(unsigned i, unsigned j) { j = iplace[j]; return tv[j].x[i]; } SpatFactor SpatDataFrame::getF(unsigned i) { unsigned j = iplace[i]; return fv[j]; } SpatFactor SpatDataFrame::getFvalue(unsigned i, unsigned j) { j = iplace[j]; return fv[j].subset({i}); } SpatDataFrame SpatDataFrame::subset_rows(unsigned i) { std::vector r = { i }; return subset_rows(r); } SpatDataFrame SpatDataFrame::subset_rows(std::vector range) { SpatDataFrame out; unsigned n = nrow(); std::vector r; r.reserve(range.size()); for (size_t i=0; i= 0) && (range[i] < n)) { r.push_back(range[i]); } } out.names = names; out.itype = itype; out.iplace = iplace; out.dv.resize(dv.size()); out.iv.resize(iv.size()); out.sv.resize(sv.size()); out.bv.resize(bv.size()); out.tv.resize(tv.size()); out.fv.resize(fv.size()); out.reserve(r.size()); for (size_t i=0; i < r.size(); i++) { for (size_t j=0; j < dv.size(); j++) { out.dv[j].push_back(dv[j][r[i]]); } for (size_t j=0; j < iv.size(); j++) { out.iv[j].push_back(iv[j][r[i]]); } for (size_t j=0; j < sv.size(); j++) { out.sv[j].push_back(sv[j][r[i]]); } for (size_t j=0; j < bv.size(); j++) { out.bv[j].push_back(bv[j][r[i]]); } for (size_t j=0; j < fv.size(); j++) { out.fv[j].v.push_back(fv[j].v[r[i]]); } for (size_t j=0; j < tv.size(); j++) { out.tv[j].x.push_back(tv[j].x[r[i]]); } } for (size_t j=0; j < fv.size(); j++) { out.fv[j].labels = fv[j].labels; } for (size_t j=0; j < tv.size(); j++) { out.tv[j].step = tv[j].step; out.tv[j].zone = tv[j].zone; } return out; } SpatDataFrame SpatDataFrame::subset_rows(std::vector range) { std::vector r(range.begin(), range.end()); return subset_rows(r); } SpatDataFrame SpatDataFrame::subset_cols(unsigned i) { std::vector c = { i }; return subset_cols(c); } SpatDataFrame SpatDataFrame::subset_cols(std::vector range) { SpatDataFrame out; unsigned dcnt=0; unsigned icnt=0; unsigned scnt=0; unsigned bcnt=0; unsigned tcnt=0; unsigned fcnt=0; for (size_t i=0; i < range.size(); i++) { if (range[i] < 0 || range[i] >= ncol()) { out.setError("invalid column"); return out; } unsigned j = range[i]; unsigned p = iplace[j]; out.names.push_back(names[j]); if (itype[j] == 0) { out.dv.push_back(dv[p]); out.iplace.push_back(dcnt); out.itype.push_back(0); dcnt++; } else if (itype[j] == 1) { out.iv.push_back(iv[p]); out.iplace.push_back(icnt); out.itype.push_back(1); icnt++; } else if (itype[j] == 2) { out.sv.push_back(sv[p]); out.iplace.push_back(scnt); out.itype.push_back(2); scnt++; } else if (itype[j] == 3) { out.bv.push_back(bv[p]); out.iplace.push_back(bcnt); out.itype.push_back(3); bcnt++; } else if (itype[j] == 4) { out.tv.push_back(tv[p]); out.iplace.push_back(tcnt); out.itype.push_back(4); tcnt++; } else { //if (itype[j] == 5) { out.fv.push_back(fv[p]); out.iplace.push_back(fcnt); out.itype.push_back(5); fcnt++; } } return out; } unsigned SpatDataFrame::ncol() { return itype.size(); } unsigned SpatDataFrame::nrow() { unsigned n; if (itype.empty()) { n = 0; } else { if (itype[0] == 0) { n = dv[0].size(); } else if (itype[0] == 1) { n = iv[0].size(); } else if (itype[0] == 2) { n = sv[0].size(); } else if (itype[0] == 3) { n = bv[0].size(); } else if (itype[0] == 4) { n = tv[0].size(); } else { //if (itype[0] == 5) { n = fv[0].size(); } } return n; } void SpatDataFrame::add_row() { for (size_t i=0; i < dv.size(); i++) { dv[i].push_back(NAN); } for (size_t i=0; i < iv.size(); i++) { iv[i].push_back(NAL); } for (size_t i=0; i < sv.size(); i++) { sv[i].push_back(NAS); } for (size_t i=0; i < bv.size(); i++) { bv[i].push_back(2); } for (size_t i=0; i < tv.size(); i++) { tv[i].push_back(NAT); } for (size_t i=0; i < fv.size(); i++) { fv[i].push_back(0); } } void SpatDataFrame::add_rows(size_t n) { size_t s = nrow() + n; for (size_t i=0; i < dv.size(); i++) { dv[i].resize(s, NAN); } long longNA = NA::value; for (size_t i=0; i < iv.size(); i++) { iv[i].resize(s, longNA); } for (size_t i=0; i < sv.size(); i++) { sv[i].resize(s, NAS); } for (size_t i=0; i < bv.size(); i++) { bv[i].resize(s, 2); } SpatTime_t timeNA = NA::value; for (size_t i=0; i < tv.size(); i++) { tv[i].resize(s, timeNA); } for (size_t i=0; i < fv.size(); i++) { fv[i].resize(s, 0); } } void SpatDataFrame::reserve(unsigned n) { for (size_t i=0; i::value; for (size_t i=0; i::value; for (size_t i=0; i r) { if (r.empty()) return; //sort(r.begin(), r.end(), std::greater()); sort(r.begin(), r.end()); r.erase(std::unique(r.begin(), r.end()), r.end()); std::reverse(r.begin(), r.end()); for (size_t j=0; j ncol())) { return false; } size_t dtype = itype[i]; size_t place = iplace[i]; size_t ii = i; if (ii < (iplace.size()-1)) { for (size_t j=i+1; j x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(dv.size()); itype.push_back(0); names.push_back(name); dv.push_back(x); return true; } bool SpatDataFrame::add_column(std::vector x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(iv.size()); itype.push_back(1); names.push_back(name); iv.push_back(x); return true; } bool SpatDataFrame::add_column(std::vector x, std::string name) { std::vector v(x.begin(), x.end()); return add_column(v, name); } bool SpatDataFrame::add_column(std::vector x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(sv.size()); itype.push_back(2); names.push_back(name); sv.push_back(x); return true; } bool SpatDataFrame::add_column(std::vector x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(bv.size()); itype.push_back(3); names.push_back(name); bv.push_back(x); return true; } bool SpatDataFrame::add_column_bool(std::vector x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(bv.size()); itype.push_back(3); names.push_back(name); std::vector b; b.reserve(x.size()); for (size_t i=0; i x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(bv.size()); itype.push_back(3); names.push_back(name); std::vector b; b.reserve(x.size()); for (size_t i=0; i x, std::string name, std::string step="seconds", std::string zone="") { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(tv.size()); itype.push_back(4); names.push_back(name); SpatTime_v v; v.x = x; v.zone=zone; v.step=step; tv.push_back(v); return true; } bool SpatDataFrame::add_column(SpatTime_v x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(tv.size()); itype.push_back(4); names.push_back(name); tv.push_back(x); return true; } bool SpatDataFrame::add_column(SpatFactor x, std::string name) { unsigned nr = nrow(); if ((nr != 0) & (nr != x.size())) return false; iplace.push_back(fv.size()); itype.push_back(5); names.push_back(name); fv.push_back(x); return true; } void SpatDataFrame::add_column(unsigned dtype, std::string name) { unsigned nr = nrow(); if (dtype == 0) { std::vector dins(nr, NAN); iplace.push_back(dv.size()); dv.push_back(dins); } else if (dtype == 1) { long longNA = NA::value; std::vector iins(nr, longNA); iplace.push_back(iv.size()); iv.push_back(iins); } else if (dtype == 2) { std::vector sins(nr, NAS); iplace.push_back(sv.size()); sv.push_back(sins); } else if (dtype == 3) { std::vector bins(nr, 2); iplace.push_back(bv.size()); bv.push_back(bins); } else if (dtype == 4) { SpatTime_t timeNA = NA::value; SpatTime_v tins; tins.resize(nr, timeNA); iplace.push_back(tv.size()); tv.push_back(tins); } else { SpatFactor fins(nr, 0); iplace.push_back(fv.size()); fv.push_back(fins); } itype.push_back(dtype); names.push_back(name); } bool SpatDataFrame::cbind(SpatDataFrame &x) { unsigned nc = x.ncol(); std::vector nms = x.names; for (size_t i=0; i d = x.getD(i); if (!add_column(d, nms[i])) return false; } else if (x.itype[i] == 1) { std::vector d = x.getI(i); if (!add_column(d, nms[i])) return false; } else if (x.itype[i] == 2) { std::vector d = x.getS(i); if (!add_column(d, nms[i])) return false; } else if (x.itype[i] == 3) { std::vector d = x.getB(i); if (!add_column(d, nms[i])) return false; } else if (x.itype[i] == 4) { SpatTime_v d = x.getT(i); if (!add_column(d, nms[i])) return false; } else { SpatFactor d = x.getF(i); if (!add_column(d, nms[i])) return false; } } return true; } bool SpatDataFrame::rbind(SpatDataFrame &x) { size_t nr1 = nrow(); size_t nr2 = x.nrow(); size_t nc1 = ncol(); size_t nc2 = x.ncol(); std::vector nms = names; std::vector xnms = x.names; if (nc2 == nc1) { bool same = true; for (size_t i=0; i::value; for (size_t k=0; k::value; for (size_t k=0; k::value; if (x.itype[i] == 0) { for (size_t k=0; k 1) { iv[a].push_back(longNA); } else { iv[a].push_back(x.bv[b][k]); } } } else if (x.itype[i] == 5) { for (size_t k=0; k SpatDataFrame::get_names() { return names; } void SpatDataFrame::set_names(std::vector nms){ if (ncol() == nms.size()) { make_valid_names(nms); make_unique_names(nms); names = nms; } else { setError("number of names is not correct"); } } std::vector SpatDataFrame::get_datatypes() { std::vector types = {"double", "long", "string", "bool", "time", "factor"}; std::vector stype(itype.size()); for (size_t i=0; i types = {"double", "long", "string", "bool", "time", "factor"}; return types[i]; } std::string SpatDataFrame::get_datatype(int field) { if ((field < 0) || (field > (int)(ncol()-1))) return ""; std::vector types = {"double", "long", "string", "bool", "time", "factor"}; return types[itype[field]]; } bool SpatDataFrame::field_exists(std::string field) { return is_in_vector(field, get_names()); } int SpatDataFrame::get_fieldindex(std::string field) { return where_in_vector(field, get_names(), false); } SpatDataFrame SpatDataFrame::unique_col(int col) { SpatDataFrame out = subset_cols(col); if (out.hasError()) return out; if (out.itype[0] == 0) { size_t sz = nrow(); out.dv[0].erase(std::remove_if(out.dv[0].begin(), out.dv[0].end(), [](const double& value) { return std::isnan(value); }), out.dv[0].end()); bool hasNAN = sz > out.dv[0].size(); std::sort(out.dv[0].begin(), out.dv[0].end()); out.dv[0].erase(std::unique(out.dv[0].begin(), out.dv[0].end()), out.dv[0].end()); if (hasNAN) out.dv[0].push_back(NAN); } else if (out.itype[0] == 1) { std::sort(out.iv[0].begin(), out.iv[0].end()); out.iv[0].erase(std::unique(out.iv[0].begin(), out.iv[0].end()), out.iv[0].end()); } else if (out.itype[0] == 2) { std::sort(out.sv[0].begin(), out.sv[0].end()); out.sv[0].erase(std::unique(out.sv[0].begin(), out.sv[0].end()), out.sv[0].end()); } else if (out.itype[0] == 3) { std::sort(out.bv[0].begin(), out.bv[0].end()); out.bv[0].erase(std::unique(out.bv[0].begin(), out.bv[0].end()), out.bv[0].end()); } else if (out.itype[0] == 4) { std::sort(out.tv[0].x.begin(), out.tv[0].x.end()); out.tv[0].x.erase(std::unique(out.tv[0].x.begin(), out.tv[0].x.end()), out.tv[0].x.end()); } else { //if (out.itype[0] == 4) { std::sort(out.fv[0].v.begin(), out.fv[0].v.end()); out.fv[0].v.erase(std::unique(out.fv[0].v.begin(), out.fv[0].v.end()), out.fv[0].v.end()); } return out; } std::vector SpatDataFrame::getIndex(int col, SpatDataFrame &x) { size_t nd = nrow(); x = unique_col(col); size_t nu = x.nrow(); std::vector idx(nd, -1); size_t ccol = iplace[col]; if (x.itype[0] == 0) { for (size_t i=0; i SpatDataFrame::as_double(size_t v) { std::vector out; if (v >= ncol()) { setError("attempting to read a column that does not exist"); return out; } if (itype[v] == 2) { setError("as_double not available for string"); return out; } size_t j = iplace[v]; size_t n = nrow(); if (itype[v] == 0) return dv[j]; out.reserve(n); if (itype[v]==1) { long longNA = NA::value; for (size_t i=0; i 1) { out.push_back(NAN); } else { out.push_back((double)bv[j][i]); } } } else if (itype[v]==4) { SpatTime_t timeNA = NA::value; for (size_t i=0; i SpatDataFrame::as_long(size_t v) { std::vector out; if (v >= ncol()) { setError("attempting to read a column that does not exist"); return out; } if (itype[v] == 2) { setError("as_long not available for string"); return out; } size_t j = iplace[v]; if (itype[v] == 1) return iv[j]; // if (itype[v] == 0) { out.reserve(nrow()); long longNA = NA::value; if (itype[v] == 0) { for (size_t i=0; i 1) { out.push_back(longNA); } else { out.push_back((long) bv[j][i]); } } } else if (itype[v]==4) { SpatTime_t timeNA = NA::value; for (size_t i=0; i SpatDataFrame::as_string(size_t v) { std::vector out; if (v >= ncol()) { setError("attempting to read a column that does not exist"); return out; } std::string dt = get_datatype(v); size_t j = iplace[v]; if (dt == "string") return sv[j]; out.reserve(nrow()); if (dt == "double") { for (size_t i=0; i SpatDataFrame::get_timesteps() { std::vector s(ncol(), ""); size_t cnt = 0; for (size_t i=0; i SpatDataFrame::get_timezones() { std::vector s(ncol(), ""); size_t cnt = 0; for (size_t i=0; i> SpatDataFrame::to_strings() { std::vector> out(ncol()); if (nrow() == 0) return out; for (size_t i= 0; i SpatDataFrame::one_string() { std::vector out; size_t n = nrow(); if (n == 0) return out; std::vector> ss = to_strings(); size_t m = ncol(); out.reserve(n); for (size_t i= 0; i s = one_string(); std::vector u = s; std::sort(u.begin(), u.end()); u.erase(std::unique(u.begin(), u.end()), u.end()); size_t nu = u.size(); size_t ns = s.size(); if (nu == ns) { return *this; } std::vector keep; keep.reserve(nu); for (size_t i=0; i s = sv[j]; for (i = 0; i nms = get_names(); int i = where_in_vector(field, nms, false); if (i < 0) { // not in df out.setError("unknown variable: " + field); return out; } size_t j = iplace[i]; std::vector order; if (itype[i] == 0) { if (descending) { order = sort_order_nan_d(dv[j]); } else { order = sort_order_nan_a(dv[j]); } } else if (itype[i] == 1) { if (descending) { order = sort_order_nal_d(iv[j]); } else { order = sort_order_nal_a(iv[j]); } } else if (itype[i] == 2) { if (descending) { order = sort_order_nas_d(sv[j]); } else { order = sort_order_nas_a(sv[j]); } } else if (itype[i] == 3) { if (descending) { order = sort_order_d(bv[j]); } else { order = sort_order_a(bv[j]); } } else if (itype[i] == 4) { if (descending) { order = sort_order_d(tv[j].x); } else { order = sort_order_a(tv[j].x); } } else { if (descending) { order = sort_order_d(fv[j].v); } else { order = sort_order_a(fv[j].v); } } for (size_t i=0; i. #include "spatRasterMultiple.h" bool SpatRaster::readStart() { //if (!valid_sources(true, true)) { // return false; //} for (size_t i=0; i> &v, BlockSize bs, size_t i) { std::vector x; readValues(x, bs.row[i], bs.nrows[i], 0, ncol()); v.resize(nlyr()); size_t off = bs.nrows[i] * ncol(); for (size_t i=0; i(x.begin()+(i*off), x.begin()+((i+1)*off)); } } // BIP void SpatRaster::readBlockIP(std::vector &x, BlockSize bs, size_t i) { readValues(x, bs.row[i], bs.nrows[i], 0, ncol()); std::vector v(x.size()); size_t off = bs.nrows[i] * ncol(); size_t nl = nlyr(); for (size_t i=0; i lyr = std::vector(x.begin()+(i*off), x.begin()+((i+1)*off)); for (size_t j=0; j &out, size_t src, size_t row, size_t nrows, size_t col, size_t ncols){ size_t nl = source[src].nlyr; if (source[src].hasWindow) { row += source[src].window.off_row; col += source[src].window.off_col; size_t endrow = row + nrows; size_t endcol = col + ncols; size_t nc = source[src].window.full_ncol; double ncells = source[src].window.full_nrow * nc; for (size_t lyr=0; lyr < nl; lyr++) { size_t add = ncells * lyr; for (size_t r = row; r < endrow; r++) { size_t off = add + r * nc; out.insert(out.end(), source[src].values.begin()+off+col, source[src].values.begin()+off+endcol); } } /* else if (source[0].window.expanded) { unsigned add = ncells * lyr; std::vector v1(source[0].window.expand[0] * ncols, NAN); out.insert(out.end(), v1.begin(), v1.end()); v1.resize(source[0].window.expand[1], NAN); std::vector v2(source[0].window.expand[2], NAN); for (size_t r = wrow; r < endrow; r++) { unsigned a = add + r * source[0].window.full_ncol; out.insert(out.end(), v1.begin(), v1.end()); out.insert(out.end(), source[src].values.begin()+a+wcol, source[src].values.begin()+a+endcol); out.insert(out.end(), v2.begin(), v2.end()); } v1.resize(source[0].window.expand[3] * ncols, NAN); out.insert(out.end(), v1.begin(), v1.end()); } */ } else { // no window size_t nc = ncol(); if (row==0 && nrows==nrow() && col==0 && ncols==nc) { out.insert(out.end(), source[src].values.begin(), source[src].values.end()); } else { double ncells = ncell(); if (col==0 && ncols==nc) { for (size_t lyr=0; lyr < nl; lyr++) { size_t add = ncells * lyr; size_t a = add + row * nc; size_t b = a + nrows * nc; out.insert(out.end(), source[src].values.begin()+a, source[src].values.begin()+b); } } else { size_t endrow = row + nrows; size_t endcol = col + ncols; for (size_t lyr=0; lyr < nl; lyr++) { size_t add = ncells * lyr; for (size_t r = row; r < endrow; r++) { size_t a = add + r * nc; out.insert(out.end(), source[src].values.begin()+a+col, source[src].values.begin()+a+endcol); } } } } } } std::vector SpatRaster::readValuesR(size_t row, size_t nrows, size_t col, size_t ncols){ std::vector out; if (((row + nrows) > nrow()) || ((col + ncols) > ncol())) { setError("invalid rows/columns"); return out; } //row = std::min(std::max(size_t(0), row), nrow()-1); //col = std::min(std::max(size_t(0), col), ncol()-1); //nrows = std::max(size_t(1), std::min(nrows, nrow()-row)); //ncols = std::max(size_t(1), std::min(ncols, ncol()-col)); if ((nrows==0) | (ncols==0)) { return out; } if (!hasValues()) { out.resize(nrows * ncols * nlyr(), NAN); addWarning("raster has no values"); return out; // or NAs? } unsigned n = nsrc(); out.reserve(nrows * ncols * nlyr()); for (size_t src=0; src gout; readChunkGDAL(gout, src, source[0].window.off_row, nrows, source[0].window.off_col, ncols); size_t rrow = row + source[0].window.off_row; size_t rcol = col + source[0].window.off_col; unsigned endrow = rrow + nrows; unsigned endcol = rcol + ncols; unsigned ncells = source[0].window.full_nrow * source[0].window.full_ncol; unsigned nl = source[src].nlyr; for (size_t lyr=0; lyr < nl; lyr++) { unsigned add = ncells * lyr; std::vector v1(source[0].window.expand[0] * ncols, NAN); out.insert(out.end(), v1.begin(), v1.end()); v1.resize(source[0].window.expand[1], NAN); std::vector v2(source[0].window.expand[2], NAN); for (size_t r = rrow; r < endrow; r++) { unsigned a = add + r * source[0].window.full_ncol; out.insert(out.end(), v1.begin(), v1.end()); out.insert(out.end(), gout.begin()+a+rcol, gout.begin()+a+endcol); out.insert(out.end(), v2.begin(), v2.end()); } v1.resize(source[0].window.expand[3] * ncols, NAN); out.insert(out.end(), v1.begin(), v1.end()); } } */ readChunkGDAL(out, src, row, nrows, col, ncols); #endif // useGDAL } } return out; } void SpatRaster::readValues(std::vector &out, size_t row, size_t nrows, size_t col, size_t ncols){ if (((row + nrows) > nrow()) || ((col + ncols) > ncol())) { setError("invalid rows/columns"); return; } if ((nrows==0) | (ncols==0)) { return; } out.resize(0); if (!hasValues()) { out.resize(nrows * ncols * nlyr(), NAN); addWarning("raster has no values"); return; // or NAs? } unsigned n = nsrc(); out.reserve(nrows * ncols * nlyr()); for (size_t src=0; src &out, size_t row, size_t nrows, size_t col, size_t ncols){ if (((row + nrows) > nrow()) || ((col + ncols) > ncol())) { setError("invalid rows/columns"); return; } if ((nrows==0) | (ncols==0)) { return; } unsigned n = nsrc(); out.resize(0); out.reserve(nrows * ncols * nlyr()); for (size_t src=0; src 0) { if (!source[0].combine_sources(source[src])) { setError("could not combine sources"); return false; } source[src].values.resize(0); } } readStop(); if (n > 1) source.resize(1); source[0].hasWindow = false; return true; } std::vector SpatRaster::getValues(long lyr, SpatOptions &opt) { std::vector out; bool hw = false; for (size_t i=0; i fvals = readValuesGDAL(src, 0, nrow(), 0, ncol()); out.insert(out.end(), fvals.begin(), fvals.end()); #endif // useGDAL } } } else { // read one lyr std::vector sl = findLyr(lyr); unsigned src=sl[0]; if (source[src].memory) { size_t start = sl[1] * ncell(); out = std::vector(source[src].values.begin()+start, source[src].values.begin()+start+ncell()); } else { #ifdef useGDAL out = readValuesGDAL(src, 0, nrow(), 0, ncol(), sl[1]); #endif // useGDAL } } return out; } bool SpatRaster::getValuesSource(size_t src, std::vector &out) { unsigned n = nsrc(); if (src > n) { return false; } bool hw = false; for (size_t i=0; i(source[src].values.begin(), source[src].values.end()); } else { #ifdef useGDAL out = readValuesGDAL(src, 0, nrow(), 0, ncol()); #endif // useGDAL } return true; } SpatRasterStack SpatRasterCollection::read_into(SpatRaster &tmp, size_t row, size_t nrows) { size_t n = size(); double nan = NAN; std::vector v(nan, nrows * tmp.ncol() * n); SpatRasterStack out; SpatExtent e = tmp.getExtent(); e.ymax = tmp.source[0].extent.ymax - row * tmp.yres(); e.ymin = tmp.source[0].extent.ymax - (row + nrows) * tmp.yres(); SpatOptions ops; for (size_t i=0; i e.ymin) & (ee.ymin < e.ymax)) { if (!tmp.compare_geom(ds[i], false, false, ops.get_tolerance(), false, false, false, true)) { out.setError(tmp.msg.error); return(out); } SpatRaster x = ds[i].crop(e, "near", true, ops); out.ds.push_back(x); } } return out; } terra/src/spatRasterMultiple.h0000644000176200001440000001337614735360206016213 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" // A class for "sub-datasets" class SpatRasterStack { public: virtual ~SpatRasterStack(){} SpatRasterStack deepCopy(); SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } void setMessage(std::string s) { msg.setMessage(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} std::string getMessage() { return msg.getMessage();} std::vector ds; std::vector names; std::vector long_names; std::vector units; SpatRasterStack() {}; SpatRasterStack(std::string fname, std::vector ids, bool useids, std::vector options); SpatRasterStack(SpatRaster r, std::string name, std::string longname, std::string unit, bool warn=false); std::vector>> extractXY(std::vector &x, std::vector &y, std::string method); std::vector>> extractCell(std::vector &cell); std::vector>>> extractVector(SpatVector v, bool touches, bool small, std::string method, SpatOptions &opt); std::vector resolution(); SpatExtent getExtent(); std::vector get_names(); void set_names(std::vector nms); std::vector get_longnames(); void set_longnames(std::vector nms); std::vector get_units(); void set_units(std::vector u); std::vector filenames(); void set_layernames(std::vector nms, long id); std::vector> get_layernames(); bool readStart(); bool readStop(); bool readAll(); unsigned nsds(); unsigned nrow(); unsigned ncol(); std::vector nlyr(); std::string getSRS(std::string s); bool push_back(SpatRaster r, std::string name, std::string longname, std::string unit, bool warn); size_t size(); bool empty(); void resize(size_t n); void erase(size_t i); SpatRaster getsds(size_t i); SpatRasterStack subset(std::vector x); SpatRasterStack crop(SpatExtent e, std::string snap, bool expand, SpatOptions &opt); void replace(unsigned i, SpatRaster x, bool setname); SpatRaster collapse(); SpatRaster summary_numb(std::string fun, std::vector add, bool narm, SpatOptions &opt); SpatRaster summary(std::string fun, bool narm, SpatOptions &opt); std::map tags; bool addTag(std::string name, std::string value); bool removeTag(std::string name); std::string getTag(std::string name); std::vector getTags(); }; // A collection of (perhaps non matching) SpatRasters class SpatRasterCollection { public: virtual ~SpatRasterCollection(){} SpatRasterCollection deepCopy(); SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } void setMessage(std::string s) { msg.setMessage(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} std::string getMessage() { return msg.getMessage();} std::vector ds; // SpatExtent extent; std::vector names; SpatRasterCollection() {}; SpatRasterCollection(std::string fname, std::vector ids, bool useids, std::vector options); // void setExtent(); SpatExtent getExtent(); SpatRasterCollection(size_t n); size_t size(); bool empty(); void resize(size_t n); void push_back(SpatRaster r, std::string name); void erase(size_t i); void readBlock(SpatRaster &r, std::vector> &v, BlockSize bs, size_t i, std::vector use, SpatOptions opt); std::string make_vrt(std::vector options, bool reverse, SpatOptions &opt); SpatRasterCollection crop(SpatExtent e, std::string snap, bool expand, std::vector use, SpatOptions &opt); SpatRasterCollection cropmask(SpatVector v, std::string snap, bool touches, bool expand, std::vector use, SpatOptions &opt); std::vector getValueType(bool unique); SpatRaster merge(bool first, bool narm, int algo, std::string method, SpatOptions &opt); SpatRaster morph(SpatRaster &x, SpatOptions &opt); SpatRaster mosaic(std::string fun, SpatOptions &opt); SpatRaster summary(std::string fun, SpatOptions &opt); std::vector dims(); std::vector get_names(); void set_names(std::vector nms); std::vector filenames(); SpatRasterStack read_into(SpatRaster &tmp, size_t row, size_t nrows); std::map tags; bool addTag(std::string name, std::string value); bool removeTag(std::string name); std::string getTag(std::string name); std::vector getTags(); }; terra/src/ram.cpp0000644000176200001440000000660214744572177013467 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifdef _WIN32 #include #elif __linux__ #include "sys/types.h" #include "sys/sysinfo.h" #include #include #include #include #include #elif __APPLE__ #include #include #include #include #endif double availableRAM() { //https://stackoverflow.com/questions/38490320/how-to-query-amount-of-allocated-memory-on-linux-and-osx //https://stackoverflow.com/questions/63166/how-to-determine-cpu-and-memory-consumption-from-inside-a-process double ram = 1e+9; // return available RAM in number of double (8 byte) cells. #ifdef _WIN32 MEMORYSTATUSEX statex; statex.dwLength = sizeof(statex); GlobalMemoryStatusEx(&statex); ram = statex.ullAvailPhys; #elif __linux__ unsigned long memAvailable = 0; std::ifstream meminfo("/proc/meminfo"); std::string line; while (std::getline(meminfo, line)) { std::istringstream iss(line); std::string key; if (std::getline(iss, key, ':')) { if (key == "MemAvailable") { std::string value_str; if (std::getline(iss >> std::ws, value_str)) { std::stringstream value_stream(value_str); unsigned long mem_available_kb; std::string units; if (value_stream >> mem_available_kb >> units) { memAvailable = mem_available_kb; } } break; } } } if (memAvailable == 0) { struct sysinfo memInfo; sysinfo (&memInfo); ram = memInfo.freeram; } else { ram = memAvailable * 1024; } #elif __APPLE__ vm_size_t page_size; mach_port_t mach_port; mach_msg_type_number_t count; #if defined(__ppc__) || defined(__i386__) vm_statistics_data_t vm_stats; #else vm_statistics64_data_t vm_stats; #endif mach_port = mach_host_self(); count = sizeof(vm_stats) / sizeof(natural_t); #if defined(__ppc__) || defined(__i386__) if (KERN_SUCCESS == host_page_size(mach_port, &page_size) && KERN_SUCCESS == host_statistics(mach_port, HOST_VM_INFO, (host_info_t)&vm_stats, &count)) { long long free_memory = ((int32_t)vm_stats.free_count + (int32_t)vm_stats.inactive_count) * (int32_t)page_size; #else if (KERN_SUCCESS == host_page_size(mach_port, &page_size) && KERN_SUCCESS == host_statistics64(mach_port, HOST_VM_INFO, (host_info64_t)&vm_stats, &count)) { long long free_memory = ((int64_t)vm_stats.free_count + (int64_t)vm_stats.inactive_count) * (int64_t)page_size; #endif ram = free_memory; //https://stackoverflow.com/questions/63166/how-to-determine-cpu-and-memory-consumption-from-inside-a-process } #endif return ram / 8; // 8 bytes for each double } terra/src/surfArea.cpp0000644000176200001440000001134614720503060014434 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "distance.h" /* Compute surface area, using method from: Jeff S. Jenness, 2004. Calculating Landscape Surface Area from Digital Elevation Models. Wildlife Society Bulletin 32(3):829-839. http://www.jstor.org/stable/3784807 With edge adjustments. From C code in R package "sp" by Barry Rowlingson (copyright 2010) Adapted for terra by Robert Hijmans (C++, support for lonlat) */ inline double height(const std::vector &heights, const long &ncols, const size_t &row, const long &col) { size_t ncr = ncols*row; if (col < 0) { return heights[ncr]; // + 0 } else if (col == ncols) { return heights[ncr + (ncols-1)]; } else { return heights[ncr + col]; } } inline double triarea(const double &a, const double &b, const double &c) { // triangle area given side lengths double s = (a + b + c) / 2.0; return sqrt(s * (s-a) * (s-b) * (s-c)); } void sarea(std::vector &heights, const size_t &nrow, const long &ncol, const std::vector &w, const double &h, bool lonlat, std::vector &sa) { // given an nx by ny matrix of heights with single-cell edge border, compute the surface area. // offsets to neighbours std::vector dyv = {-1, -1, -1, 0, 1, 1, 1, 0, -1}; std::vector dxv = {-1, 0, 1, 1, 1, 0, -1, -1, -1}; // triangle diagonal length double s2 = sqrt((w[0]*w[0]) + (h*h)); // radial side lengths std::vector side = {s2, h, s2, w[0], s2, h, s2, w[0], s2}; // outer edges lengths std::vector l3v = {w[0], w[0], h, h, w[0], w[0], h, h}; sa = std::vector(heights.size() - 2*ncol, NAN); size_t cell = 0; for (size_t i=1; i<(nrow-1); i++){ if (lonlat) { size_t k = i - 1; s2 = sqrt((w[k]*w[k]) + (h*h)); side = {s2, h, s2, w[k], s2, h, s2, w[k], s2}; l3v = {w[k], w[k], h, h, w[k], w[k], h, h}; } for (long j=0; j resx = { xr }; double resy = yres(); if (lonlat) { resy = distance_lonlat(0, 0, 0, resy); } std::vector rows; for (size_t i = 0; i < cbs.n; i++) { std::vector v; readBlock(v, cbs, i); if (i==0) { v.insert(v.begin(), v.begin(), v.begin()+nc); } if (i == (cbs.n - 1)) { v.insert(v.end(), v.end()-nc, v.end()); } if (lonlat) { rows.resize(out.bs.nrows[i]); std::iota(rows.begin(), rows.end(), out.bs.row[i]); std::vector y = yFromRow(rows); resx = distance_lon(xr, y); } std::vector sa; sarea(v, out.bs.nrows[i]+2, nc, resx, resy, lonlat, sa); if (!out.writeBlock(sa, i)) return out; } readStop(); out.writeStop(); return(out); } terra/src/geos_methods.cpp0000644000176200001440000025503214755146561015367 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include "geos_spat.h" #include "distance.h" #include "recycle.h" #include "string_utils.h" void callbck(void *item, void *userdata) { // callback function for tree selection std::vector *ret = (std::vector *) userdata; ret->push_back(*((size_t *) item)); } SpatVector SpatVector::allerretour() { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); SpatVector out = vect_from_geos(g, hGEOSCtxt, type()); geos_finish(hGEOSCtxt); return out; } SpatVectorCollection SpatVector::bienvenue() { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); SpatVectorCollection out = coll_from_geos(g, hGEOSCtxt); geos_finish(hGEOSCtxt); return out; } /* std::vector SpatVector::wkt() { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector out::crop out.reserve(g.size()); char * wkt; for (size_t i = 0; i < g.size(); i++) { wkt = GEOSGeomToWKT_r(hGEOSCtxt, g[i].get()); out.push_back(wkt); } geos_finish(hGEOSCtxt); return out; } */ std::vector SpatVector::wkt() { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector out; out.reserve(g.size()); GEOSWKTWriter* writer = GEOSWKTWriter_create_r(hGEOSCtxt); for (size_t i = 0; i < g.size(); i++) { char *wkt = GEOSGeomToWKT_r(hGEOSCtxt, g[i].get()); out.push_back(wkt); } GEOSWKTWriter_destroy_r(hGEOSCtxt, writer); geos_finish(hGEOSCtxt); return out; } std::vector SpatVector::wkb() { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector out; out.reserve(g.size()); GEOSWKBWriter* writer = GEOSWKBWriter_create_r(hGEOSCtxt); size_t len=0; for (size_t i=0; i(wkb), len); out.push_back(s); GEOSFree_r(hGEOSCtxt, wkb); } GEOSWKBWriter_destroy_r(hGEOSCtxt, writer); geos_finish(hGEOSCtxt); return out; } std::vector> SpatVector::wkb_raw() { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector> out; size_t len = 0; for (size_t i = 0; i < g.size(); i++) { unsigned char *hex = GEOSGeomToWKB_buf_r(hGEOSCtxt, g[i].get(), &len); std::vector raw; raw = std::vector(hex, hex+len); out.push_back(raw); free(hex); } geos_finish(hGEOSCtxt); return out; } std::vector SpatVector::hex() { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector out; out.reserve(g.size()); size_t len = 0; for (size_t i = 0; i < g.size(); i++) { unsigned char *hex = GEOSGeomToHEX_buf_r(hGEOSCtxt, g[i].get(), &len); std::string s( reinterpret_cast(hex), len) ; out.push_back(s); free(hex); } geos_finish(hGEOSCtxt); return out; } SpatVector SpatVector::from_hex(std::vector x, std::string srs) { GEOSContextHandle_t hGEOSCtxt = geos_init(); size_t n = x.size(); std::vector p; p.resize(n); for (size_t i = 0; i < n; i++) { const char* cstr = x[i].c_str(); size_t len = strlen(cstr); const unsigned char *hex = (const unsigned char *) cstr; GEOSGeometry* r = GEOSGeomFromHEX_buf_r(hGEOSCtxt, hex, len); p[i] = geos_ptr(r, hGEOSCtxt); } SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt); geos_finish(hGEOSCtxt); SpatVector out = coll.get(0); if (coll.size() > 1) { out.addWarning("not all geometries were transferred, use svc for a geometry collection"); } out.setSRS(srs); return out; } SpatVectorCollection SpatVectorCollection::from_hex_col(std::vector x, std::string srs) { GEOSContextHandle_t hGEOSCtxt = geos_init(); size_t n = x.size(); std::vector p; p.resize(n); for (size_t i = 0; i < n; i++) { const char* cstr = x[i].c_str(); size_t len = strlen(cstr); const unsigned char *hex = (const unsigned char *) cstr; GEOSGeometry* r = GEOSGeomFromHEX_buf_r(hGEOSCtxt, hex, len); p[i] = geos_ptr(r, hGEOSCtxt); } SpatVectorCollection out = coll_from_geos(p, hGEOSCtxt); geos_finish(hGEOSCtxt); for (size_t i = 0; i < out.size(); i++) { out.v[i].setSRS(srs); } return out; } std::vector SpatVector::geos_isvalid() { GEOSContextHandle_t hGEOSCtxt = geos_init2(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector out; out.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { char v = GEOSisValid_r(hGEOSCtxt, g[i].get()); out.push_back(v); } geos_finish(hGEOSCtxt); return {out}; } std::vector SpatVector::geos_isvalid_msg() { GEOSContextHandle_t hGEOSCtxt = geos_init2(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector out; out.reserve(2 * g.size()); for (size_t i = 0; i < g.size(); i++) { char v = GEOSisValid_r(hGEOSCtxt, g[i].get()); std::string valid = {v}; out.push_back(valid); if (!v) { char *r = GEOSisValidReason_r(hGEOSCtxt, g[i].get()); std::string reason = r; free(r); out.push_back(reason); } else { out.push_back(""); } } geos_finish(hGEOSCtxt); return {out}; } SpatVector SpatVector::make_valid2() { SpatVector out; #ifndef GEOS380 out.setError("make_valid is not available for GEOS < 3.8"); #else GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); size_t n = size(); std::vector ids; ids.reserve(n); for (size_t i=0; i g = geos_geoms(this, hGEOSCtxt); std::vector p; p.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* r = GEOSGeom_setPrecision_r(hGEOSCtxt, g[i].get(), gridSize, 0); if (r == NULL) { out.setError("something bad happened"); geos_finish(hGEOSCtxt); return out; } if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } if (p.size() > 0) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt); out = coll.get(0); out.df = df; } geos_finish(hGEOSCtxt); out.srs = srs; return out; } */ std::vector> SpatVector::index_2d(SpatVector v) { std::vector> out(2); size_t n = std::max(size(), v.size()) * 2; out[0].reserve(n); out[1].reserve(n); size_t k = 0; for (size_t i=0; i n) { n += std::max(size(), v.size()); out[0].reserve(n); out[1].reserve(n); } } } } return out; } std::vector> SpatVector::index_sparse(SpatVector v) { std::vector> out(v.size()); for (size_t i=0; i -180.001) && (extent.xmax < 180.001)) { if ((e.xmin < -180) && (e.xmax < 180)) { double xmn = e.xmin + 360; if (xmn > -180) { if (xmn < e.xmax) xmn = e.xmax; SpatExtent e2 = e; e2.xmax = 180; e2.xmin = xmn; SpatVector second = crop(e2, false); first = first.append(second, true); } } else if ((e.xmax > 180) && (e.xmin > -180)) { double xmx = -360 + e.xmax; if (xmx < 180) { if (xmx > e.xmin) xmx = e.xmin; SpatExtent e2 = e; e2.xmin = -180; e2.xmax = xmx; SpatVector second = crop(e2, false); first = first.append(second, true); } } } return(first); } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector p; p.reserve(g.size()); std::vector id; id.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* r = GEOSClipByRect_r(hGEOSCtxt, g[i].get(), e.xmin, e.ymin, e.xmax, e.ymax); if (r == NULL) { out.setError("something bad happened"); geos_finish(hGEOSCtxt); return out; } if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); id.push_back(i); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } if (!p.empty()) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt, id); out = coll.get(0); out.df = df.subset_rows(out.df.iv[0]); } geos_finish(hGEOSCtxt); out.srs = srs; return out; #endif } SpatVector SpatVector::make_nodes() { SpatVector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector p; p.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* r = GEOSNode_r(hGEOSCtxt, g[i].get()); if (r == NULL) { out.setError("something bad happened"); geos_finish(hGEOSCtxt); return out; } if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } if (!p.empty()) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt); out = coll.get(0); out.df = df; } geos_finish(hGEOSCtxt); out.srs = srs; return out; } SpatVector SpatVector::boundary() { SpatVector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector p; p.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* r = GEOSBoundary_r(hGEOSCtxt, g[i].get()); if (r == NULL) { out.setError("something bad happened"); geos_finish(hGEOSCtxt); return out; } if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } if (!p.empty()) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt); out = coll.get(0); out.df = df; } geos_finish(hGEOSCtxt); out.srs = srs; return out; } SpatVector SpatVector::normalize() { SpatVector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector p; p.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* r = g[i].get(); if (GEOSNormalize_r(hGEOSCtxt, r)) { g[i] = geos_ptr(r, hGEOSCtxt); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } out = vect_from_geos(g, hGEOSCtxt, type()); geos_finish(hGEOSCtxt); out.df = df; out.srs = srs; return out; } SpatVector SpatVector::line_merge() { SpatVector out; if (type() != "lines") { out.setError("input must be lines"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector p; p.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* r = GEOSLineMerge_r(hGEOSCtxt, g[i].get()); if (r == NULL) { out.setError("something bad happened"); geos_finish(hGEOSCtxt); return out; } if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } if (!p.empty()) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt); out = coll.get(0); out.df = df; } geos_finish(hGEOSCtxt); out.srs = srs; return out; } SpatVector SpatVector::simplify(double tolerance, bool preserveTopology) { SpatVector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector p; p.reserve(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* r; if (preserveTopology) { r = GEOSTopologyPreserveSimplify_r(hGEOSCtxt, g[i].get(), tolerance); } else { r = GEOSSimplify_r(hGEOSCtxt, g[i].get(), tolerance); } if (r == NULL) { out.setError("something bad happened"); geos_finish(hGEOSCtxt); return out; } if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } if (!p.empty()) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt); out = coll.get(0); out.df = df; } geos_finish(hGEOSCtxt); out.srs = srs; return out; } SpatVector SpatVector::shared_paths(bool index) { if (type() == "polygons") { SpatVector x = as_lines(); return x.shared_paths(index); } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); size_t s = size(); std::vector id1, id2; std::vector p; if (!index) { // calculate shared paths for (size_t i=0; i<(s-1); i++) { for (size_t j=(i+1); j items(x.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < s; i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), x[i].get(), &(items[i])); } for (size_t i = 0; i < s; i++) { // pre-select x's using tree: std::vector tree_sel, sel; if (!GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } if (! tree_sel.empty()) { for (size_t j = 0; j < tree_sel.size(); j++) { if (tree_sel[j] > i) { GEOSGeometry* r = GEOSSharedPaths_r(hGEOSCtxt, x[i].get(), x[tree_sel[j]].get()); if (r != NULL) { if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); id1.push_back(i+1); id2.push_back(tree_sel[j]+1); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } } } } } } SpatVector out; if (!p.empty()) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt, std::vector(), false, false); out = coll.get(0); out = out.line_merge(); } geos_finish(hGEOSCtxt); out.srs = srs; out.df.add_column(id1, "id1"); out.df.add_column(id2, "id2"); return out; } SpatVector SpatVector::shared_paths(SpatVector x, bool index) { if (x.type() == "polygons") { x = x.as_lines(); } if (type() == "polygons") { SpatVector v = as_lines(); return v.shared_paths(x, index); } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector a = geos_geoms(this, hGEOSCtxt); std::vector b = geos_geoms(&x, hGEOSCtxt); size_t sa = size(); size_t sb = b.size(); std::vector id1, id2; std::vector p; if (!index) { for (size_t i=0; i items(x.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < sb; i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, b[i].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), b[i].get(), &(items[i])); } for (size_t i = 0; i < sa; i++) { // pre-select x's using tree: std::vector tree_sel, sel; if (!GEOSisEmpty_r(hGEOSCtxt, a[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), a[i].get(), callbck, &tree_sel); } if (! tree_sel.empty()) { for (size_t j = 0; j < tree_sel.size(); j++) { GEOSGeometry* r = GEOSSharedPaths_r(hGEOSCtxt, a[i].get(), b[tree_sel[j]].get()); if (r != NULL) { if (!GEOSisEmpty_r(hGEOSCtxt, r)) { p.push_back(geos_ptr(r, hGEOSCtxt)); id1.push_back(i+1); id2.push_back(tree_sel[j]+1); } else { GEOSGeom_destroy_r(hGEOSCtxt, r); } } } } } } SpatVector out; if (!p.empty()) { SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt, std::vector(), false, false); out = coll.get(0); out = out.line_merge(); } geos_finish(hGEOSCtxt); out.srs = srs; out.df.add_column(id1, "id1"); out.df.add_column(id2, "id2"); return out; } bool find_segments(GEOSContextHandle_t hGEOSCtxt, std::vector &x, std::vector &y, std::vector &cx, std::vector &cy, std::vector &si, std::vector &sx, std::vector &sy) { size_t n = x.size() - 1; size_t m = cx.size() - 1; double ix, iy; si.resize(0); sx.resize(0); sy.resize(0); for (size_t i=0; i 0; } SpatVector SpatVector::split_lines(SpatVector v) { // check GEOS version SpatVector out; return out; /* SpatVector out = *this; std::vector si; std::vector sx, sy; GEOSContextHandle_t hGEOSCtxt = geos_init(); for (size_t i=0; i x = out.relate(tmp, "intersects", true, true); std::vector> xy1 = tmp.coordinates(); for (size_t j=0; j> xy2 = tmp.coordinates(); // if (find_segments(hGEOSCtxt, xy1[0], xy1[1], xy2[0], xy2[1], si, sx, sy)) { // } } } } return out; */ } /* SpatVector SpatVector::split_polygons(SpatVector lns) { SpatGeom glns; glns.gtype = lines; glns.setPart(SpatPart(x, y), 0); std::vector xln = {180, 180}; std::vector yln = {-91, 91}; glns.setPart(SpatPart(xln, yln), 1); SpatVector v; v.addGeom(glns); v = v.line_merge(); v = v.aggregate(false); v = v.polygonize(); g = v.geoms[0]; */ SpatVector polygonize_one(const GEOSGeometry* gi, GEOSContextHandle_t hGEOSCtxt) { size_t ngeoms = 1; std::vector p(1); SpatVector out; GEOSGeometry* r = GEOSPolygonize_r(hGEOSCtxt, &gi, ngeoms); if (r == NULL) { out.setError("something bad happened"); geos_finish(hGEOSCtxt); return out; } if (GEOSisEmpty_r(hGEOSCtxt, r)) { GEOSGeom_destroy_r(hGEOSCtxt, r); } else { p[0] = geos_ptr(r, hGEOSCtxt); SpatVectorCollection coll = coll_from_geos(p, hGEOSCtxt); out = coll.get(0); out.aggregate(false); } return out; } SpatVector SpatVector::polygonize() { if (type() == "polygons") { return *this; } SpatVector out; out.srs = srs; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); const GEOSGeometry* gi = g[0].get(); out = polygonize_one(gi, hGEOSCtxt); for (size_t i = 1; i < g.size(); i++) { const GEOSGeometry* gi = g[i].get(); SpatVector onegeom = polygonize_one(gi, hGEOSCtxt); out.addGeom(onegeom.getGeom(0)); } geos_finish(hGEOSCtxt); out.srs = srs; if (df.nrow() == out.size()) { out.df = df; } return out; } SpatVector SpatVector::snap(double tolerance) { size_t s = size(); SpatVector out; if (s == 0) { return out; } tolerance = std::max(0.0, tolerance); GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector ids; ids.reserve(s); for (size_t i=0; i<(s-1); i++) { GEOSGeometry* r = x[i].get(); for (size_t j=(i+1); j x = geos_geoms(this, hGEOSCtxt); std::vector to = geos_geoms(&y, hGEOSCtxt); std::vector ids; ids.reserve(s); GEOSGeometry* gto = to[0].get(); for (size_t i=0; i x = geos_geoms(this, hGEOSCtxt); // if ((type() != "polygons") & (type() != "mutlipolygons")) { if ((v.type() != "polygons")) { v = v.hull("convex"); } else if (v.nrow() > 1) { v = v.aggregate(false); } // return intersect(v, false); std::vector y = geos_geoms(&v, hGEOSCtxt); std::vector result; std::vector ids; size_t nx = size(); ids.reserve(nx); for (size_t i = 0; i < nx; i++) { GEOSGeometry* geom = GEOSIntersection_r(hGEOSCtxt, x[i].get(), y[0].get()); if (geom == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } if (!GEOSisEmpty_r(hGEOSCtxt, geom)) { result.push_back(geos_ptr(geom, hGEOSCtxt)); ids.push_back(i); } else { GEOSGeom_destroy_r(hGEOSCtxt, geom); } } // SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt); if (!result.empty()) { // SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt); // SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt, ids); SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt, ids, true, false); out = coll.get(0); // std::vector nms = out.get_names(); // out = out.aggregate(nms[0], true); out.df = df.subset_rows(out.df.iv[0]); out.srs = srs; } geos_finish(hGEOSCtxt); return out; } SpatVector SpatVector::hull(std::string htype, std::string by, double param, bool allowHoles, bool tight) { SpatVector out; if (nrow() == 0) { out.srs = srs; return out; } std::vector methods = {"convex", "rectangle", "circle", "concave_ratio", "concave_length"}; if (std::find(methods.begin(), methods.end(), htype) == methods.end()) { out.setError("unknown hull type"); return out; } if (!by.empty()) { SpatVector tmp = aggregate(by, false); if (tmp.hasError()) { return tmp; } for (size_t i=0; i -85) && (extent.ymax < 85)) { SpatVector tmp = project("+proj=merc", false); tmp = tmp.hull(htype, ""); tmp = tmp.project(srs.wkt, false); return tmp; } } */ SpatVector a = aggregate(false); GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(&a, hGEOSCtxt); //std::string vt = type(); GEOSGeometry* h; if (htype == "convex") { h = GEOSConvexHull_r(hGEOSCtxt, g[0].get()); } else if (htype == "circle") { #ifndef GEOS380 geos_finish(hGEOSCtxt); out.setError("GEOS 3.8 required for bounding circle"); return out; #else h = GEOSMinimumBoundingCircle_r(hGEOSCtxt, g[0].get(), NULL, NULL); #endif } else if (htype == "rectangle") { #ifndef GEOS361 geos_finish(hGEOSCtxt); out.setError("GEOS 3.6.1 required for rotated rectangle"); return out; #else h = GEOSMinimumRotatedRectangle_r(hGEOSCtxt, g[0].get()); #endif } else if (htype == "concave_ratio") { #ifndef GEOS3110 geos_finish(hGEOSCtxt); out.setError("GEOS 3.11 required for concave hull"); return out; #else h = GEOSConcaveHull_r(hGEOSCtxt, g[0].get(), param, allowHoles); #endif } else if (htype == "concave_length") { #ifndef GEOS3110 geos_finish(hGEOSCtxt); out.setError("GEOS 3.11 required for concave_length hull"); return out; #else if (type() == "polygons") { h = GEOSConcaveHullOfPolygons_r(hGEOSCtxt, g[0].get(), param, tight, allowHoles); } else { #ifndef GEOS3120 geos_finish(hGEOSCtxt); out.setError("GEOS 3.12 required for concave_length hull for points and lines"); return out; #else h = GEOSConcaveHullByLength_r(hGEOSCtxt, g[0].get(), param, allowHoles); #endif } #endif } else { geos_finish(hGEOSCtxt); out.setError("unknown hull type"); return out; } std::vector b(1); b[0] = geos_ptr(h, hGEOSCtxt); SpatVectorCollection coll = coll_from_geos(b, hGEOSCtxt); geos_finish(hGEOSCtxt); out = coll.get(0); out.srs = srs; return out; } SpatVector SpatVector::voronoi(SpatVector bnd, double tolerance, int onlyEdges) { SpatVector out; if (nrow() == 0) { out.addWarning("input SpatVector has no geometries"); return out; } #ifndef GEOS350 out.setError("GEOS 3.5 required for voronoi"); return out; #else GEOSContextHandle_t hGEOSCtxt = geos_init(); SpatVector a = aggregate(false); std::vector g = geos_geoms(&a, hGEOSCtxt); GEOSGeometry* v; if (bnd.empty()) { v = GEOSVoronoiDiagram_r(hGEOSCtxt, g[0].get(), NULL, tolerance, onlyEdges); } else { if (bnd.type() != "polygons") { out.setError("boundary must have a polygon geometry"); geos_finish(hGEOSCtxt); return out; } std::vector ge = geos_geoms(&bnd, hGEOSCtxt); v = GEOSVoronoiDiagram_r(hGEOSCtxt, g[0].get(), ge[0].get(), tolerance, onlyEdges); } if (v == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } std::vector b(1); b[0] = geos_ptr(v, hGEOSCtxt); SpatVectorCollection coll = coll_from_geos(b, hGEOSCtxt); geos_finish(hGEOSCtxt); out = coll.get(0); out.srs = srs; if (!out.hasError()) { out = out.disaggregate(false); if (!bnd.empty()) { SpatDataFrame empty; bnd.df = empty; out = out.intersect(bnd, true); } if ((type() == "points") && (!onlyEdges)) { std::vector atts = out.relateFirst(*this, "intersects"); std::vector a; a.reserve(atts.size()); for (size_t i=0; i=0) a.push_back(atts[i]); } if (a.size() == out.size()) { out.df = df.subset_rows(a); } } } return out; #endif } SpatVector SpatVector::delaunay(double tolerance, int onlyEdges, bool constrained) { SpatVector out; if (nrow() == 0) { out.addWarning("input SpatVector has no geometries"); return out; } #ifndef GEOS350 out.setError("GEOS 3.5 required for delaunay"); return out; #endif #ifndef GEOS3100 if (constrained) { out.setError("GEOS 3.10 required for constrained delaunay"); return out; } #else GEOSContextHandle_t hGEOSCtxt = geos_init(); SpatVector a = aggregate(false); std::vector g = geos_geoms(&a, hGEOSCtxt); GEOSGeometry* v; if (constrained) { v = GEOSConstrainedDelaunayTriangulation_r(hGEOSCtxt, g[0].get()); } else { v = GEOSDelaunayTriangulation_r(hGEOSCtxt, g[0].get(), tolerance, onlyEdges); } if (v == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } std::vector b(1); b[0] = geos_ptr(v, hGEOSCtxt); SpatVectorCollection coll = coll_from_geos(b, hGEOSCtxt); geos_finish(hGEOSCtxt); out = coll.get(0); out.srs = srs; if (!out.hasError()) { out = out.disaggregate(false); // associate with attributes } return out; #endif } SpatVector SpatVector::buffer(std::vector d, unsigned quadsegs, std::string capstyle, std::string joinstyle, double mitrelimit, bool singlesided) { // quadsegs = std::min(quadsegs, (unsigned) 180); SpatVector out; if (srs.is_empty()) { out.addWarning("unknown CRS. Results may be wrong"); } if (d.empty()) { out.setError("no buffer distance provided"); return out; } bool islonlat = is_lonlat(); if (d.size() == 1 && d[0] == 0) { islonlat = false; //faster } std::string vt = type(); if (vt == "points" || vt == "lines") { for (size_t i=0; i g = geos_geoms(this, hGEOSCtxt); std::vector b(size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* pt = GEOSBufferWithParams_r(hGEOSCtxt, g[i].get(), bufparms, d[i]); // GEOSGeometry* pt = GEOSBuffer_r(hGEOSCtxt, g[i].get(), d[i], quadsegs); if (pt == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } b[i] = geos_ptr(pt, hGEOSCtxt); } const std::vector ids = std::vector(); SpatVectorCollection coll = coll_from_geos(b, hGEOSCtxt, ids, false); GEOSBufferParams_destroy_r(hGEOSCtxt, bufparms); geos_finish(hGEOSCtxt); out = coll.get(0); out.srs = srs; out.df = df; // revdep problem with ShapePattern if (std::isnan(out.extent.xmin)) { SpatVector empty; empty.srs = srs; return empty; } return out; } // basic version of buffer, for debugging SpatVector SpatVector::buffer2(std::vector d, unsigned quadsegs) { SpatVector out; recycle(d, size()); GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector b(size()); for (size_t i = 0; i < g.size(); i++) { // Rcpp::Rcout << "buffer " << i; GEOSGeometry* pt = GEOSBuffer_r(hGEOSCtxt, g[i].get(), d[i], (int) quadsegs); // Rcpp::Rcout << " done" << std::endl; if (pt == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } b[i] = geos_ptr(pt, hGEOSCtxt); } SpatVectorCollection coll = coll_from_geos(b, hGEOSCtxt); geos_finish(hGEOSCtxt); out = coll.get(0); out.srs = srs; out.df = df; return out; } SpatVector SpatVector::intersect(SpatVector v, bool values) { SpatVector out; out.srs = srs; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); //v = v.aggregate(false); std::vector y = geos_geoms(&v, hGEOSCtxt); std::vector result; // size_t nx = size(); // size_t ny = v.size(); std::vector idx, idy; std::vector> r = which_relate(v, "intersects", true); size_t n = r[0].size(); idx.reserve(n); idy.reserve(n); for (size_t i=0; i ids; ids.reserve(n); if (type() == "points") { // idx = wr[0]; // idy = wr[1]; /* for (size_t j = 0; j < ny; j++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, y[j].get()), hGEOSCtxt); for (size_t i = 0; i < nx; i++) { if (GEOSPreparedIntersects_r(hGEOSCtxt, pr.get(), x[i].get())) { idx.push_back(i); idy.push_back(j); } } } */ out = subset_rows(idx); } else { //long k = 0; for (size_t i = 0; i < n; i++) { GEOSGeometry* geom = GEOSIntersection_r(hGEOSCtxt, x[idx[i]].get(), y[idy[i]].get()); if (geom == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } if (!GEOSisEmpty_r(hGEOSCtxt, geom)) { result.push_back(geos_ptr(geom, hGEOSCtxt)); //idx.push_back(i); //idy.push_back(j); ids.push_back(i); //k++; } else { GEOSGeom_destroy_r(hGEOSCtxt, geom); } } //SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt); if (!result.empty()) { SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt, ids, false, false); out = coll.get(0); out.srs = srs; } } geos_finish(hGEOSCtxt); if (!srs.is_same(v.srs, true)) { out.addWarning("different crs"); } if ((type() == "polygons") && (v.type() == "polygons") && (out.type() != "polygons")) { // intersection is point or line, return empty out = SpatVector(); out.addWarning("no intersection"); out.srs = srs; } SpatDataFrame df1, df2; n = out.nrow(); if (values) { if (n < idx.size()) { std::vector idx2, idy2; idx2.reserve(n); idy2.reserve(n); for (size_t i=0; i idx2; idx2.reserve(n); for (size_t i=0; i getRelateFun(const std::string rel) { std::function rfun; if (rel == "equals") { rfun = GEOSEquals_r; // } else if (rel == "equalidentical") { // rfun = GEOSEqualsIdentical_r; } else if (rel == "intersects") { rfun = GEOSIntersects_r; } else if (rel == "disjoint") { rfun = GEOSDisjoint_r; } else if (rel == "touches") { rfun = GEOSTouches_r; } else if (rel == "crosses") { rfun = GEOSCrosses_r; } else if (rel == "within") { rfun = GEOSWithin_r; } else if (rel == "contains") { rfun = GEOSContains_r; // } else if (rel == "containsproperly") { // rfun = GEOSContainsProperly_r; } else if (rel == "overlaps") { rfun = GEOSOverlaps_r; } else if (rel == "covers") { rfun = GEOSCovers_r; } else if (rel == "coveredby") { rfun = GEOSCoveredBy_r; } return rfun; } std::function getPrepRelateFun(const std::string rel) { std::function rfun; if (rel == "intersects") { rfun = GEOSPreparedIntersects_r; } else if (rel == "disjoint") { rfun = GEOSPreparedDisjoint_r; } else if (rel == "touches") { rfun = GEOSPreparedTouches_r; } else if (rel == "crosses") { rfun = GEOSPreparedCrosses_r; } else if (rel == "within") { rfun = GEOSPreparedWithin_r; } else if (rel == "contains") { rfun = GEOSPreparedContains_r; } else if (rel == "containsproperly") { rfun = GEOSPreparedContainsProperly_r; } else if (rel == "overlaps") { rfun = GEOSPreparedOverlaps_r; } else if (rel == "covers") { rfun = GEOSPreparedCovers_r; } else if (rel == "coveredby") { rfun = GEOSPreparedCoveredBy_r; } return rfun; } int getRel(std::string &relation) { int pattern = 1; std::string rel = relation; std::transform(rel.begin(), rel.end(), rel.begin(), ::tolower); std::vector f {"rook", "queen", "intersects", "touches", "crosses", "overlaps", "within", "contains", "covers", "coveredby", "disjoint", "equals"}; // tbd: "equalsexact", "equals" if (std::find(f.begin(), f.end(), rel) == f.end()) { if (relation.size() != 9) { pattern = 2; } else { std::string r = relation; for (size_t i=0; i<9; i++) { if (!(r.at(i) == 'T' || r.at(i) == 'F' || r.at(i) == '0' || r.at(i) == '1' || r.at(i) == '2' || r.at(i) == '*')) { pattern = 2; break; } } } } else if (rel == "rook") { relation = "F***1****"; } else if (rel == "queen") { relation = "F***T****"; } else { pattern = 0; relation = rel; } return pattern; } std::vector SpatVector::pointInPolygon(std::vector &x, std::vector &y) { std::vector out; #ifdef GEOS3120 size_t ng = size(); size_t np = x.size(); out.reserve(np); GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); for (size_t i = 0; i < ng; i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, g[i].get()), hGEOSCtxt); for (size_t j = 0; j < np; j++) { out.push_back( GEOSPreparedIntersectsXY_r(hGEOSCtxt, pr.get(), x[j], y[j])); } } # else SpatVector pnts; pnts.srs = srs; pnts.setPointsGeometry(x, y); out = relate(pnts, "intersects", true, true); # endif return out; } std::vector SpatVector::relate(SpatVector v, std::string relation, bool prepared, bool index) { // this method is redundant with "which_relate") std::vector out; int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } if ((relation == "FF*FF****") || (relation == "disjoint")) index = false; if (relation.substr(0, 5) == "equal") { prepared = false; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); out.reserve(nx * ny); if (!index) { out.reserve(nx*ny); if (pattern == 1) { for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { out.push_back( GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[j].get(), relation.c_str())); } } } else if (prepared) { std::function relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < ny; j++) { out.push_back( relFun(hGEOSCtxt, pr.get(), y[j].get())); } } } else { std::function relFun = getRelateFun(relation); for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { out.push_back( relFun(hGEOSCtxt, x[i].get(), y[j].get())); } } } } else { // use spatial index out.resize(nx*ny); std::vector items(y.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < y.size(); i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, y[i].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), y[i].get(), &(items[i])); } if (pattern == 1) { for (size_t i = 0; i < nx; i++) { // pre-select y's using tree: std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } for (size_t j = 0; j < tree_sel.size(); j++) { if (GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[tree_sel[j]].get(), relation.c_str())) { out[i * nx + tree_sel[j]] = 1; //.push_back(tree_sel[j]); } } } } else if (prepared) { std::function relFun = getPrepRelateFun(relation); for (size_t i=0; i tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } if (! tree_sel.empty()) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j=0; j < tree_sel.size(); j++) { int r = relFun(hGEOSCtxt, pr.get(), y[tree_sel[j]].get()); if (r == 2) { setError("an exception occurred"); return out; } out[i*ny + tree_sel[j]] = r; } } } } else { std::function relFun = getRelateFun(relation); for (size_t i=0; i tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } if (! tree_sel.empty()) { for (size_t j=0; j < tree_sel.size(); j++) { int r = relFun(hGEOSCtxt, x[i].get(), y[tree_sel[j]].get()); if (r == 2) { setError("an exception occurred"); return out; } out[i * ny + tree_sel[j]] = r; } } } } } geos_finish(hGEOSCtxt); return out; } std::vector> SpatVector::which_relate(SpatVector v, std::string relation, bool narm) { bool index=true; if ((relation == "FF*FF****") || (relation == "disjoint")) index = false; std::vector> out(2); int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); out[0].reserve(nx * 1.5); out[1].reserve(nx * 1.5); if (relation.substr(0, 5) == "equal") { std::function relFun = getRelateFun(relation); for (size_t i = 0; i < nx; i++) { bool none = !narm; for (size_t j = 0; j < ny; j++) { if ( relFun(hGEOSCtxt, x[i].get(), y[j].get())) { out[0].push_back(i); out[1].push_back(j); none = false; } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } else if (!index) { if (pattern == 1) { for (size_t i = 0; i < nx; i++) { bool none = !narm; for (size_t j = 0; j < ny; j++) { if ( GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[j].get(), relation.c_str())) { out[0].push_back(i); out[1].push_back(j); none = false; } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { bool none = !narm; PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < ny; j++) { if (relFun(hGEOSCtxt, pr.get(), y[j].get())) { out[0].push_back(i); out[1].push_back(j); none = false; } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } } else { std::vector items(y.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < y.size(); i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, y[i].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), y[i].get(), &(items[i])); } if (pattern == 1) { for (size_t i = 0; i < nx; i++) { // pre-select y's using tree: std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } bool none = !narm; for (size_t j = 0; j < tree_sel.size(); j++) { if (GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[tree_sel[j]].get(), relation.c_str())) { out[0].push_back(i); out[1].push_back(tree_sel[j]); none = false; } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i=0; i tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } bool none = !narm; if (! tree_sel.empty()) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j=0; j < tree_sel.size(); j++) { if (relFun(hGEOSCtxt, pr.get(), y[tree_sel[j]].get())) { out[0].push_back(i); out[1].push_back(tree_sel[j]); none = false; } } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } } geos_finish(hGEOSCtxt); return out; } std::vector> SpatVector::which_relate(std::string relation, bool narm) { bool index=true; if ((relation == "FF*FF****") || (relation == "disjoint")) index = false; std::vector> out(2); int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); size_t nx = size(); out[0].reserve(nx * 1.5); out[1].reserve(nx * 1.5); if (relation.substr(0, 5) == "equal") { std::function relFun = getRelateFun(relation); for (size_t i = 0; i < nx; i++) { bool none = !narm; for (size_t j = 0; j < nx; j++) { if ( relFun(hGEOSCtxt, x[i].get(), x[j].get())) { out[0].push_back(i); out[1].push_back(j); none = false; } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } else if (!index) { if (pattern == 1) { for (size_t i=0; i relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { bool none = !narm; PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < nx; j++) { if (relFun(hGEOSCtxt, pr.get(), x[j].get())) { out[0].push_back(i); out[1].push_back(j); none = false; } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } } else { std::vector items(x.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < x.size(); i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), x[i].get(), &(items[i])); } } if (pattern == 1) { for (size_t i = 0; i < nx; i++) { std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } bool none = !narm; for (size_t j = 0; j < tree_sel.size(); j++) { if (GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), x[tree_sel[j]].get(), relation.c_str())) { out[0].push_back(i); out[1].push_back(tree_sel[j]); none = false; } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i=0; i tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } bool none = !narm; if (! tree_sel.empty()) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j=0; j < tree_sel.size(); j++) { if (relFun(hGEOSCtxt, pr.get(), x[tree_sel[j]].get())) { out[0].push_back(i); out[1].push_back(tree_sel[j]); none = false; } } } if (none) { out[0].push_back(i); out[1].push_back(NAN); } } } } geos_finish(hGEOSCtxt); return out; } std::vector SpatVector::relate(std::string relation, bool symmetrical) { // this method is redundant with "which_relate") std::vector out; int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); if (symmetrical) { size_t s = size(); size_t n = ((s-1) * s)/2; out.reserve(n); if (pattern == 1) { for (size_t i=0; i<(s-1); i++) { for (size_t j=(i+1); j relFun = getPrepRelateFun(relation); for (size_t i=0; i<(s-1); i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j=(i+1); j relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < nx; j++) { out.push_back( relFun(hGEOSCtxt, pr.get(), x[j].get())); } } } } geos_finish(hGEOSCtxt); return out; } /* std::vector> SpatVector::which_relate(SpatVector v, std::string relation) { std::vector> out(2); int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); out[0].reserve(nx * 1.5); out[1].reserve(nx * 1.5); if (pattern == 1) { for (size_t i=0; i relFun = getPrepRelateFun(relation); for (size_t i=0; i SpatVector::relateFirst(SpatVector v, std::string relation) { int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); std::vector out; return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); std::vector out(nx, -1); if (pattern == 1) { for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { if (GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[j].get(), relation.c_str())) { out[i] = j; continue; } } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < ny; j++) { if (relFun(hGEOSCtxt, pr.get(), y[j].get())) { out[i] = j; continue; } } } } geos_finish(hGEOSCtxt); return out; } */ std::vector SpatVector::relateFirst(SpatVector v, std::string relation) { bool index=true; if ((relation == "FF*FF****") || (relation == "disjoint")) index = false; std::vector out; int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); out.resize(nx, -1); if (!index) { if (pattern == 1) { for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { if ( GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[j].get(), relation.c_str())) { out[i] = j; continue; } } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < ny; j++) { if (relFun(hGEOSCtxt, pr.get(), y[j].get())) { out[i] = j; continue; } } } } } else { std::vector items(y.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < y.size(); i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, y[i].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), y[i].get(), &(items[i])); } if (pattern == 1) { for (size_t i = 0; i < nx; i++) { std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } for (size_t j = 0; j < tree_sel.size(); j++) { if (GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[tree_sel[j]].get(), relation.c_str())) { out[i] = tree_sel[j]; continue; } } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i=0; i tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } if (! tree_sel.empty()) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j=0; j < tree_sel.size(); j++) { if (relFun(hGEOSCtxt, pr.get(), y[tree_sel[j]].get())) { out[i] = tree_sel[j]; continue; } } } } } } geos_finish(hGEOSCtxt); return out; } /* std::vector SpatVector::is_related(SpatVector v, std::string relation) { std::vector out; int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); out.resize(nx, false); if (pattern == 1) { for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { bool isrel = GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[j].get(), relation.c_str()); if (isrel) { out[i] = true; continue; } } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < ny; j++) { bool isrel = relFun(hGEOSCtxt, pr.get(), y[j].get()); if (isrel) { out[i] = true; continue; } } } } geos_finish(hGEOSCtxt); return out; } */ std::vector SpatVector::is_related(SpatVector v, std::string relation) { bool index=true; if ((relation == "FF*FF****") || (relation == "disjoint")) index = false; std::vector out; int pattern = getRel(relation); if (pattern == 2) { setError("'" + relation + "'" + " is not a valid relate name or pattern"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); out.resize(nx, false); if (!index) { if (pattern == 1) { for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { if ( GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[j].get(), relation.c_str())) { out[i] = true; continue; } } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i = 0; i < nx; i++) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j = 0; j < ny; j++) { if (relFun(hGEOSCtxt, pr.get(), y[j].get())) { out[i] = true; continue; } } } } } else { std::vector items(y.size()); TreePtr tree1 = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); for (size_t i = 0; i < y.size(); i++) { items[i] = i; if (! GEOSisEmpty_r(hGEOSCtxt, y[i].get())) GEOSSTRtree_insert_r(hGEOSCtxt, tree1.get(), y[i].get(), &(items[i])); } if (pattern == 1) { for (size_t i = 0; i < nx; i++) { std::vector tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } for (size_t j = 0; j < tree_sel.size(); j++) { if (GEOSRelatePattern_r(hGEOSCtxt, x[i].get(), y[tree_sel[j]].get(), relation.c_str())) { out[i] = true; continue; } } } } else { std::function relFun = getPrepRelateFun(relation); for (size_t i=0; i tree_sel, sel; if (! GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { GEOSSTRtree_query_r(hGEOSCtxt, tree1.get(), x[i].get(), callbck, &tree_sel); } if (! tree_sel.empty()) { PrepGeomPtr pr = geos_ptr(GEOSPrepare_r(hGEOSCtxt, x[i].get()), hGEOSCtxt); for (size_t j=0; j < tree_sel.size(); j++) { if (relFun(hGEOSCtxt, pr.get(), y[tree_sel[j]].get())) { out[i] = true; continue; } } } } } } geos_finish(hGEOSCtxt); return out; } std::vector SpatVector::equals_exact(SpatVector v, double tol) { std::vector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); out.reserve(nx*ny); for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { out.push_back( GEOSEqualsExact_r(hGEOSCtxt, x[i].get(), y[j].get(), tol)); } } geos_finish(hGEOSCtxt); return out; } std::vector SpatVector::equals_exact(bool symmetrical, double tol) { std::vector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); if (symmetrical) { size_t s = size(); size_t n = ((s-1) * s)/2; out.reserve(n); for (size_t i=0; i<(s-1); i++) { for (size_t j=(i+1); j b = is_related(x, "intersects"); if (inverse) { for (size_t i=0; i r; r.reserve(b.size()); for (size_t i=0; i SpatVector::geos_distance(SpatVector v, bool parallel, std::string fun, double m) { std::vector out; dist_fn distfun; if (!get_dist_fun(distfun, fun)) { setError("invalid distance function"); return out; } size_t nx = size(); size_t ny = v.size(); GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); double d; if (parallel) { bool nyone = false; if (nx != ny) { if (ny == 1) { nyone = true; } else if ((nx == 1) && (ny > 1)) { std::swap(x, y); std::swap(nx, ny); nyone = true; } else { setError("SpatVectors have different lengths"); return out; } } if (nyone) { out.reserve(nx); for (size_t i = 0; i < nx; i++) { if ( distfun(hGEOSCtxt, x[i].get(), y[0].get(), &d)) { out.push_back(d); } else { out.push_back(NAN); } } } else { out.reserve(nx); for (size_t i = 0; i < nx; i++) { if ( distfun(hGEOSCtxt, x[i].get(), y[i].get(), &d)) { out.push_back(d); } else { out.push_back(NAN); } } } } else { out.reserve(nx*ny); for (size_t i = 0; i < nx; i++) { for (size_t j = 0; j < ny; j++) { if ( distfun(hGEOSCtxt, x[i].get(), y[j].get(), &d)) { out.push_back(d); } else { out.push_back(NAN); } } } } geos_finish(hGEOSCtxt); if (m != 1) { for (double &d : out) d *= m; } return out; } std::vector SpatVector::geos_distance(bool sequential, std::string fun, double m) { std::vector out; dist_fn distfun; if (!get_dist_fun(distfun, fun)) { setError("invalid distance function"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); size_t s = size(); double d; if (sequential) { out.reserve(s); out.push_back(0); for (size_t i=0; i<(s-1); i++) { if ( distfun(hGEOSCtxt, x[i].get(), x[i+1].get(), &d)) { out.push_back(d); } else { out.push_back(NAN); } } } else { out.reserve((s-1) * s / 2); for (size_t i=0; i<(s-1); i++) { for (size_t j=(i+1); j 0) && (gtp == sdif.type())) { return sdif.append(out, true); } return out; } SpatVector SpatVector::unite() { int n = size(); std::vector x(1, 1); SpatDataFrame d; d.add_column(x, "id_1"); SpatVector out = subset_rows(0); out.df = d; for (int i=1; i x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); std::vector result; std::vector ids; ids.reserve(size()); size_t nx = size(); size_t ny = v.size(); for (size_t i = 0; i < nx; i++) { GEOSGeometry* geom = x[i].get(); for (size_t j = 0; j < ny; j++) { geom = GEOSDifference_r(hGEOSCtxt, geom, y[j].get()); if (geom == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } if (GEOSisEmpty_r(hGEOSCtxt, geom)) { break; } } if (!GEOSisEmpty_r(hGEOSCtxt, geom)) { result.push_back(geos_ptr(geom, hGEOSCtxt)); ids.push_back(i); } else { GEOSGeom_destroy_r(hGEOSCtxt, geom); } } if (result.size() > 0) { SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt); out = coll.get(0); out.srs = srs; out.df = df.subset_rows(ids); } geos_finish(hGEOSCtxt); if (!srs.is_same(v.srs, true)) { out.addWarning("different crs"); } return out.append(v, true); */ } SpatVector SpatVector::cover(SpatVector v, bool identity, bool expand) { if (v.srs.is_empty()) { v.srs = srs; } SpatVector out = erase(v); if (identity) { SpatVector insect = intersect(v, true); out = out.append(insect, true); if (expand) { v = v.erase(insect); out = out.append(v, true); } } else { if (!expand) { v = v.crop(*this); } out = out.append(v, true); } return out; } SpatVector SpatVector::erase_agg(SpatVector v) { if ((nrow()==0) || (v.nrow() == 0)) { return(*this); } if ((type() == "points") || (v.type() == "points")) { std::vector b = is_related(v, "intersects"); std::vector r; r.reserve(b.size()); for (size_t i=0; i < b.size(); i++) { if (!b[i]) r.push_back(i); } return subset_rows(r); } SpatVector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); // this approach is nicer than the below in ::erase // but it fails if polys overlap // v = v.aggregate(false); // so we do v = v.aggregate(true); std::vector y = geos_geoms(&v, hGEOSCtxt); std::vector rids; size_t nx = size(); std::vector result; for (size_t i = 0; i < nx; i++) { GEOSGeometry* geom = GEOSDifference_r(hGEOSCtxt, x[i].get(), y[0].get()); if (geom == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } if (GEOSisEmpty_r(hGEOSCtxt, geom)) { GEOSGeom_destroy_r(hGEOSCtxt, geom); } else { result.push_back(geos_ptr(geom, hGEOSCtxt)); rids.push_back(i); } } if (!result.empty()) { std::vector ids; SpatVectorCollection coll = coll_from_geos(result, hGEOSCtxt, ids, true, false); out = coll.get(0); out.srs = srs; out.df = df.subset_rows(rids); } else { std::vector none(1, -1); out = subset_rows(none); } geos_finish(hGEOSCtxt); if (!srs.is_same(v.srs, true)) { out.addWarning("different crs"); } return out; } SpatVector SpatVector::erase(SpatVector v) { if ((nrow()==0) || (v.nrow() == 0)) { return(*this); } if ((type() == "points") || (v.type() == "points")) { std::vector b = is_related(v, "intersects"); std::vector r; r.reserve(b.size()); for (size_t i=0; i x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); size_t nx = size(); size_t ny = v.size(); std::vector rids; rids.reserve(nx); for (size_t i = 0; i < nx; i++) { bool good=true; for (size_t j = 0; j < ny; j++) { GEOSGeometry* geom = GEOSDifference_r(hGEOSCtxt, x[i].get(), y[j].get()); if (geom == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } if (GEOSisEmpty_r(hGEOSCtxt, geom)) { GEOSGeom_destroy_r(hGEOSCtxt, geom); good = false; break; } x[i] = geos_ptr(geom, hGEOSCtxt); } if (good) rids.push_back(i); } if (rids.empty()) { std::vector none(1, -1); out = subset_rows(none); } else { SpatVectorCollection coll = coll_from_geos(x, hGEOSCtxt); out = coll.get(0); out.srs = srs; out.df = df; if (rids.size() != out.nrow()) { out = out.subset_rows(rids); } } geos_finish(hGEOSCtxt); if (!srs.is_same(v.srs, true)) { out.addWarning("different crs"); } return out; } /* SpatVector SpatVector::erase(SpatVector v) { if ((type() == "points") || (v.type() == "points")) { std::vector b = relateFirst(v, "intersects"); std::vector r; r.reserve(b.size()); for (size_t i=0; i x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); std::vector rids; size_t nx = size(); size_t ny = v.size(); for (size_t i = 0; i < nx; i++) { //GEOSGeometry* geom = x[i].get(); for (size_t j = 0; j < ny; j++) { GEOSGeometry* geom = GEOSDifference_r(hGEOSCtxt, x[i].get(), y[j].get()); if (geom == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } if (GEOSisEmpty_r(hGEOSCtxt, geom)) { GEOSGeom_destroy_r(hGEOSCtxt, geom); rids.push_back(i); break; } x[i] = geos_ptr(geom, hGEOSCtxt); } } if (rids.size() < nx) { SpatVectorCollection coll = coll_from_geos(x, hGEOSCtxt); out = coll.get(0); out.df = df; out.df.remove_rows(rids); } geos_finish(hGEOSCtxt); if (!srs.is_same(v.srs, true)) { out.addWarning("different crs"); } out.srs = srs; return out; } */ SpatVector SpatVector::erase(bool sequential) { if (nrow()==0) { return(*this); } SpatVector out; if (type() != "polygons") { out.setError("not polygons"); return out; } size_t n = size(); if (n < 2) { return *this; } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector rids; if (sequential) { for (size_t i = 0; i < (n-1); i++) { for (size_t j = (i+1); j < n; j++) { GEOSGeometry* geom = GEOSDifference_r(hGEOSCtxt, x[i].get(), x[j].get()); if (geom == NULL) { out.setError("GEOS exception"); geos_finish(hGEOSCtxt); return(out); } else if (GEOSisEmpty_r(hGEOSCtxt, geom)) { GEOSGeom_destroy_r(hGEOSCtxt, geom); rids.push_back(i); break; } else { x[i] = geos_ptr(geom, hGEOSCtxt); } } } } else { std::vector y = geos_geoms(this, hGEOSCtxt); for (size_t i=0; i r(1, j); p.srs = srs; return p.remove_rows(r); */ } // also use GEOSPreparedNearestPoints_r() SpatVector SpatVector::nearest_point(SpatVector v, bool parallel, const std::string method) { SpatVector out; if ((size() == 0) || v.empty()) { out.setError("empty SpatVecor(s)"); return out; } if (!srs.is_equal(v.srs)) { out.setError("CRSs do not match"); return out; } bool lonlat = is_lonlat(); if (lonlat) { std::vector methods = {"geo", "cosine", "haversine"}; if (!is_in_vector(method, methods)) { out.setError("invalid distance method"); } } out.srs = srs; if (lonlat && (type() == "points") && (v.type() == "points")) { std::vector nlon, nlat, dist; std::vector id; std::vector> p = coordinates(); std::vector> pv = v.coordinates(); nearest_lonlat(id, dist, nlon, nlat, p[0], p[1], pv[0], pv[1], method); out.setPointsGeometry(nlon, nlat); std::vector fromid(id.size()); std::iota(fromid.begin(), fromid.end(), 0); out.df.add_column(fromid, "from_id"); out.df.add_column(p[0], "from_x"); out.df.add_column(p[1], "from_y"); out.df.add_column(id, "to_id"); out.df.add_column(nlon, "to_x"); out.df.add_column(nlat, "to_y"); out.df.add_column(dist, "distance"); return out; } GEOSContextHandle_t hGEOSCtxt = geos_init(); if (parallel) { if ((size() != v.size())) { out.setError("SpatVecors do not have the same size"); return out; } std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); std::vector b(size()); for (size_t i=0; i < x.size(); i++) { GEOSCoordSequence* csq = GEOSNearestPoints_r(hGEOSCtxt, x[i].get(), y[i].get()); GEOSGeometry* geom = GEOSGeom_createLineString_r(hGEOSCtxt, csq); b[i] = geos_ptr(geom, hGEOSCtxt); } out = vect_from_geos(b, hGEOSCtxt, "lines"); } else { SpatVector mp = v.aggregate(false); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&mp, hGEOSCtxt); std::vector b(size()); for (size_t i = 0; i < x.size(); i++) { GEOSCoordSequence* csq = GEOSNearestPoints_r(hGEOSCtxt, x[i].get(), y[0].get()); GEOSGeometry* geom = GEOSGeom_createLineString_r(hGEOSCtxt, csq); b[i] = geos_ptr(geom, hGEOSCtxt); } out = vect_from_geos(b, hGEOSCtxt, "lines"); } geos_finish(hGEOSCtxt); out.srs = srs; return out; } SpatVector SpatVector::nearest_point(const std::string method) { SpatVector out; if ((size() == 0)) { out.addWarning("empty SpatVecor"); return out; } if ((size() == 1)) { out.setError("single geometry"); return out; } size_t n = size(); out.srs = srs; bool lonlat = is_lonlat(); if (lonlat) { std::vector methods = {"geo", "cosine", "haversine"}; if (!is_in_vector(method, methods)) { out.setError("invalid distance method"); } } if (lonlat) { if (type() == "points") { std::vector nlon, nlat, dist; std::vector id; std::vector> p = coordinates(); nearest_lonlat_self(id, dist, nlon, nlat, p[0], p[1], method); out.setPointsGeometry(nlon, nlat); out.df.add_column(id, "id"); out.df.add_column(dist, "distance"); return out; } else { out.setError("not yet implement for non-point lonlat vector data"); return out; } } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector b(n); for (unsigned i = 0; i < n; i++) { SpatVector xa = remove_rows({i}); xa = xa.aggregate(false); std::vector y = geos_geoms(&xa, hGEOSCtxt); GEOSCoordSequence* csq = GEOSNearestPoints_r(hGEOSCtxt, x[i].get(), y[0].get()); GEOSGeometry* geom = GEOSGeom_createLineString_r(hGEOSCtxt, csq); b[i] = geos_ptr(geom, hGEOSCtxt); } out = vect_from_geos(b, hGEOSCtxt, "lines"); geos_finish(hGEOSCtxt); out.srs = srs; return out; } #ifdef GEOS361 // helper struct for STRtree: typedef struct { GEOSGeom g; size_t id; } item_g; int distance_fn(const void *item1, const void *item2, double *distance, void *userdata) { return GEOSDistance_r( (GEOSContextHandle_t) userdata, ((item_g *)item1)->g, ((item_g *)item2)->g, distance); } std::vector SpatVector::nearest_geometry(SpatVector v) { GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector x = geos_geoms(this, hGEOSCtxt); std::vector y = geos_geoms(&v, hGEOSCtxt); TreePtr tree = geos_ptr(GEOSSTRtree_create_r(hGEOSCtxt, 10), hGEOSCtxt); std::vector items(y.size()); bool tree_is_empty = true; for (size_t i = 0; i < y.size(); i++) { items[i].id = i; items[i].g = y[i].get(); if (!GEOSisEmpty_r(hGEOSCtxt, y[i].get())) { GEOSSTRtree_insert_r(hGEOSCtxt, tree.get(), y[i].get(), &(items[i])); tree_is_empty = false; } } std::vector out; if (tree_is_empty) { setError("cannot make spatial index"); return out; } out.resize(nrow(), -1); for (size_t i = 0; i < x.size(); i++) { if (!GEOSisEmpty_r(hGEOSCtxt, x[i].get())) { item_g item, *ret_item; item.id = -99; item.g = x[i].get(); ret_item = (item_g *) GEOSSTRtree_nearest_generic_r(hGEOSCtxt, tree.get(), &item, x[i].get(), distance_fn, hGEOSCtxt); if (ret_item != NULL) { out[i] = ret_item->id; } else { setError("GEOS error"); return out; } } } geos_finish(hGEOSCtxt); // SpatVector out = v.subset_rows(sel); return out; } #else std::vector SpatVector::nearest_geometry(SpatVector v) { setError("you need GEOS 3.6.1 for this method"); std::vector out; return out; } #endif // GEOS361 SpatVector SpatVector::cross_dateline(bool &fixed) { SpatVector out; fixed = false; if (type() == "points") { return out; } out.reserve(size()); for (size_t i=0; i 1) && ((geoms[i].extent.xmax - geoms[i].extent.xmin) > 180)) { SpatGeom g = geoms[i]; for (size_t j=0; j g = geos_geoms(this, hGEOSCtxt); std::vector b(size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* pt = GEOSGetCentroid_r(hGEOSCtxt, g[i].get()); if (pt == NULL) { out.setError("NULL geom"); geos_finish(hGEOSCtxt); return out; } b[i] = geos_ptr(pt, hGEOSCtxt); } out = vect_from_geos(b, hGEOSCtxt, "points"); geos_finish(hGEOSCtxt); out.srs = srs; out.df = df; return out; } SpatVector SpatVector::point_on_surface(bool check_lonlat) { SpatVector out; if (nrow() == 0) { out.setError("input has no geometries"); return out; } if (check_lonlat && could_be_lonlat()) { bool changed = false; SpatVector v = cross_dateline(changed); if (changed) { out = v.point_on_surface(false); out.fix_lonlat_overflow(); return out; } } GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector b(size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* pt = GEOSPointOnSurface_r(hGEOSCtxt, g[i].get()); if (pt == NULL) { out.setError("NULL geom"); geos_finish(hGEOSCtxt); return out; } b[i] = geos_ptr(pt, hGEOSCtxt); } out = vect_from_geos(b, hGEOSCtxt, "points"); geos_finish(hGEOSCtxt); out.srs = srs; out.df = df; return out; } SpatVector SpatVector::unaryunion() { SpatVector out; GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector gout(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* u = GEOSUnaryUnion_r(hGEOSCtxt, g[i].get()); if (u == NULL) { out.setError("NULL geom"); geos_finish(hGEOSCtxt); return out; } gout[i] = geos_ptr(u, hGEOSCtxt); } SpatVectorCollection coll = coll_from_geos(gout, hGEOSCtxt); geos_finish(hGEOSCtxt); out = coll.get(0); out.srs = srs; return out; } /* bool geos_buffer(GEOSContextHandle_t hGEOSCtxt, std::vector &g, double dist, unsigned nQuadSegs) { std::vector g(size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* pt = GEOSBuffer_r(hGEOSCtxt, g[i].get(), dist, nQuadSegs); if (pt == NULL) { return false; } g[i] = geos_ptr(pt, hGEOSCtxt); } return true; } */ SpatVector SpatVector::width() { SpatVector tmp; #ifndef GEOS361 tmp.setError("GEOS 3.6.1 required for width"); return tmp; #else GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector gout(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* w = GEOSMinimumWidth_r(hGEOSCtxt, g[i].get()); if (w == NULL) { tmp.setError("found NULL geom"); geos_finish(hGEOSCtxt); return tmp; } gout[i] = geos_ptr(w, hGEOSCtxt); } SpatVectorCollection coll = coll_from_geos(gout, hGEOSCtxt); geos_finish(hGEOSCtxt); tmp = coll.get(0); tmp.srs = srs; return tmp; #endif } SpatVector SpatVector::clearance() { SpatVector tmp; #ifndef GEOS361 tmp.setError("GEOS 3.6 required for clearance"); return tmp; #else GEOSContextHandle_t hGEOSCtxt = geos_init(); std::vector g = geos_geoms(this, hGEOSCtxt); std::vector gout(g.size()); for (size_t i = 0; i < g.size(); i++) { GEOSGeometry* w = GEOSMinimumClearanceLine_r(hGEOSCtxt, g[i].get()); if (w == NULL) { tmp.setError("NULL geom"); geos_finish(hGEOSCtxt); return tmp; } gout[i] = geos_ptr(w, hGEOSCtxt); } SpatVectorCollection coll = coll_from_geos(gout, hGEOSCtxt); geos_finish(hGEOSCtxt); tmp = coll.get(0); tmp.srs = srs; return tmp; #endif } bool SpatPart::is_CCW() { #ifndef GEOS370 return true; #else GEOSContextHandle_t hGEOSCtxt = geos_init(); GEOSCoordSequence *pseq; size_t n = size(); pseq = GEOSCoordSeq_create_r(hGEOSCtxt, n, 2); for (size_t i = 0; i < n; i++) { GEOSCoordSeq_setX_r(hGEOSCtxt, pseq, i, x[i]); GEOSCoordSeq_setY_r(hGEOSCtxt, pseq, i, y[i]); } char is_ccw; bool success = GEOSCoordSeq_isCCW_r(hGEOSCtxt, pseq, &is_ccw); GEOSCoordSeq_destroy_r(hGEOSCtxt, pseq); geos_finish(hGEOSCtxt); if (success) { return is_ccw != 0; } else { return true; } #endif } void SpatVector::make_CCW() { #ifndef GEOS370 setError("GEOS >= 3.7 needed for CCW"); return; #else size_t n = size(); if (n == 0) return; if (geoms[0].gtype != polygons) return; for (size_t i=0; i. #include "spatRaster.h" #include "vecmath.h" #include "sort.h" inline double rarea(const double &Ax, const double &Ay, const double &Bx, const double &By, const double &Cx, const double &Cy) { return std::abs( (Bx*Ay - Ax*By) + (Cx*By - Bx*Cy) + (Ax*Cy - Cx*Ay) ) / 2; } void sortvecs(std::vector &X, std::vector &Y, std::vector &Z) { std::vector p = sort_order_a(X); permute(X, p); permute(Y, p); permute(Z, p); p = sort_order_a(Y); permute(X, p); permute(Y, p); permute(Z, p); } std::vector> SpatRaster::win_rect(std::vector x, std::vector y, std::vector z, std::vector win, SpatOptions &opt) { sortvecs(x, y, z); win[0] = std::abs(win[0]); win[1] = std::abs(win[1]); const double h = win[0] / 2; const double w = win[1] / 2; // multiply for floating point imprecision const double rar = win[0] * win[1] * 1.00000001; double angle = std::fmod(win[2], 360.0); if (angle < 0) angle += 360.0; const bool rotated = angle != 0.0; double cphi=0, sphi=0, bigw=0, bigh=0, offh; double wcphi=0, hcphi=0, wsphi=0, hsphi=0; std::vector ox(4); std::vector oy(4); if (rotated) { angle = angle * M_PI / 180.0; cphi = cos(angle); sphi = sin(angle); wcphi= cphi * w; hcphi= cphi * h; wsphi= sphi * w; hsphi= sphi * h; ox[0] = -wcphi - hsphi; oy[0] = -wsphi + hcphi; ox[1] = wcphi - hsphi; oy[1] = wsphi + hcphi; ox[2] = wcphi + hsphi; oy[2] = wsphi - hcphi; ox[3] = -wcphi + hsphi; oy[3] = -wsphi - hcphi; bigw = (vmax(ox, false) - vmin(ox, false))/2; bigh = (vmax(oy, false) - vmin(oy, false))/2; offh = bigh * 1.00000001; } else { offh = h * 1.00000001; } const size_t nc = ncol(); const size_t nr = nrow(); size_t np = x.size() * 2; std::vector> out(2); out[0].reserve(np); out[1].reserve(np); size_t minpt = win[3] < 2 ? 1 : win[3]; std::vector rx(4); std::vector ry(4); std::vector cols(nc); std::iota(cols.begin(), cols.end(), 0); std::vector xc = xFromCol(cols); if (minpt < 2) { if (rotated) { for (size_t r=0; r=0; i--) { if (y[i] > ytop) { y.pop_back(); // above current row } else if (y[i] >= ybot) { for (long j=(nc-1); j>=0; j--) { double dist = x[i] - xc[j]; if (dist > bigw) { break; } else if (std::abs(dist) <= bigw) { rx[0] = xc[j] + ox[0]; rx[1] = xc[j] + ox[1]; rx[2] = xc[j] + ox[2]; rx[3] = xc[j] + ox[3]; // triangles apd, dpc, cpb, bpa double area = rarea(rx[0], ry[0], x[i], y[i], rx[3], ry[3]); area += rarea(rx[3], ry[3], x[i], y[i], rx[2], ry[2]); area += rarea(rx[2], ry[2], x[i], y[i], rx[1], ry[1]); area += rarea(rx[1], ry[1], x[i], y[i], rx[0], ry[0]); if (area < rar) { out[0].push_back(rnc+j); out[1].push_back(z[i]); } } } } else { break; } } } } else { for (size_t r=0; r=0; i--) { if (y[i] > ytop) { y.pop_back(); // above current row } else if (y[i] >= ybot) { for (long j=(nc-1); j>=0; j--) { double dist = x[i] - xc[j]; if (dist > w) { break; } else if (std::abs(dist) <= w) { out[0].push_back(rnc+j); out[1].push_back(z[i]); } } } else { break; } } } } } else { if (rotated) { for (size_t r=0; r tmp0, tmp1; for (long i=(np-1); i>=0; i--) { if (y[i] > ytop) { y.pop_back(); // above current row } else if (y[i] >= ybot) { bool found = false; size_t minlim = 0; for (long j=(nc-1); j>=0; j--) { double dist = x[i] - xc[j]; if (dist > bigw) { break; } else if (std::abs(dist) <= bigw) { rx[0] = xc[j] + ox[0]; rx[1] = xc[j] + ox[1]; rx[2] = xc[j] + ox[2]; rx[3] = xc[j] + ox[3]; // triangles apd, dpc, cpb, bpa double area = rarea(rx[0], ry[0], x[i], y[i], rx[3], ry[3]); area += rarea(rx[3], ry[3], x[i], y[i], rx[2], ry[2]); area += rarea(rx[2], ry[2], x[i], y[i], rx[1], ry[1]); area += rarea(rx[1], ry[1], x[i], y[i], rx[0], ry[0]); if (area < rar) { tmp0.push_back(rnc+j); tmp1.push_back(z[i]); found = true; minlim++; } } } if (found) { if (minlim >= minpt) { out[0].insert(out[0].end(), tmp0.begin(), tmp0.end()); out[1].insert(out[1].end(), tmp1.begin(), tmp1.end()); } tmp0.resize(0); tmp1.resize(0); tmp0.reserve(10); tmp1.reserve(10); } } else { break; } } } } else { for (size_t r=0; r tmp0, tmp1; for (long i=(np-1); i>=0; i--) { if (y[i] > ytop) { y.pop_back(); // above current row } else if (y[i] >= ybot) { bool found = false; size_t minlim = 0; for (long j=(nc-1); j>=0; j--) { double dist = x[i] - xc[j]; if (dist > w) { break; } else if (std::abs(dist) <= w) { tmp0.push_back(rnc+j); tmp1.push_back(z[i]); found = true; minlim++; } } if (found) { if (minlim >= minpt) { out[0].insert(out[0].end(), tmp0.begin(), tmp0.end()); out[1].insert(out[1].end(), tmp1.begin(), tmp1.end()); } tmp0.resize(0); tmp1.resize(0); tmp0.reserve(10); tmp1.reserve(10); } } else { break; } } } } } return out; } std::vector> SpatRaster::win_circle(std::vector x, std::vector y, std::vector z, std::vector win, SpatOptions &opt) { // the basic approach is from GDALGRID sortvecs(x, y, z); const double radius1 = win[0] * win[0]; const double radius2 = win[1] * win[1]; const double R12 = radius1 * radius2; double angle = std::fmod(win[2], 360.0); if (angle < 0) angle += 360.0; const bool rotated = angle != 0.0; angle = angle * M_PI / 180.0; // coefficients for coordinate system rotation. const double cf1 = rotated ? cos(angle) : 0.0; const double cf2 = rotated ? sin(angle) : 0.0; size_t minpt = win[3] < 2 ? 1 : win[3]; // for now assuming circles const double h = std::max(win[0], win[1]); // const double w = h; const size_t nc = ncol(); const size_t nr = nrow(); size_t np = x.size() * 2; std::vector> out(2); out[0].reserve(np); out[1].reserve(np); std::vector rx(4); std::vector ry(4); std::vector cols(nc); std::iota(cols.begin(), cols.end(), 0); std::vector xc = xFromCol(cols); if (minpt < 2) { for (size_t r=0; r=0; i--) { if (y[i] > ytop) { y.pop_back(); // above current row } else if (y[i] >= ybot) { bool found = false; for (long j=(nc-1); j>=0; j--) { double RX = x[i] - xc[j]; double RY = y[i] - yrow; if (rotated) { RX = RX * cf1 + RY * cf2; RY = RY * cf1 - RX * cf2; } if ((radius2 * RX * RX + radius1 * RY * RY) <= R12) { out[0].push_back(rnc+j); out[1].push_back(z[i]); found = true; } else { if (found) break; } } } else { break; } } } } else { for (size_t r=0; r tmp0, tmp1; for (long i=(np-1); i>=0; i--) { if (y[i] > ytop) { y.pop_back(); // above current row } else if (y[i] >= ybot) { bool found = false; size_t minlim = 0; for (long j=(nc-1); j>=0; j--) { double RX = x[i] - xc[j]; double RY = y[i] - yrow; if (rotated) { RX = RX * cf1 + RY * cf2; RY = RY * cf1 - RX * cf2; } if ((radius2 * RX * RX + radius1 * RY * RY) <= R12) { tmp0.push_back(rnc+j); tmp1.push_back(z[i]); found = true; minlim++; } } if (found) { if (minlim >= minpt) { out[0].insert(out[0].end(), tmp0.begin(), tmp0.end()); out[1].insert(out[1].end(), tmp1.begin(), tmp1.end()); } tmp0.resize(0); tmp1.resize(0); tmp0.reserve(10); tmp1.reserve(10); } } else { break; } } } } return out; } terra/src/date.h0000644000176200001440000001370214536376240013261 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifndef SPATDATE_GUARD #define SPATDATE_GUARD #include //#include //#include class SpatDate { public: long long v; SpatDate() {v = 0;}; SpatDate(const int& year, const int& month, const int& day); SpatDate(int doy, int year); SpatDate(const long& d) { v = d; }; // SpatDate(const std::string& s); virtual ~SpatDate(){} std::vector ymd(); int doy(); bool is_leap_year(); SpatDate operator ++(); // prefix SpatDate operator ++(int); // postfix SpatDate operator --(); // prefix SpatDate operator --(int); // postfix void operator = (const SpatDate&); }; SpatDate operator + (SpatDate&, int); SpatDate operator + (int, SpatDate&); SpatDate operator - (SpatDate&, int); int operator - (SpatDate&, SpatDate&); bool operator == (const SpatDate&, const SpatDate&); bool operator != (const SpatDate&, const SpatDate&); bool operator < (const SpatDate&, const SpatDate&); bool operator > (const SpatDate&, const SpatDate&); bool operator <= (const SpatDate&, const SpatDate&); bool operator >= (const SpatDate&, const SpatDate&); bool isleapyear(const int& year) { return (year % 4 == 0) && ((year % 400 == 0) || (year % 100 != 0 )); } std::vector month_days(int year) { if (isleapyear(year)) { std::vector md {31,29,31,30,31,30,31,31,30,31,30,31}; return md; } else { std::vector md {31,28,31,30,31,30,31,31,30,31,30,31}; return md; } } std::vector SpatDate::ymd() { int year, month, day; long x = v; if (x >= 0) { long days = 0; year = 1969; while (days <= x) { year++; days += (365 + isleapyear(year)); } x = x - days + (365 + isleapyear(year)); std::vector mdays = month_days(year); days = -1; month = -1; while (days < x) { month++; days += mdays[month]; } day = x - days + mdays[month]; month++; } else { // (x < 0) long days = 0; year = 1970; while (days > x) { year--; days -= (365 + isleapyear(year)); } x = x - (days + (365 + isleapyear(year))); x = abs(x); std::vector mdays = month_days(year); days = 0; month = 12; while (days < x) { month--; days += mdays[month]; } day = days - x +1; month++; } std::vector result {year, month, day}; return result; } int date_from_ymd(std::vector ymd) { int year = 1970; long day = -1; if (ymd[0] > 1970) { for (int i=0; i<(ymd[0]-1970); i++) { day += 365 + isleapyear(year); year++; } std::vector mdays = month_days(year); for (int i=0; i<(ymd[1]-1); i++) { day += mdays[i]; } day += ymd[2]; } else { day = -1; for (int i=0; i<(1970-ymd[0]); i++) { day -= 365 + isleapyear(year); year--; } std::vector mdays = month_days(year); for (int i=0; i<(ymd[1]-1); i++) { day += mdays[i]; } day += ymd[2]; } return(day); } bool SpatDate::is_leap_year() { std::vector d = ymd(); return isleapyear( d[0] ); } SpatDate::SpatDate(const int& year, const int& month, const int& day) { std::vector ymd {year, month, day}; v = date_from_ymd(ymd); } SpatDate::SpatDate(int doy, int year) { if (doy == 0) doy = 1; if (doy < 0) { // this is a weird case, but let's try to handle it while ( doy < 0 ) { year--; doy = doy + 365 + isleapyear(year); } doy = 365 + isleapyear(year) - doy; } else { while ( doy > 366 ) { doy = doy - 365 - isleapyear(year); year++; } } std::vector mdays = month_days(year); int month= 0 ; while ( doy > mdays[month] ) { doy = doy - mdays[month]; month++; } SpatDate(year, month+1, doy); } int SpatDate::doy() { std::vector d = ymd(); std::vector mdays = month_days(d[0]); int doy = 0; for (int i=0; i < d[1]-1; i++) { doy = doy + mdays[i]; } return( doy + d[2] ); } bool operator == (const SpatDate& d1,const SpatDate& d2){ return (d1.v == d2.v); } bool operator !=(const SpatDate& d1, const SpatDate& d2){ return (d1.v != d2.v); } inline SpatDate next_date(const SpatDate& d) { SpatDate x(d.v+1); return x; } inline SpatDate previous_date(const SpatDate& d){ SpatDate x(d.v-1); return x; } SpatDate SpatDate::operator ++(int){ SpatDate d = *this; *this = next_date(d); return d; } SpatDate SpatDate::operator ++() { *this = next_date(*this); return *this; } SpatDate SpatDate::operator --(int){ SpatDate d = *this; *this = previous_date(d); return d; } SpatDate SpatDate::operator --(){ *this = previous_date(*this); return *this; } bool operator < (const SpatDate& d1, const SpatDate& d2){ return (d1.v < d2.v); } bool operator <=(const SpatDate& d1, const SpatDate& d2){ return (d1.v <= d2.v); } bool operator >=(const SpatDate& d1, const SpatDate& d2) { return (d1.v >= d2.v); } bool operator > (const SpatDate& d1, const SpatDate& d2) { return (d1.v > d2.v); } int operator - (SpatDate& d1, SpatDate& d2) { return (d1.v - d2.v); } SpatDate operator +(SpatDate &d1, int x){ return SpatDate(d1.v + x); } SpatDate operator +(int x, SpatDate &d1) { return SpatDate(d1.v + x); } SpatDate operator -(SpatDate &d1, int x){ return SpatDate(d1.v - x); } void SpatDate::operator =(const SpatDate &d){ this->v = d.v; } #endif terra/src/mediancut.cpp0000644000176200001440000000507314720502767014652 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . /* #include "spatRaster.h" make_cut <- function(x) { j <- length(x) out <- vector("list", 2*j) for (i in 1:j) { rgb <- x[[i]] if (NROW(rgb) <= 1) { out[[i]] <- rgb j <- j - 1 next } rng <- apply(rgb[,-1], 2, function(i) diff(range(i))) if (max(rng) == 0) { out[[i]] <- rgb j <- j - 1 next } p <- which.max(rng) + 1 m <- median(rgb[,p]) out[[i]] <- rgb[rgb[,p] >= m, ,drop=FALSE] out[[i+j]] <- rgb[rgb[,p] < m, ,drop=FALSE] } i <- sapply(out, is.null) out <- out[!i] i <- sapply(out, nrow) > 0 out[i] } median_cut <- function(v) { v <- list(v) n <- 0 while ((length(v) < 129) & (length(v) > n)) { n <- length(v) v <- make_cut(v) } s <- sapply(v, function(i) max(apply(i[,-1,drop=FALSE], 2, function(j) diff(range(j))))) n <- 256 - length(v) ss <- rev(sort(s)) ss <- max(2, min(ss[1:n])) i <- which(s > ss) if (length(i) > 0) { vv <- make_cut(v[i]) v <- c(v[-i], vv) } v <- lapply(1:length(v), function(i) cbind(group=i, v[[i]])) do.call(rbind, v) } SpatRatser SpatRaster::RGB2col(std::string stretch, SpatOptions &opt) { std::vector idx = x.RGB(); SpatRaster out = geometry(1); if (idx.size() != 3) { out.setError("x does not have a valid RGB attribute"); return out; } if (vmax(idx) >= x.nlyr()) { out.setError("invalid RGB indices") } *this = subset(idx); if (stretch != "") { if (stretch == "lin") { } else if (stretch == "hist") { } else { out.addWarning("invalid stretch option"); } } v <- cbind(id=1:ncell(x), values(x)) v <- median_cut(stats::na.omit(v)) a <- aggregate(v[,3:5], list(v[,1]), median) a$cols <- grDevices::rgb(a[,2], a[,3], a[,4], maxColorValue=255) m <- merge(v[,1:2], a[, c(1,5)], by=1) r <- rast(x, 1) r[m$id] <- m$group - 1 coltab(r) <- a$cols if (filename != "") { r <- writeRaster(r, filename, overwrite, ...) } r } ) */ terra/src/file_utils.h0000644000176200001440000000276014552724316014504 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifndef FILEUTILS_GUARD #define FILEUTILS_GUARD bool file_exists(const std::string& name); bool path_exists(std::string path); bool filepath_exists(const std::string& name); bool can_write(std::vector filenames, std::vector srcnames, bool overwrite, std::string &msg); std::string getFileExt(const std::string& s); std::string setFileExt(const std::string& s, const std::string& ext); std::string basename(std::string filename); std::string basename_noext(std::string filename); std::string noext(std::string filename); std::string tempFile(std::string tmpdir, std::string fname, std::string ext); std::string dirname(std::string filename); bool write_text(std::string filename, std::vector s); std::vector read_text(std::string filename); #endif terra/src/spatRaster.cpp0000644000176200001440000020031714754675115015034 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "string_utils.h" #include "file_utils.h" #include "spatTime.h" #include "recycle.h" #include "vecmath.h" #include #ifdef useGDAL #include "crs.h" #endif SpatRaster::SpatRaster(std::string fname, std::vector subds, std::vector subdsname, std::vector drivers, std::vector options) { #ifdef useGDAL constructFromFile(fname, subds, subdsname, drivers, options, false); #endif } SpatRaster::SpatRaster(std::vector fname, std::vector subds, std::vector subdsname, bool multi, std::vector drivers, std::vector options, std::vector xyz, bool noflip) { if (fname.empty()) { setError("no filename"); return; } #ifdef useGDAL if (multi) { constructFromFileMulti(fname[0], subds, subdsname, drivers, options, xyz); return; } if (!constructFromFile(fname[0], subds, subdsname, drivers, options, noflip)) { //setError("cannot open file: " + fname[0]); return; } SpatOptions opt; for (size_t i=1; i &s) { source = s; } void SpatRaster::setSource(SpatRasterSource &s) { s.resize(s.nlyr); // appears to be necessary! source = {s}; } SpatRaster::SpatRaster(SpatRasterSource &s) { source = {s}; } SpatRaster::SpatRaster() { SpatRasterSource s; s.nrow = 10; s.ncol = 10; s.extent = SpatExtent(); s.memory = true; s.filename = ""; //s.driver = ""; s.nlyr = 1; // or 0? s.resize(1); s.hasRange = { false }; s.hasValues = false; s.valueType = { 0 }; s.layers.resize(1, 0); s.dtype = ""; s.names = {"lyr.1"}; s.srs.proj4 = "+proj=longlat +datum=WGS84"; s.srs.wkt = "GEOGCRS[\"WGS 84\", DATUM[\"World Geodetic System 1984\", ELLIPSOID[\"WGS 84\",6378137,298.257223563, LENGTHUNIT[\"metre\",1]]], PRIMEM[\"Greenwich\",0, ANGLEUNIT[\"degree\",0.0174532925199433]], CS[ellipsoidal,2], AXIS[\"geodetic latitude (Lat)\",north, ORDER[1], ANGLEUNIT[\"degree\",0.0174532925199433]], AXIS[\"geodetic longitude (Lon)\",east, ORDER[2], ANGLEUNIT[\"degree\",0.0174532925199433]], USAGE[ SCOPE[\"Horizontal component of 3D system.\"], AREA[\"World.\"], BBOX[-90,-180,90,180]], ID[\"EPSG\",4326]]"; setSource(s); } /* SpatRaster SpatRaster::dropSource() { SpatRaster out = geometry(); out.source.resize(0); return out; } */ SpatRaster SpatRaster::subsetSource(size_t snr) { if (snr >= source.size()) { SpatRaster out; out.setError("invalid source number"); return out; } SpatRaster out(source[snr]); return out; } bool SpatRaster::hasValues() { // if (source.size() == 0) { // return false; // } else { return source[0].hasValues ; // } } SpatRaster::SpatRaster(std::vector rcl, std::vector ext, std::string crs) { SpatRasterSource s; rcl.resize(3, 1); s.nrow=rcl[0]; s.ncol=rcl[1]; s.extent.xmin = ext[0]; s.extent.xmax = ext[1]; s.extent.ymin = ext[2]; s.extent.ymax = ext[3]; s.hasValues = false; s.hasRange = {false}; s.valueType = { 0 }; s.memory = true; s.filename = ""; //s.driver = ""; s.nlyr = rcl[2]; s.layers.resize(1, 0); //s.layers.resize(1, s.nlyr); //std::iota(s.layers.begin(), s.layers.end(), 0); s.dtype = ""; #ifdef useGDAL std::string msg; if (!s.srs.set( crs, msg )) { setError(msg); return; } else if (!msg.empty()) { addWarning(msg); } #else s.srs.proj4 = lrtrim_copy(crs); #endif for (size_t i=0; i < rcl[2]; i++) { s.names.push_back("lyr." + std::to_string(i+1)) ; } setSource(s); } SpatRaster::SpatRaster(size_t nr, size_t nc, size_t nl, SpatExtent ext, std::string crs) { SpatRasterSource s; s.nrow = nr; s.ncol = nc; s.extent = ext; s.hasValues = false; s.memory = true; s.filename = ""; //s.driver = ""; s.nlyr = nl; s.hasRange = { false }; s.valueType = { 0 }; s.layers.resize(1, 0); //s.layers.resize(1, _nlyr); //std::iota(s.layers.begin(), s.layers.end(), 0); s.dtype = ""; #ifdef useGDAL std::string msg; if (!s.srs.set(crs, msg )) { setError(msg); return; } else if (!msg.empty()) { addWarning(msg); } #else s.srs.proj4 = lrtrim_copy(crs); #endif for (size_t i=0; i < nl; i++) { s.names.push_back("lyr." + std::to_string(i+1)) ; } setSource(s); } /* SpatRaster::SpatRaster(const SpatRaster &r) { source.nrow = r.nrow; source.ncol = r.ncol; source.extent = r.extent; source.crs = r.crs; source.memory = true; nlyrs = (nlyrs < 1) ? nlyr(): nlyrs; source.resize(nlyrs); source.values.resize(0); std::vector nms(s.nlyr); for (size_t i=0; i < s.nlyr; i++) { nms[i] = "lyr" + std::to_string(i+1); } source.names = nms; // would still need "setSource" to set } */ SpatRaster SpatRaster::geometry(long nlyrs, bool properties, bool time, bool units, bool tags) { SpatRasterSource s; //s.values.resize(0); s.nrow = nrow(); s.ncol = ncol(); s.extent = getExtent(); s.srs = source[0].srs; //s.prj = prj; s.memory = true; s.hasValues = false; long nl = nlyr(); bool keepnlyr = ((nlyrs == nl) || (nlyrs < 1)); nlyrs = (keepnlyr) ? nlyr(): nlyrs; // should be within "if (keepnlyr)" block? if (properties) { s.hasColors = hasColors(); s.cols = getColors(); s.hasCategories = hasCategories(); s.cats = getCategories(); } s.resize(nlyrs); std::vector nms; if (keepnlyr) { nms = getNames(); if (time && hasTime()) { s.hasTime = true; s.timestep = getTimeStep(); s.timezone = getTimeZone(); s.time = getTime(); } if (units && hasUnit()) { s.hasUnit = true; s.unit = getUnit(); } std::vector un = getSourceNames(); std::sort(un.begin(), un.end() ); un.erase(std::unique(un.begin(), un.end()), un.end()); if (un.size() == 1) { s.source_name = un[0]; } un = getLongSourceNames(); std::sort(un.begin(), un.end() ); un.erase(std::unique(un.begin(), un.end()), un.end()); if (un.size() == 1) { s.source_name_long = un[0]; } if (tags) { s.lyrTags = getAllLyrTags(); } } else { for (size_t i=0; i < s.nlyr; i++) { nms.push_back("lyr" + std::to_string(i+1)); } } s.names = nms; SpatRaster out(s); if (keepnlyr && properties) { out.rgb = rgb; out.rgbtype = rgbtype; out.rgblyrs = rgblyrs; } if (tags) { out.user_tags = user_tags; } return out; } SpatRaster SpatRaster::geometry_opt(long nlyrs, bool properties, bool time, bool units, bool tags, bool datatype, SpatOptions &opt) { if (datatype && hasValues() && (!opt.datatype_set)) { std::vector dt = getDataType(true, true); if ((dt.size() == 1) && !dt[0].empty()) { if (!hasScaleOffset()) { opt.set_datatype(dt[0]); } } } return geometry(nlyrs, properties, time, units, tags); } SpatRaster SpatRaster::deepCopy() { return *this; } std::vector SpatRaster::resolution() { SpatExtent extent = getExtent(); return std::vector { (extent.xmax - extent.xmin) / ncol(), (extent.ymax - extent.ymin) / nrow() }; } SpatRaster SpatRaster::setResolution(double xres, double yres) { SpatRaster out; if ((xres <= 0) | (yres <= 0)) { out.setError("resolution must be larger than 0"); return(out); } SpatExtent e = getExtent(); size_t nc = std::max(1., round((e.xmax-e.xmin) / xres)); size_t nr = std::max(1., round((e.ymax-e.ymin) / yres)); double xmax = e.xmin + nc * xres; double ymax = e.ymin + nr * yres; size_t nl = nlyr(); std::vector rcl = {nr, nc, nl}; std::vector ext = {e.xmin, xmax, e.ymin, ymax}; out = SpatRaster(rcl, ext, {""}); out.source[0].srs = source[0].srs; return out; } size_t SpatRaster::ncol() { if (source.empty()) { return 0; } else { return source[0].ncol; } } size_t SpatRaster::nrow() { if (source.empty()) { return source[0].ncol; } else { return source[0].nrow; } } size_t SpatRaster::nlyr() { size_t x = 0; for (size_t i=0; i SpatRaster::filenames() { std::vector x(source.size()); for (size_t i=0; i SpatRaster::inMemory() { std::vector m(source.size()); for (size_t i=0; i SpatRaster::hasRange() { std::vector x; for (size_t i=0; i SpatRaster::getValueType(bool unique) { std::vector d; d.reserve(nlyr()); for (size_t i=0; i 3) { return false; } for (size_t i=0; i(source[i].nlyr, d); } return true; } std::vector SpatRaster::range_min() { std::vector x; for (size_t i=0; i SpatRaster::range_max() { std::vector x; for (size_t i=0; i SpatRaster::is_flipped() { std::vector x; size_t n = nsrc(); x.reserve(n); for (size_t i=0; i 361) || (e.ymin < -90.001) || (e.ymax > 90.001)) { addWarning("coordinates are out of range for lon/lat"); } return true; } return false; } bool SpatRaster::could_be_lonlat() { if (is_lonlat()) return true; SpatExtent e = getExtent(); return source[0].srs.could_be_lonlat(e); } bool SpatRaster::is_global_lonlat() { SpatExtent e = getExtent(); return source[0].srs.is_global_lonlat(e); } int SpatRaster::ns_polar() { int polar = 0; if (!is_lonlat()) { return polar; } SpatExtent e = getExtent(); if ((e.ymax - 90) > -0.00001) { polar = 1; } if ((e.ymin + 90) < 0.00001) { polar = polar == 1 ? 2 : -1; } return polar; } bool SpatRaster::sources_from_file() { for (size_t i=0; i &tmpfs, bool unique, SpatOptions &opt) { // if a tool needs to read from disk, perhaps from unique filenames // use writeRaster to write to a single file. SpatRaster out; size_t nsrc = source.size(); std::set ufs; size_t ufsize = ufs.size(); std::string tmpbasename = tempFile(opt.get_tempdir(), opt.tmpfile, "_temp_"); SpatOptions ops(opt); for (size_t i=0; i SpatRaster::getNames() { std::vector x; for (size_t i=0; i names, bool make_valid) { if (names.size() == 1) { recycle(names, nlyr()); } if (names.size() != nlyr()) { return false; } else { if (make_valid) { make_valid_names(names); make_unique_names(names); } size_t begin=0; size_t end; for (size_t i=0; i (names.begin() + begin, names.begin() + end); begin = end; } return true; } } std::vector SpatRaster::getLongSourceNames() { std::vector x; x.reserve(source.size()); for (size_t i=0; i names) { if (names.size() == 1) { for (size_t i=0; i SpatRaster::getSourceNames() { std::vector x; x.reserve(source.size()); for (size_t i=0; i names) { if (names.size() == 1) { for (size_t i=0; i flag) { size_t sz = source.size(); if (flag.size() == 1) recycle(flag, sz); if (flag.size() != sz) { return false; } double na = NAN; for (size_t i=0; i SpatRaster::getNAflag() { std::vector out(source.size(), NAN); for (size_t i=0; i SpatRaster::getTimeDbl() { std::vector t64 = getTime(); std::vector out(t64.size()); for (size_t i=0; i < out.size(); i++) { out[i] = t64[i]; } return out; } */ std::string make_string(int i, size_t n = 2) { std::string s = std::to_string(i); return std::string(n - std::min(n, s.length()), '0') + s; } std::vector SpatRaster::getTimeStr(bool addstep, std::string timesep) { std::vector out; std::vector time = getTime(); out.reserve(time.size()+addstep); if (addstep) out.push_back(source[0].timestep); if (source[0].timestep == "seconds") { std::string tz = getTimeZone(); for (size_t i=0; i < time.size(); i++) { std::vector x = get_date(time[i]); // if (x.size() > 2) { std::string s = make_string(x[0], 4) + "-" + make_string(x[1]) + "-" + make_string(x[2]) + timesep + make_string(x[3]) + ":" + make_string(x[4]) + ":" + make_string(x[5]); if (tz != "") { s = s + "z" + tz; } out.push_back(s); // } else { // out.push_back(""); // } } } else if (source[0].timestep == "days") { for (size_t i=0; i < time.size(); i++) { std::vector x = get_date(time[i]); if (x.size() > 2) { out.push_back( make_string(x[0], 4) + "-" + make_string(x[1]) + "-" + make_string(x[2]) ); } else { out.push_back(""); } } } else if (source[0].timestep == "years") { for (size_t i=0; i < time.size(); i++) { std::vector x = get_date(time[i]); out.push_back( make_string(x[0], 4) + "-00-00"); } } else if (source[0].timestep == "yearmonths") { for (size_t i=0; i < time.size(); i++) { std::vector x = get_date(time[i]); out.push_back( make_string(x[0], 4) + "-" + make_string(x[1], 2) + "-00"); } } else if (source[0].timestep == "months") { for (size_t i=0; i < time.size(); i++) { std::vector x = get_date(time[i]); out.push_back("0000-" + make_string(x[1], 2) + "-00"); } } else { for (size_t i=0; i < time.size(); i++) { out.push_back( std::to_string(time[i])); } } return out; } std::vector SpatRaster::getTime() { std::vector x; for (size_t i=0; i nas(source[i].nlyr, 0); x.insert(x.end(), nas.begin(), nas.end()); } else { x.insert(x.end(), source[i].time.begin(), source[i].time.end()); } } return(x); } std::string SpatRaster::getTimeStep() { return source[0].timestep; } std::string SpatRaster::getTimeZone() { return source[0].timezone; } bool SpatRaster::setTime(std::vector time, std::string step, std::string zone) { if (time.empty() || step == "remove") { for (size_t i=0; i (source[i].nlyr); source[i].timestep = ""; source[i].timezone = ""; source[i].hasTime = false; } return true; } if (time.size() != nlyr()) { return false; } std::vector steps = {"seconds", "raw", "days", "yearmonths", "years", "months"}; if (!is_in_vector(step, steps)) { return false; } size_t begin=0; for (size_t i=0; i (time.begin() + begin, time.begin() + end); source[i].timestep = step; source[i].timezone = zone; source[i].hasTime = true; begin = end; } return true; } std::vector SpatRaster::getDepth() { std::vector x; for (size_t i=0; i nas(source[i].nlyr, NAN); x.insert(x.end(), nas.begin(), nas.end()); } else { x.insert(x.end(), source[i].depth.begin(), source[i].depth.end()); } } return(x); } bool SpatRaster::setDepth(std::vector depths) { if (depths.empty()) { for (size_t i=0; i(source[i].nlyr); } return true; } if (depths.size() == 1) { for (size_t i=0; i (source[i].nlyr, depths[0]); } return true; } else if (depths.size() != nlyr()) { return false; } else { size_t begin=0; for (size_t i=0; i (depths.begin() + begin, depths.begin() + end); begin = end; } return true; } } bool SpatRaster::setUnit(std::vector units) { if (units.size() == 1) { bool hu = true; if (units[0].empty()) { hu = false; } for (size_t i=0; i (source[i].nlyr, units[0]); source[i].hasUnit = hu; } return true; } else if (units.size() != nlyr()) { return false; } else { size_t begin=0; for (size_t i=0; i (units.begin() + begin, units.begin() + end); source[i].hasUnit = true; begin = end; } return true; } } bool SpatRaster::hasUnit() { bool test = source[0].hasUnit; for (size_t i=1; i SpatRaster::getUnit() { std::vector x; for (size_t i=0; i nas(source[i].nlyr, ""); // x.insert(x.end(), nas.begin(), nas.end()); // } else { x.insert(x.end(), source[i].unit.begin(), source[i].unit.end()); // } } return(x); } double SpatRaster::xres() { SpatExtent extent = getExtent(); return (extent.xmax - extent.xmin) / ncol() ; } double SpatRaster::yres() { SpatExtent extent = getExtent(); return (extent.ymax - extent.ymin) / nrow() ; } std::vector SpatRaster::is_rotated() { std::vector b(source.size(), false); for (size_t i=0; i ff; for (size_t i=0; i SpatRaster::hasWindow() { std::vector out; out.reserve(nlyr()); for (size_t i=0; i rc(2); std::vector exp(4, 0); int_64 r = rowFromY(x.ymax - 0.5 * yr); if (r < 0) { rc[0] = 0; expand = true; exp[0] = trunc(abs(e.ymax - x.ymax) / yr); } else { rc[0] = r; } r = rowFromY(x.ymin + 0.5 * yr); if (r < 0) { expand = true; exp[1] = trunc((e.ymax - x.ymin) / yr); } r = colFromX(x.xmin + 0.5 * xr); if (r < 0) { rc[1] = 0; expand = true; exp[2] = trunc((x.xmin - e.xmin) / xres()); } else { rc[1] = r; } r = colFromX(x.xmax - 0.5 * xr); if (r < 0) { expand = true; exp[3] = trunc(abs(x.xmin - e.xmin) / xres()); } if (expand) { setError("expansion is not yet allowed"); return false; } for (size_t i=0; i lyrs; if (layer == 0) { out = x; lyrs.resize(n-1); std::iota(lyrs.begin(), lyrs.end(), 1); SpatRaster r = subset(lyrs, fopt); out.addSource(r, false, fopt); } else if (layer == n-1) { lyrs.resize(n-1); std::iota(lyrs.begin(), lyrs.end(), 0); out = subset(lyrs, fopt); out.addSource(x, false, fopt); } else { lyrs.resize(layer); std::iota(lyrs.begin(), lyrs.end(), 0); out = subset(lyrs, fopt); out.addSource(x, false, fopt); lyrs.resize(n-layer-1); std::iota(lyrs.begin(), lyrs.end(), layer+1); SpatRaster r = subset(lyrs, fopt); out.addSource(r, false, fopt); } return out; } SpatRaster SpatRaster::makeCategorical(long layer, SpatOptions &opt) { SpatRaster out; if (!hasValues()) { out.setError("cannot make categories if the raster has no values"); return out; } SpatRaster r; SpatOptions fopt(opt); if (layer >= 0) { if (layer > (long) nlyr()) { out.setError("layer number is too high"); return out; } std::vector lyrs = {(size_t) layer}; r = subset(lyrs, fopt); } else { r = *this; } r.math2("round", 0, fopt); std::vector> u = r.unique(true, NAN, true, fopt); std::vector names = r.getNames(); for (size_t i=0; i uu(u[i].size()); std::vector s(u[i].size()); for (size_t j=0; j (nlyr()-1)) { setError("invalid layer number"); return(false); } std::vector lyrs(1, layer); SpatRaster r = subset(lyrs, opt); std::vector> u = r.unique(false, NAN, true, opt); std::vector sl = findLyr(layer); std::vector s(u[0].size()); for (size_t i=0; i SpatRaster::hasCategories() { std::vector b; b.reserve(nlyr()); std::vector ns = nlyrBySource(); for (size_t i=0; i SpatRaster::getDataType(bool unique, bool memtype) { std::vector d; size_t n = nsrc(); d.reserve(n); for (size_t i=0; i v = source[i].valueType; std::sort(v.begin(), v.end()); v.erase(std::unique(v.begin(), v.end()), v.end()); if (v.size() == 1) { if (v[0] == 1) { if (vmax(source[i].range_min, false) > 0) { d.push_back("INT4U"); } else { d.push_back("INT4S"); } } else if (v[0] == 3) { d.push_back("INT1U"); } } else { d.push_back("FLT4S"); } } else { d.push_back(source[i].dtype); } } if (unique) { std::sort(d.begin(), d.end()); d.erase(std::unique(d.begin(), d.end()), d.end()); } return d; } std::vector SpatRaster::dataType() { std::vector d; size_t n = nsrc(); d.reserve(n); for (size_t i=0; i> SpatRaster::getMetadata(bool layers) { std::vector> d; size_t n = nsrc(); if (layers) { d.reserve(nlyr()); for (size_t i=0; i values, std::vector labels, std::string name) { if (layer > (nlyr()-1)) { setError("invalid layer number"); return(false); } if (values.size() != labels.size()) { setError("size of values is not the same as the size of labels"); return(false); } if (values.empty()) { addWarning("no labels"); return(true); } std::vector sl = findLyr(layer); SpatCategories cats; cats.d.add_column(values, "ID"); cats.d.add_column(labels, name); cats.index = 1; if (source[sl[0]].cats.size() <= sl[1]) { source[sl[0]].cats.resize(sl[1]+1); source[sl[0]].hasCategories.resize(sl[1]+1); } source[sl[0]].cats[sl[1]] = cats; source[sl[0]].hasCategories[sl[1]] = true; return true; } bool SpatRaster::setCategories(size_t layer, SpatDataFrame d, size_t index) { if (layer >= nlyr()) { setError("invalid layer number"); return(false); } std::vector sl = findLyr(layer); SpatCategories cats; cats.d = d; cats.index = index; if (source[sl[0]].cats.size() < sl[1]) { source[sl[0]].cats.resize(sl[1]); } source[sl[0]].cats[sl[1]] = cats; source[sl[0]].hasCategories[sl[1]] = true; return true; } bool SpatRaster::removeCategories(long layer) { if (layer > (((long)nlyr())-1)) { setError("invalid layer number"); return(false); } SpatCategories s; if (layer < 0) { for (size_t i=0; i sl = findLyr(layer); source[sl[0]].cats[sl[1]] = s; source[sl[0]].hasCategories[sl[1]] = false; } return true; } SpatCategories SpatRaster::getLayerCategories(size_t layer) { std::vector sl = findLyr(layer); SpatCategories cat = source[sl[0]].cats[sl[1]]; return cat; } std::vector SpatRaster::getCategories() { std::vector cats; cats.reserve(nlyr()); for (size_t i=0; i> SpatRaster::getScaleOffset() { std::vector> so(2); so[0].reserve(nlyr()); so[1].reserve(nlyr()); for (size_t i=0; i sc, std::vector of) { size_t n = sc.size(); size_t nl = nlyr(); if (n != of.size()) { setError("length of scale and offset should be the same"); return false; } if (n > nl) { setError("length of scale and offset cannot exceed the number of layers"); return false; } if (n < nl) { recycle(sc, nl); recycle(of, nl); if (n > 1) { addWarning("recycling scale and offset to the number of layers"); } } size_t k=0; size_t nc=ncell(); for (size_t i=0; i SpatRaster::getLabels(size_t layer) { std::vector out; if (layer >= nlyr()) return out; std::vector hascat = hasCategories(); if (!hascat[layer]) return out; std::vector cats = getCategories(); SpatCategories cat = cats[layer]; int nc = cat.d.ncol(); if (nc <= 0) return out; cat.index = cat.index > (nc-1) ? (nc-1) : cat.index; out = cat.d.as_string(cat.index); return out; } bool SpatRaster::setCatIndex(size_t layer, int index) { if (layer > (nlyr()-1)) { return(false); } std::vector sl = findLyr(layer); int nc = source[sl[0]].cats[sl[1]].d.ncol(); if (index < nc) { source[sl[0]].cats[sl[1]].index = index; if (index >= 0) { source[sl[0]].names[sl[1]] = source[sl[0]].cats[sl[1]].d.names[index]; } return true; } else { return false; } } int SpatRaster::getCatIndex(size_t layer) { if (layer > (nlyr()-1)) { return( -1 ); } std::vector sl = findLyr(layer); return source[sl[0]].cats[sl[1]].index; } SpatRaster SpatRaster::dropLevels() { std::vector hascats = hasCategories(); bool bany = false; for (size_t i=0; i cats = getCategories(); SpatOptions opt; SpatRaster out = *this; std::vector> uvv = unique(true, NAN, true, opt); for (size_t i=0; i uv = uvv[i]; std::vector uvi(uv.size()); for (size_t j=0; j isin; isin.reserve(n); for (size_t j=0; j SpatRaster::getColors() { std::vector cols; for (size_t i=0; i 5) { setError("n columns should be 4 or 5"); return false; } if (layer >= nlyr()) { setError("layer > nlyr"); return false; } if (cols.ncol() == 4) { std::vector a(cols.nrow(), 255); cols.add_column(a, "alpha"); } std::vector sl = findLyr(layer); if (source[sl[0]].cols.size() < (sl[1]+1)) { source[sl[0]].cols.resize(sl[1]+1); } if (source[sl[0]].hasColors.size() < (sl[1]+1)) { source[sl[0]].hasColors.resize(sl[1]+1); } source[sl[0]].cols[sl[1]] = cols; source[sl[0]].hasColors[sl[1]] = (cols.nrow() > 0); return true; } bool SpatRaster::removeColors(size_t layer) { if (layer >= nlyr()) { return false; } std::vector sl = findLyr(layer); if (source[sl[0]].hasColors[sl[1]]) { SpatDataFrame d; source[sl[0]].cols[sl[1]] = d; source[sl[0]].hasColors[sl[1]] = false; } return true; } std::vector SpatRaster::hasColors() { std::vector b(nlyr()); std::vector ns = nlyrBySource(); size_t k = 0; for (size_t i=0; i SpatRaster::cellFromXY (std::vector x, std::vector y, double missing) { // size of x and y should be the same size_t size = x.size(); std::vector cells(size); SpatExtent extent = getExtent(); double yr_inv = nrow() / (extent.ymax - extent.ymin); double xr_inv = ncol() / (extent.xmax - extent.xmin); for (size_t i = 0; i < size; i++) { // cannot use trunc here because trunc(-0.1) == 0 long row = std::floor((extent.ymax - y[i]) * yr_inv); // points in between rows go to the row below // except for the last row, when they must go up if (y[i] == extent.ymin) { row = nrow()-1 ; } long col = std::floor((x[i] - extent.xmin) * xr_inv); // as for rows above. Go right, except for last column if (x[i] == extent.xmax) { col = ncol() - 1 ; } long nr = nrow(); long nc = ncol(); if (row < 0 || row >= nr || col < 0 || col >= nc) { cells[i] = missing; } else { cells[i] = row * ncol() + col; } } return cells; } double SpatRaster::cellFromXY (double x, double y, double missing) { std::vector X = {x}; std::vector Y = {y}; std::vector cell = cellFromXY(X, Y, missing); return cell[0]; } std::vector SpatRaster::cellFromRowCol(std::vector row, std::vector col) { recycle(row, col); size_t n = row.size(); std::vector result(n); int_64 nr = nrow(); int_64 nc = ncol(); for (size_t i=0; i= nr || col[i]<0 || col[i] >= nc) ? NAN : (double)row[i] * nc + col[i]; } return result; } double SpatRaster::cellFromRowCol (int_64 row, int_64 col) { std::vector rows = {row}; std::vector cols = {col}; std::vector cell = cellFromRowCol(rows, cols); return cell[0]; } std::vector SpatRaster::cellFromRowColCombine(std::vector row, std::vector col) { size_t n = row.size(); size_t m = col.size(); double nc = ncol(); double nr = nrow(); std::vector x; x.reserve(n * m); for (size_t i=0; i= nr || col[j]<0 || col[j] >= nc) { x.push_back(NAN); } else { x.push_back(row[i] * nc + col[j]); } } } return x; } double SpatRaster::cellFromRowColCombine(int_64 row, int_64 col) { return cellFromRowCol(row, col); } std::vector SpatRaster::yFromRow(const std::vector &row) { size_t size = row.size(); std::vector result( size ); SpatExtent extent = getExtent(); double ymax = extent.ymax; double yr = yres(); int_64 nr = nrow(); for (size_t i = 0; i < size; i++) { result[i] = (row[i] < 0 || row[i] >= nr ) ? NAN : ymax - ((row[i]+0.5) * yr); } return result; } double SpatRaster::yFromRow (int_64 row) { std::vector rows = {row}; std::vector y = yFromRow(rows); return y[0]; } std::vector SpatRaster::xFromCol(const std::vector &col) { size_t size = col.size(); std::vector result( size ); SpatExtent extent = getExtent(); double xmin = extent.xmin; double xr = xres(); int_64 nc = ncol(); for (size_t i = 0; i < size; i++) { result[i] = (col[i] < 0 || col[i] >= nc ) ? NAN : xmin + ((col[i]+0.5) * xr); } return result; } double SpatRaster::xFromCol(int_64 col) { std::vector cols = {col}; std::vector x = xFromCol(cols); return x[0]; } std::vector SpatRaster::colFromX(const std::vector &x) { SpatExtent extent = getExtent(); double xmin = extent.xmin; double xmax = extent.xmax; double xr = xres(); size_t xs = x.size(); std::vector result(xs, -1); for (size_t i = 0; i < xs; i++) { if (x[i] >= xmin && x[i] < xmax ) { result[i] = trunc((x[i] - xmin) / xr); } else if (x[i] == xmax) { result[i] = ncol()-1; } } return result; } int_64 SpatRaster::colFromX(double x) { std::vector xv = {x}; return colFromX(xv)[0]; } std::vector SpatRaster::rowFromY(const std::vector &y) { SpatExtent extent = getExtent(); double ymin = extent.ymin; double ymax = extent.ymax; double yr = yres(); size_t ys = y.size(); std::vector result(ys, -1); for (size_t i = 0; i < ys; i++) { if (y[i] > ymin && y[i] <= ymax) { result[i] = trunc((ymax - y[i]) / yr); } else if (y[i] == ymin) { result[i] = nrow() - 1; } } return result; } int_64 SpatRaster::rowFromY(double y) { std::vector Y = {y}; return rowFromY(Y)[0]; } void SpatRaster::xyFromCell( std::vector> &xy ) { SpatExtent extent = getExtent(); double xmin = extent.xmin; double ymax = extent.ymax; double yr = yres(); double xr = xres(); size_t nr = nrow(); size_t nc = ncol(); xy[0].reserve(ncell()+2); xy[1].reserve(ncell()+2); for (size_t i = 0; i> SpatRaster::xyFromCell( std::vector &cell) { size_t n = cell.size(); SpatExtent extent = getExtent(); double xmin = extent.xmin; double ymax = extent.ymax; double yr = yres(); double xr = xres(); double ncells = ncell(); size_t nc = ncol(); std::vector< std::vector > out(2, std::vector (n, NAN) ); for (size_t i = 0; i= ncells)) continue; size_t row = cell[i] / nc; size_t col = cell[i] - (row * nc); out[0][i] = xmin + (col + 0.5) * xr; out[1][i] = ymax - (row + 0.5) * yr; } return out; } std::vector< std::vector> SpatRaster::xyFromCell( double cell) { std::vector vcell = {cell}; return xyFromCell(vcell); } std::vector> SpatRaster::rowColFromCell(std::vector &cell) { size_t cs = cell.size(); std::vector> result(2, std::vector (cs, -1) ); double nc = ncell(); for (size_t i = 0; i < cs; i++) { if ((cell[i] >= 0) && (cell[i] < nc )) { result[0][i] = trunc(cell[i]/ ncol()); result[1][i] = (cell[i] - ((result[0][i]) * ncol())); } } return result; } std::vector> SpatRaster::rowColFromExtent(SpatExtent e) { std::vector> xy = e.asPoints(); std::vector col = colFromX(xy[0]); std::vector row = rowFromY(xy[1]); std::vector> out = { row, col }; return out; } std::vector SpatRaster::adjacentMat(std::vector cells, std::vector mat, std::vector dim, bool include) { std::vector out; if ((dim.size() != 2) || (dim[0] % 2 == 0) || (dim[1] %2 == 0)) { setError("invalid matrix dimensions (must be odd sized)"); return out; } if ((dim[0] == 1) && (dim[1] == 1)) { setError("invalid matrix dimensions (too small)"); return out; } int dy = dim[0] / 2; int dx = dim[1] / 2; size_t n = cells.size(); int nngb = std::accumulate(mat.begin(), mat.end(), 0); out.reserve(n * (nngb + include)); std::vector offcols(nngb); std::vector offrows(nngb); size_t i = 0; size_t j = 0; for (int r = -dy; r<=dy; r++) { for (int c = -dx; c<=dx; c++) { if (mat[i]) { offrows[j] = r; offcols[j] = c; j++; } i++; } } bool globlatlon = is_global_lonlat(); std::vector> rc = rowColFromCell(cells); std::vector r = rc[0]; std::vector c = rc[1]; std::vector cols(nngb); std::vector rows(nngb); int_64 nc = ncol(); int_64 lc = nc-1; for (size_t i=0; i lc) cols[j] = cols[j] - nc; } } std::vector adjcells = cellFromRowCol(rows, cols); if (include) { out.push_back(cells[i]); } out.insert(out.end(), adjcells.begin(), adjcells.end()); } return out; } std::vector SpatRaster::adjacent(std::vector cells, std::string directions, bool include) { std::vector out; std::vector f {"rook", "queen", "bishop", "4", "8", "16"}; if (std::find(f.begin(), f.end(), directions) == f.end()) { setError("argument directions is not valid"); return(out); } size_t n = cells.size(); size_t nngb = (directions=="queen" || directions=="8") ? 8 : (directions=="16" ? 16 : 4); nngb += include; out.reserve(n * nngb); std::vector> rc = rowColFromCell(cells); std::vector r = rc[0]; std::vector c = rc[1]; bool globlatlon = is_global_lonlat(); int_64 nc = ncol(); int_64 lc = nc-1; std::vector cols, rows; if (directions == "rook" || directions == "4") { for (size_t i=0; i adjcells = cellFromRowCol(rows, cols); out.insert(out.end(), adjcells.begin(), adjcells.end()); } } else if (directions == "queen" || directions == "8") { for (size_t i=0; i adjcells = cellFromRowCol(rows, cols); out.insert(out.end(), adjcells.begin(), adjcells.end()); } } else if (directions == "bishop") { for (size_t i=0; i adjcells = cellFromRowCol(rows, cols); out.insert(out.end(), adjcells.begin(), adjcells.end()); } } else if (directions == "16") { for (size_t i=0; i lc) ? cols[j]-nc : cols[j]; } } } if (include) { out.push_back(cells[i]); } std::vector adjcells = cellFromRowCol(rows, cols); out.insert(out.end(), adjcells.begin(), adjcells.end()); } } return(out); } SpatVector SpatRaster::as_multipoints(bool narm, bool nall, SpatOptions &opt) { BlockSize bs = getBlockSize(opt); size_t ncl = ncell(); SpatVector pv; pv.reserve(1); std::vector> xy; if (!narm) { for (size_t i=0; i v, x, y; for (size_t i = 0; i < bs.n; i++) { readValues(v, bs.row[i], bs.nrows[i], 0, nc); size_t off1 = (bs.row[i] * nc); size_t vnc = bs.nrows[i] * nc; for (size_t j=0; j> xy; if ((!values) && (!narm)) { for (size_t i=0; i nms = getNames(); for (size_t i=0; i v; for (size_t i = 0; i < bs.n; i++) { readValues(v, bs.row[i], bs.nrows[i], 0, nc); size_t off1 = (bs.row[i] * nc); size_t vnc = bs.nrows[i] * nc; if (narm) { if (values) { pv.df.reserve(ncl); } for (size_t j=0; j(v.begin()+off2, v.begin()+off2+vnc); } } } readStop(); // pv.srs = source[0].srs; return(pv); } std::vector> SpatRaster::as_points_value(const double& target, SpatOptions &opt) { std::vector> xy(2); if (nlyr() > 1) { setError("can only process one layer"); return xy; } BlockSize bs = getBlockSize(opt); if (!readStart()) { return(xy); } size_t nc = ncol(); size_t ncl = ncell(); std::vector cells; cells.reserve(std::min(ncl/10, (size_t)10000)); std::vector v; if (std::isnan(target)) { for (size_t i = 0; i < bs.n; i++) { readValues(v, bs.row[i], bs.nrows[i], 0, nc); size_t base = (bs.row[i] * nc); size_t szv = v.size(); for (size_t j=0; j> SpatRaster::coordinates(bool narm, bool nall, SpatOptions &opt) { std::vector> xy(2); if ( !(narm) || (!hasValues()) ) { xyFromCell(xy); return xy; } BlockSize bs = getBlockSize(opt); if (!readStart()) { return(xy); } size_t nc = ncol(); size_t nl = nlyr(); std::vector v; for (size_t i = 0; i < bs.n; i++) { readValues(v, bs.row[i], bs.nrows[i], 0, nc); size_t off1 = (bs.row[i] * nc); size_t vnc = bs.nrows[i] * nc; for (size_t j=0; j> xyc = xyFromCell( off1+j ); xy[0].push_back(xyc[0][0]); xy[1].push_back(xyc[1][0]); } } readStop(); return(xy); } std::vector> SpatRaster::cells_notna(SpatOptions &opt) { std::vector> out(2); if (nlyr() > 1) { setError("can only process one layer"); return out; } BlockSize bs = getBlockSize(opt); if (!readStart()) { return(out); } size_t nc = ncol(); size_t ncl = ncell(); size_t rs = std::max(ncl/50, (size_t)10000); out[0].reserve(rs); out[1].reserve(rs); for (size_t i = 0; i < bs.n; i++) { std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); size_t base = (bs.row[i] * nc); size_t szv = v.size(); for (size_t j=0; j SpatRaster::cells_notna_novalues(SpatOptions &opt) { if (nlyr() > 1) { SpatOptions topt(opt); SpatRaster x = nonan(true, topt); return x.cells_notna_novalues(opt); } std::vector out; BlockSize bs = getBlockSize(opt); if (!readStart()) { return(out); } size_t nc = ncol(); size_t ncl = ncell(); size_t rs = std::max(ncl/500, (size_t)10000); out.reserve(rs); for (size_t i = 0; i < bs.n; i++) { std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); size_t base = (bs.row[i] * nc); size_t szv = v.size(); for (size_t j=0; j &x, std::vector &y, const double &X, const double &Y, const double &xr, const double &yr) { x[0] = X - xr; y[0] = Y - yr; x[1] = X - xr; y[1] = Y + yr; x[2] = X + xr; y[2] = Y + yr; x[3] = X + xr; y[3] = Y - yr; x[4] = x[0]; y[4] = y[0]; } SpatVector SpatRaster::as_polygons(bool round, bool dissolve, bool values, bool narm, bool nall, int digits, SpatOptions &opt) { if (!hasValues()) { values = false; narm = false; dissolve=false; } if (dissolve) { return polygonize(round, values, narm, dissolve, digits, opt); } SpatVector vect; opt.ncopies = 12; if (!canProcessInMemory(opt)) { if (ncell() > 1000000) { // for testing with canPIM=false vect.setError("the raster is too large"); return vect; } } bool remove_values = false; if (narm) { if (!values) remove_values = true; values=true; } size_t nl = nlyr(); size_t nc = ncell(); if (values) { std::vector v = getValues(-1, opt); std::vector nms = getNames(); make_unique_names(nms); for (size_t i=0; i vv(v.begin()+offset, v.begin()+offset+nc); vect.add_column(vv, nms[i]); } } SpatGeom g; g.gtype = polygons; double xr = xres()/2; double yr = yres()/2; std::vector x(5); std::vector y(5); std::vector cells(ncell()) ; std::iota (std::begin(cells), std::end(cells), 0); std::vector< std::vector > xy = xyFromCell(cells); vect.reserve(cells.size()); for (int i=nc-1; i>=0; i--) { if (narm) { bool erase; if (nall) { erase = true; for (size_t j=0; j 1000000) { // for testing with canPIM=false vect.setError("the raster is too large"); return vect; } } SpatGeom g; g.gtype = lines; std::vector cols(ncol()); std::vector rows(nrow()); std::iota(std::begin(rows), std::end(rows), 0); std::iota(std::begin(cols), std::end(cols), 0); std::vector x = xFromCol(cols); std::vector y = yFromRow(rows); double xr = xres()/2; double yr = yres()/2; for (double &d : x) d = d - xr; for (double &d : y) d = d + yr; x.push_back(x[x.size()-1] + xres()); y.push_back(y[y.size()-1] - yres()); SpatExtent e = getExtent(); for (size_t i=0; i xc = {x[i], x[i]}; std::vector yc = {e.ymin, e.ymax}; SpatPart p(xc, yc); g.addPart(p); vect.addGeom(g); g.parts.resize(0); } for (size_t i=0; i xc = {e.xmin, e.xmax}; std::vector yc = {y[i], y[i]}; SpatPart p(xc, yc); g.addPart(p); vect.addGeom(g); g.parts.resize(0); } vect.srs = source[0].srs; return(vect); } bool SpatRaster::setRGB(int r, int g, int b, int alpha, std::string type) { std::vector channels; if (alpha >= 0) { channels = {r, g, b, alpha}; } else { channels = {r, g, b}; } size_t mxlyr = vmax( channels, false ); if (nlyr() <= mxlyr) { //addWarning("layer number for R, G, B, cannot exceed the number of layers"); return false; } else { size_t mnlyr = vmin( channels, false );; if (mnlyr >= 0) { rgblyrs = channels; std::vector f = {"rgb", "hsv", "hsi", "hsl"}; std::transform(type.begin(), type.end(), type.begin(), ::tolower); if (std::find(f.begin(), f.end(), type) == f.end()) { addWarning("color type must be one of: 'rgb', 'hsv', 'hsi', 'hsl'"); type = "rgb"; } rgbtype = type; rgb = true; } else { rgb = false; return false; } } return true; } std::vector SpatRaster::getRGB(){ return rgblyrs; } void SpatRaster::removeRGB(){ rgblyrs = std::vector(0); rgbtype = ""; rgb = false; } bool SpatRaster::to_memory(SpatOptions &opt) { if ((nsrc() == 1) && (source[0].memory)) { return true; } SpatRaster g = geometry(); SpatRasterSource s = g.source[0]; s.hasValues = true; s.memory = true; s.names = getNames(); s.driver = "memory"; source[0].values = getValues(-1, opt); return true; } SpatRaster SpatRaster::to_memory_copy(SpatOptions &opt) { SpatRaster m = geometry(); std::vector v = getValues(-1, opt); m.setValues(v, opt); return m; } std::vector SpatRaster::getFileBlocksize() { std::vector b; b.reserve(2 * nlyr()); for (size_t i=0; i::iterator it = user_tags.find(name); if (it == user_tags.end()) return false; user_tags.erase(it); return true; } std::string SpatRaster::getTag(std::string name) { std::map::iterator it = user_tags.find(name); if (it != user_tags.end()) return it->second; return ""; } std::vector SpatRaster::getTags() { std::vector out; out.reserve(2 * user_tags.size()); for (auto e : user_tags) { out.push_back(e.first); out.push_back(e.second); } return out; } void SpatRasterSource::addLyrTag(size_t slyr, std::string name, std::string value) { if (name != "") { if (slyr >= lyrTags.size()) lyrTags.resize(slyr+1); lyrTags[slyr][name] = value; } } void SpatRaster::addLyrTags(std::vector lyrs, std::vector names, std::vector values) { size_t n = std::max(std::max(lyrs.size(), names.size()), values.size()); if (n == 0) return; recycle(lyrs, n); recycle(names, n); recycle(values, n); size_t nl = nlyr(); for (size_t i=0; i= nl) continue; lrtrim(names[i]); lrtrim(values[i]); if (values[i] == "") { removeLyrTag(lyrs[i], names[i]); } else { std::vector sl = findLyr(lyrs[i]); source[sl[0]].addLyrTag(sl[1], names[i], values[i]); } } } bool SpatRaster::removeLyrTag(size_t lyr, std::string name) { std::vector sl = findLyr(lyr); if (sl[1] >= source[sl[0]].lyrTags.size()) return false; std::map::iterator it = source[sl[0]].lyrTags[sl[1]].find(name); if (it == source[sl[0]].lyrTags[sl[1]].end()) return false; source[sl[0]].lyrTags[sl[1]].erase(it); return true; } bool SpatRaster::removeLyrTags() { for (size_t i=0; i sl = findLyr(lyr); if (sl[1] >= source[sl[0]].lyrTags[sl[1]].size()) return ""; std::map::iterator it = source[sl[0]].lyrTags[sl[1]].find(name); if (it != source[sl[0]].lyrTags[sl[1]].end()) return it->second; return ""; } std::vector SpatRaster::getLyrTags(std::vector lyrs) { std::vector out; out.reserve(lyrs.size()); for (size_t i=0; i sl = findLyr(lyrs[i]); if (sl[1] < source[sl[0]].lyrTags.size()) { for(auto e : source[sl[0]].lyrTags[sl[1]]) { out.push_back(std::to_string(lyrs[i])); out.push_back(e.first); out.push_back(e.second); } } } return out; } std::vector> SpatRaster::getAllLyrTags() { std::vector> out; bool found = false; for (size_t i=0; i 0) { found = true; break; } } if (found) { out.reserve(nlyr()); for (size_t i=0; i> tags = source[i].lyrTags; tags.resize(source[i].nlyr); out.insert(out.end(), tags.begin(), tags.end()); } } return out; } terra/src/focal.cpp0000644000176200001440000003620014755253716013766 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "vecmath.h" std::vector rcValue(std::vector &d, const int& nrow, const int& ncol, const unsigned& nlyr, const int& row, const int& col) { std::vector out(nlyr, NAN); if ((row < 0) || (row > (nrow -1)) || (col < 0) || (col > (ncol-1))) { return out; } else { unsigned nc = nrow * ncol; unsigned cell = row * ncol + col; for (size_t i=0; i SpatRaster::focal_values(std::vector w, double fillvalue, int_64 row, int_64 nrows, SpatOptions &ops) { if (nlyr() > 1) { std::vector lyr = {0}; SpatRaster s = subset(lyr, ops); s.focal_values(w, fillvalue, row, nrows, ops); } std::vector error; if (w.size() < 2) { setError("weights matrix must have more than one side"); return(error); } for (size_t i=0; i nr ) { readnrows = nr-startrow; endoff = readnrows - (nrows+startoff); } // ?? //wr = std::min(wr, std::max((int_64)1, nrows-1)); size_t n = nrows * nc * w[0] * w[1]; int_64 nrmax = nrows + startoff + endoff - 1; //int nrmax = d.size() / ncol - 1; size_t f = 0; std::vector d; readValues(d, startrow, readnrows, 0, nc); std::vector out(n, fillvalue); // << "sr " << startrow << " so " << startoff << " rnr " << readnrows << " wr " << wr << " wc " << wc << " nrows " << nrows << std::endl; for (int_64 r=0; r < nrows; r++) { for (int_64 c=0; c < nc; c++) { for (int_64 i = -wr; i <= wr; i++) { int_64 row = r+startoff+i; if ((row < 0) || (row > nrmax)) { f += w[1]; } else { size_t bcell = row * nc; for (int_64 j = -wc; j <= wc; j++) { int_64 col = c + j; if ((col >= 0) && (col < nc)) { size_t idx = bcell+col; out[f] = d[idx]; } else if (global) { if (col < 0) { col = nc + col; } else if (col >= nc) { col = col - nc; } size_t idx = bcell+col; out[f] = d[idx]; } f++; } } } } } return out; } void focal_win_fun(const std::vector &d, std::vector &out, int nc, int srow, int nr, std::vector window, int wnr, int wnc, double fill, bool narm, bool naonly, bool naomit, bool expand, bool global, std::function&, bool)> fun) { out.resize(nc * nr); int hwc = wnc / 2; int hwr = wnr / 2; std::vector winNA(window.size(), false); for (size_t i=0; i v; v.reserve(wnr * wnc); for (int rr=0; rr nc1 ? col - nc : col; v.push_back(d[nc*row + col] * window[wi]); } else if (expand) { col = col < 0 ? 0 : col; col = col > nc1 ? nc1 : col; v.push_back(d[nc*row + col] * window[wi]); } else { if (col >= 0 && col < nc) { v.push_back(d[nc*row + col] * window[wi]); } else { v.push_back(fill * window[wi]); } } } } out[cell] = fun(v, narm); } } } void focal_win_sum(const std::vector &d, std::vector &out, int nc, int srow, int nr, std::vector window, int wnr, int wnc, double fill, bool narm, bool naonly, bool naomit, bool expand, bool global) { out.resize(nc*nr, NAN); int hwc = wnc / 2; int hwr = wnr / 2; bool nafill = std::isnan(fill); bool dofill = !(narm && nafill); std::vector winNA(window.size(), false); for (size_t i=0; i nc1 ? col - nc : col; if (narm) { if (!std::isnan(d[nc * row + col])) { value += d[nc*row + col] * window[wi]; found = true; } } else { value += d[nc*row + col] * window[wi]; } } else if (expand) { col = col < 0 ? 0 : col; col = col > nc1 ? nc1 : col; if (narm) { if (!std::isnan(d[nc * row + col])) { value += d[nc*row + col] * window[wi]; found = true; } } else { value += d[nc*row + col] * window[wi]; } } else { if (col >= 0 && col < nc) { if (narm) { if (!std::isnan(d[nc*row + col])) { value += d[nc*row + col] * window[wi]; found = true; } } else { value += d[nc*row + col] * window[wi]; } } else if (dofill) { value += fill * window[wi]; } } } } if (narm) { if (found) { out[cell] = value; } } else { out[cell] = value; } } } } void focal_win_mean(const std::vector &d, std::vector &out, int nc, int srow, int nr, std::vector window, int wnr, int wnc, double fill, bool narm, bool naonly, bool naomit, bool expand, bool global) { out.resize(nc*nr, NAN); int hwc = wnc / 2; int hwr = wnr / 2; bool nafill = std::isnan(fill); bool dofill = !(narm && nafill); std::vector winNA(window.size(), false); double winsum = 0; std::vector poswin = window; for (size_t i=0; i nc1 ? col - nc : col; if (narm) { if (!std::isnan(d[nc * row + col])) { value += d[nc * row + col] * window[wi]; winsum += poswin[wi]; } } else { value += d[nc * row + col] * window[wi]; } } else if (expand) { col = col < 0 ? 0 : col; col = col > nc1 ? nc1 : col; if (narm) { if (!std::isnan(d[nc * row + col])) { value += d[nc * row + col] * window[wi]; winsum += poswin[wi]; } } else { value += d[nc * row + col] * window[wi]; } } else { if (col >= 0 && col < nc) { if (narm) { if (!std::isnan(d[nc * row + col])) { value += d[nc * row + col] * window[wi]; winsum += poswin[wi]; } } else { value += d[nc * row + col] * window[wi]; } } else if (dofill) { value += fill; if (narm) { winsum += poswin[wi]; } } } } } if (winsum > 0) { out[cell] = value / winsum; } } } } SpatRaster SpatRaster::focal(std::vector w, std::vector m, double fillvalue, bool narm, bool naonly, bool naomit, std::string fun, bool expand, SpatOptions &opt) { std::vector f {"modal", "min", "max", "first"}; auto it = std::find(f.begin(), f.end(), fun); bool props = (it != f.end()); SpatRaster out = geometry(-1, props); bool global = is_global_lonlat(); size_t nl = nlyr(); if (!source[0].hasValues) { return(out); } if (w.size() != 2) { out.setError("size of w is not 1 or 2"); return out; } if ((w[0] % 2) == 0 || (w[1] % 2) == 0) { out.setError("w must be odd sized"); return out; } unsigned ww = w[0] * w[1]; if (ww < 3) { out.setError("not a meanigful window"); return out; } if (ww != m.size()) { out.setError("weights matrix size does not match prod(w)"); return out; } size_t nc = ncol(); size_t nr = nrow(); if (w[0] > (nr*2)) { out.setError("nrow(w) > 2 * nrow(x)"); return out; } if (w[1] > (nc*2)) { out.setError("ncol(w) > 2 * ncol(x)"); return out; } if (!readStart()) { out.setError(getError()); return(out); } // opt.ncopies += 2; opt.minrows = w[0] > nr ? nr : w[0]; if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t hw0 = w[0]/2; size_t dhw0 = hw0 * 2; //size_t fsz = hw0*nc; size_t fsz2 = dhw0*nc; bool dofun = false; std::function&, bool)> fFun; if ((fun != "mean") && (fun != "sum")) { if (!haveFun(fun)) { out.setError("unknown function argument"); return out; } fFun = getFun(fun); dofun = true; } std::vector fill; if (nl == 1) { for (size_t i = 0; i < out.bs.n; i++) { unsigned rstart, roff; unsigned rnrows = out.bs.nrows[i]; if (i == 0) { rstart = 0; roff = dhw0; if (i != (out.bs.n-1)) { rnrows += hw0; } } else { rstart = out.bs.row[i] + hw0; roff = hw0; if (i == (out.bs.n-1)) { rnrows -= hw0; } } std::vector vout, vin; readValues(vin, rstart, rnrows, 0, nc); vout.clear(); if (i==0) { if (expand) { fill.reserve(dhw0 * nc); for (size_t i=0; i vout, voutcomb, vin, vincomb; size_t off=0; readValues(vincomb, rstart, rnrows, 0, nc); off = nc * rnrows; //out.bs.nrows[i]; voutcomb.reserve(vincomb.size()); for (size_t lyr=0; lyr& v, size_t s, size_t e); double median_se(const std::vector& v, size_t s, size_t e); double sum_se_rm(const std::vector& v, size_t s, size_t e); double sum_se(const std::vector& v, size_t s, size_t e); double sum2_se_rm(const std::vector& v, size_t s, size_t e); double sum2_se(const std::vector& v, size_t s, size_t e); double prod_se_rm(const std::vector& v, size_t s, size_t e); double prod_se(const std::vector& v, size_t s, size_t e); double mean_se_rm(const std::vector& v, size_t s, size_t e); double mean_se(const std::vector& v, size_t s, size_t e); double sd_se_rm(const std::vector& v, size_t s, size_t e); double sd_se(const std::vector& v, size_t s, size_t e); double sdpop_se_rm(const std::vector& v, size_t s, size_t e); double sdpop_se(const std::vector& v, size_t s, size_t e); double min_se_rm(const std::vector& v, size_t s, size_t e); double min_se(const std::vector& v, size_t s, size_t e); double max_se_rm(const std::vector& v, size_t s, size_t e); double max_se(const std::vector& v, size_t s, size_t e); double first_se_rm(std::vector& v, size_t s, size_t e); double first_se(std::vector& v, size_t s, size_t e); double which_se_rm(const std::vector& v, size_t s, size_t e); double which_se(const std::vector& v, size_t s, size_t e); double whichmin_se_rm(const std::vector& v, size_t s, size_t e); double whichmin_se(const std::vector& v, size_t s, size_t e); double whichmax_se_rm(const std::vector& v, size_t s, size_t e); double whichmax_se(const std::vector& v, size_t s, size_t e); double all_se_rm(const std::vector& v, size_t s, size_t e); double all_se(const std::vector& v, size_t s, size_t e); double any_se_rm(const std::vector& v, size_t s, size_t e); double any_se(const std::vector& v, size_t s, size_t e); std::vector range_se_rm(std::vector& v, size_t s, size_t e); std::vector range_se(std::vector& v, size_t s, size_t e); double modal_se_rm(std::vector& v, size_t s, size_t e); double modal_se(std::vector& v, size_t s, size_t e); double isna_se(const std::vector& v, size_t s, size_t e); double isnotna_se(const std::vector& v, size_t s, size_t e); void cumsum_se_rm(std::vector& v, size_t s, size_t e); void cumsum_se(std::vector& v, size_t s, size_t e); void cumprod_se_rm(std::vector& v, size_t s, size_t e); void cumprod_se(std::vector& v, size_t s, size_t e); void cummax_se_rm(std::vector& v, size_t s, size_t e); void cummax_se(std::vector& v, size_t s, size_t e); void cummin_se_rm(std::vector& v, size_t s, size_t e); void cummin_se(std::vector& v, size_t s, size_t e); //double sum_se_rm(const std::vector& v, const std::vector &w, size_t s, size_t e); //double sum_se(const std::vector& v, const std::vector &w, size_t s, size_t e); //double mean_se_rm(const std::vector& v, const std::vector &w, size_t s, size_t e); //double mean_se(const std::vector& v, const std::vector &w, size_t s, size_t e); //double min_se_rm(const std::vector& v, const std::vector &w, size_t s, size_t e); //double min_se(const std::vector& v, const std::vector &w, size_t s, size_t e); //double max_se_rm(const std::vector& v, const std::vector &w, size_t s, size_t e); //double max_se(const std::vector& v, const std::vector &w, size_t s, size_t e); bool haveseFun(std::string fun); bool getseFun(std::function&, size_t, size_t)> &fun, std::string fname, bool narm); bool haveseWFun(std::string fun); bool getseWfun(std::function&, std::vector&, size_t, size_t)> &fun, std::string fname, bool narm); #endif terra/src/spatVector2.h0000644000176200001440000003224414536376240014562 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . /* #ifndef SPATVECTOR2_GUARD #define SPATVECTOR2_GUARD #include "spatBase.h" #include "spatDataframe.h" #ifdef useGDAL #include "gdal_priv.h" #endif class SpatVector2 { // g // geom gparts (cumulative) // 1 4 // 2 5 // 3 8 // 4 9 // p & h //part p h // 1 10 -1 // 2 22 -1 // 3 28 -1 // 4 36 1 // 1 40 -1 public: std::vector X; std::vector Y; std::vector Z; std::vector G; // number of parts per geom, cumulative std::vector P; // part offsets std::vector H; // hole SpatGeomType gtype = null; SpatExtent extent; SpatDataFrame df; //std::vector crs; SpatSRS srs; SpatVector2(); SpatVector to_old(); SpatVector2 from_old(SpatVector x); size_t ngeoms(); }; */ /* bool is_proxy = false; std::string read_query = ""; std::vector read_extent; std::string source = ""; std::string source_layer = ""; size_t geom_count = 0; SpatVector2(); //SpatVector(const SpatVector &x); SpatVector2(SpatGeom g); SpatVector2(SpatExtent e, std::string crs); SpatVector2(std::vector x, std::vector y, SpatGeomType g, std::string crs); SpatVector2(std::vector wkt); virtual ~SpatVector2(){} SpatGeom window; // for point patterns, must be polygon std::vector get_names(); void set_names(std::vector s); unsigned nrow(); unsigned ncol(); unsigned nxy(); SpatVector2 deepCopy() {return *this;} SpatExtent getExtent(); // bool is_geographic(); bool is_lonlat(); bool could_be_lonlat(); std::string type(); SpatGeomType getGType(std::string &type); SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} //std::vector getCRS(); //void setCRS(std::vector _crs); bool setSRS(std::string _srs) { std::string msg; if (!srs.set(_srs, msg)){ addWarning("Cannot set SRS to vector: "+ msg); return false; } return true; } std::string getSRS(std::string x) { return srs.get(x); } SpatGeom getGeom(unsigned i); bool addGeom(SpatGeom2 p); bool setGeom(SpatGeom2 p); bool replaceGeom(SpatGeom2 p, unsigned i); std::vector> getGeometry(); SpatDataFrame getGeometryDF(); std::vector getGeometryWKT(); void computeExtent(); size_t ncoords(); std::vector> coordinates(); SpatVector project(std::string crs); */ /* std::vector project_xy(std::vector x, std::vector y, std::string fromCRS, std::string toCRS); SpatVector subset_cols(int i); SpatVector subset_cols(std::vector range); SpatVector subset_rows(int i); SpatVector subset_rows(std::vector range); SpatVector subset_rows(std::vector range); SpatVector remove_rows(std::vector range); void setGeometry(std::string type, std::vector gid, std::vector part, std::vector x, std::vector y, std::vector hole); void setPointsGeometry(std::vector &x, std::vector &y); void setPointsDF(SpatDataFrame &x, std::vector geo, std::string crs, bool keepgeom); std::vector area(std::string unit, bool transform, std::vector mask); void reserve(size_t n); std::vector length(); std::vector distance(SpatVector x, bool pairwise, std::string unit); std::vector pointdistance(const std::vector& px, const std::vector& py, const std::vector& sx, const std::vector& sy, bool pairwise, double m, bool lonlat); // std::vector pointdistance_seq(const std::vector& px, const std::vector& py, double m, bool lonlat); std::vector distance(bool sequential, std::string unit); std::vector linedistLonLat(SpatVector pts); std::vector> knearest(size_t k); size_t size(); SpatVector as_lines(); SpatVector as_points(bool multi, bool skiplast=false); SpatVector remove_holes(); SpatVector get_holes(); SpatVector set_holes(SpatVector x, size_t i); SpatVector remove_duplicate_nodes(int digits); bool read(std::string fname, std::string layer, std::string query, std::vector extent, SpatVector filter, bool as_proxy, std::string what); bool write(std::string filename, std::string lyrname, std::string driver, bool append, bool overwrite, std::vector); #ifdef useGDAL GDALDataset* write_ogr(std::string filename, std::string lyrname, std::string driver, bool append, bool overwrite, std::vector options); GDALDataset* GDAL_ds(); bool read_ogr(GDALDataset *poDS, std::string layer, std::string query, std::vector extent, SpatVector filter, bool as_proxy, std::string what); SpatVector fromDS(GDALDataset *poDS); bool ogr_geoms(std::vector &ogrgeoms, std::string &message); bool delete_layers(std::string filename, std::vector layers, bool return_error); std::vector layer_names(std::string filename); #endif // attributes std::vector getDv(unsigned i); std::vector getIv(unsigned i); std::vector getSv(unsigned i); std::vector getItype(); std::vector getIplace(); void add_column(unsigned dtype, std::string name) { df.add_column(dtype, name); }; template bool add_column(std::vector x, std::string name) { return df.add_column(x, name); } bool add_column_bool(std::vector x, std::string name) { return df.add_column_bool(x, name); } bool add_column_time(std::vector x, std::string name, std::string step, std::string zone) { return df.add_column_time(x, name, step, zone); } bool add_column_factor(SpatFactor x, std::string name) { return df.add_column(x, name); } void remove_df() { SpatDataFrame empty; df = empty; }; bool set_df(SpatDataFrame x) { if (x.nrow() != nrow()) { setError("nrow dataframe does not match nrow geometry"); return false; } df = x; return true; }; bool remove_column(std::string field) { return df.remove_column(field); }; bool remove_column(int i) { return df.remove_column(i); }; std::vector get_datatypes() { return df.get_datatypes(); } */ /* SpatVector append(SpatVector x, bool ignorecrs); SpatVector disaggregate(bool segments); SpatVector shift(double x, double y); SpatVector rescale(double fx, double fy, double x0, double y0); SpatVector transpose(); SpatVector flip(bool vertical); SpatVector rotate(double angle, std::vector x0, std::vector y0); SpatVector normalize_longitude(); SpatVector rotate_longitude(double longitude, bool left); std::vector> linesNA(); std::vector>> linesList(); std::vector>>> polygonsList(); //ogr std::vector is_valid(); SpatVector make_valid(); //geos SpatVector make_valid2(); std::vector geos_isvalid(); std::vector geos_isvalid_msg(); std::vector wkt(); std::vector wkb(); std::vector hex(); SpatVector from_hex(std::vector x, std::string srs); SpatVector make_nodes(); SpatVector polygonize(); SpatVector normalize(); SpatVector boundary(); SpatVector line_merge(); SpatVector simplify(double tolerance, bool preserveTopology); SpatVector shared_paths(); SpatVector shared_paths(SpatVector x); SpatVector snap(double tolerance); SpatVector snapto(SpatVector y, double tolerance); SpatVector thin(double threshold); SpatVector allerretour(); SpatVectorCollection bienvenue(); SpatVector aggregate(bool dissolve); SpatVector aggregate(std::string field, bool dissolve); SpatVector buffer(std::vector d, unsigned quadsegs); SpatVector point_buffer(std::vector d, unsigned quadsegs, bool no_multipolygons); SpatVector centroid(bool check_lonlat); SpatVector point_on_surface(bool check_lonlat); SpatVector crop(SpatExtent e); SpatVector crop(SpatVector e); SpatVector voronoi(SpatVector e, double tolerance, int onlyEdges); SpatVector delaunay(double tolerance, int onlyEdges); SpatVector hull(std::string htype, std::string by=""); SpatVector intersect(SpatVector v, bool values); SpatVector unite(SpatVector v); SpatVector unite(); SpatVector erase_agg(SpatVector v); SpatVector erase(SpatVector v); SpatVector erase(bool sequential); SpatVector elongate(double length); SpatVector mask(SpatVector x, bool inverse); SpatVector gaps(); SpatVector cover(SpatVector v, bool identity, bool expand); SpatVectorCollection split(std::string field); SpatVector symdif(SpatVector v); SpatVector set_precision(double gridSize); std::vector> index_2d(SpatVector v); std::vector> index_sparse(SpatVector v); std::vector> which_relate(SpatVector v, std::string relation, bool narm); std::vector> which_relate(std::string relation, bool narm); std::vector is_related(SpatVector v, std::string relation); // std::vector relate(SpatVector v, std::string relation); std::vector relate(SpatVector v, std::string relation, bool prepared, bool index); std::vector relate(std::string relation, bool symmetrical); std::vector relateFirst(SpatVector v, std::string relation); std::vector equals_exact(SpatVector v, double tol); std::vector equals_exact(bool symmetrical, double tol); std::vector geos_distance(SpatVector v, bool parallel, std::string fun); std::vector geos_distance(bool sequential, std::string fun); SpatVector nearest_point(SpatVector v, bool parallel); SpatVector nearest_point(); std::vector nearest_geometry(SpatVector v); SpatVector sample(unsigned n, std::string method, unsigned seed); SpatVector sample_geom(std::vector n, std::string method, unsigned seed); SpatVector clearance(); SpatVector width(); SpatVector unaryunion(); SpatVector cbind(SpatDataFrame d); void fix_lonlat_overflow(); SpatVector cross_dateline(bool &fixed); SpatVector densify(double interval, bool adjust); SpatVector round(int digits); std::vector nullGeoms(); }; */ /* class SpatVectorCollection { public: virtual ~SpatVectorCollection(){} SpatVectorCollection deepCopy() { return *this; } std::vector v; std::vector names; std::vector getNames() { return names;} bool setNames(std::vector nms, bool make_valid=false); SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} size_t size() { return v.size(); } void reserve(size_t n) { v.reserve(n); names.reserve(n); } void resize(size_t n) { v.resize(n); names.resize(n); } void push_back(SpatVector x) { v.push_back(x); names.push_back(""); }; bool replace(SpatVector x, size_t i) { if (i < size()) { v[i] = x; return true; } else { return false; } } SpatVectorCollection subset(std::vector i) { SpatVectorCollection out; for (size_t j=0; j x, std::string srs); }; class SpatVectorProxy { public: SpatVector v; SpatVectorProxy(){} virtual ~SpatVectorProxy(){} SpatVectorProxy deepCopy() {return *this;} SpatVector query_filter(std::string query, std::vector extent, SpatVector filter); }; #endif // SPATVECTOR2_GUARD */ terra/src/vecmathse.cpp0000644000176200001440000004127314720502767014662 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include #include #include #include #include double median_se_rm(const std::vector& v, size_t s, size_t e) { size_t n = (e - s) + 1; std::vector vv; vv.reserve(n); for (size_t i=s; i& v, size_t s, size_t e) { size_t n = (e - s) + 1; std::vector vv; vv.reserve(n); for (size_t i=s; i& v, size_t s, size_t e) { double x = v[s]; for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s]; if (std::isnan(x)) { return(x); } for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s] * v[s]; for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s] * v[s]; if (std::isnan(x)) return(x); for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s]; for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s]; if (std::isnan(x)) { return(NAN); } for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = 0; unsigned d = 0; for (size_t i=s; i 0) { x /= (double) d; } else { x = NAN; } return x; } double mean_se(const std::vector& v, size_t s, size_t e) { double x = 0; unsigned d = 0; for (size_t i=s; i 0) { x /= (double) d; } else { x = NAN; } return x; } double sd_se_rm(const std::vector& v, size_t s, size_t e) { double m = mean_se_rm(v, s, e); if (std::isnan(m)) return m; double x = 0; size_t n = 0; for (size_t i=s; i& v, size_t s, size_t e) { double m = mean_se(v, s, e); if (std::isnan(m)) return m; double x = 0; size_t n = 0; for (size_t i=s; i& v, size_t s, size_t e) { double m = mean_se_rm(v, s, e); if (std::isnan(m)) return m; double x = 0; size_t n = 0; for (size_t i=s; i& v, size_t s, size_t e) { double m = mean_se(v, s, e); if (std::isnan(m)) return m; double x = 0; size_t n = 0; for (size_t i=s; i& v, size_t s, size_t e) { double x = v[s]; for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s]; if (std::isnan(x)) return x; for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s]; for (size_t i=(s+1); i& v, size_t s, size_t e) { double x = v[s]; if (std::isnan(x)) return x; for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=s; i& v, size_t s, size_t e) { return v[s]; } double which_se_rm(const std::vector& v, size_t s, size_t e) { for (size_t i=s; i& v, size_t s, size_t e) { return which_se_rm(v, s, e); } double whichmin_se_rm(const std::vector& v, size_t s, size_t e) { double x = v[s]; double out = s; if (std::isnan(x)) { out = NAN; } for (size_t i=(s+1); i& v, size_t s, size_t e) { return whichmin_se_rm(v, s, e); } double whichmax_se_rm(const std::vector& v, size_t s, size_t e) { double x = v[s]; double out = s; if (std::isnan(x)) { out = NAN; } for (size_t i=(s+1); i x) { x = v[i]; out = i; } } } out++; // +1 for R return (out - s); } double whichmax_se(const std::vector& v, size_t s, size_t e) { return whichmax_se_rm(v, s, e); } double all_se_rm(const std::vector& v, size_t s, size_t e) { double x = 1; for (size_t i=s; i& v, size_t s, size_t e) { double x = 1; for (size_t i=s; i& v, size_t s, size_t e) { double x = NAN; for (size_t i=s; i& v, size_t s, size_t e) { double x = 0; for (size_t i=s; i range_se_rm(std::vector& v, size_t s, size_t e) { std::vector x = { v[s], v[s] }; for (size_t i=(s+1); i range_se(std::vector& v, size_t s, size_t e) { std::vector x = { v[s], v[s] }; if (!std::isnan(x[0])) { return x; } for (size_t i=(s+1); i& v, size_t s, size_t e) { std::map count; for_each( v.begin()+s, v.begin()+e, [&count]( double val ){ if(!std::isnan(val)) count[val]++; } ); if (count.size() == 0) return NAN; std::map::iterator mode = std::max_element(count.begin(), count.end(),[] (const std::pair& a, const std::pair& b)->bool{ return a.second < b.second; } ); return mode->first; } double modal_se(std::vector& v, size_t s, size_t e) { std::map count; for(size_t i=s; i::iterator mode = std::max_element(count.begin(), count.end(),[] (const std::pair& a, const std::pair& b)->bool{ return a.second < b.second; } ); return mode->first; } double isna_se(const std::vector& v, size_t s, size_t e) { double x = 0; for (size_t i=s; i& v, size_t s, size_t e) { double x = 0; for (size_t i=s; i& v, size_t s, size_t e) { for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=(s+1); i& v, size_t s, size_t e) { for (size_t i=(s+1); i f {"sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first", "isNA", "notNA"}; auto it = std::find(f.begin(), f.end(), fun); if (it == f.end()) { return false; } return true; } bool getseFun(std::function&, size_t, size_t)> &fun, std::string fname, bool narm) { if (fname == "mean") { fun = narm ? mean_se_rm : mean_se; } else if (fname == "sum") { fun = narm ? sum_se_rm : sum_se; } else if (fname == "sum2") { fun = narm ? sum2_se_rm : sum2_se; } else if (fname == "min") { fun = narm ? min_se_rm : min_se; } else if (fname == "max") { fun = narm ? max_se_rm : max_se; } else if (fname == "median") { fun = narm ? median_se_rm : median_se; } else if (fname == "modal") { fun = narm ? modal_se_rm : modal_se; } else if (fname == "prod") { fun = narm ? prod_se_rm : prod_se; } else if (fname == "which") { fun = narm ? which_se_rm : which_se; } else if (fname == "which.min") { fun = narm ? whichmin_se_rm : whichmin_se; } else if (fname == "which.max") { fun = narm ? whichmax_se_rm : whichmax_se; } else if (fname == "any") { fun = narm ? any_se_rm : any_se; } else if (fname == "all") { fun = narm ? all_se_rm : all_se; } else if (fname == "sd") { fun = narm ? sd_se_rm : sd_se; } else if (fname == "std") { fun = narm ? sdpop_se_rm : sdpop_se; } else if (fname == "first") { fun = narm ? first_se_rm : first_se; } else if (fname == "isNA") { fun = isna_se; } else if (fname == "notNA") { fun = isnotna_se; } else { return false; } return true; } double wsum_se_rm(const std::vector& v, const std::vector& w, size_t s, size_t e) { if (w.size() == 0) return NAN; double x = 0; bool allna = true; for (size_t i=s; i& v, const std::vector& w, size_t s, size_t e) { if (w.size() == 0) return NAN; double x = 0; for (size_t i=s; i& v, const std::vector& w, size_t s, size_t e) { double sv = 0; double sw = 0; for (size_t i=s; i& v, const std::vector& w, size_t s, size_t e) { double sv = 0; double sw = 0; for (size_t i=s; i& v, const std::vector& w, size_t s, size_t e) { double x = NAN; for (size_t i=(s); i& v, const std::vector& w, size_t s, size_t e) { double x = NAN; for (size_t i=(s); i& v, const std::vector& w, size_t s, size_t e) { double x = NAN; for (size_t i=(s); i& v, const std::vector& w, size_t s, size_t e) { double x = NAN; for (size_t i=(s); i f {"sum", "mean", "min", "max"}; auto it = std::find(f.begin(), f.end(), fun); if (it == f.end()) { return false; } return true; } bool getseWfun(std::function&, std::vector&, size_t, size_t)> &fun, std::string fname, bool narm) { if (fname == "mean") { fun = narm ? wmean_se_rm : wmean_se; } else if (fname == "sum") { fun = narm ? wsum_se_rm : wsum_se; } else if (fname == "min") { fun = narm ? wmin_se_rm : wmin_se; } else if (fname == "max") { fun = narm ? wmax_se_rm : wmax_se; } else { return false; } return true; } terra/src/string_utils.cpp0000644000176200001440000001667014737142466015440 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifndef STRINGUTILS_H #define STRINGUTILS_H #include #include #include #include #include std::string double_to_string(double x) { std::string s = std::to_string(x); s.erase( s.find_last_not_of('0') + 1, std::string::npos ); s.erase( s.find_last_not_of('.') + 1, std::string::npos ); return s; } void unquote(std::string &s) { s.erase(std::remove(s.begin(), s.end(), '\"'), s.end()); } std::vector string_to_charpnt(std::vector s) { size_t n = s.size(); std::vector out(n + 1); for (size_t i = 0; i < n; i++) { out[i] = (char *) (s[i].c_str()); } out[n] = NULL; return out; } //std::vector string_to_char(std::vector s) { // std::vector charstr(s.c_str(), s.c_str() + s.size() + 1); // return charstr; //} std::vector double_to_string(const std::vector &x, std::string prep) { std::vector out(x.size()); for (size_t i=0; i v, std::string delim) { for (size_t i=0; i<(v.size()-1); i++) { v[i] = v[i] + delim; } std::string s; for (const auto &piece : v) s += piece; return s; } std::vector getlastpart (std::vector s, std::string delim) { std::vector out(s.size()); for (size_t i=0; i= end.length()) { if (s.compare(s.length() - end.length(), s.length(), end) == 0) { return false; } } return true; } std::string lower_case(std::string s) { std::transform(s.begin(), s.end(), s.begin(), ::tolower); return s; } void lowercase(std::string &s) { std::transform(s.begin(), s.end(), s.begin(), ::tolower); } void lowercase(std::vector &ss) { for (std::string &s : ss) lowercase(s); } bool is_in_vector(std::string s, std::vector ss) { //std::set sset (ss.begin(), ss.end()); //return sset.find(s) != sset.end(); auto it = std::find (ss.begin(), ss.end(), s); return (it != ss.end()); } int where_in_vector(std::string s, const std::vector &ss, const bool &tolower) { int i = -1; if (tolower) lowercase(s); auto it = std::find (ss.begin(), ss.end(), s); if (it != ss.end()) { i = std::distance(ss.begin(), it); } return i; } std::string is_in_set_default(std::string s, std::vector ss, std::string defvalue, bool tolower) { if (tolower) lowercase(s); std::set sset (ss.begin(), ss.end()); if (sset.find(s) == sset.end() ) { s = defvalue; } return s; } std::vector strsplit(std::string s, std::string delimiter){ std::vector out; size_t pos = 0; while ((pos = s.find(delimiter)) != std::string::npos) { out.push_back(s.substr(0, pos)); s.erase(0, pos + delimiter.length()); } out.push_back(s.substr(0, pos)); return out; } std::vector strsplit_first(std::string s, std::string delimiter){ std::vector out; size_t pos = 0; if ((pos = s.find(delimiter)) != std::string::npos) { out.push_back(s.substr(0, pos)); s.erase(0, pos + delimiter.length()); } out.push_back(s); return out; } std::vector str2dbl(std::vector s) { std::vector d (s.size()); std::transform(s.begin(), s.end(), d.begin(), [](const std::string& val) { return std::stod(val); }); return d; } std::vector str2long(std::vector s) { std::vector d (s.size()); std::transform(s.begin(), s.end(), d.begin(), [](const std::string& val) { return std::stol(val); }); return d; } std::vector str2int(std::vector s) { std::vector d (s.size()); std::transform(s.begin(), s.end(), d.begin(), [](const std::string& val) { return std::stoi(val); }); return d; } std::vector dbl2str(std::vector d) { std::vector s (d.size()); std::transform(d.begin(), d.end(), s.begin(), [](double i) { return std::to_string(i); } ); return s; } // trim from start (in place) void ltrim(std::string &s) { s.erase(s.begin(), std::find_if(s.begin(), s.end(), [](int ch) { return !std::isspace(ch); })); } // trim from end (in place) void rtrim(std::string &s) { s.erase(std::find_if(s.rbegin(), s.rend(), [](int ch) { return !std::isspace(ch); }).base(), s.end()); } // trim from both ends (in place) void lrtrim(std::string &s) { ltrim(s); rtrim(s); } // trim from start (copying) std::string ltrim_copy(std::string s) { ltrim(s); return s; } // trim from end (copying) std::string rtrim_copy(std::string s) { rtrim(s); return s; } // trim from both ends (copying) std::string lrtrim_copy(std::string s) { lrtrim(s); return s; } void make_valid_names(std::vector &s) { for (size_t i=0; i 1)) { // if (isdigit(s[i][1])) s[i] = "X" + s[i]; // } std::replace(s[i].begin(), s[i].end(), ' ', '.'); } } template std::vector order(const std::vector &v) { std::vector idx(v.size()); std::iota(idx.begin(), idx.end(), 0); std::stable_sort(idx.begin(), idx.end(), [&v](size_t i1, size_t i2) {return v[i1] < v[i2];}); return idx; } void make_unique_names(std::vector &s) { std::vector x = order(s); std::sort(s.begin(), s.end()); std::vector ss = s; unsigned j = 1; for (size_t i=1; i/dev/null)) LIBSHARPYUV = $(or $(and $(wildcard $(R_TOOLS_SOFT)/lib/libsharpyuv.a),-lsharpyuv),) PKG_LIBS = \ -fopenmp -lgdal -larmadillo -lopenblas -lgfortran -lquadmath -lpq -lpgcommon -lpgport -lodbc32 -lodbccp32 -lblosc -lkea -lhdf5_cpp -lhdf5 -lpoppler -llcms2 -lfreetype -lharfbuzz -lfreetype -llz4 -lpcre2-8 -lxml2 -lopenjp2 -lnetcdf -lmysqlclient -lspatialite -lgeos_c -lgeos -lminizip -lgeos -ljson-c -lgta -lfreexl -lexpat -lssl -lpsapi -lgif -lmfhdf -lhdf5_hl -lcrypto -lportablexdr -ldf -lhdf5 -lsz -lpng16 -lpng -lpoppler -llcms2 -lfreetype -lharfbuzz -lfreetype -llz4 -lpcre2-8 -lpcre -lcurl -lbcrypt -lrtmp -lssl -lssh2 -lidn2 -lunistring -liconv -lgcrypt -lcrypto -lgpg-error -lws2_32 -ltiff -llzma -ljpeg -lz -lcfitsio -lzstd -lwebpdecoder -lwebp $(LIBSHARPYUV) -lsbml-static -lgeotiff -lproj -lsqlite3 -lbz2 -lcrypt32 -lwldap32 -lsecur32 else PKG_LIBS = $(shell pkg-config --libs gdal geos proj) endif CXX_STD = CXX all: clean winlibs winlibs: cp -r "$(R_TOOLS_SOFT)/share/gdal" ../inst/ cp -r "$(R_TOOLS_SOFT)/share/proj" ../inst/ clean: rm -f $(SHLIB) $(OBJECTS) .PHONY: all winlibs clean terra/src/raster_stats.cpp0000644000176200001440000011276714720502767015430 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include #include #include #include #include #include "vecmath.h" #include "vecmathse.h" #include "math_utils.h" #include "string_utils.h" std::map table(std::vector &v) { std::map count; for_each( v.begin(), v.end(), [&count]( double val ){ if(!std::isnan(val)) count[val]++; } ); return count; } std::map ctable(std::map &x, std::map &y) { for(auto p : y) { x[p.first] += p.second; } return(x); } std::vector vtable(std::map &x) { std::vector> out(2); for( auto p : x ) { out[0].push_back(p.first); out[1].push_back(p.second); } out[0].insert(out[0].end(), out[1].begin(), out[1].end()); return out[0]; } std::vector> SpatRaster::freq(bool bylayer, bool round, int digits, SpatOptions &opt) { std::vector> out; if (!hasValues()) return out; BlockSize bs = getBlockSize(opt); unsigned nc = ncol(); unsigned nl = nlyr(); if (!readStart()) { return(out); } if (bylayer) { out.resize(nl); std::vector> tabs(nl); for (size_t i = 0; i < bs.n; i++) { unsigned nrc = bs.nrows[i] * nc; std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); if (round) { for(double& d : v) d = roundn(d, digits); } for (size_t lyr=0; lyr vv(v.begin()+off, v.begin() + off + nrc); std::map tab = table(vv); tabs[lyr] = ctable(tabs[lyr], tab); } } for (size_t lyr=0; lyr tabs; for (size_t i = 0; i < bs.n; i++) { std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); if (round) { for (double& d : v) d = roundn(d, digits); } std::map tab = table(v); tabs = ctable(tabs, tab); } out[0] = vtable(tabs); } readStop(); return(out); } std::vector SpatRaster::count(double value, bool bylayer, bool round, int digits, SpatOptions &opt) { std::vector out; if (!hasValues()) return out; BlockSize bs = getBlockSize(opt); unsigned nc = ncol(); unsigned nl = nlyr(); if (!readStart()) { return(out); } if (bylayer) { out.resize(nl); for (size_t i = 0; i < bs.n; i++) { unsigned nrc = bs.nrows[i] * nc; std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); if (round) { for(double& d : v) d = roundn(d, digits); } if (std::isnan(value)) { for (size_t lyr=0; lyr v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); if (round) { for (double& d : v) d = roundn(d, digits); } if (std::isnan(value)) { out[0] += count_if(v.begin(), v.end(), [](double d){return std::isnan(d);}); } else { out[0] += std::count(v.begin(), v.end(), value); } } } readStop(); return(out); } SpatRaster SpatRaster::quantile(std::vector probs, bool narm, SpatOptions &opt) { SpatRaster out = geometry(1); size_t n = probs.size(); if (n == 0) { out.setError("no probs"); return out; } else if (nlyr() < 2) { out.setError("more than one layer needed to compute quantiles"); return out; } double pmin = min_se(probs, 0, probs.size()); double pmax = max_se(probs, 0, probs.size()); if ((std::isnan(pmin)) || (std::isnan(pmax)) || (pmin < 0) || (pmax > 1)) { SpatRaster out = geometry(1); out.setError("intvalid probs"); return out; } out = geometry(probs.size()); out.source[0].names = double_to_string(probs, "q"); if (!hasValues()) { return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } unsigned nl = nlyr(); std::vector v(nl); for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); unsigned nc = out.bs.nrows[i] * out.ncol(); std::vector b(nc * n); for (size_t j=0; j p = vquantile(v, probs, narm); for (size_t k=0; k &d) { d.erase(std::remove_if(d.begin(), d.end(), [](const double& value) { return std::isnan(value); }), d.end()); std::sort(d.begin(), d.end()); d.erase(std::unique(d.begin(), d.end()), d.end()); } void unique_values(std::vector &d, bool narm) { if (narm) { d.erase(std::remove_if(d.begin(), d.end(), [](const double& value) { return std::isnan(value); }), d.end()); std::set u { d.begin(), d.end()}; std::copy(u.begin(), u.end(), d.begin()); d.erase(d.begin()+u.size(), d.end()); } else { size_t s = d.size(); d.erase(std::remove_if(d.begin(), d.end(), [](const double& value) { return std::isnan(value); }), d.end()); bool addNAN = s > d.size(); std::set u { d.begin(), d.end()}; std::copy(u.begin(), u.end(), d.begin()); d.erase(d.begin()+u.size(), d.end()); if (addNAN) d.push_back(NAN); } } std::vector> SpatRaster::unique(bool bylayer, double digits, bool narm, SpatOptions &opt) { std::vector> out; if (!hasValues()) return out; constexpr double lowest_double = std::numeric_limits::lowest(); BlockSize bs = getBlockSize(opt); unsigned nc = ncol(); unsigned nl = nlyr(); if (!readStart()) { return(out); } out.resize(nl); if (nl == 1) bylayer = true; if (bylayer) { for (size_t i = 0; i < bs.n; i++) { unsigned n = bs.nrows[i] * nc; std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); if (!std::isnan(digits)) { int dig = digits; for(double& d : v) d = roundn(d, dig); } for (size_t lyr=0; lyr> temp; for (size_t i = 0; i < bs.n; i++) { unsigned n = bs.nrows[i] * nc; std::vector> m(n, std::vector(nl)); std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, nc); if (!std::isnan(digits)) { int dig = digits; for (size_t j = 0; j < v.size(); j++) { if (std::isnan(v[j])) { v[j] = lowest_double; } else { v[j] = roundn(v[j], dig); } } } else { for (size_t j = 0; j < v.size(); j++) { if (std::isnan(v[j])) v[j] = lowest_double; } } for (size_t lyr=0; lyr &u, const std::vector &v, const std::vector &z, std::string fun, bool narm, std::vector& out, std::vector &cnt) { if (fun=="sum") { if (narm) { for (size_t i=0; i f {"sum", "mean", "min", "max"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("not a valid function"); return(out); } if (!hasValues()) { out.setError("SpatRaster has no values"); return(out); } if (!z.hasValues()) { out.setError("zonal SpatRaster has no values"); return(out); } if (!compare_geom(z, false, true, opt.get_tolerance())) { out.setError("dimensions and/or extent do not match"); return(out); } if (z.nlyr() > 1) { SpatOptions xopt(opt); std::vector lyr = {0}; z = z.subset(lyr, xopt); out.addWarning("only the first zonal layer is used"); } size_t nl = nlyr(); std::vector> uq = z.unique(true, true, opt); std::vector u = uq[0]; double initv = 0; double posinf = std::numeric_limits::infinity(); double neginf = -posinf; if (fun == "max") initv = neginf; if (fun == "min") initv = posinf; std::vector> stats(nl, std::vector(u.size(), initv)); std::vector> cnt(nl, std::vector(u.size(), 0)); if (!readStart()) { out.setError(getError()); return(out); } if (!z.readStart()) { out.setError(z.getError()); return(out); } opt.ncopies = 6; BlockSize bs = getBlockSize(opt); for (size_t i=0; i v, zv; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); z.readValues(zv, bs.row[i], bs.nrows[i], 0, ncol()); std::vector zvr(zv.size()); for (size_t j=0; j 1) { for (size_t lyr=0; lyr vx( v.begin()+offset, v.begin()+offset+off); jointstats(u, vx, zvr, fun, narm, stats[lyr], cnt[lyr]); } } else { jointstats(u, v, zvr, fun, narm, stats[0], cnt[0]); } } readStop(); z.readStop(); if (fun=="mean") { for (size_t lyr=0; lyr 0) { stats[lyr][j] = stats[lyr][j] / cnt[lyr][j]; } else { stats[lyr][j] = NAN; } } } } else if (fun == "min") { for (size_t lyr=0; lyr nms = getNames(); for (size_t i=0; i &v, const std::vector &zv, std::vector> &m, std::vector> &cnt, size_t nl, unsigned &nrc, bool narm){ for (size_t i=0; i &v, const std::vector &zv, const std::vector &gv, std::vector>> &m, std::vector>> &cnt, size_t nl, unsigned &nrc, bool narm){ for (size_t i=0; i &v, const std::vector &zv, std::vector> &m, std::vector> &cnt, size_t nl, unsigned &nrc, bool narm){ for (size_t i=0; i &v, const std::vector &zv, const std::vector &gv, std::vector>> &m, std::vector>> &cnt, size_t nl, unsigned &nrc, bool narm){ for (size_t i=0; i &v, const std::vector &zv, std::vector> &m, std::vector> &cnt, size_t nl, unsigned &nrc, bool narm){ double posinf = std::numeric_limits::infinity(); for (size_t i=0; i &v, const std::vector &zv, const std::vector &gv, std::vector>> &m, std::vector>> &cnt, size_t nl, unsigned &nrc, bool narm){ double posinf = std::numeric_limits::infinity(); for (size_t i=0; i &v, const std::vector &zv, std::vector> &m, std::vector> &cnt, size_t nl, unsigned &nrc, bool narm){ double neginf = -std::numeric_limits::infinity(); for (size_t i=0; i &v, const std::vector &zv, const std::vector &gv, std::vector>> &m, std::vector>> &cnt, size_t nl, unsigned &nrc, bool narm){ double neginf = -std::numeric_limits::infinity(); for (size_t i=0; i &v, const std::vector &zv, std::vector> &m, std::vector> &cnt, size_t nl, unsigned &nrc, bool narm){ for (size_t i=0; i &v, const std::vector &zv, const std::vector &gv, std::vector>> &m, std::vector>> &cnt, size_t nl, unsigned &nrc, bool narm){ for (size_t i=0; i &v, const std::vector &zv, std::vector> &m, std::vector> &cnt, size_t nl, unsigned &nrc, bool narm){ for (size_t i=0; i &v, const std::vector &zv, const std::vector &gv, std::vector>> &m, std::vector>> &cnt, size_t nl, unsigned &nrc, bool narm) { for (size_t i=0; i f {"sum", "mean", "min", "max", "isNA", "notNA"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("not a valid function"); return(out); } if (!hasValues()) { out.setError("SpatRaster has no values"); return(out); } if (!z.hasValues()) { out.setError("zonal SpatRaster has no values"); return(out); } bool groups = false; std::vector groupid; if (g.hasValues()) { if (g.nlyr() > 1) { SpatOptions xopt(opt); g = g.subset({0}, xopt); out.addWarning("only the first grouping layer is used"); } groups = true; } if (!compare_geom(z, false, true, opt.get_tolerance(), true)) { out.setError(getError()); return(out); } if (hasWarning()) { std::vector w = getWarnings(); for (size_t i=0; i 1) { // this is not very efficient. Should deal with multiple z layers below. SpatOptions xopt(opt); SpatDataFrame spout; std::vector nms = z.getNames(); make_unique_names(nms); z.setNames(nms); for (size_t i=0; i lyr = {i}; SpatRaster zz = z.subset(lyr, xopt); SpatDataFrame spd = zonal(zz, g, fun, narm, xopt); std::vector id(spd.nrow(), i); spd.add_column(id, "zlyr"); if (i == 0) { spout = spd; } else { spout.rbind(spd); } } return spout; } if (!readStart()) { out.setError(getError()); return(out); } if (!z.readStart()) { out.setError(z.getError()); return(out); } opt.ncopies = 6; std::vector cats; if (groups) { if (!g.readStart()) { out.setError(g.getError()); return(out); } opt.ncopies = 8; } BlockSize bs = getBlockSize(opt); size_t nl = nlyr(); size_t nc = ncol(); std::vector> m; std::vector> cnt; std::vector>> gm; std::vector>> gcnt; if (groups) { gm.resize(nl); gcnt.resize(nl); } else { m.resize(nl); cnt.resize(nl); } for (size_t i=0; i vv, zv, gv; readValues(vv, bs.row[i], bs.nrows[i], 0, ncol()); z.readValues(zv, bs.row[i], bs.nrows[i], 0, ncol()); if (groups) { g.readValues(gv, bs.row[i], bs.nrows[i], 0, ncol()); if (fun == "sum") { zonalsumgroup(vv, zv, gv, gm, gcnt, nl, nrc, narm); } else if (fun == "mean") { zonalmeangroup(vv, zv, gv, gm, gcnt, nl, nrc, narm); } else if (fun == "min") { zonalmingroup(vv, zv, gv, gm, gcnt, nl, nrc, narm); } else if (fun == "max") { zonalmaxgroup(vv, zv, gv, gm, gcnt, nl, nrc, narm); } else if (fun == "isNA") { zonalisnagroup(vv, zv, gv, gm, gcnt, nl, nrc, narm); } else if (fun == "notNA") { zonalnotnagroup(vv, zv, gv, gm, gcnt, nl, nrc, narm); } } else { if (fun == "sum") { zonalsum(vv, zv, m, cnt, nl, nrc, narm); } else if (fun == "mean") { zonalmean(vv, zv, m, cnt, nl, nrc, narm); } else if (fun == "min") { zonalmin(vv, zv, m, cnt, nl, nrc, narm); } else if (fun == "max") { zonalmax(vv, zv, m, cnt, nl, nrc, narm); } else if (fun == "isNA") { zonalisna(vv, zv, m, cnt, nl, nrc, narm); } else if (fun == "notNA") { zonalnotna(vv, zv, m, cnt, nl, nrc, narm); } } } readStop(); z.readStop(); if (groups) g.readStop(); std::vector zone; std::vector nms = getNames(); if (groups) { size_t n1 = gm.size(); size_t n2 = gm[0].size(); size_t n = n1*n2; std::vector layer; std::vector group; std::vector value; std::vector cnter; layer.reserve(n); group.reserve(n); zone.reserve(n); value.reserve(n); cnter.reserve(n); if ((fun == "notNA") || (fun == "isNA")){ for (size_t i=0; i mcnt = it1.second; for (auto& it2:mcnt) { layer.push_back(i); group.push_back(it1.first); zone.push_back(it2.first); value.push_back(it2.second); } } } } else { for (size_t i=0; i mcnt = it1.second; for (auto& it2:mcnt) { cnter.push_back(it2.second); } } for (auto& it1:gm[i]) { std::map mg = it1.second; for (auto& it2:mg) { layer.push_back(i); group.push_back(it1.first); zone.push_back(it2.first); value.push_back(it2.second); } } } if (fun == "mean") { for (size_t i=0; i 0) { value[i] /= cnter[i]; } else { value[i] = NAN; } } } else { for (size_t i=0; i value; value.reserve(n); if (i==0) { for (auto& it : cnt[0]) { zone.push_back(it.first); value.push_back(it.second); } out.add_column(zone, "zone"); } else { for (auto& it : cnt[i]) { value.push_back(it.second); } } out.add_column(value, nms[i]); } } else { size_t n = m[0].size(); zone.reserve(n); for (size_t i=0; i value; value.reserve(n); if (i==0) { for (auto& it : m[0]) { zone.push_back(it.first); value.push_back(it.second); } out.add_column(zone, "zone"); } else { for (auto& it : m[i]) { value.push_back(it.second); } } size_t j = 0; if (fun == "mean") { for (auto& it : cnt[i]) { double d = (double)it.second; if (d > 0) { value[j] /= d; } else { value[j] = NAN; } j++; } } else { for (auto& it : cnt[i]) { if (it.second == 0) { value[j] = NAN; } j++; } } out.add_column(value, nms[i]); } } } // std::vector nms = getNames(); // for (size_t i=0; i w = getWarnings(); for (size_t i=0; i 1) { SpatOptions xopt(opt); std::vector lyr = {0}; z = z.subset(lyr, xopt); out.addWarning("only the first zonal layer is used"); } if (w.nlyr() > 1) { SpatOptions xopt(opt); std::vector lyr = {0}; w = w.subset(lyr, xopt); out.addWarning("only the first weights layer is used"); } if (!readStart()) { out.setError(getError()); return(out); } if (!z.readStart()) { out.setError(z.getError()); return(out); } if (!w.readStart()) { out.setError(z.getError()); return(out); } opt.ncopies = 8; BlockSize bs = getBlockSize(opt); size_t nl = nlyr(); size_t nc = ncol(); std::vector> m(nl); std::vector> wsum(nl); for (size_t i=0; i vv, zv, wv; readValues(vv, bs.row[i], bs.nrows[i], 0, ncol()); z.readValues(zv, bs.row[i], bs.nrows[i], 0, ncol()); w.readValues(wv, bs.row[i], bs.nrows[i], 0, ncol()); for (size_t j=0; j v(vv.begin()+off, vv.begin() + off + nrc); for (size_t k=0; k zone; std::vector nms = getNames(); size_t n = m[0].size(); zone.reserve(n); for (size_t i=0; i value; value.reserve(n); if (i==0) { for (auto& it : m[0]) { zone.push_back(it.first); value.push_back(it.second); } out.add_column(zone, "zone"); } else { for (auto& it : m[i]) { value.push_back(it.second); } } size_t j = 0; for (auto& it : wsum[i]) { double d = (double)it.second; if (d > 0) { value[j] /= d; } else { value[j] = NAN; } j++; } out.add_column(value, nms[i]); } return(out); } SpatDataFrame SpatRaster::zonal_poly(SpatVector x, std::string fun, bool weights, bool exact, bool touches,bool small, bool narm, SpatOptions &opt) { SpatDataFrame out; std::string gtype = x.type(); if (gtype != "polygons") { out.setError("SpatVector must have polygon geometry"); return out; } if (!hasValues()) { out.setError("raster has no values"); return out; } if ((weights || exact)) { if ((fun != "mean") && (fun!="min") && (fun!="max")) { out.setError("fun should be 'min', 'max' or 'mean' when using weights/exact"); return out; } } if (!haveseFun(fun)) { out.setError("Unknown function: " + fun); return out; } std::function&, size_t, size_t)> zfun; if (!getseFun(zfun, fun, narm)) { out.setError("Unknown function"); return out; } unsigned nl = nlyr(); unsigned ng = x.size(); std::vector> zv(nl, std::vector(ng)); SpatRaster r = geometry(1); for (size_t i=0; i cell, wgt; if (weights) { rasterizeCellsWeights(cell, wgt, p, opt); } else if (exact) { rasterizeCellsExact(cell, wgt, p, opt); } else { cell = rasterizeCells(p, touches, small, opt); } std::vector> e = extractCell(cell); if ((weights || exact) && fun == "mean") { if (narm) { for (size_t j=0; j nms = getNames(); for (size_t j=0; j tabfun(std::vector x, std::vector w) { // if (w.size() == 0) { std::map tab = table(x); return vtable(tab); // } else { // } } std::vector> SpatRaster::zonal_poly_table(SpatVector x, bool weights, bool exact, bool touches, bool small, bool narm, SpatOptions &opt) { std::vector> out; std::string gtype = x.type(); if (gtype != "polygons") { setError("SpatVector must have polygon geometry"); return out; } if (!hasValues()) { setError("raster has no values"); return out; } unsigned nl = nlyr(); if (nl > 1) { SpatOptions ops(opt); SpatRaster r = subset({0}, ops); out = r.zonal_poly_table(x, weights, exact, touches, small, narm, opt); addWarning("only the first layer of the raster is used"); return out; } unsigned ng = x.size(); std::vector> zv(nl, std::vector(ng)); out.resize(ng); SpatRaster r = geometry(1); for (size_t i=0; i cell, wgt; if (weights) { rasterizeCellsWeights(cell, wgt, p, opt); } else if (exact) { rasterizeCellsExact(cell, wgt, p, opt); } else { cell = rasterizeCells(p, touches, small, opt); } std::vector> e = extractCell(cell); out[i] = tabfun(e[0], wgt); } return out; } SpatDataFrame SpatRaster::zonal_poly_weighted(SpatVector x, SpatRaster w, bool weights, bool exact, bool touches, bool small, bool narm, SpatOptions &opt) { SpatDataFrame out; std::string gtype = x.type(); if (gtype != "polygons") { out.setError("SpatVector must have polygon geometry"); return out; } if (!compare_geom(w, false, true, opt.get_tolerance(), true)) { out.setError(getError()); return(out); } if (!hasValues()) { out.setError("raster has no values"); return out; } if (!w.hasValues()) { out.setError("raster has no values"); return out; } unsigned nl = nlyr(); unsigned ng = x.size(); std::vector> zv(nl, std::vector(ng)); SpatRaster r = geometry(1); for (size_t i=0; i cell, wgt; if (weights) { rasterizeCellsWeights(cell, wgt, p, opt); } else if (exact) { rasterizeCellsExact(cell, wgt, p, opt); } else { cell = rasterizeCells(p, touches, small, opt); } std::vector> e = extractCell(cell); std::vector> we = w.extractCell(cell); if (weights || exact) { if (narm) { for (size_t j=0; j nms = getNames(); for (size_t j=0; j. #ifndef SPATBASE_GUARD #define SPATBASE_GUARD #include #include #include #include #ifndef standalone #define useRcpp #endif #ifndef nogdal #define useGDAL #endif /* #ifdef useGDAL #include "gdal_priv.h" #endif */ #ifndef M_PI #define M_PI (3.14159265358979323846) #endif class SpatMessages { public: virtual ~SpatMessages(){} bool has_error = false; bool has_warning = false; std::string error; std::string message; std::vector warnings; void setError(std::string s) { has_error = true; error = s; } std::string getError() { has_error = false; std::string err = error; error = ""; return err; } void addWarning(std::string s) { has_warning = true; warnings.push_back(s); } std::vector getWarnings() { std::vector w = warnings; warnings.resize(0); has_warning = false; return w; } std::string getMessage() { std::string out = message; message = ""; return out; } void setMessage(std::string s) { message = s; } /* std::vector getAll() { std::string warns = getWarnings(); std::string error = getError(); std::string msg = getMessage(); std::vector amsgs = { error, warns, msg}; return amsgs; } */ }; class SpatOptions { private: std::string tempdir = ""; bool todisk = false; double memmax = -1; double memmin = 134217728; // 1024^3 / 8 double memfrac = 0.5; double tolerance = 0.1; std::vector offset = {0}; std::vector scale = {1}; public: SpatOptions(); SpatOptions(const SpatOptions &opt); SpatOptions deepCopy(); virtual ~SpatOptions(){} size_t ncopies = 4; size_t minrows = 1; bool threads=false; std::string def_datatype = "FLT4S"; std::string def_filetype = "GTiff"; //std::string def_bandorder = "BIL"; bool overwrite = false; size_t progress = 3; size_t steps = 0; bool hasNAflag = false; double NAflag = NAN; bool def_verbose = false; bool verbose = false; //bool append = false; int statistics = 1; bool datatype_set = false; //bool ncdfcopy = false; unsigned char value_type = 0; std::string tmpfile = ""; std::string datatype = ""; //std::string bandorder = ""; std::string filetype = ""; std::vector filenames = {""}; std::vector gdal_options; std::vector names; // permanent bool get_todisk(); void set_todisk(bool b); double get_memfrac(); void set_memfrac(double d); double get_memmax(); void set_memmax(double d); double get_memmin(); void set_memmin(double d); std::string get_tempdir(); void set_tempdir(std::string d); double get_tolerance(); void set_tolerance(double d); std::string get_def_datatype(); std::string get_def_bandorder(); std::string get_def_filetype(); bool get_def_verbose(); void set_def_datatype(std::string d); //void set_def_bandorder(std::string d); void set_def_filetype(std::string d); // single use void set_verbose(bool v); void set_def_verbose(bool v); void set_NAflag(double flag); //void set_ncdfcopy(bool x); void set_statistics(int s); //void set_filename(std::string f); void set_filenames(std::vector f); void set_filetype(std::string d); void set_datatype(std::string d); //void set_bandorder(std::string d); void set_overwrite(bool b); //void set_append(bool b); void set_progress(size_t p); std::string get_filename(); std::vector get_filenames(); std::string get_filetype(); std::string get_datatype(); //std::string get_bandorder(); bool get_verbose(); //bool get_ncdfcopy(); int get_statistics(); double get_NAflag(); bool has_NAflag(double &flag); bool get_overwrite(); //bool get_append(); size_t get_progress(); bool show_progress(size_t n); bool progressbar=true; void set_steps(size_t n); size_t get_steps(); void set_ncopies(size_t n); size_t get_ncopies(); void set_offset(std::vector d); std::vector get_offset(); void set_scale(std::vector d); std::vector get_scale(); SpatMessages msg; bool hasWarning() {return msg.has_warning;} bool hasError() {return msg.has_error;} std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} }; class SpatExtent { public: double xmin, xmax, ymin, ymax; SpatExtent() {xmin = -180; xmax = 180; ymin = -90; ymax = 90;} SpatExtent(double _xmin, double _xmax, double _ymin, double _ymax) {xmin = _xmin; xmax = _xmax; ymin = _ymin; ymax = _ymax;} virtual ~SpatExtent(){} SpatExtent deepCopy() {return *this;} SpatExtent align(double d, std::string snap); bool intersects(SpatExtent e) { if ((xmin > e.xmax) || (xmax < e.xmin) || (ymin > e.ymax) || (ymax < e.ymin)) { return false; } return true; } SpatExtent intersect(SpatExtent e) { // check first if intersects? SpatExtent out; out.xmin = std::max(xmin, e.xmin); out.xmax = std::min(xmax, e.xmax); out.ymin = std::max(ymin, e.ymin); out.ymax = std::min(ymax, e.ymax); return out; } void unite(SpatExtent e) { if (std::isnan(xmin)) { xmin = e.xmin; xmax = e.xmax; ymin = e.ymin; ymax = e.ymax; } else { xmin = std::min(xmin, e.xmin); xmax = std::max(xmax, e.xmax); ymin = std::min(ymin, e.ymin); ymax = std::max(ymax, e.ymax); } } std::vector asVector() { std::vector e = { xmin, xmax, ymin, ymax }; return(e); } std::vector> asPoints() { std::vector> pts(2, std::vector(4)); pts[0][0] = xmin; pts[1][0] = ymin; pts[0][1] = xmin; pts[1][1] = ymax; pts[0][2] = xmax; pts[1][2] = ymax; pts[0][3] = xmax; pts[1][3] = ymin; return(pts); } bool valid() { return ((xmax >= xmin) && (ymax >= ymin)); } bool valid_notempty() { return ((xmax > xmin) && (ymax > ymin)); } bool empty() { return ((xmax <= xmin) || (ymax <= ymin)); } bool compare(SpatExtent e, std::string oper, double tolerance); SpatExtent round(int n); SpatExtent floor(); SpatExtent ceil(); std::vector test_sample(size_t size, size_t N, bool replace, std::vector w, unsigned seed); std::vector> sampleRegular(size_t size, bool lonlat); std::vector> sampleRandom(size_t size, bool lonlat, unsigned seed); }; class SpatSRS { public: virtual ~SpatSRS(){} // SpatSRS(std::string s); std::string proj4, wkt; bool set(std::string txt, std::string &msg); /* #ifdef useGDAL bool set(OGRSpatialReference *poSRS, std::string &msg); #endif */ double to_meter(); bool m_dist(double &m, bool lonlat, std::string unit); std::string get(std::string x) { return (x == "proj4" ? proj4 : wkt); } std::string get_prj() { return proj4; } bool is_equal(SpatSRS x) { return (proj4 == x.proj4); } bool is_empty() { return wkt.empty(); } bool is_same(std::string other, bool ignoreempty); bool is_same(SpatSRS other, bool ignoreempty); bool is_lonlat(); // as below, but using GDAL bool is_lonlat_text() { bool b1 = proj4.find("longlat") != std::string::npos; bool b2 = proj4.find("epsg:4326") != std::string::npos; return (b1 | b2); } bool could_be_lonlat(SpatExtent e) { bool b = is_lonlat(); if ((!b) & is_empty()) { if ((e.xmin >= -180.1) & (e.xmax <= 180.1) & (e.ymin >= -90.1) & (e.ymax <= 90.1)) { b = true; } } return b; } bool is_global_lonlat(SpatExtent e) { if (is_lonlat()) { return (std::abs(e.xmax - e.xmin - 360) < 0.001); //double halfres = xres()/ 180; //if (((e.xmin - halfres) <= -180) && ((e.xmax + halfres) >= 180)) { // return true; //} } return false; } }; class SpatProgress { public: virtual ~SpatProgress(){} size_t nstep; size_t step; std::vector steps; void init(size_t n, int nmin); bool show = false; void stepit(); void finish(); void interrupt(); }; #endif terra/src/RcppFunctions.cpp0000644000176200001440000004040714756505553015503 0ustar liggesusers#include #include "spatRasterMultiple.h" #include "string_utils.h" #include "math_utils.h" #include "sort.h" #include "gdal_priv.h" #include "gdalio.h" #include "ogr_spatialref.h" //#define GEOS_USE_ONLY_R_API #include #if GDAL_VERSION_MAJOR >= 3 #include "proj.h" #define projh #if PROJ_VERSION_MAJOR >=6 # define PROJ_6 #endif #if PROJ_VERSION_MAJOR > 7 # define PROJ_71 #else # if PROJ_VERSION_MAJOR == 7 # if PROJ_VERSION_MINOR >= 1 # define PROJ_71 # endif # endif #endif #else #if PROJ_VERSION_MAJOR >=8 #include "proj.h" #else #define ACCEPT_USE_OF_DEPRECATED_PROJ_API_H #include #endif #endif //from sf #ifdef projh // [[Rcpp::export]] std::string proj_version() { std::stringstream buffer; buffer << PROJ_VERSION_MAJOR << "." << PROJ_VERSION_MINOR << "." << PROJ_VERSION_PATCH; return buffer.str(); } #else std::string proj_version() { int v = PJ_VERSION; std::stringstream buffer; buffer << v / 100 << "." << (v / 10) % 10 << "." << v % 10; return buffer.str(); } #endif // [[Rcpp::export]] std::vector hex2rgb(std::string s) { unsigned char r, g, b; s = s.erase(0,1); // remove the "#" sscanf(s.c_str(), "%02hhx%02hhx%02hhx", &r, &g, &b); std::vector x = {r, g, b}; return x; } /* // [[Rcpp::export]] std::vector terra_order(std::vector v) { return sort_order_a(v); } // [[Rcpp::export]] std::vector terra_permute(std::vector v, std::vector p) { permute(v, p); return v; } */ // [[Rcpp::export]] std::string rgb2hex(std::vector x) { std::stringstream ss; ss << "#" << std::hex << std::setw(6) << (x[0] << 16 | x[1] << 8 | x[2] ); std::string s = ss.str(); //std::transform(s.begin(), s.end(), s.begin(), ::toupper); str_replace_all(s, " ", "0"); return s; } // [[Rcpp::export(name = ".sameSRS")]] bool sameSRS(std::string x, std::string y) { std::string msg; SpatSRS srs; if (!srs.set(x, msg)) return false; return srs.is_same(y, false); } // [[Rcpp::export(name = ".SRSinfo")]] std::vector getCRSname(std::string s) { OGRSpatialReference x; OGRErr erro = x.SetFromUserInput(s.c_str()); if (erro != OGRERR_NONE) { return {"unknown", "", "", "", ""}; } std::string node; if (x.IsGeographic()) { node = "geogcs"; } else { node = "projcs"; } const char *value; std::string name = ""; value = x.GetAttrValue(node.c_str()); if (value != NULL) { name = value; } std::string aname = ""; value = x.GetAuthorityName(node.c_str()); if (value != NULL) { aname = value; } std::string acode = ""; value = x.GetAuthorityCode(node.c_str()); if (value != NULL) { acode = value; } double west, south, east, north; west = -10000; east = -10000; south = -10000; north = -10000; std::string aoi="", box=""; #if GDAL_VERSION_MAJOR >= 3 if (x.GetAreaOfUse(&west, &south, &east, &north, &value)) { if (value != NULL) { if (west > -1000) { aoi = value; box = std::to_string(west) + ", " + std::to_string(east) + ", " + std::to_string(south) + ", " + std::to_string(north); } } } #endif return {name, aname, acode, aoi, box}; } // [[Rcpp::export(name = ".getLinearUnits")]] double getLinearUnits(std::string s) { std::string msg; SpatSRS srs; if (!srs.set(s, msg)) return NAN; return srs.to_meter(); } // [[Rcpp::export(name = ".geotransform")]] std::vector geotransform(std::string fname) { std::vector out; GDALDataset *poDataset = static_cast(GDALOpenEx( fname.c_str(), GDAL_OF_RASTER | GDAL_OF_READONLY, NULL, NULL, NULL )); if( poDataset == NULL ) { Rcpp::Rcout << "cannot read from: " + fname << std::endl; return out; } double gt[6]; if( poDataset->GetGeoTransform( gt ) != CE_None ) { Rcpp::Rcout << "bad geotransform" << std::endl; } out = std::vector(std::begin(gt), std::end(gt)); GDALClose( (GDALDatasetH) poDataset ); return out; } // [[Rcpp::export(name = ".gdal_setconfig")]] void gdal_setconfig(std::string option, std::string value) { if (value.empty()) { CPLSetConfigOption(option.c_str(), NULL); } else { CPLSetConfigOption(option.c_str(), value.c_str()); } } // [[Rcpp::export(name = ".gdal_getconfig")]] std::string gdal_getconfig(std::string option) { const char * value = CPLGetConfigOption(option.c_str(), NULL); std::string out = ""; if (value != NULL) { out = value; } return out; } // [[Rcpp::export(name = ".gdalinfo")]] std::string ginfo(std::string filename, std::vector options, std::vector oo) { std::string out = gdalinfo(filename, options, oo); return out; } // [[Rcpp::export(name = ".sdinfo")]] std::vector> sd_info(std::string filename) { std::vector> sd = sdinfo(filename); return sd; } // [[Rcpp::export(name = ".gdal_version")]] std::string gdal_version() { const char* what = "RELEASE_NAME"; const char* x = GDALVersionInfo(what); std::string s = (std::string) x; return s; } // [[Rcpp::export(name = ".geos_version")]] std::string geos_version(bool runtime = false, bool capi = false) { if (runtime) return GEOSversion(); else { if (capi) return GEOS_CAPI_VERSION; else return GEOS_VERSION; } } // [[Rcpp::export(name = ".metadata")]] std::vector metatdata(std::string filename) { std::vector m = get_metadata(filename); return m; } // [[Rcpp::export(name = ".sdsmetadata")]] std::vector sdsmetatdata(std::string filename) { std::vector m = get_metadata_sds(filename); return m; } // [[Rcpp::export(name = ".parsedsdsmetadata")]] std::vector> sdsmetatdataparsed(std::string filename) { std::vector m = sdsmetatdata(filename); std::vector> s = parse_metadata_sds(m); return s; } // [[Rcpp::export(name = ".gdaldrivers")]] std::vector> gdal_drivers() { size_t n = GetGDALDriverManager()->GetDriverCount(); std::vector> s(6, std::vector(n)); GDALDriver *poDriver; char **papszMetadata; for (size_t i=0; iGetDriver(i); const char* ss = poDriver->GetDescription(); if (ss != NULL ) s[0][i] = ss; ss = poDriver->GetMetadataItem( GDAL_DMD_LONGNAME ); if (ss != NULL ) s[5][i] = ss; papszMetadata = poDriver->GetMetadata(); bool rst = CSLFetchBoolean( papszMetadata, GDAL_DCAP_RASTER, FALSE); bool vct = CSLFetchBoolean( papszMetadata, GDAL_DCAP_VECTOR, FALSE); s[1][i] = std::to_string(rst); s[2][i] = std::to_string(vct); bool create = CSLFetchBoolean( papszMetadata, GDAL_DCAP_CREATE, FALSE); bool copy = CSLFetchBoolean( papszMetadata, GDAL_DCAP_CREATECOPY, FALSE); s[3][i] = std::to_string(create + copy); bool vsi = CSLFetchBoolean( papszMetadata, GDAL_DCAP_VIRTUALIO, FALSE); s[4][i] = std::to_string(vsi); } return s; } template inline void warningNoCall(const char* fmt, Args&&... args ) { Rf_warningcall(R_NilValue, "%s", tfm::format(fmt, std::forward(args)... ).c_str()); } template inline void NORET stopNoCall(const char* fmt, Args&&... args) { throw Rcpp::exception(tfm::format(fmt, std::forward(args)... ).c_str(), false); } static void __err_warning(CPLErr eErrClass, int err_no, const char *msg) { switch ( eErrClass ) { case 0: break; case 1: case 2: warningNoCall("%s (GDAL %d)", msg, err_no); break; case 3: warningNoCall("%s (GDAL error %d)", msg, err_no); break; case 4: stopNoCall("%s (GDAL unrecoverable error %d)", msg, err_no); break; default: warningNoCall("%s (GDAL error class %d, #%d)", msg, eErrClass, err_no); break; } return; } static void __err_error(CPLErr eErrClass, int err_no, const char *msg) { switch ( eErrClass ) { case 0: case 1: case 2: break; case 3: warningNoCall("%s (GDAL error %d)", msg, err_no); break; case 4: stopNoCall("%s (GDAL unrecoverable error %d)", msg, err_no); break; default: stopNoCall("%s (GDAL unrecoverable error %d)", msg, err_no); break; } return; } static void __err_fatal(CPLErr eErrClass, int err_no, const char *msg) { switch ( eErrClass ) { case 0: case 1: case 2: case 3: break; case 4: stopNoCall("%s (GDAL unrecoverable error %d)", msg, err_no); break; default: break; } return; } static void __err_none(CPLErr eErrClass, int err_no, const char *msg) { return; } // [[Rcpp::export(name = ".set_gdal_warnings")]] void set_gdal_warnings(int level) { if (level==4) { CPLSetErrorHandler((CPLErrorHandler)__err_none); } else if (level==1) { CPLSetErrorHandler((CPLErrorHandler)__err_warning); } else if (level==2) { CPLSetErrorHandler((CPLErrorHandler)__err_error); } else { CPLSetErrorHandler((CPLErrorHandler)__err_fatal); } } #include "common.h" std::mt19937 my_rgen; // [[Rcpp::export(name = ".seedinit")]] void seed_init(uint32_t seed_val) { my_rgen.seed(seed_val); } /* [[Rcpp::export(name = ".rnumb")]] int rnumb() { std::uniform_int_distribution rand_nr(0, 9); return rand_nr(my_rgen); } */ // [[Rcpp::export(name = ".gdalinit")]] void gdal_init(std::string projpath, std::string datapath) { set_gdal_warnings(2); GDALAllRegister(); OGRRegisterAll(); CPLSetConfigOption("GDAL_MAX_BAND_COUNT", "9999999"); CPLSetConfigOption("OGR_CT_FORCE_TRADITIONAL_GIS_ORDER", "YES"); CPLSetConfigOption("GDAL_DATA", datapath.c_str()); CPLSetConfigOption("CPL_VSIL_USE_TEMP_FILE_FOR_RANDOM_WRITE", "YES"); //GDAL_NETCDF_IGNORE_XY_AXIS_NAME_CHECKS //GDALregistred = true; #if GDAL_VERSION_MAJOR >= 3 #ifdef PROJ_6 if (!projpath.empty()) { const char *cp = projpath.c_str(); proj_context_set_search_paths(PJ_DEFAULT_CTX, 1, &cp); } #endif #endif #ifdef PROJ_71 #ifndef __EMSCRIPTEN__ proj_context_set_enable_network(PJ_DEFAULT_CTX, 1); #endif #endif } // [[Rcpp::export(name = ".precRank")]] std::vector percRank(std::vector x, std::vector y, double minc, double maxc, int tail) { std::vector out; out.reserve(y.size()); size_t nx = x.size(); for (size_t i=0; i maxc )) { out.push_back( 0 ); } else { size_t b = 0; size_t t = 0; for (size_t j=0; j x[j]) { b++; } else if (y[i] == x[j]) { t++; } else { // y is sorted, so we need not continue break; } } double z = (b + 0.5 * t) / nx; if (tail == 1) { // both if (z > 0.5) { z = 2 * (1 - z); } else { z = 2 * z; } } else if (tail == 2) { // high if (z < 0.5) { z = 1; } else { z = 2 * (1 - z); } } else { // if (tail == 3) { // low if (z > 0.5) { z = 1; } else { z = 2 * z; } } out.push_back(z); } } return(out); } // [[Rcpp::export(name = ".clearVSIcache")]] void clearVSIcache(bool vsi) { //if (vsi) VSICurlClearCache(); } // [[Rcpp::export(name = ".setGDALCacheSizeMB")]] void setGDALCacheSizeMB(double x, bool vsi) { if (vsi) { int64_t v = x * 1024 * 1024; CPLSetConfigOption("CPL_VSIL_CURL_CACHE_SIZE", std::to_string(v).c_str()); } else { GDALSetCacheMax64(static_cast(x) * 1024 * 1024); } } // [[Rcpp::export(name = ".getGDALCacheSizeMB")]] double getGDALCacheSizeMB(bool vsi) { if (vsi) { std::string out = gdal_getconfig("CPLGetConfigOption"); Rcpp::Rcout << out << std::endl; if (out == "") return NAN; double v = -1; try { v = stod(out) / (1024 * 1024); } catch(...){ return(NAN); } return(v); } else { return static_cast(GDALGetCacheMax64() / 1024 / 1024); } } // convert NULL-terminated array of strings to std::vector std::vector charpp2vect(char **cp) { std::vector out; if (cp == NULL) return out; size_t i=0; while (cp[i] != NULL) { out.push_back(cp[i]); i++; } return out; } // [[Rcpp::export(name = ".get_proj_search_paths")]] std::vector get_proj_search_paths() { std::vector out; #if GDAL_VERSION_NUM >= 3000300 char **cp = OSRGetPROJSearchPaths(); out = charpp2vect(cp); CSLDestroy(cp); #else out.push_back("error: GDAL >= 3.0.3 required"); #endif return out; } // [[Rcpp::export(name = ".set_proj_search_paths")]] bool set_proj_search_paths(std::vector paths) { if (paths.empty()) { return false; } #if GDAL_VERSION_NUM >= 3000000 std::vector cpaths(paths.size()+1); for (size_t i = 0; i < paths.size(); i++) { cpaths[i] = (char *) (paths[i].c_str()); } cpaths[cpaths.size()] = NULL; OSRSetPROJSearchPaths(cpaths.data()); return true; #else return false; #endif } // [[Rcpp::export(name = ".PROJ_network")]] std::string PROJ_network(bool enable, std::string url) { std::string s = ""; #ifdef PROJ_71 if (enable) { proj_context_set_enable_network(PJ_DEFAULT_CTX, 1); if (url.size() > 5) { proj_context_set_url_endpoint(PJ_DEFAULT_CTX, url.c_str()); } s = proj_context_get_url_endpoint(PJ_DEFAULT_CTX); } else { // disable: proj_context_set_enable_network(PJ_DEFAULT_CTX, 0); } #endif return s; } // [[Rcpp::export(name = ".pearson")]] double pearson_cor(std::vector x, std::vector y, bool narm) { if (narm) { size_t n = x.size()-1; for (long i=n; i >= 0; i--) { if (std::isnan(x[i]) || std::isnan(y[i])) { x.erase(x.begin()+i); y.erase(y.begin()+i); } } if (x.size() < 2) { return(NAN); } } size_t n = x.size(); double xbar = accumulate(x.begin(), x.end(), 0.0) / n; double ybar = accumulate(y.begin(), y.end(), 0.0) / n; double numer = 0; for (size_t i=0; i x, std::vector y, std::vector weights, bool narm=true) { if (narm) { size_t n = x.size()-1; for (long i=n; i >= 0; i--) { if (std::isnan(x[i]) || std::isnan(y[i])) { x.erase(x.begin()+i); y.erase(y.begin()+i); weights.erase(weights.begin()+i); } } if (x.size() < 2) { return(NAN); } } size_t n = x.size(); double sw = accumulate(weights.begin(), weights.end(), 0.0); for (double &d : weights) d /= sw; double sxw = 0; double syw = 0; for (size_t i=0; i x, std::vector y) { size_t n = x.size(); for (size_t i=0; i y[i]) { double tmp = x[i]; x[i] = y[i]; y[i] = tmp; } } sort_unique_2d(x, y); Rcpp::IntegerMatrix mat(x.size(), 2); std::copy(x.begin(), x.end(), mat.begin()); std::copy(y.begin(), y.end(), mat.begin()+x.size()); return mat; // x.insert(x.end(), y.begin(), y.end()); /// return(x); } /* # include "vecmathse.h" // [[Rcpp::export(name = ".stattest1")]] double stattest1(std::vector x, std::string fun, bool narm) { if (!haveseFun(fun)) { Rcpp::Rcout << fun + " is not available" << std::endl; return NAN; } std::function&, size_t, size_t)> f; if (!getseFun(f, fun, narm)) { Rcpp::Rcout << "Unknown function" << std::endl; return NAN; } return f(x, 0, x.size()); } # include "vecmath.h" // [[Rcpp::export(name = ".stattest2")]] double stattest2(std::vector x, std::string fun, bool narm) { if (!haveFun(fun)) { Rcpp::Rcout << fun + " is not available" << std::endl; return NAN; } std::function&, bool)> f = getFun(fun); return f(x, narm); } */ terra/src/spatGraph.h0000644000176200001440000000237714536376240014303 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatVector.h" class SpatGraph { public: virtual ~SpatGraph(){} std::vector x; std::vector y; std::vector index; std::vector edges; SpatDataFrame atts; std::string crs; SpatGraph() {}; SpatGraph(std::vector nx, std::vector ny, std::vector from, std::vector to); void set_values(SpatDataFrame d); SpatDataFrame get_values(); SpatGraph clean(); bool writeGraph(SpatOptions opt); SpatGraph readGraph(SpatOptions opt); SpatVector shortestPath(); }; terra/src/raster_methods.cpp0000644000176200001440000047122614753415041015725 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRasterMultiple.h" #include "recycle.h" #include "vecmath.h" #include "vecmathse.h" #include #include #include "math_utils.h" #include "file_utils.h" #include "string_utils.h" #include "sort.h" /* std::vector flat(std::vector> v) { unsigned s1 = v.size(); unsigned s2 = v[0].size(); std::size_t s = s1 * s2; std::vector result(s); for (size_t i=0; i 1) { SpatOptions ops(opt); out.addWarning("only processing the first layer"); std::vector lyr = {0}; *this = subset(lyr, ops); } if (!hasValues()) { return(out); } if (n >= ncell()) { return isnotnan(opt); } std::vector sel; if (!readStart()) { return(out); } BlockSize bs = getBlockSize(opt); for (size_t i = 0; i < bs.n; i++) { std::vector v; readBlock(v, out.bs, i); for (size_t j=0; j c2) { std::swap(c1, c2); } r1 = std::min(std::max(r1, (int_64)0), nr); r2 = std::min(std::max(r2, (int_64)0), nr); if (r1 > r2) { std::swap(r1, r2); } double xn = xFromCol(c1) - 0.5 * xrs; double xx = xFromCol(c2) + 0.5 * xrs; double yx = yFromRow(r1) + 0.5 * yrs; double yn = yFromRow(r2) - 0.5 * yrs; return SpatExtent(xn, xx, yn, yx); } SpatExtent SpatRaster::ext_from_cell( double cell) { std::vector cells = {cell}; std::vector> rc = rowColFromCell(cells); return ext_from_rc(rc[0][0], rc[0][0], rc[1][0], rc[1][0]); } std::vector SpatRaster::get_tiles_extent(SpatRaster x, bool expand, std::vector buffer) { x = x.geometry(1, false, false, false); SpatExtent e = getExtent(); recycle(buffer, 2); std::vector ebuf = {buffer[0] * xres(), buffer[1] * yres()}; SpatOptions opt; if (expand) { x = x.extend(e, "out", NAN, opt); } x = x.crop(e, "out", false, opt); std::vector d(x.ncell()); std::iota(d.begin(), d.end(), 1); std::vector> ee(4); for (size_t i=0; i<4; i++) { ee[i].reserve(d.size()); } SpatRaster y = geometry(1, false, false, false); for (size_t i=0; i 0) { ee[0][k] = ee[1][k-1]; } if (i > 0) { ee[3][k] = ee[2][k-nc]; } } } for (size_t i=0; i out; out.reserve(ee[0].size() * 4); for (size_t i=0; i<4; i++) { out.insert(out.end(), ee[i].begin(), ee[i].end()); } return out; } std::vector SpatRaster::make_tiles(SpatRaster x, bool expand, std::vector buffer, bool narm, std::string filename, SpatOptions &opt) { std::vector ff; if (!hasValues()) { setError("input raster has no values"); return ff; } x = x.geometry(1, false, false, false); SpatExtent e = getExtent(); recycle(buffer, 2); std::vector ebuf = {buffer[0] * xres(), buffer[1] * yres()}; SpatOptions ops(opt); if (expand) { x = x.extend(e, "out", NAN, ops); } x = x.crop(e, "out", false, ops); std::vector d(x.ncell()); std::iota(d.begin(), d.end(), 1); std::string fext = getFileExt(filename); std::string f = noext(filename); ff.reserve(d.size()); size_t nl = nlyr(); bool overwrite = opt.get_overwrite(); for (size_t i=0; i rmin = out.range_min(); size_t cnt = 0; for (double &v : rmin) { if (std::isnan(v)) cnt++; } if (cnt == nl) { remove(fout.c_str()); continue; } } ff.push_back(fout); } } return ff; } std::vector SpatRaster::get_tiles_extent_vect(SpatVector x, bool expand, std::vector buffer) { std::vector ee; if (x.type() != "polygons") { setError("The SpatVector must have a polygons geometry"); return ee; } SpatExtent e = getExtent(); std::vector d(x.size()); std::iota(d.begin(), d.end(), 1); ee.reserve(d.size() * 4); SpatOptions opt; SpatRaster y = geometry(1, false, false, false); recycle(buffer, 2); std::vector ebuf = {buffer[0] * xres(), buffer[1] * yres()}; for (size_t i=0; i SpatRaster::make_tiles_vect(SpatVector x, bool expand, std::vector buffer, bool narm, std::string filename, SpatOptions &opt) { std::vector ff; if (!hasValues()) { setError("input raster has no values"); return ff; } if (x.type() != "polygons") { setError("The SpatVector must have a polygons geometry"); return ff; } SpatExtent e = getExtent(); SpatOptions ops(opt); std::vector d(x.size()); std::iota(d.begin(), d.end(), 1); std::string fext = getFileExt(filename); std::string f = noext(filename); ff.reserve(d.size()); size_t nl = nlyr(); bool overwrite = opt.get_overwrite(); recycle(buffer, 2); std::vector ebuf = {buffer[0] * xres(), buffer[1] * yres()}; for (size_t i=0; i rmin = out.range_min(); size_t cnt = 0; for (double &v : rmin) { if (std::isnan(v)) cnt++; } if (cnt == nl) { remove(fout.c_str()); continue; } } ff.push_back(fout); } } return ff; } bool SpatRaster::get_aggregate_dims(std::vector &fact, std::string &message ) { size_t fs = fact.size(); if ((fs > 3) | (fs == 0)) { message = "argument 'fact' should have length 1, 2, or 3"; return false; } auto min_value = *std::min_element(fact.begin(),fact.end()); if (min_value < 1) { message = "values in argument 'fact' should be > 0"; return false; } auto max_value = *std::max_element(fact.begin(),fact.end()); if (max_value == 1) { message = "all values in argument 'fact' are 1, nothing to do"; return false; } fact.resize(6); if (fs == 1) { fact[1] = fact[0]; fact[2] = 1; } else if (fs == 2) { fact[2] = 1; } // int dy = dim[0], dx = dim[1], dz = dim[2]; fact[0] = fact[0] < 1 ? 1 : fact[0]; fact[0] = fact[0] > nrow() ? nrow() : fact[0]; fact[1] = fact[1] < 1 ? 1 : fact[1]; fact[1] = fact[1] > ncol() ? ncol() : fact[1]; fact[2] = std::max(size_t(1), std::min(fact[2], nlyr())); // new dimensions: rows, cols, lays fact[3] = std::ceil(double(nrow()) / fact[0]); fact[4] = std::ceil(double(ncol()) / fact[1]); fact[5] = std::ceil(double(nlyr()) / fact[2]); return true; } std::vector SpatRaster::get_aggregate_dims2(std::vector fact) { // for use with R std::string message = ""; get_aggregate_dims(fact, message); return(fact); } std::vector> SpatRaster::get_aggregates(std::vector &in, size_t nr, std::vector dim) { // dim 0, 1, 2, are the aggregations factors dy, dx, dz // and 3, 4, 5 are the new nrow, ncol, nlyr // adjust for chunk //dim[3] = std::ceil(double(nr) / dim[0]); //size_t bpC = dim[3]; size_t bpC = std::ceil(double(nr) / dim[0]); size_t dy = dim[0], dx = dim[1], dz = dim[2]; size_t bpR = dim[4]; size_t bpL = bpR * bpC; // new number of layers size_t newNL = dim[5]; // new number of rows, adjusted for additional (expansion) rows size_t adjnr = bpC * dy; // number of aggregates size_t nblocks = (bpR * bpC * newNL); // cells per aggregate size_t blockcells = dx * dy * dz; // output: each row is a block std::vector< std::vector > a(nblocks, std::vector(blockcells, std::numeric_limits::quiet_NaN())); size_t nc = ncol(); // size_t ncells = ncell(); size_t ncells = nr * nc; size_t nl = nlyr(); size_t lstart, rstart, cstart, lmax, rmax, cmax, f, lj, cell; for (size_t b = 0; b < nblocks; b++) { lstart = dz * (b / bpL); rstart = (dy * (b / bpR)) % adjnr; cstart = dx * (b % bpR); lmax = std::min(nl, (lstart + dz)); rmax = std::min(nr, (rstart + dy)); // nrow -> nr cmax = std::min(nc, (cstart + dx)); f = 0; for (size_t j = lstart; j < lmax; j++) { lj = j * ncells; for (size_t r = rstart; r < rmax; r++) { cell = lj + r * nc; for (size_t c = cstart; c < cmax; c++) { a[b][f] = in[cell + c]; f++; } } } } return(a); } void compute_aggregates(const std::vector &in, std::vector &out, size_t nr, size_t nc, size_t nl, std::vector dim, std::function&, bool)> fun, bool narm) { // dim 0, 1, 2, are the aggregations factors dy, dx, dz // and 3, 4, 5 are the new nrow, ncol, nlyr size_t dy = dim[0], dx = dim[1], dz = dim[2]; // size_t bpC = dim[3]; // adjust for chunk // size_t bpC = std::ceil(double(nr) / dim[0]); size_t bpC = std::ceil((double)nr / (double)dim[0]); size_t bpR = dim[4]; size_t bpL = bpR * bpC; // new number of layers size_t newNL = dim[5]; // new number of rows, adjusted for additional (expansion) rows size_t adjnr = bpC * dy; // number of aggregates size_t nblocks = (bpR * bpC * newNL); // cells per aggregate size_t blockcells = dx * dy * dz; // output: each row is a block out = std::vector(nblocks, NAN); // size_t nl = nlyr(); // size_t nc = ncol(); size_t ncells = nr * nc; size_t lstart, rstart, cstart, lmax, rmax, cmax, f, lj, cell; for (size_t b = 0; b < nblocks; b++) { lstart = dz * (b / bpL); rstart = (dy * (b / bpR)) % adjnr; cstart = dx * (b % bpR); lmax = std::min(nl, (lstart + dz)); rmax = std::min(nr, (rstart + dy)); // nrow -> nr cmax = std::min(nc, (cstart + dx)); f = 0; std::vector a(blockcells, NAN); for (size_t j = lstart; j < lmax; j++) { lj = j * ncells; for (size_t r = rstart; r < rmax; r++) { cell = lj + r * nc; for (size_t c = cstart; c < cmax; c++) { a[f] = in[cell + c]; f++; } } } out[b] = fun(a, narm); } } void tabulate_aggregates(const std::vector &in, std::vector &out, size_t nr, size_t nc, std::vector dim, const std::map &counts, bool narm) { // dim 0, 1, are the aggregations factors dy, dx // and 3, 4, 5 are the new nrow, ncol, nlyr size_t dy = dim[0], dx = dim[1]; size_t bpC = std::ceil((double)nr / (double)dim[0]); size_t bpR = dim[4]; // new number of layers size_t newNL = dim[5]; // new number of rows, adjusted for additional (expansion) rows size_t adjnr = bpC * dy; // number of aggregates size_t nblocks = (bpR * bpC); // cells per aggregate //size_t blockcells = dx * dy; // output: each element is a block out = std::vector(nblocks * newNL, NAN); // size_t ncells = nr * nc; for (size_t b = 0; b < nblocks; b++) { size_t rstart = (dy * (b / bpR)) % adjnr; size_t cstart = dx * (b % bpR); size_t rmax = std::min(nr, rstart + dy); // nrow -> nr size_t cmax = std::min(nc, cstart + dx); if (!narm) { if ((nr < (rstart + dy)) || (nc < (cstart + dx))) { continue; } } std::map block_counts = counts; if (narm) { for (size_t r = rstart; r < rmax; r++) { size_t cell = r * nc; bool anyval = false; for (size_t c = cstart; c < cmax; c++) { size_t j = cell + c; if (!std::isnan(in[j])) { long j = in[cell + c]; block_counts[j]++; anyval = true; } } long i = 0; if (anyval) { for (auto it = block_counts.begin(); it != block_counts.end(); ++it) { size_t off = b + (i*nblocks); out[off] = it->second; i++; } } } } else { bool nafound = false; for (size_t r = rstart; r < rmax; r++) { if (nafound) break; size_t cell = r * nc; for (size_t c = cstart; c < cmax; c++) { size_t j = cell + c; if (std::isnan(in[j])) { nafound = true; break; } long k = in[j]; block_counts[k]++; } } if (!nafound) { long i = 0; for (auto it = block_counts.begin(); it != block_counts.end(); ++it) { size_t off = b + (i*nblocks); out[off] = it->second; i++; } } } } } SpatRaster SpatRaster::aggregate(std::vector fact, std::string fun, bool narm, SpatOptions &opt) { SpatRaster out; if ((fun == "table") && (nlyr() > 1)) { SpatOptions ops(opt); SpatRaster out = subset({0}, ops); out = out.aggregate(fact, fun, narm, opt); out.addWarning("only the first layer is used with 'fun=table'"); return out; } std::string message = ""; // fact 0, 1, 2, are the aggregation factors dy, dx, dz // and 3, 4, 5 are the new nrow, ncol, nlyr if (!get_aggregate_dims(fact, message)) { if (message.substr(0,3) == "all") { std::string filename = opt.get_filename(); if (filename.empty()) { out = *this; out.addWarning(message); } else { out = writeRaster(opt); } } else { out.setError(message); } return out; } SpatExtent extent = getExtent(); double xmax = extent.xmin + fact[4] * fact[1] * xres(); double ymin = extent.ymax - fact[3] * fact[0] * yres(); SpatExtent e = SpatExtent(extent.xmin, xmax, ymin, extent.ymax); SpatCategories cats; std::map counts; if (fun == "table") { std::vector has_cats = hasCategories(); if (has_cats[0]) { cats = getLayerCategories(0); //fact[5] = cats.d.nrow(); std::vector uvals = cats.d.getI(0); int n = uvals.size(); for (int i=0; i(uvals[i], 0)); } fact[5] = counts.size(); out = SpatRaster(fact[3], fact[4], fact[5], e, ""); if (cats.d.nrow() == counts.size()) { out.setNames(getLabels(0)); } else { std::vector nms; nms.reserve(fact[5]); for (auto it = counts.begin(); it != counts.end(); ++it) { nms.push_back(std::to_string(it->first)); } out.setNames(nms); } } else { SpatOptions tops(opt); std::vector> ud = unique(false, 0, true, tops); int n = ud[0].size(); for (int i=0; i(v, 0)); } fact[5] = counts.size(); out = SpatRaster(fact[3], fact[4], fact[5], e, ""); std::vector nms; nms.reserve(fact[5]); for (auto it = counts.begin(); it != counts.end(); ++it) { nms.push_back(std::to_string(it->first)); } out.setNames(nms); } } else { out = SpatRaster(fact[3], fact[4], fact[5], e, ""); out.source[0].time = getTime(); if (fact[5] == nlyr()) { out.setNames(getNames()); } } out.source[0].srs = source[0].srs; if (!source[0].hasValues) { return out; } std::function&, bool)> agFun; if ((fun != "table") && (!haveFun(fun))) { out.setError("unknown function argument"); return out; } else { agFun = getFun(fun); } //BlockSize bs = getBlockSize(4, opt.get_memfrac()); opt.progress *= 300; BlockSize bs = getBlockSize(opt); //bs.n = floor(nrow() / fact[0]); # ambiguous on solaris bs.n = std::floor(static_cast (nrow() / fact[0])); bs.nrows = std::vector(bs.n, fact[0]); bs.row.resize(bs.n); for (size_t i =0; i vin, vout; readValues(vin, bs.row[i], bs.nrows[i], 0, nc); tabulate_aggregates(vin, vout, bs.nrows[i], nc, fact, counts, narm); if (!out.writeValues(vout, i, 1)) return out; } } else { for (size_t i = 0; i < bs.n; i++) { std::vector vin, v; readValues(vin, bs.row[i], bs.nrows[i], 0, nc); compute_aggregates(vin, v, bs.nrows[i], nc, nlyr(), fact, agFun, narm); if (!out.writeValues(v, i, 1)) return out; } } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::weighted_mean(SpatRaster w, bool narm, SpatOptions &opt) { SpatRaster out; if (nlyr() != w.nlyr()) { out.setError("nlyr of data and weights are different"); return out; } SpatOptions topt(opt); out = arith(w, "*", false, topt); out = out.summary("sum", narm, topt); if (narm) { w = w.mask(*this, false, NAN, NAN, topt); } SpatRaster wsum = w.summary("sum", narm, topt); if (opt.names.empty()) { opt.names = {"weighted.mean"}; } return out.arith(wsum, "/", false, opt); } SpatRaster SpatRaster::weighted_mean(std::vector w, bool narm, SpatOptions &opt) { SpatRaster out; for (size_t i=0; i v; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; std::vector wm(off, 0); std::vector wv(off, 0); for (size_t j=0; j classes, double keepvalue, double othervalue, bool round, int digits, SpatOptions &opt) { SpatRaster out; if (!hasValues()) { out.setError("input has no values"); return out; } if (nlyr() > 1) { out.setError("input may only have one layer"); return out; } if (classes.empty()) { SpatOptions topt(opt); std::vector> rc = unique(false, NAN, true, topt); classes = rc[0]; } if (round) { for (size_t i=0; i snms(n); for (size_t i=0; i v; readBlock(v, out.bs, i); if (round) { for(double& d : v) d = roundn(d, digits); } size_t nn = v.size(); std::vector vv(nn * n, NAN); for (size_t j=0; j m, SpatOptions &opt) { SpatRaster out = geometry(); if (m.empty()) { out.setError("no matches supplied"); return(out); } if (!hasValues()) { out.setError("input has no values"); return(out); } int hasNAN = 0; for (size_t i=0; i v; readBlock(v, out.bs, i); std::vector vv(v.size(), 0); for (size_t j=0; j> SpatRaster::is_in_cells(std::vector m, bool keepvalue, SpatOptions &opt) { std::vector> out(nlyr()); std::vector> outval(nlyr()); if (m.empty()) { return(out); } if (!hasValues()) { return(out); } bool hasNAN = false; for (size_t i=0; i v; readBlock(v, bs, i); size_t cellperlayer = bs.nrows[i] * nc; for (size_t j=0; j minv, std::vector maxv, std::vector minq, std::vector maxq, std::vector smin, std::vector smax, SpatOptions &opt) { SpatRaster out = geometry(-1, true, true, true, true); if (!hasValues()) return(out); size_t nl = nlyr(); recycle(minv, nl); recycle(maxv, nl); recycle(minq, nl); recycle(maxq, nl); recycle(smin, nl); recycle(smax, nl); std::vector> q(nl); std::vector useS(nl, false); std::vector mult(nl); for (size_t i=0; i= maxv[i]) { out.setError("maxv must be larger than minv"); return out; } if ((!std::isnan(smin[i])) && (!std::isnan(smax[i]))) { if (smin[i] >= smax[i]) { out.setError("smax must be larger than smin"); return out; } useS[i] = true; q[i] = {smin[i], smax[i]}; } else { if (minq[i] >= maxq[i]) { out.setError("maxq must be larger than minq"); return out; } if ((minq[i] < 0) || (maxq[i] > 1)) { out.setError("minq and maxq must be between 0 and 1"); return out; } } } std::vector hR = hasRange(); for (size_t i=0; i rmn = range_min(); std::vector rmx = range_max(); q[i] = {rmn[i], rmx[i]}; } else { std::vector probs = {minq[i], maxq[i]}; SpatOptions xopt(opt); std::vector v = getValues(i, xopt); q[i] = vquantile(v, probs, true); } } mult[i] = maxv[i] / (q[i][1]-q[i][0]); } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector v; readBlock(v, out.bs, i); size_t nc = out.bs.nrows[i] * ncol(); for (size_t j=0; j maxv[lyr]) v[j] = maxv[lyr]; } if (!out.writeBlock(v, i)) return out; } readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::apply(std::vector ind, std::string fun, bool narm, std::vector nms, std::vector time, std::string timestep, std::string timezone, SpatOptions &opt) { recycle(ind, nlyr()); std::vector ui = vunique(ind); size_t nl = ui.size(); SpatRaster out = geometry(nl); recycle(nms, nl); out.setNames(nms); if (!time.empty()) { recycle(time, nl); if (!out.setTime(time, timestep, timezone)) { out.addWarning("could not set time"); } } if (!haveFun(fun)) { out.setError("unknown function argument"); return out; } if (!hasValues()) return(out); if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } out.bs = getBlockSize(opt); // #ifdef useRcpp // out.pbar = new Progress(out.bs.n+2, opt.show_progress(bs.n)); // out.pbar->increment(); // #endif std::vector> v(nl); std::vector ird(ind.size()); std::vector jrd(ind.size()); for (size_t i=0; i&, bool)> theFun = getFun(fun); for (size_t i=0; i a; readBlock(a, out.bs, i); size_t nc = out.bs.nrows[i] * ncol(); std::vector b(nc * nl); for (size_t j=0; j vt = getValueType(true); if (vt.size() == 1) { out.setValueType(vt[0]); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector v, m; for (size_t i = 0; i < out.bs.n; i++) { readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); x.readValues(m, out.bs.row[i], out.bs.nrows[i], 0, ncol()); recycle(v, m); if (inverse) { if (std::isnan(maskvalue)) { for (size_t j=0; j < v.size(); j++) { if (!std::isnan(m[j])) { v[j] = updatevalue; } } } else { for (size_t j=0; j < v.size(); j++) { if (m[j] != maskvalue) { v[j] = updatevalue; } } } } else { if (std::isnan(maskvalue)) { for (size_t j=0; j < v.size(); j++) { if (std::isnan(m[j])) { v[j] = updatevalue; } } } else { for (size_t j=0; j < v.size(); j++) { if (m[j] == maskvalue) { v[j] = updatevalue; } } } } if (!out.writeBlock(v, i)) return out; } out.writeStop(); readStop(); x.readStop(); return(out); } SpatRaster SpatRaster::mask(SpatRaster &x, bool inverse, std::vector maskvalues, double updatevalue, SpatOptions &opt) { maskvalues = vunique(maskvalues); if (maskvalues.size() == 1) { return mask(x, inverse, maskvalues[0], updatevalue, opt); } size_t nl = std::max(nlyr(), x.nlyr()); SpatRaster out = geometry(nl, true); if (maskvalues.empty()) { out.setError("no mask value supplied"); return(out); } if (!hasValues()) { out.setError("raster has no values"); return out; } if (!x.hasValues()) { out.setError("mask raster has no values"); return out; } if (!out.compare_geom(x, false, true, opt.get_tolerance(), true, true, true, false)) { return(out); } if (!readStart()) { out.setError(getError()); return(out); } if (!x.readStart()) { out.setError(x.getError()); return(out); } bool maskNA = false; for (int i = maskvalues.size()-1; i>=0; i--) { if (std::isnan(maskvalues[i])) { maskNA = true; maskvalues.erase(maskvalues.begin()+i); } } if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector v, m; for (size_t i = 0; i < out.bs.n; i++) { readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); x.readValues(m, out.bs.row[i], out.bs.nrows[i], 0, ncol()); recycle(v, m); if (inverse) { for (size_t i=0; i < v.size(); i++) { if (maskNA && std::isnan(m[i])) { v[i] = updatevalue; } else { bool found = false; for (size_t j=0; j < maskvalues.size(); j++) { if (m[i] == maskvalues[j]) { found = true; break; } } if (!found) v[i] = updatevalue; } } } else { for (size_t i=0; i < v.size(); i++) { if (maskNA && std::isnan(m[i])) { v[i] = updatevalue; } else { for (size_t j=0; j < maskvalues.size(); j++) { if (m[i] == maskvalues[j]) { v[i] = updatevalue; break; } } } } } if (!out.writeBlock(v, i)) return out; } out.writeStop(); readStop(); x.readStop(); return(out); } SpatRaster SpatRaster::mask(SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) return out; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nl = nlyr(); size_t nc = ncol(); for (size_t i=0; i v; std::vector w; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; w.resize(off, false); for (size_t j=0; j koff; koff.reserve(nl); for (size_t k=0; k v; readValues(v, 0, nr, out.bs.row[i], nc); std::vector vv(v.size()); for (size_t lyr=0; lyr v; size_t firstrow, lastrow, firstcol, lastcol; if (std::isnan(value)) { for (r=0; rfirstrow; r--) { readValues(v, r, 1, 0, ncol()); if (std::count_if(v.begin(), v.end(), [](double d) { return std::isnan(d); } ) < ncl) { break; } } lastrow = std::max(std::min(r+padding, nrow()), size_t(0)); if (lastrow < firstrow) { std::swap(firstrow, lastrow); } size_t c; for (c=0; cfirstcol; c--) { readValues(v, 0, nrow(), c, 1); if (std::count_if( v.begin(), v.end(), [](double d) { return std::isnan(d); } ) < nrl) { break; } } lastcol = std::max(std::min(c+padding, ncol()), size_t(0)); } else { for (r=0; rfirstrow; r--) { readValues(v, r, 1, 0, ncol()); if (std::count( v.begin(), v.end(), value) < ncl) { break; } } lastrow = std::max(std::min(r+padding, nrow()), size_t(0)); if (lastrow < firstrow) { std::swap(firstrow, lastrow); } size_t c; for (c=0; cfirstcol; c--) { readValues(v, 0, nrow(), c, 1); if (std::count( v.begin(), v.end(), value) < nrl) { break; } } lastcol = std::max(std::min(c+padding, ncol()), size_t(0)); } readStop(); if (lastcol < firstcol) { std::swap(firstcol, lastcol); } std::vector res = resolution(); double xr = res[0]; double yr = res[1]; SpatExtent e = SpatExtent(xFromCol(firstcol)-0.5*xr, xFromCol(lastcol)+0.5*xr, yFromRow(lastrow)-0.5*yr, yFromRow(firstrow)+0.5*yr); return( crop(e, "near", false, opt) ) ; } void block_cols(const std::vector &v, std::function fun, const double &value, size_t &firstcol, size_t &lastcol, bool &firstcoldone, bool &lastcoldone, const size_t &firstrow, const size_t &lastrow, const size_t &nr, const size_t &nc, const size_t &nl, const size_t &padding) { size_t maxcol = nc - padding - 1; std::vector loff(nl); for (size_t i=0; i=(long)lastcol; c--) { if (fun(v[loff[lyr] + roff + c], value)) { lastcol = c; if (lastcol >= maxcol) lastcoldone = true; break; } } if (lastcoldone) break; } if (lastcoldone) break; } } } inline bool trim_value(const double &x, const double &y) { return x != y; } inline bool trim_nan(const double &x, const double &y) { return !std::isnan(x); } SpatRaster SpatRaster::trim2(double value, size_t padding, SpatOptions &opt) { // check if opt.filename exists and overwrite=false? if (!readStart()) { SpatRaster out; out.setError(getError()); return(out); } std::vector v; BlockSize bs = getBlockSize(opt); size_t nl = nlyr(); size_t nc = ncol(); size_t nr = nrow(); bool firstrowfound = false; bool lastrowfound = false; bool firstcolfound = false; bool lastcolfound = false; size_t bstart = 0; size_t bend = bs.n - 1; size_t firstrow = nr-1; size_t lastrow = 0; size_t firstcol = nc-1; size_t lastcol = 0; if (padding >= nc) { firstcolfound = true; lastcolfound = true; firstcol = 0; lastcol = nc-1; } if (padding >= nr) { firstrowfound = true; lastrowfound = true; firstrow = 0; lastrow = nr-1; } std::function fun; if (std::isnan(value)) { fun = trim_nan; } else { fun = trim_value; } bool rowfound = false; for (size_t i=0; i loff(nl); for (size_t j=0; j loff(nl); for (size_t j=0; j=0; r--) { size_t roff = r * nc; for (size_t lyr=0; lyr=0; i--) { bend = i; readBlock(v, bs, i); std::vector loff(nl); for (size_t j=0; j=0; r--) { size_t roff = r * nc; for (size_t lyr=0; lyr res = resolution(); double xr = res[0]; double yr = res[1]; SpatExtent e = SpatExtent(xFromCol(firstcol)-0.5*xr, xFromCol(lastcol)+0.5*xr, yFromRow(lastrow)-0.5*yr, yFromRow(firstrow)+0.5*yr); return( crop(e, "near", false, opt) ) ; } void clamp_vector(std::vector &v, double low, double high, bool usevalue) { size_t n = v.size(); if (usevalue) { for (size_t i=0; i high ) { v[i] = high; } } } else { for (size_t i=0; i high)) { v[i] = NAN; } } } } SpatRaster SpatRaster::clamp(std::vector low, std::vector high, bool usevalue, SpatOptions &opt) { SpatRaster out = geometry(nlyr(), true); if (!hasValues()) { out.setError("cannot clamp a raster with no values"); return out; } if (low.empty() || high.empty()) { out.setError("you must provide low and high clamp values"); return out; } size_t nl = nlyr(); if ((low.size() > nl) || (high.size() > nl)) { out.setError("there are more low and/or high values than layers"); return out; } bool do_one = true; if ((low.size() > 1) || (high.size() > 1)) { do_one = false; recycle(low, nl); recycle(high, nl); } for (size_t i=0; i high[i]) { out.setError("lower clamp value cannot be larger than the higher clamp value"); return out; } } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (do_one) { for (size_t i = 0; i < out.bs.n; i++) { std::vector v; readBlock(v, out.bs, i); clamp_vector(v, low[0], high[0], usevalue); if (!out.writeBlock(v, i)) return out; } } else { size_t nc = ncol(); for (size_t i = 0; i < out.bs.n; i++) { size_t off = out.bs.nrows[i] * nc; std::vector v; readBlock(v, out.bs, i); if (usevalue) { for (size_t j=0; j high[j] ) { v[k] = high[j]; } } } } else { for (size_t j=0; j high[j])) { v[k] = NAN; } } } } if (!out.writeBlock(v, i)) return out; } } readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::clamp_raster(SpatRaster &x, SpatRaster &y, std::vector low, std::vector high, bool usevalue, SpatOptions &opt) { SpatRaster out = geometry(nlyr(), true); if (!hasValues()) { out.setError("cannot clamp a raster with no values"); return out; } size_t nl = nlyr(); bool do_one = true; bool rA = false; bool rB = false; bool onex = true; bool oney = true; if (std::isnan(low[0])) { rA = true; if (!x.hasValues()) { out.setError("cannot clamp with raster that has no values"); return out; } if (x.nlyr() > 1) { if (x.nlyr() != nl) { out.setError("clamp raster must have one layer or the same number of layers as x"); return out; } else { onex = false; } } } else { if (low.size() > nl) { out.setError("there are more low values than layers"); return out; } } if (std::isnan(high[0])) { rB = true; if (!y.hasValues()) { out.setError("cannot clamp with raster that has no values"); return out; } if (y.nlyr() > 1) { if (y.nlyr() != nl) { out.setError("clamp raster must have one layer or the same number of layers as x"); return out; } else { oney = false; } } } else { if (high.size() > nl) { out.setError("there are more high values than layers"); return out; } } if ((low.size() > 1) || (high.size() > 1) || rA || rB) { do_one = false; recycle(low, nl); recycle(high, nl); } if (!(rA | rB)) { for (size_t i=0; i high[i]) { out.setError("lower clamp value cannot be larger than the higher clamp value"); return out; } } } if (rA) { if (!x.readStart()) { out.setError(x.getError()); return(out); } } if (rB) { if (!y.readStart()) { out.setError(y.getError()); return(out); } } if (!readStart()) { out.setError(getError()); return(out); } opt.ncopies = (1 + oney + onex) * opt.ncopies; if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (!(rA | rB)) { if (do_one) { for (size_t i = 0; i < out.bs.n; i++) { std::vector v; readBlock(v, out.bs, i); clamp_vector(v, low[0], high[0], usevalue); if (!out.writeBlock(v, i)) return out; } } else { size_t nc = ncol(); for (size_t i = 0; i < out.bs.n; i++) { size_t off = out.bs.nrows[i] * nc; std::vector v; readBlock(v, out.bs, i); if (usevalue) { for (size_t j=0; j high[j] ) { v[k] = high[j]; } } } } else { for (size_t j=0; j high[j])) { v[k] = NAN; } } } } if (!out.writeBlock(v, i)) return out; } } } else if (rA & rB) { for (size_t i = 0; i < out.bs.n; i++) { std::vector v, vx, vy; readBlock(v, out.bs, i); x.readBlock(vx, out.bs, i); y.readBlock(vy, out.bs, i); size_t ncl = vx.size(); if (usevalue) { for (size_t j=0; j vy[ky] ) { v[j] = vy[ky]; } } } else { for (size_t j=0; j vy[ky] ) { v[j] = NAN; } } } if (!out.writeBlock(v, i)) return out; } } else if (rA) { for (size_t i = 0; i < out.bs.n; i++) { std::vector v, vx; readBlock(v, out.bs, i); x.readBlock(vx, out.bs, i); size_t ncl = vx.size(); if (usevalue) { for (size_t j=0; j high[lyr] ) { v[j] = high[lyr]; } } } else { for (size_t j=0; j high[lyr] ) { v[j] = NAN; } } } if (!out.writeBlock(v, i)) return out; } } else if (rB) { for (size_t i = 0; i < out.bs.n; i++) { std::vector v, vy; readBlock(v, out.bs, i); y.readBlock(vy, out.bs, i); size_t ncl = vy.size(); if (usevalue) { for (size_t j=0; j vy[k]) { v[j] = vy[k]; } } } else { for (size_t j=0; j vy[k]) { v[j] = NAN; } } } if (!out.writeBlock(v, i)) return out; } } readStop(); if (rA) x.readStop(); if (rB) y.readStop(); out.writeStop(); return(out); } std::vector bip2bil(const std::vector &v, size_t nl) { size_t n = v.size(); size_t ncell = n / nl; std::vector out(n); std::vector offlyr(nl); for (size_t j=0; j v; readBlockIP(v, out.bs, i); for (size_t j=0; j 1 && recycleby < nl) { nrecs = nl / recycleby; } else { recycleby = 0; } SpatRaster out = geometry( z * nrecs ); if (!out.compare_geom(x, false, false, opt.get_tolerance())) { return(out); } if (!hasValues()) return(out); if (x.nlyr() > 1) { out.setError("index raster must have only one layer"); return out; } if (!x.hasValues()) { out.setError("index raster has no values"); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!x.readStart()) { out.setError(x.getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i=0; i v, idx; readBlock(v, out.bs, i); x.readBlock(idx, out.bs, i); size_t is = idx.size(); std::vector vv(is*z*nrecs, NAN); size_t ncell = out.bs.nrows[i] * ncol(); // same as is? for (size_t j=0; j= 0) && (start < nl)) { int zz = std::min(nl-start, z); // do not surpass the last layer for (int i=0; i= 0) && (index < nl)) { // vv[j] = v[j + index * ncell]; // } //} if (!out.writeBlock(vv, i)) return out; } readStop(); x.readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::roll(size_t n, std::string fun, std::string type, bool circular, bool narm, SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) { out.setError("no values in input"); return(out); } if (!haveFun(fun)) { out.setError("unknown function argument"); return out; } if (n >= nlyr()) { out.setError("it makes no sense to use a rolling function with n >= nlyr(x)"); return out; } if (n <= 1) { out.setError("n should be > 1"); return out; } std::vector types = {"around", "to", "from"}; if (!is_in_vector(type, types)) { out.setError("unknown roll type, should be 'around', 'to', or 'from'"); return out; } // to do: use functions that iterate over vector instead of copying std::function&, bool)> theFun = getFun(fun); size_t nl = nlyr(); if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (circular) { for (size_t i=0; i v; readBlockIP(v, out.bs, i); size_t ncell = out.bs.nrows[i] * ncol(); std::vector vv(v.size(), NAN); if (type=="from") { for (size_t j=0; j se; size_t start = offset + k; size_t end = k + n; if (end > nl) { size_t cend = end - nl; se = {v.begin()+offset, v.begin()+offset+cend}; end = nl; } end += offset; se.insert(se.end(), v.begin()+start, v.begin()+end); vv[ncell * k + j] = theFun(se, narm); } } } else if (type=="around") { size_t halfn = n / 2; for (size_t j=0; j se; size_t start, end; if (k < halfn) { start = 0; end = n + k - halfn; size_t cbegin = nl - (halfn - k); se = {v.begin()+offset+cbegin, v.begin()+offset+nl}; } else { start = k - halfn; end = start + n; } if (end > nl) { end = nl; size_t cend = end - nl + 1; se = {v.begin()+offset, v.begin()+offset+cend}; } start += offset; end += offset; se.insert(se.end(), v.begin()+start, v.begin()+end); vv[ncell * k + j] = theFun(se, narm); } } } else if (type=="to") { for (size_t j=0; j se; size_t start; size_t end = offset + k + 1; if (k < (n-1)) { start = offset; size_t cbegin = nl - (n - k - 1); se = {v.begin()+offset+cbegin, v.begin()+offset+nl}; } else { start = end - n; } se.insert(se.end(), v.begin()+start, v.begin()+end); vv[ncell * k + j] = theFun(se, narm); } } } if (!out.writeBlock(vv, i)) return out; } } else { // not circular std::vector se; for (size_t i=0; i v; readBlockIP(v, out.bs, i); size_t ncell = out.bs.nrows[i] * ncol(); std::vector vv(v.size(), NAN); if (type=="from") { for (size_t j=0; j nl) { if (narm) { end = nl; } else { continue; } } end += offset; se = {v.begin()+start, v.begin()+end}; vv[ncell * k + j] = theFun(se, narm); } } } else if (type=="around") { size_t halfn = n / 2; for (size_t j=0; j nl) { if (narm) { end = nl; } else { continue; } } start += offset; end += offset; se = {v.begin()+start, v.begin()+end}; vv[ncell * k + j] = theFun(se, narm); } } } else if (type=="to") { for (size_t j=0; j&, bool)> theFun = getFun(fun); int nl = nlyr(); if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!x.readStart()) { out.setError(x.getError()); return(out); } for (size_t i=0; i v, idx; readBlock(v, out.bs, i); x.readBlock(idx, out.bs, i); size_t ncell = out.bs.nrows[i] * ncol(); std::vector vv(ncell, NAN); for (size_t j=0; j= nl ? (nl-1) : end; if (circular) { end = end < 0 ? 0 : end; start = start >= nl ? (nl-1) : start; } } bool inrange = (start < nl) && (end < nl) && (start >= 0) && (end >= 0); bool circ = false; if (start > end) { if (circular) { circ = true; } else { inrange = false; } } if (inrange) { std::vector se; if (circ) { se.reserve(end + nl - start + 1); for (int k = start; k> SpatRaster::rappvals(SpatRaster x, double first, double last, bool clamp, bool all, double fill, size_t startrow, size_t nrows, bool circular) { std::vector> r; bool sval = !std::isnan(first); bool eval = !std::isnan(last); if (sval && eval) { setError("first or last must be NA. See `app` for other cases"); return r; } int start = sval ? first-1 : 0; int end = eval ? last-1 : 0; if (!compare_geom(x, false, false, 0.1)) { return(r); } if (!hasValues()) { return r; } if (!x.hasValues()) { setError("index raster has no values"); return r; } size_t expnl = 2 - (sval + eval); if (x.nlyr() != expnl) { setError("index raster must have " + std::to_string(expnl) + "layer(s)"); return r; } int nl = nlyr(); if (!readStart()) { return(r); } if (!x.readStart()) { setError(x.getError()); return(r); } std::vector v, idx; readValues(v, startrow, nrows, 0, ncol()); x.readValues(idx, startrow, nrows, 0, ncol()); size_t ncell = nrows * ncol(); r.resize(ncell); for (size_t j=0; j= nl ? (nl-1) : end; if (circular) { end = end < 0 ? 0 : end; start = start >= nl ? (nl-1) : start; } } bool inrange = (start < nl) && (end < nl) && (start >= 0) && (end >= 0); bool circ = false; if (start > end) { if (circular) { circ = true; } else { inrange = false; } } if (all) { if (inrange) { r[j].resize(nl, fill); if (circ) { for (int k=start; k &fact, std::string &message ) { size_t fs = fact.size(); if ((fs > 3) | (fs == 0)) { message = "argument 'fact' should have length 1, 2, or 3"; return false; } auto min_value = *std::min_element(fact.begin(),fact.end()); if (min_value < 1) { message = "values in argument 'fact' should be > 0"; return false; } auto max_value = *std::max_element(fact.begin(),fact.end()); if (max_value == 1) { message = "all values in argument 'fact' are 1, nothing to do"; return false; } fact.resize(3); if (fs == 1) { fact[1] = fact[0]; } fact[2] = 1; return true; } SpatRaster SpatRaster::disaggregate(std::vector fact, SpatOptions &opt) { SpatRaster out = geometry(nlyr(), true); std::string message = ""; if (!disaggregate_dims(fact, message)) { if (message.substr(0,3) == "all") { out = *this; out.addWarning(message); } else { out.setError(message); } return out; } out.source[0].nrow = out.source[0].nrow * fact[0]; out.source[0].ncol = out.source[0].ncol * fact[1]; out.source[0].nlyr = out.source[0].nlyr * fact[2]; if (!hasValues()) { return out; } opt.ncopies = 4 + fact[0]*fact[1]*fact[2]; BlockSize bs = getBlockSize(opt); opt.steps = bs.n; //opt.set_blocksizemp(); size_t nc = ncol(); size_t nl = nlyr(); std::vector newrow(nc*fact[1]); if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < bs.n; i++) { std::vector v, vout; readValues(v, bs.row[i], bs.nrows[i], 0, nc); vout.reserve(v.size() * fact[0] * fact[1] * fact[2]); for (size_t lyr=0; lyr f {"row", "col", "cell", "x", "y", "chess"}; bool test = std::find(f.begin(), f.end(), value) == f.end(); if (test) { out.setError("not a valid init option"); return out; } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nc = ncol(); std::vector v; if (value == "row") { for (size_t i = 0; i < out.bs.n; i++) { v.resize(nc * out.bs.nrows[i]); for (size_t j = 0; j < out.bs.nrows[i]; j++) { size_t r = out.bs.row[i] + j + plusone; for (size_t k = 0; k < nc; k++) { v[j*nc+k] = r; } } if (!out.writeBlock(v, i)) return out; } //source[0].range_min.resize(1, 0 + plusone); //source[0].range_max.resize(1, nrow() - 1 + plusone); //source[0].hasRange.resize(1, true); } else if (value == "col") { std::vector cnn(nc); double start = plusone ? 1 : 0; std::iota(cnn.begin(), cnn.end(), start); size_t oldnr = 0; for (size_t i = 0; i < out.bs.n; i++) { if (oldnr != out.bs.nrows[i]) { v = cnn; recycle(v, out.bs.nrows[i] * nc); } if (!out.writeBlock(v, i)) return out; } //source[0].range_min.resize(1, 0 + plusone); //source[0].range_max.resize(1, nc - 1 + plusone); //source[0].hasRange.resize(1, true); } else if (value == "cell") { for (size_t i = 0; i < out.bs.n; i++) { v.resize(nc * out.bs.nrows[i]); size_t firstcell = cellFromRowCol(out.bs.row[i], 0); firstcell = plusone ? firstcell + 1 : firstcell; std::iota(v.begin(), v.end(), firstcell); if (!out.writeBlock(v, i)) return out; } //source[0].range_min.resize(1, 0 + plusone); //source[0].range_max.resize(1, ncell() - 1 + plusone); //source[0].hasRange.resize(1, true); } else if (value == "x") { std::vector col(nc); std::iota(col.begin(), col.end(), 0); std::vector xcoords = xFromCol(col); size_t oldnr = 0; for (size_t i = 0; i < out.bs.n; i++) { if (oldnr != out.bs.nrows[i]) { v = xcoords; recycle(v, out.bs.nrows[i] * nc); } if (!out.writeBlock(v, i)) return out; } //source[0].range_min.resize(1, xcoords[0]); //source[0].range_max.resize(1, xcoords[nc-1]); //source[0].hasRange.resize(1, true); } else if (value == "y") { for (size_t i = 0; i < out.bs.n; i++) { v.resize(out.bs.nrows[i] * nc ); for (size_t j = 0; j < out.bs.nrows[i]; j++) { double y = yFromRow(out.bs.row[i] + j); for (size_t k = 0; k < nc; k++) { v[j*nc+k] = y; } } if (!out.writeBlock(v, i)) return out; } //source[0].range_min.resize(1, yFromRow(0)); //source[0].range_max.resize(1, yFromRow(nrow()-1)); //source[0].hasRange.resize(1, true); } else if (value == "chess") { std::vector a(nc); std::vector b(nc); for (size_t i=0; i v; for (size_t i = 0; i < out.bs.n; i++) { if ((out.bs.row[i]%2) == 0) { v = a; v.insert(v.end(), b.begin(), b.end()); } else { v = b; v.insert(v.end(), b.begin(), b.end()); } recycle(v, out.bs.nrows[i] * nc); if (!out.writeBlock(v, i)) return out; } //source[0].range_min.resize(1, 0); //source[0].range_max.resize(1, 1); //source[0].hasRange.resize(1, true); } out.writeStop(); return(out); } SpatRaster SpatRaster::init(std::vector values, SpatOptions &opt) { SpatRaster out = geometry(); if (values.empty()) { out.setError("no value supplied"); return(out); } if (!out.writeStart(opt, filenames())) { return out; } size_t nc = ncol(); size_t nl = nlyr(); if (values.size() == 1) { double val = values[0]; std::vector v; for (size_t i = 0; i < out.bs.n; i++) { v.resize(out.bs.nrows[i]*nc*nl, val); if (!out.writeBlock(v, i)) return out; } //source[0].range_min.resize(1, val); //source[0].range_max.resize(1, val); //source[0].hasRange.resize(1, true); } else { int over = 0; for (size_t i = 0; i < out.bs.n; i++) { if (over > 0) { std::vector newv(values.begin()+over, values.end()); newv.insert(newv.end(), values.begin(), values.begin()+over); values = newv; } std::vector v = values; recycle(v, out.bs.nrows[i]*nc); recycle(v, out.bs.nrows[i]*nc*nl); over = v.size() % values.size(); if (!out.writeBlock(v, i)) return out; } } out.writeStop(); return(out); } SpatRaster SpatRaster::rotate(bool left, SpatOptions &opt) { size_t nc = ncol(); size_t nl = nlyr(); size_t hnc = (nc / 2); double addx = hnc * xres(); if (left) { addx = -addx; } SpatRaster out = geometry(nlyr(), true, true, true); SpatExtent outext = out.getExtent(); outext.xmin = outext.xmin + addx; outext.xmax = outext.xmax + addx; out.setExtent(outext, true, true, ""); if (!hasValues()) return out; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i=0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); std::vector b; b.reserve(a.size()); for (size_t j=0; j < nl; j++) { for (size_t r=0; r < out.bs.nrows[i]; r++) { size_t s1 = j * out.bs.nrows[i] * nc + r * nc; size_t e1 = s1 + hnc; b.insert(b.end(), a.begin()+e1, a.begin()+s1+nc); b.insert(b.end(), a.begin()+s1, a.begin()+e1); } } if (!out.writeBlock(b, i)) return out; } out.writeStop(); readStop(); return(out); } bool SpatRaster::shared_basegeom(SpatRaster &x, double tol, bool test_overlap) { if (!compare_origin(x.origin(), tol)) return false; if (!about_equal(xres(), x.xres(), xres() * tol)) return false; if (!about_equal(yres(), x.yres(), yres() * tol)) return false; if (test_overlap) { SpatExtent e = x.getExtent(); e = e.intersect(getExtent()); if (!e.valid()) return false; } return true; } SpatRaster SpatRaster::cover(SpatRaster x, std::vector values, SpatOptions &opt) { size_t nl = std::max(nlyr(), x.nlyr()); SpatRaster out = geometry(nl, true, true, true); bool rmatch = false; if (out.compare_geom(x, false, false, opt.get_tolerance(), true)) { rmatch = true; } else { // if (!shared_basegeom(x, 0.1, true)) { out.setError("raster dimensions do not match"); return(out); // } else { // out.msg.has_error = false; // out.msg.error = ""; // SpatExtent e = getExtent(); // SpatExtent xe = x.getExtent(); // double prec = std::min(xres(), yres())/1000; // if (!xe.compare(e, "<=", prec)) { // SpatOptions xopt(opt); // x = x.crop(e, "near", xopt); // } // } } if (!x.hasValues()) { return *this; } if (!hasValues()) { if (rmatch) { return x.deepCopy(); } else { SpatExtent e = getExtent(); return x.extend(e, "near", NAN, opt); } } std::vector cats = hasCategories(); std::vector xcats = x.hasCategories(); recycle(cats, xcats); for (size_t i =0; i v, m; readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); x.readValues(m, out.bs.row[i], out.bs.nrows[i], 0, ncol()); recycle(v, m); if (std::isnan(value)) { for (size_t j=0; j < v.size(); j++) { if (std::isnan(v[j])) { v[j] = m[j]; } } } else { for (size_t j=0; j < v.size(); j++) { if (v[j] == value) { v[j] = m[j]; } } } if (!out.writeBlock(v, i)) return out; } } else { values = vunique(values); bool hasNA = false; for (int i = values.size()-1; i>=0; i--) { if (std::isnan(values[i])) { hasNA = true; values.erase(values.begin()+i); } } for (size_t i = 0; i < out.bs.n; i++) { std::vector v, m; readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); x.readValues(m, out.bs.row[i], out.bs.nrows[i], 0, ncol()); recycle(v, m); for (size_t j=0; j < v.size(); j++) { if (hasNA) { if (std::isnan(v[j])) { v[j] = m[j]; continue; } } for (size_t k=0; k values, SpatOptions &opt) { SpatRaster out = geometry(1, true, true, true); if (!hasValues()) return out; size_t nl = nlyr(); if (nl == 1) { return deepCopy(); } if (!readStart()) { out.setError(getError()); return out; } if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (values.size() == 1) { double value=values[0]; for (size_t i = 0; i < out.bs.n; i++) { std::vector off(nl); for (size_t k=1; k < nl; k++) { off[k] = k * out.bs.nrows[i] * ncol(); } std::vector v; readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); if (std::isnan(value)) { for (size_t j=0; j < off[1]; j++) { for (size_t k=1; k < nl; k++) { if (std::isnan(v[j])) { v[j] = v[j + off[k]]; } else { continue; } } } } else { for (size_t j=0; j < off[1]; j++) { for (size_t k=1; k < nl; k++) { if (v[j] == value) { v[j] = v[j + off[k]]; } else { continue; } } } } std::vector w = {v.begin(), v.begin()+off[1]}; if (!out.writeBlock(w, i)) return out; } } else { values = vunique(values); bool hasNA = false; for (int i = values.size()-1; i>=0; i--) { if (std::isnan(values[i])) { hasNA = true; values.erase(values.begin()+i); } } for (size_t i = 0; i < out.bs.n; i++) { std::vector off(nl); for (size_t k=1; k < nl; k++) { off[k] = k * out.bs.nrows[i] * ncol(); } std::vector v; readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); for (size_t j=0; j < off[1]; j++) { if (hasNA) { for (size_t k=1; k < nl; k++) { if (std::isnan(v[j])) { v[j] = v[j+off[k]]; continue; } } } for (size_t j=0; j w = {v.begin(), v.begin()+off[1]}; if (!out.writeBlock(w, i)) return out; } } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::extend(SpatExtent e, std::string snap, double fill, SpatOptions &opt) { SpatRaster out = geometry_opt(nlyr(), true, true, true, true, true, opt); e = out.align(e, snap); SpatExtent extent = getExtent(); e.unite(extent); out.setExtent(e, true, true, ""); if (!hasValues() ) { if (!opt.get_filename().empty()) { out.addWarning("ignoring filename argument because there are no cell values"); } return(out); } double tol = std::min(xres(), yres()) / 1000; if (extent.compare(e, "==", tol)) { // same extent if (opt.get_filename().empty()) { out = deepCopy(); } else { out = writeRaster(opt); } return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } out.fill(fill); BlockSize bs = getBlockSize(opt); for (size_t i=0; i v; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); size_t row1 = out.rowFromY(yFromRow(bs.row[i])); size_t row2 = out.rowFromY(yFromRow(bs.row[i]+bs.nrows[i]-1)); size_t col1 = out.colFromX(xFromCol(0)); size_t col2 = out.colFromX(xFromCol(ncol()-1)); if (!out.writeValuesRect(v, row1, row2-row1+1, col1, col2-col1+1)) return out; } readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::crop(SpatExtent e, std::string snap, bool expand, SpatOptions &opt) { SpatRaster out = geometry_opt(nlyr(), true, true, true, true, true, opt); if ( !e.valid() ) { out.setError("invalid extent"); return out; } if ((e.xmin == e.xmax) && (e.ymin == e.ymax)) { out.setError("cannot crop a SpatRaster with an empty extent"); return out; } SpatExtent ein = getExtent(); SpatExtent fext = e; e = e.intersect(ein); if ( !e.valid_notempty() ) { out.setError("extents do not overlap"); return out; } SpatOptions ops; if (expand) { if ((fext.xmax <= ein.xmax) && (fext.xmin >= ein.xmin) && (fext.ymax <= ein.ymax) && (fext.ymin >= ein.ymin)) { expand = false; } else if ((fext.xmax >= ein.xmax) && (fext.xmin <= ein.xmin) && (fext.ymax >= ein.ymax) && (fext.ymin <= ein.ymin)) { return extend(fext, snap, NAN, opt); } else { ops = opt; opt = SpatOptions(opt); } } out.setExtent(e, true, false, snap); if (!hasValues() ) { if (expand) { if (!ops.get_filename().empty()) { out.addWarning("ignoring filename argument because there are no cell values"); } out = out.extend(fext, snap, NAN, opt); } else { if (!opt.get_filename().empty()) { out.addWarning("ignoring filename argument because there are no cell values"); } } return(out); } double hxr = xres() / 2; double hyr = yres() / 2; SpatExtent outext = out.getExtent(); size_t col1 = colFromX(outext.xmin + hxr); size_t col2 = colFromX(outext.xmax - hxr); size_t row1 = rowFromY(outext.ymax - hyr); size_t row2 = rowFromY(outext.ymin + hyr); std::vector hw = hasWindow(); bool haswin = hw[0]; for (size_t i=1; i vt = getValueType(true); if (vt.size() == 1) { out.setValueType(vt[0]); } size_t ncols = out.ncol(); if (!readStart()) { out.setError(getError()); return(out); } // opt.ncopies = 2; if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector v; for (size_t i = 0; i < out.bs.n; i++) { readValues(v, row1+out.bs.row[i], out.bs.nrows[i], col1, ncols); if (!out.writeBlock(v, i)) return out; } out.writeStop(); readStop(); if (expand) { out = out.extend(fext, snap, NAN, ops); } return(out); } SpatRaster SpatRaster::cropmask(SpatVector &v, std::string snap, bool touches, bool extend, SpatOptions &opt) { SpatRaster out; if (v.nrow() == 0) { out.setError("cannot crop a SpatRaster with an empty SpatVector"); return out; } std::vector w = hasWindow(); bool haswin = false; for (size_t i=0; i a, b; size_t startrow = nrow() - out.bs.row[i] - out.bs.nrows[i]; readValues(a, startrow, out.bs.nrows[i], 0, ncol()); b.reserve(a.size()); for (size_t j=0; j < nl; j++) { size_t offset = j * out.bs.nrows[i] * nc; for (size_t k=0; k < out.bs.nrows[i]; k++) { size_t start = offset + (out.bs.nrows[i] - 1 - k) * nc; b.insert(b.end(), a.begin()+start, a.begin()+start+nc); } } if (!out.writeBlock(b, i)) return out; } } else { for (size_t i=0; i < out.bs.n; i++) { std::vector a, b; readBlock(a, out.bs, i); b.reserve(a.size()); size_t lyrrows = nl * out.bs.nrows[i]; for (size_t j=0; j < lyrrows; j++) { size_t start = j * nc; size_t end = start + nc; std::vector v(a.begin()+start, a.begin()+end); std::reverse(v.begin(), v.end()); b.insert(b.end(), v.begin(), v.end()); } if (!out.writeBlock(b, i)) return out; } } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::reverse(SpatOptions &opt) { SpatRaster out = geometry_opt(nlyr(), true, true, true, true, true, opt); if (!hasValues()) return out; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nc = ncol(); size_t nl = nlyr(); for (size_t i=0; i < out.bs.n; i++) { size_t ii = out.bs.n - 1 - i; std::vector a, b; readBlock(a, out.bs, ii); b.reserve(a.size()); size_t lyrrows = nl * out.bs.nrows[ii]; for (size_t j=0; j < lyrrows; j++) { size_t start = (lyrrows - 1 - j) * nc; size_t end = start + nc; std::vector v(a.begin()+start, a.begin()+end); std::reverse(v.begin(), v.end()); b.insert(b.end(), v.begin(), v.end()); } if (!out.writeBlock(b, i)) return out; } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::shift(double x, double y, SpatOptions &opt) { SpatRaster out = deepCopy(); SpatExtent outext = out.getExtent(); outext.xmin = outext.xmin + x; outext.xmax = outext.xmax + x; outext.ymin = outext.ymin + y; outext.ymax = outext.ymax + y; out.setExtent(outext, true, true, ""); return out; } bool SpatRaster::compare_origin(std::vector x, double tol) { std::vector y = origin(); if (!about_equal(x[0], y[0], xres() * tol)) return false; if (!about_equal(x[1], y[1], yres() * tol)) return false; return true; } /* void print_ext(SpatRaster &r){ SpatExtent e = r.getExtent(); Rcpp::Rcout << e.xmin << " " << e.xmax << " " << e.ymin << " " << e.ymax << " - " << r.xres() << " " << r.yres() << std::endl; } */ bool write_part(SpatRaster& out, SpatRaster r, const double& hxr, size_t& nl, bool notfirstlyr, std::string method, size_t &warn, SpatOptions &opt) { BlockSize bs = r.getBlockSize(opt); SpatExtent re = r.getExtent(); SpatRaster tmp = out.geometry(); tmp = tmp.crop(r.getExtent(), "near", false, opt); if (!tmp.compare_geom(r, false, true, opt.get_tolerance(), false, true, true, false)) { std::vector hascats = r.hasCategories(); if (method == "") method = hascats[0] ? "near" : "bilinear"; //std::string filename = tempFile(opt.get_tempdir(), opt.tmpfile, ".tif"); SpatOptions wopt(opt); r = r.warper(tmp, "", method, false, false, true, wopt); if (r.hasError()) { out.setError(r.getError()); return false; } warn++; bs = r.getBlockSize(opt); re = r.getExtent(); } for (size_t i=0; i v, vout; size_t row1 = out.rowFromY(r.yFromRow(bs.row[i])); size_t row2 = out.rowFromY(r.yFromRow(bs.row[i]+bs.nrows[i]-1)); size_t col1 = out.colFromX(re.xmin + hxr); size_t col2 = out.colFromX(re.xmax - hxr); size_t ncols = col2-col1+1; size_t nrows = row2-row1+1; if (!r.readStart()) { out.setError(r.getError()); return false; } r.readBlock(v, bs, i); recycle(v, ncols * nrows * nl); if (notfirstlyr) { out.readValuesWhileWriting(vout, row1, nrows, col1, ncols); for (size_t j=0; j vt = getValueType(true); if (vt.size() == 1) { out.setValueType(vt[0]); } opt.ncopies = std::max(opt.ncopies, size() + nl); if (!out.writeStart(opt, filenames())) { return out; } std::vector seq(n); if (first) { std::iota(seq.rbegin(), seq.rend(), 0); } else { std::iota(seq.begin(), seq.end(), 0); } SpatOptions topt(opt); size_t warn = 0; bool notfirst = false; for (size_t i=0; i 0; } if (!write_part(out, ds[seq[i]], hxr, nl, notfirst, method, warn, topt)) { return out; } } out.writeStop(); if (warn > 0) { out.addWarning(std::to_string(warn) + " raster(s) that did not share the base geometry of the first raster were resampled"); } return(out); } else if (algo == 2) { // narm is not used std::vector use; use.reserve(n); if (ds[0].hasValues()) use.push_back(0); SpatExtent e = ds[0].getExtent(); size_t nl = ds[0].nlyr(); for (size_t i=1; i vt = getValueType(true); if (vt.size() == 1) { out.setValueType(vt[0]); } opt.ncopies = std::max(opt.ncopies, size() + nl); if (!out.writeStart(opt, filenames())) { return out; } SpatOptions ropt(opt); for (size_t i=0; i> v; readBlock(out, v, out.bs, i, use, ropt); if (hasError()) { out.writeStop(); out.setError(getError()); return out; } std::vector sizes(v.size()); size_t n = nl * out.bs.nrows[i] * out.ncol(); size_t m = v.size(); bool multi_sz = false; std::vector sz(m); for (size_t j=0; j n) { out.setError("something is not right. Exected: " + std::to_string(n) + " got: " + std::to_string(v[j].size()) + " values"); return out; } } if (m == 1) { if (!out.writeBlock(v[0], i)) return out; } else if (first) { recycle(v[0], n); if (multi_sz) { // with recycling for (size_t j=0; j= 0; k--) { if (std::isnan(v[m][j])) { v[m][j] = v[k][j%sz[k]]; } else { continue; } } } } else { for (size_t j=0; j= 0; k--) { if (std::isnan(v[m][j])) { v[m][j] = v[k][j]; } else { continue; } } } } if (!out.writeBlock(v[m], i)) return out; } } out.writeStop(); return(out); } else if (algo==3) { // narm is not used SpatExtent e = ds[0].getExtent(); size_t nl = ds[0].nlyr(); for (size_t i=1; i options = {"-r", method}; bool wvrt = false; std::string fout = opt.get_filename(); if (!fout.empty()) { if (fout.size() > 4) { std::string ss = fout.substr(fout.size()-4, fout.size()); lowercase(ss); wvrt = ss == ".vrt"; } } std::vector warnings; if (fout != "") { std::string fname; if (opt.names.empty()) { opt.names = ds[0].getNames(); } if (wvrt) { fname = make_vrt(options, first, opt); warnings = opt.msg.warnings; } else { SpatOptions vopt(opt); fname = make_vrt(options, first, vopt); warnings = vopt.msg.warnings; } if (hasError()) { out.setError(getError()); return out; } SpatRaster v(fname, {}, {}, {}, {}); if (warnings.size() > 0) { v.msg.warnings = warnings; v.msg.has_warning = true; } if (wvrt) { return v; } else { return v.writeRaster(opt); } } SpatOptions vopt(opt); std::string fname = make_vrt(options, first, vopt); SpatRaster v(fname, {}, {}, {}, {}); v.setNames(ds[0].getNames(), false); if (vopt.msg.warnings.size() > 0) { v.msg.warnings = warnings; v.msg.has_warning = true; } return v; } else { out.setError("invalid algo (should be 1, 2, or 3)"); return out; } } bool overlaps(const std::vector& r1, const std::vector& r2, const std::vector& c1, const std::vector& c2) { size_t n = r1.size(); for (size_t i=0; i<(n-1); i++) { for (size_t j=(i+1); j= r1[j]) && (c1[i] <= c2[j]) && (c2[i] >= c1[j])) { return true; } } } return false; } SpatRaster SpatRasterCollection::mosaic(std::string fun, SpatOptions &opt) { SpatRaster out; std::vector f {"first", "last", "sum", "mean", "median", "min", "max", "modal"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("argument 'fun' is not a valid function name"); return out; } if ((fun == "first") || (fun == "last")) { return merge(fun=="first", true, 1, "", opt); } size_t n = size(); if (n == 0) { out.setError("empty collection"); return(out); } if (n == 1) { if (opt.get_filename() != "") { out = ds[0].writeRaster(opt); } else { out = ds[0].deepCopy(); } return(out); } std::vector hvals(n); hvals[0] = ds[0].hasValues(); SpatExtent e = ds[0].getExtent(); size_t nl = ds[0].nlyr(); //std::vector resample(n, false); std::vector use; use.reserve(n); if (hvals[0]) use.push_back(0); for (size_t i=1; i=0; i--) { if (!hvals[i]) { erase(i); } } n = size(); if (size() == 0) { if (opt.get_filename() != "") { out = out.writeRaster(opt); } else { out = ds[0].deepCopy(); } return(out); } // if (!overlaps(r1, r2, c1, c2)) { // return merge(true, true, opt); // } double ncl = 1000; if (n > 50) ncl = 500; if (n > 100) ncl = 250; double ar = std::ceil(out.nrow() / ncl); size_t arow = std::ceil(out.nrow() / ar); double ac = std::ceil(out.ncol() / ncl); size_t acol = std::ceil(out.ncol() / ac); SpatOptions sopt(opt); SpatExtent ae = out.getExtent(); SpatRaster aout = out.aggregate({arow, acol}, "", true, sopt); SpatVector ve = aout.as_polygons(false, false, false, false, false, 0, sopt); SpatVector vcrp(out.getExtent(), ""); ve = ve.intersect(vcrp, false); size_t nv = ve.nrow(); bool warn = false; if (!out.writeStart(opt, filenames())) { return out; } sopt.progressbar = false; SpatRasterStack s; for (size_t i=0; i f {"first", "last", "sum", "mean", "median", "min", "max"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("argument 'fun' is not a valid function name"); return out; } if (fun == "first") { return merge(true, true, opt); } if (fun == "last") { return merge(false, true, opt); } unsigned n = size(); if (n == 0) { out.setError("empty collection"); return(out); } if (n == 1) { out = ds[0].deepCopy(); return(out); } std::vector hvals(n); hvals[0] = ds[0].hasValues(); SpatExtent e = ds[0].getExtent(); unsigned nl = ds[0].nlyr(); std::vector resample(n, false); for (size_t i=1; i=0; i--) { if (!hvals[i]) { erase(i); } } n = size(); if (size() == 0) { return out; } // SpatExtent eout = out.getExtent(); double hxr = out.xres()/2; double hyr = out.yres()/2; std::vector r1, r2, c1, c2; r1.reserve(n); r2.reserve(n); c1.reserve(n); c2.reserve(n); SpatVector ve; ve.reserve(n); for (size_t i=0; i> rsti(n); for (size_t i=0; i rcnt(n); for (size_t i=0; i ord = sort_order_a(rcnt); permute(rcnt, ord); permute(rsti, ord); bool warn = false; if (!out.writeStart(opt, filenames())) { return out; } SpatOptions sopt(opt); sopt.progressbar = false; for (size_t i=0; i 1) { SpatVector vi = ve.subset_rows(ord[i]); SpatRasterCollection x = crop(vi.extent, "near", true, rsti[i], sopt); if (x.empty()) { continue; } SpatRasterStack s; s.ds = x.ds; //r = s.summary(fun, true, sopt); // see #1159 // if (i == 57 || i == 79 | i == 269) { // && (rcnt[i] == 6)) { r = s.collapse(); r = r.summary(fun, true, sopt); if (r.hasError()) { return r; } } if (!write_part(out, r, hxr, nl, false, warn, sopt)) { return out; } } out.writeStop(); if (warn) out.addWarning("rasters did not align and were resampled"); return out; } */ SpatRaster SpatRasterCollection::morph(SpatRaster &x, SpatOptions &opt) { SpatRaster out; size_t n = size(); if (n == 0) { out.setError("empty collection"); return(out); } std::string filename = opt.get_filename(); opt.set_filenames({""}); SpatExtent e = x.getExtent(); out.source.resize(0); SpatRaster g = x.geometry(); SpatOptions topt(opt); for (size_t i=0; i hasCats = ds[i].hasCategories(); // this should be done by layer bool call = true; for (size_t j=0; j &x, double &n) { for (size_t i=0; i &v, std::string fun, bool narm, double &stat, double &stat2,double &n, size_t step) { if (v.empty()) return; if (fun == "sum") { double s = vsum(v, narm); if (step > 0) { std::vector ss = {stat, s}; stat = vsum(ss, narm); } else { stat = s; } } else if (fun == "mean") { double s = vsum(v, narm); if (step > 0) { std::vector ss = {stat, s}; stat = vsum(ss, narm); } else { stat = s; } if (narm) { notisnan(v, n); } else { n += v.size(); } } else if (fun == "prod") { double p = vprod(v, narm); if (step > 0) { std::vector pp = {stat, p}; stat = vprod(pp, narm); } else { stat = p; } } else if (fun == "rms") { if (narm) { notisnan(v, n); } else { n += v.size(); } double s = vsum2(v, narm); if (step > 0) { std::vector ss = {stat, s}; stat = vsum(ss, narm); } else { stat = s; } } else if (fun == "min") { double s = vmin(v, narm); if (step > 0) { std::vector ss = {stat, s}; stat = vmin(ss, narm); } else { stat = s; } } else if (fun == "max") { double s = vmax(v, narm); if (step > 0) { std::vector ss = {stat, s}; stat = vmax(ss, narm); } else { stat = s; } } else if (fun == "range") { double sn = vmin(v, narm); double sx = vmax(v, narm); if (step > 0) { std::vector ss1 = {stat, sn}; stat = vmin(ss1, narm); std::vector ss2 = {stat2, sx}; stat2 = vmax(ss2, narm); } else { stat = sn; stat2 = sx; } } else if (fun == "sd") { if (narm) { notisnan(v, n); } else { n += v.size(); } double s1 = vsum(v, narm); double s2 = vsum2(v, narm); if (step > 0) { std::vector ss1 = {stat, s1}; stat = vsum(ss1, narm); std::vector ss2 = {stat2, s2}; stat2 = vsum(ss2, narm); } else { stat = s1; stat2 = s2; } } else if (fun == "notNA" || fun == "isNA") { notisnan(v, n); } } void do_mstats(std::vector &v, size_t start, size_t end, std::vector funs, bool narm, std::vector &stat, std::vector &stat2, double &n, bool first, bool last) { size_t nstat = funs.size(); if (first) { stat.resize(0); stat.resize(nstat); stat2.resize(0); stat2.resize(nstat); n = 0; } if (v.empty()) return; double sum = 0; if (is_in_vector("sum", funs) || is_in_vector("mean", funs) || is_in_vector("sd", funs) || is_in_vector("std", funs)) { if (narm) { sum = sum_se_rm(v, start, end); } else { sum = sum_se(v, start, end); } } size_t notna = 0; if (is_in_vector("mean", funs) || is_in_vector("rms", funs) || is_in_vector("sd", funs) || is_in_vector("std", funs) || is_in_vector("notNA", funs) || is_in_vector("isNA", funs)) { if (narm) { notna = isnotna_se(v, start, end); n += notna; } else { n += (end - start); } } for (size_t i=0; i ss = {stat[i], sum}; stat[i] = vsum(ss, narm); } } else if (fun == "mean") { if (first) { stat[i] = sum; } else { std::vector ss = {stat[i], sum}; stat[i] = vsum(ss, narm); } if (last) { if (n > 0) { stat[i] = stat[i] / n; } else { stat[i] = NAN; } } } else if (fun == "prod") { double p; if (narm) { p = prod_se_rm(v, start, end); } else { p = prod_se(v, start, end); } if (first) { stat[i] = p; } else { std::vector pp = {stat[i], p}; stat[i] = vprod(pp, narm); } } else if (fun == "rms") { double s; if (narm) { s = sum2_se_rm(v, start, end); } else { s = sum2_se(v, start, end); } if (first) { stat[i] = s; } else { std::vector ss = {stat[i], s}; stat[i] = vsum(ss, narm); } if (last) { // rms = sqrt(sum(x^2)/(n-1)) if (n > 0) { stat[i] = sqrt(stat[i] / (n-1)); } else { stat[i] = NAN; } } } else if (fun == "min") { double s; if (narm) { s = min_se_rm(v, start, end); } else { s = min_se(v, start, end); } if (first) { stat[i] = s; } else { std::vector ss = {stat[i], s}; stat[i] = vmin(ss, narm); } } else if (fun == "max") { double s; if (narm) { s = max_se_rm(v, start, end); } else { s = max_se(v, start, end); } if (first) { stat[i] = s; } else { std::vector ss = {stat[i], s}; stat[i] = vmax(ss, narm); } } else if ((fun == "sd") || (fun == "std")) { double s2; if (narm) { s2 = sum2_se_rm(v, start, end); } else { s2 = sum2_se(v, start, end); } if (first) { stat[i] = sum; stat2[i] = s2; } else { std::vector ss1 = {stat[i], sum}; stat[i] = vsum(ss1, narm); std::vector ss2 = {stat2[i], s2}; stat2[i] = vsum(ss2, narm); } if (last) { if (n > 0) { double mn = stat[i] / n; double mnsq = mn * mn; double mnsumsq = stat2[i] / n; if (fun == "std") { stat[i] = sqrt(mnsumsq - mnsq); } else { stat[i] = sqrt((mnsumsq - mnsq) * n/(n-1)); } } else { stat[i] = NAN; } } } else if (fun == "notNA") { if (narm) { // if (last) { stat[i] = n; } else { stat[i] += isnotna_se(v, start, end); } } else if (fun == "isNA") { if (narm) { stat[i] += end - start - notna; } else { stat[i] += end - start - isnotna_se(v, start, end); } } } } SpatDataFrame SpatRaster::mglobal(std::vector funs, bool narm, SpatOptions &opt) { SpatDataFrame out; std::vector f {"sum", "mean", "min", "max", "prod", "rms", "sd", "std", "isNA", "notNA"}; size_t nf = funs.size(); for (size_t i=0; i> stats(nl, std::vector(nf)); std::vector> stats2(nl, std::vector(nf)); std::vector n(nl); if (!readStart()) { out.setError(getError()); return(out); } BlockSize bs = getBlockSize(opt); for (size_t i=0; i v; readBlock(v, bs, i); size_t off = bs.nrows[i] * ncol() ; for (size_t lyr=0; lyr vv = { v.begin()+offset, v.begin()+offset+off }; do_mstats(v, offset, (offset+off), funs, narm, stats[lyr], stats2[lyr], n[lyr], i==0, i==(bs.n-1)); } } readStop(); // transpose std::vector> tstat(nf, std::vector(nl)); std::vector> tstat2(nf, std::vector(nl)); for (size_t i=0; i f {"anyNA", "anynotNA"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("not a valid function"); return(out); } if (!hasValues()) { out.setError("SpatRaster has no values"); return(out); } size_t nl = nlyr(); std::vector stats(nl, false); if (!readStart()) { out.setError(getError()); return(out); } BlockSize bs = getBlockSize(opt); for (size_t i=0; i v; readBlock(v, bs, i); size_t off = bs.nrows[i] * ncol() ; if (fun == "anyNA") { for (size_t lyr=0; lyr> SpatRaster::layerCor(std::string fun, std::string use, bool asSample, SpatOptions &opt) { std::vector> out(3); if (!hasValues()) { setError("SpatRaster has no values"); return(out); } size_t nl = nlyr(); if (nl < 2) { setError("SpatRaster must have at least two layers"); return(out); } if (use == "complete.observations") { SpatOptions sopt(opt); SpatRaster x = anynan(true, sopt); x = mask(x, false, NAN, NAN, sopt); return x.layerCor(fun, "", asSample, opt); } bool narm = true; if (use == "all.observations") { narm = false; } if (fun == "cor") { // pearson std::vector means(nl*nl, NAN); std::vector cor(nl*nl, 1); std::vector nn(nl*nl, NAN); SpatOptions topt(opt); BlockSize bs = getBlockSize(topt); std::vector gfuns = {"mean", "sd"}; for (size_t i=0; i<(nl-1); i++) { for (size_t j=(i+1); j> stats(2); std::vector> stats2(2); std::vector n(2); std::vector vi, vj; for (size_t k=0; k0; kk--) { size_t k = kk-1; if (k < (bs.n-1)) { xi.readBlock(vi, bs, k); xj.readBlock(vj, bs, k); } if (narm) { for (size_t m=0; m f {"sum", "mean", "min", "max", "range", "prod", "rms", "sd", "std", "stdpop", "isNA", "notNA"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("not a valid function"); return(out); } if (!hasValues()) { out.setError("SpatRaster has no values"); return(out); } std::string sdfun = fun; if ((fun == "std") || (fun == "sdpop")) { sdfun = "std"; fun = "sd"; } size_t nl = nlyr(); std::vector stats(nl); std::vector stats2(nl); std::vector n(nl); if (!readStart()) { out.setError(getError()); return(out); } BlockSize bs = getBlockSize(opt); for (size_t i=0; i v; readBlock(v, bs, i); size_t off = bs.nrows[i] * ncol() ; for (size_t lyr=0; lyr vv = { v.begin()+offset, v.begin()+offset+off }; do_stat(vv, fun, narm, stats[lyr], stats2[lyr], n[lyr], i); } } readStop(); if (fun=="mean") { for (size_t lyr=0; lyr 0) { stats[lyr] = stats[lyr] / n[lyr]; } else { stats[lyr] = NAN; } } } else if (fun=="rms") { // rms = sqrt(sum(x^2)/(n-1)) for (size_t lyr=0; lyr 0) { stats[lyr] = sqrt(stats[lyr] / (n[lyr]-1)); } else { stats[lyr] = NAN; } } } else if (fun == "sd") { for (size_t lyr=0; lyr 0) { double mn = stats[lyr] / n[lyr]; double mnsq = mn * mn; double mnsumsq = stats2[lyr] / n[lyr]; if (sdfun == "std") { stats[lyr] = sqrt(mnsumsq - mnsq); } else { stats[lyr] = sqrt((mnsumsq - mnsq) * n[lyr]/(n[lyr]-1)); } } else { stats[lyr] = NAN; } } } else if ((fun == "notNA") || (fun == "isNA")) { for (size_t lyr=0; lyr f {"sum", "mean"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("not a valid function"); return(out); } if (!hasValues()) { out.setError("SpatRaster has no values"); return(out); } if (weights.nlyr() != 1) { out.setError("The weights raster must have 1 layer"); return(out); } if (!compare_geom(weights, false, false, opt.get_tolerance(), true)) { out.setError( msg.getError() ); return(out); } std::vector stats(nlyr()); double stats2 = 0; std::vector n(nlyr()); std::vector w(nlyr()); if (!readStart()) { out.setError(getError()); return(out); } if (!weights.readStart()) { out.setError(weights.getError()); return(out); } BlockSize bs = getBlockSize(opt); for (size_t i=0; i v, wv; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); weights.readValues(wv, bs.row[i], bs.nrows[i], 0, ncol()); size_t off = bs.nrows[i] * ncol() ; for (size_t lyr=0; lyr vv(v.begin()+offset, v.begin()+offset+off); for (size_t j=0; j 0 && w[lyr] != 0) { stats[lyr] /= w[lyr]; } else { stats[lyr] = NAN; } } out.add_column(stats, "weighted_mean"); } else { out.add_column(stats, "weighted_sum"); } return(out); } SpatRaster SpatRaster::scale(std::vector center, bool docenter, std::vector scale, bool doscale, SpatOptions &opt) { SpatRaster out; SpatOptions opts(opt); SpatDataFrame df; if (docenter) { if (center.empty()) { df = global("mean", true, opts); center = df.getD(0); } if (doscale) { out = arith(center, "-", false, false, opts); } else { out = arith(center, "-", false, false, opt); } } if (doscale) { if (scale.empty()) { // divide by sd if centered, and the root mean square otherwise. // rms = sqrt(sum(x^2)/(n-1)); if centered rms == sd if (docenter) { df = out.global("rms", true, opts); } else { df = global("rms", true, opts); } scale = df.getD(0); } if (docenter) { out = out.arith(scale, "/", false, false, opt); } else { out = arith(scale, "/", false, false, opt); } } return out; } SpatRaster SpatRaster::scale_linear(double smin, double smax, SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) return out; if (smin >= smax) { out.setError("min scaling value must be smaller than the max scaling value"); return out; } SpatOptions opts(opt); setRange(opts, false); std::vector rmin = SpatRaster::range_min(); std::vector rmax = SpatRaster::range_max(); std::vector rdif; rdif.reserve(rmin.size()); double dmnmx = smax - smin; for (size_t i=0; i v; readBlock(v, out.bs, i); size_t lyroff = 0; size_t cellperlyr = out.bs.nrows[i] * ncol(); for (size_t lyr = 0; lyr < nl; lyr++) { for (size_t j=lyroff; j<(lyroff+cellperlyr); j++) { v[j] = ((v[j] - rmin[lyr]) / rdif[i]) + smin; } lyroff = lyroff + cellperlyr; } if (!out.writeBlock(v, i)) return out; } readStop(); out.writeStop(); return out; } /* bool can_use_replace(const std::vector &from, const std::vector &to) { // test if any "to" later occurs in "from" size_t n = from.size(); for (size_t i = 0; i < (n-1); i++) { for (size_t j = (i+1); j < n; j++) { if (to[i] == from[j]) { return false; } } } return true; } */ SpatRaster SpatRaster::replaceValues(std::vector from, std::vector to, long nl, bool setothers, double others, bool keepcats, SpatOptions &opt) { SpatRaster out; if (from.empty()) { out.setError("argument 'from' cannot be empty"); return out; } if (to.empty()) { out.setError("argument 'to' cannot be empty"); return out; } bool mout = false; bool min = false; if (nl > 1) { if (nlyr() > 1) { out.setError("cannot create layer-varying replacement with multi-layer input"); return out; } mout = true; } else if (nl < -1) { nl = abs(nl); if (nlyr() != (size_t) nl) { out.setError("nlyr() does not match ncol(from)"); return out; } min = true; } if (min) { out = geometry(1); if (keepcats) { out.source[0].hasCategories[0] = source[0].hasCategories[0]; out.source[0].cats[0] = source[0].cats[0]; out.source[0].hasColors = source[0].hasColors; out.source[0].cols = source[0].cols; } } else { if (nl == 0) { out = geometry(nlyr()); out.source[0].hasCategories = hasCategories(); out.source[0].cats = getCategories(); out.source[0].hasColors = hasColors(); out.source[0].cols = getColors(); } else { out = geometry(nl); if (keepcats) { for (long i=0; i v; readBlock(v, out.bs, i); size_t vs = v.size(); v.reserve(vs * nlyr); for (size_t lyr = 1; lyr < nlyr; lyr++) { v.insert(v.end(), v.begin(), v.begin()+vs); } std::vector vv; if (setothers) { vv.resize(v.size(), others); } else { vv = v; } for (size_t lyr = 0; lyr < nlyr; lyr++) { std::vector tolyr(to.begin()+lyr*tosz, to.begin()+(lyr+1)*tosz); recycle(tolyr, from); size_t offset = lyr*vs; for (size_t j=0; j< from.size(); j++) { if (std::isnan(from[j])) { for (size_t k=offset; k<(offset+vs); k++) { vv[k] = std::isnan(v[k]) ? tolyr[j] : v[k]; } } else { for (size_t k=offset; k<(offset+vs); k++) { if (v[k] == from[j]) { vv[k] = tolyr[j]; } } } } } if (!out.writeBlock(vv, i)) return out; } } else if (min) { size_t n = from.size()/nl; size_t nlr = nl; recycle(to, n); std::vector> fro(n); for (size_t i=0; i v; readBlock(v, out.bs, i); size_t nc = v.size() / nlr; std::vector vv(nc, others); for (size_t j=0; j v; readBlock(v, out.bs, i); std::vector vv; if (setothers) { vv.resize(v.size(), others); } else { vv = v; } for (size_t j=0; j< from.size(); j++) { if (std::isnan(from[j])) { for (size_t k=0; k &v, std::vector> rcl, bool right_closed, bool left_right_closed, bool lowest, bool others, double othersValue) { size_t nc = rcl.size(); // should be 2 or 3 double NAval = NAN; size_t n = v.size(); size_t nr = rcl[0].size(); if (nc == 1) { std::vector rc = rcl[0]; std::sort(rc.begin(), rc.end()); if (right_closed) { if (lowest) { for (size_t i=0; i rc[nr-1])) { v[i] = NAval; } else { for (size_t j=1; j rc[nr-1])) { v[i] = NAval; } else { for (size_t j=1; j rc[nr-1])) { v[i] = NAval; } else if (v[i] == rc[nr-1]) { v[i] = nr-2; // safe because there must be at least 2 classes } else { for (size_t j=1; j= rc[nr-1])) { v[i] = NAval; } else { for (size_t j=1; j= rcl[0][j]) && (v[i] <= rcl[1][j])) { v[i] = rcl[2][j]; found = true; break; } } if ((!found) && others) { v[i] = othersValue; } } } } else if (right_closed) { if (lowest) { // include lowest value (left) of interval double lowval = rcl[0][0]; double lowres = rcl[2][0]; for (size_t i=1; i rcl[0][j]) && (v[i] <= rcl[1][j])) { v[i] = rcl[2][j]; found = true; break; } } if ((!found) && others) { v[i] = othersValue; } } } } else { // !lowest for (size_t i=0; i rcl[0][j]) && (v[i] <= rcl[1][j])) { v[i] = rcl[2][j]; found = true; break; } } if ((!found) && others) { v[i] = othersValue; } } } } } else { // left closed if (lowest) { // which here means highest because right=FALSE double lowval = rcl[1][0]; double lowres = rcl[2][0]; for (size_t i=0; i lowval) { lowval = rcl[1][i]; lowres = rcl[2][i]; } } for (size_t i=0; i= rcl[0][j]) && (v[i] < rcl[1][j])) { v[i] = rcl[2][j]; found = true; break; } } if ((!found) && others) { v[i] = othersValue; } } } } else { //!dolowest for (size_t i=0; i= rcl[0][j]) && (v[i] < rcl[1][j])) { v[i] = rcl[2][j]; found = true; break; } } if ((!found) && others) { v[i] = othersValue; } } } } } } } SpatRaster SpatRaster::reclassify(std::vector> rcl, unsigned openclosed, bool lowest, bool others, double othersValue, bool bylayer, bool brackets, bool keepcats, SpatOptions &opt) { SpatRaster out = geometry(); if (keepcats) { out.source[0].hasCategories = hasCategories(); out.source[0].cats = getCategories(); } size_t nc = rcl.size(); size_t nr = rcl[0].size(); size_t nl = nlyr(); if (nl == 1) bylayer = false; size_t maxnc = 3 + nl * bylayer; size_t rcldim = nc; if (bylayer) { if (((nc != maxnc) && (nc != (maxnc-1))) || nr < 1) { out.setError("reclass matrix is not correct. Should be nlyr(x) plus 1 or 2"); return out; } rcldim = nc - (nl-1); } else { if (nc < 1 || nc > 3 || nr < 1) { out.setError("matrix must have 1, 2 or 3 columns, and at least one row"); return out; } } //bool left = openclosed == 0; bool right = openclosed != 0 ; bool leftright = openclosed == 2; if (nc == 1) { if (nr == 1) { int breaks = rcl[0][0]; if (breaks < 2) { out.setError("cannot classify with a single number that is smaller than 2"); return out; } std::vector hr = hasRange(); bool hasR = true; for (size_t i=0; i mn = range_min(); std::vector mx = range_max(); double mnv = vmin(mn, true); double mxv = vmax(mx, true); rcl[0] = seq_steps(mnv, mxv, breaks); lowest = true; } size_t rn = rcl[0].size(); if ((rn > 1) && (rn < 256)) { std::vector s; if (brackets) { std::string bleft = ((!right) || lowest) ? "[" : "("; std::string bright = right ? "]" : ")"; s.push_back(bleft+ double_to_string(rcl[0][0]) + " - " + double_to_string(rcl[0][1]) + bright); bleft = right ? "(" : "["; for (size_t i=2; i<(rn-1); i++) { s.push_back(bleft + double_to_string(rcl[0][i-1]) + " - " + double_to_string(rcl[0][i]) + bright); } bright = (right || lowest) ? "]" : ")"; s.push_back(bleft + double_to_string(rcl[0][rn-2]) + " - " + double_to_string(rcl[0][rn-1]) + bright); } else { for (size_t i=1; i u(s.size()); std::iota(u.begin(), u.end(), 0); std::vector nms = getNames(); for (size_t i=0; i rcl[1][i]) { out.setError("'from' larger than 'to': (" + std::to_string(rcl[0][i]) + " - " + std::to_string(rcl[1][i]) +")"); return out; } } } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (bylayer) { std::vector> lyrrcl(rcldim+1); for (size_t i=0; i v; readBlock(v, out.bs, i); for (size_t lyr = 0; lyr < nl; lyr++) { size_t offset = lyr * off; lyrrcl[rcldim] = rcl[rcldim+lyr]; std::vector vx(v.begin()+offset, v.begin()+offset+off); reclass_vector(vx, lyrrcl, right, leftright, lowest, others, othersValue); std::copy(vx.begin(), vx.end(), v.begin()+offset); } if (!out.writeBlock(v, i)) return out; } } else { for (size_t i = 0; i < out.bs.n; i++) { std::vector v; readBlock(v, out.bs, i); reclass_vector(v, rcl, right, leftright, lowest, others, othersValue); if (!out.writeBlock(v, i)) return out; } } readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::reclassify(std::vector rcl, size_t nc, unsigned openclosed, bool lowest, bool others, double othersValue, bool bylayer, bool brackets, bool keepcats, SpatOptions &opt) { SpatRaster out; if ((rcl.size() % nc) != 0) { out.setError("incorrect length of reclassify matrix"); return(out); } size_t maxnc = 3 + bylayer * (nlyr() - 1); size_t nr = rcl.size() / nc; if (nc > maxnc) { out.setError("incorrect number of columns in reclassify matrix"); return(out); } std::vector< std::vector> rc(nc); for (size_t i=0; i(rcl.begin()+(i*nr), rcl.begin()+(i+1)*nr); } out = reclassify(rc, openclosed, lowest, others, othersValue, bylayer, brackets, keepcats, opt); return out; } std::vector> clump_getRCL(std::vector> rcl, size_t n) { std::vector> rcl2(rcl[0].size()); for (size_t i=0; i> out(2); for (size_t i=0; i lost = out[0]; lost.push_back(n); size_t sub = 0; for (size_t i=0; i &v, size_t n, std::vector& d, size_t cstart, std::vector>& rcl, size_t &ncps) { d.erase(std::remove_if(d.begin(), d.end(), [](const double& v) { return std::isnan(v); }), d.end()); std::sort(d.begin(), d.end()); d.erase(std::unique(d.begin(), d.end()), d.end()); size_t nd = d.size(); if (nd == 0) { v[n] = ncps; ncps++; return; } else if (nd == 1) { v[n] = d[0]; return; } v[n] = d[0]; for (size_t i=0; i &v, std::vector& above, const size_t &dirs, size_t &ncps, const size_t &nr, const size_t &nc, std::vector> &rcl, bool is_global) { size_t nstart = ncps; bool d4 = dirs == 4; size_t stopnc = nc-1; std::vector d; //first row, no row above it, use "above" //first cell //Rcpp::Rcout << "r x i v[i] nc v[i] nc" << std::endl; if ( !std::isnan(v[0]) ) { //Rcout << 0 << " ff " << 0 << " " << v[0] << " " << ncps << " " ; if (d4) { if (std::isnan(above[0])) { v[0] = ncps; // new patch ncps++; } else { v[0] = above[0]; // same as above } } else if (is_global) { //d8 global d = {above[0], above[1], above[stopnc]} ; clump_replace(v, 0, d, nstart, rcl, ncps); } else { //d8 d = {above[0], above[1]} ; clump_replace(v, 0, d, nstart, rcl, ncps); } //Rcout << v[0] << " " << ncps << std::endl; } // other cells for (size_t i=1; i(v.begin()+off, v.end()); } SpatRaster SpatRaster::clumps(int directions, bool zeroAsNA, SpatOptions &opt) { SpatRaster out = geometry(1); if (nlyr() > 1) { SpatOptions ops(opt); std::vector nms = getNames(); if (ops.names.size() == nms.size()) { nms = opt.names; } for (size_t i=0; i lyr = {i}; ops.names = {nms[i]}; SpatRaster x = subset(lyr, ops); x = x.clumps(directions, zeroAsNA, ops); out.addSource(x, false, ops); } if (!opt.get_filename().empty()) { out = out.writeRaster(opt); } return out; } if (!(directions == 4 || directions == 8)) { out.setError("directions must be 4 or 8"); return out; } if (!hasValues()) { out.setError("cannot compute clumps for a raster with no values"); return out; } std::vector dim = {nrow(), ncol()}; std::string tempfile = ""; std::vector d, v, vv; if (!readStart()) { out.setError(getError()); return(out); } std::string filename = opt.get_filename(); if (!filename.empty()) { bool overwrite = opt.get_overwrite(); std::string errmsg; if (!can_write({filename}, filenames(), overwrite, errmsg)) { out.setError(errmsg + " (" + filename +")"); return(out); } } if (opt.names.empty()) { opt.names = {"patches"}; } opt.set_filenames({""}); if (!out.writeStart(opt, filenames())) { return out; } size_t nc = ncol(); size_t ncps = 1; std::vector above(nc, NAN); std::vector> rcl(2); bool is_global = is_global_lonlat(); for (size_t i = 0; i < out.bs.n; i++) { readBlock(v, out.bs, i); if (zeroAsNA) { std::replace(v.begin(), v.end(), 0.0, (double)NAN); } broom_clumps(v, above, directions, ncps, out.bs.nrows[i], nc, rcl, is_global); if (!out.writeBlock(v, i)) return out; // perhaps here keep track of unique values, so that gaps can be removed } out.writeStop(); readStop(); opt.set_filenames({filename}); if (!rcl[0].empty()) { std::vector> rc = clump_getRCL(rcl, ncps); out = out.reclassify(rc, 3, true, false, 0.0, false, false, false, opt); } else if (!filename.empty()) { out = out.writeRaster(opt); } return out; } bool SpatRaster::replaceCellValues(std::vector &cells, std::vector &v, bool bylyr, SpatOptions &opt) { size_t cs = cells.size(); double nce = ncell() - 1; for (size_t i=0; i nce)) { setError("cell number(s) out of range"); return false; } } size_t vs = v.size(); size_t nl = nlyr(); if (vs == 1) { bylyr = false; recycle(v, cs); } else if (bylyr) { if (vs == nl) { rep_each(v, cs); } else if (vs != (cs*nl)) { setError("length of cells and values do not match"); return false; } } else if (cs != vs) { if ((vs / nl) == cs) { bylyr = true; } else { setError("lengths of cells and values do not match"); return false; } } size_t nc = ncell(); size_t ns = nsrc(); if (!hasValues()) { *this = init({NAN}, opt); } for (size_t i=0; i layers, std::vector &cells, std::vector &v, bool bylyr, SpatOptions &opt) { size_t cs = cells.size(); double nce = ncell() - 1; for (size_t i=0; i nce)) { setError("cell number(s) out of range"); return false; } } size_t nl = layers.size(); size_t maxnl = nlyr()-1; for (size_t i=0; i maxnl) { setError("invalid layer number"); return(false); } } size_t vs = v.size(); if (vs == 1) { bylyr = false; recycle(v, cs); } else if (bylyr) { if (vs != (cs*nl)) { setError("length of cells and values do not match"); return false; } } else if (cs != vs) { if ((vs / nl) == cs) { bylyr = true; } else { setError("lengths of cells and values do not match"); return false; } } size_t nc = ncell(); if (!hasValues()) { *this = init({NAN}, opt); } std::vector srcs; srcs.reserve(nl); for (size_t i=0; i sl = findLyr(layers[i]); size_t src = sl[0]; size_t lyr = sl[1]; srcs.push_back(src); if (!source[src].memory) { // if sources is a temp file update the file? // or create a tmp file? try { readAll(); } catch(...) { setError("cannot process this raster in memory"); return false; } } size_t off = nc * lyr; if (bylyr) { size_t koff = cs * i; for (size_t k=0; k nms; if (type == "hsv") { nms = {"hue", "saturation", "value"}; hsv = true; } else if (type == "hsi") { nms = {"hue", "saturation", "intensity"}; hsi = true; } else if (type == "hsl") { nms = {"hue", "saturation", "lightness"}; //hsl = true; } else { out.setError("unknown type. Should be one of 'hsv', 'hsi' or 'hsl'"); return out; } out.setNames(nms); out.rgbtype = type; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { return out; } size_t nc=ncol(); for (size_t i = 0; i < out.bs.n; i++) { std::vector v; readBlock(v, out.bs, i); size_t n = out.bs.nrows[i] * nc; size_t n2 = n * 2; size_t iR = rgblyrs[0] * n; size_t iG = rgblyrs[1] * n; size_t iB = rgblyrs[2] * n; for (size_t j = 0; j < n; j++) { double R = v[j + iR] / 255.; double G = v[j + iG] / 255.; double B = v[j + iB] / 255.; double m = std::min(std::min(R, G), B); double M = std::max(std::max(R, G), B); double C = (M - m); if ((M == 0) || (C == 0)) { v[j] = 0; // H (hue) v[j+n] = 0; // S (saturation) if (hsv) { v[j+n2] = M; // V } else if (hsi) { v[j+n2] = (R + G + B) / 3; // I } else { v[j+n2] = (M + m) / 2; // L } } else { // S if (hsv) { v[j+n] = C / M; v[j+n2] = M; // value } else if (hsi) { v[j+n2] = (R + G + B) / 3; // I v[j+n] = 1 - m / v[j+n2]; } else { double L = (M + m) / 2; v[j+n] = C / (1 - std::fabs(2 * L - 1)); v[j+n2] = L; } // H if (hsi) { double H = ((R-G)+(R-B))/2.0; H = H/sqrt((R-G)*(R-G) + (R-B)*(G-B)); H = acos(H); if (B > G) { H = 2 * M_PI - H; } v[j] = H/(2 * M_PI); //v[j] = acos( sqrt((((R-G) + (R-B)) / 2) / pow((R - G),2) + (R-B)*(G-B)) ); } else { if (M == R) { v[j] = 60 * (G - B) / C; } else if (M == G) { v[j] = 60 * ((B - R) / C) + 120; } else { v[j] = 60 * ((R - G) / C) + 240; } v[j] = v[j] < 0 ? (v[j] + 360) / 360 : v[j] / 360; } } } if (!out.writeBlock(v, i)) return out; } out.writeStop(); readStop(); return out; } SpatRaster SpatRaster::hsx2rgb(SpatOptions &opt) { SpatRaster out = geometry(); if (nlyr() != 3) { out.setError("x must have three layers"); return out; } if (!hasValues()) { out.setError("no cell values"); return out; } bool hsv=false; bool hsl=false; if (rgbtype == "hsv") { hsv = true; } else if (rgbtype == "hsl") { hsl = true; } else if (rgbtype != "hsi") { out.setError("input color scheme should be one of 'hsv', 'hsi' or 'hsl'"); return out; } std::vector nms={"red", "green", "blue"}; out.setNames(nms); out.rgb = true; out.rgblyrs = {0,1,2}; out.rgbtype = "rgb"; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { return out; } size_t nc=ncol(); for (size_t i = 0; i < out.bs.n; i++) { std::vector v; readBlock(v, out.bs, i); size_t n = out.bs.nrows[i] * nc; size_t n2 = n * 2; for (size_t j = 0; j < n; j++) { if (std::isnan(v[j])) continue; double H = v[j] * 360; double S = v[j+n]; double X, C, m; if (hsv) { double V = v[j + n2]; C = V * S; m = V - C; X = C * (1 - std::fabs(std::fmod((H / 60.), 2) - 1)); } else if (hsl) { double L = v[j + n2]; C = (1 - std::fabs(2*L-1)) * S; m = L - C/2; X = C * (1 - std::fabs(std::fmod((H / 60.), 2) - 1)); } else { // hsi double I = v[j + n2]; double Z = 1 - std::fabs((std::fmod(H/60., 2.)) -1); C = (3 * I * S) / (1 + Z); X = C * Z; m = I * (1-S); } if (H < 60) { v[j]=C; v[j+n]=X; v[j+n2]=0; } else if (H < 120) { v[j]=X; v[j+n]=C; v[j+n2]=0; } else if (H < 180) { v[j]=0; v[j+n]=C; v[j+n2]=X; } else if (H < 240) { v[j]=0; v[j+n]=X; v[j+n2]=C; } else if (H < 300) { v[j]=X; v[j+n]=0; v[j+n2]=C; } else { v[j]=C; v[j+n]=0; v[j+n2]=X; } v[j] = (v[j] + m) * 255; v[j+n] = (v[j+n] + m) * 255; v[j+n2] = (v[j+n2] + m) * 255; } if (!out.writeBlock(v, i)) return out; } out.writeStop(); readStop(); return out; } SpatRaster SpatRaster::sort(bool decreasing, bool order, SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) { return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nl = out.nlyr(); std::vector v(nl); size_t nc; if (order) { for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); nc = out.bs.nrows[i] * out.ncol(); std::vector knc; knc.reserve(nl); for (size_t k=0; k ord; for (size_t j=0; j a; readBlock(a, out.bs, i); nc = out.bs.nrows[i] * out.ncol(); for (size_t j=0; j 1) { out.setError("can only do this for a single layer SpatRasters"); } if (!out.compare_geom(x, false, false, opt.get_tolerance(), true)) { out.setError("raster dimensions do not match"); return(out); } if (!x.hasValues() || !hasValues()) { out.setError("both SpatRasters must have cell values"); } std::vector cats = hasCategories(); std::vector xcats = x.hasCategories(); if ((cats[0]) && (xcats[0])) { SpatCategories sc = getLayerCategories(0); SpatCategories xsc = x.getLayerCategories(0); if (sc.concatenate(xsc)) { SpatOptions topt(opt); x.addSource(*this, false, topt); std::vector from, to; to = sc.d.as_double(0); for (size_t i=0; i cr = {0,1}; sc.d = sc.d.subset_cols(cr); x.source[0].cats[0] = sc; x.source[0].hasCategories[0] = true; x = x.replaceValues(from, to, -2, false, NAN, true, opt); return x; } else { out.setError("cannot concatenate categories"); return out; } } else { out.setError("both SpatRasters must be categorical"); return out; } //return(out); } SpatRaster SpatRaster::intersect(SpatRaster &x, SpatOptions &opt) { size_t nl = std::max(nlyr(), x.nlyr()); SpatRaster out = geometry(nl); out.setValueType(3); if (!hasValues()) return out; if (!x.hasValues()) return out; if (!out.compare_geom(x, false, false, opt.get_tolerance(), true)) { if (!shared_basegeom(x, 0.1, true)) { out.setError("rasters are not aligned"); return(out); } else { out.msg.has_error = false; out.msg.error = ""; SpatExtent e = getExtent(); e = e.intersect(x.getExtent()); if (e.empty()) { out.setError("rasters do not intersect"); return(out); } SpatOptions xopt(opt); x = x.crop(e, "near", false, xopt); SpatRaster y = crop(e, "near", false, xopt); return y.intersect(x, opt); } } if (!readStart()) { out.setError(getError()); return(out); } if (!x.readStart()) { out.setError(x.getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); x.readStop(); return out; } for (size_t i=0; i a, b; readValues(a, out.bs.row[i], out.bs.nrows[i], 0, ncol()); x.readValues(b, out.bs.row[i], out.bs.nrows[i], 0, ncol()); recycle(a, b); std::vector d(a.size()); for (size_t j=0; j v; readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); std::vector d((v.size() / 2) * nl); if (circular) { for (size_t j=0; j end) { //std::swap(start, end); circ = true; } if ((start > nl) | (end > nl)) { for (size_t k=0; k nl) || (v[jnc] < v[j])) { for (size_t k=0; k x, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { out.setError("the input raster must have values"); return out; } size_t nl = nlyr(); size_t ncls = x.size() / nl; if ((nl*ncls) != x.size()) { out.setError("the number of layers does not match the values provided"); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i=0; i v; readValues(v, out.bs.row[i], out.bs.nrows[i], 0, ncol()); std::vector d; d.reserve(nc); std::vector dist(nl); std::vector offsets(nl); for (size_t k=0; k. #include "spatBase.h" #include #include #include #include #include #include /* #if defined __has_include # if __has_include () # include namespace filesyst = std::filesystem; # else # include namespace filesyst = std::experimental::filesystem; # endif #elif defined __GNUC__ # if __GNUC__ < 8 # include namespace filesyst = std::experimental::filesystem; # else # include namespace filesyst = std::filesystem; # endif #else # include namespace filesyst = std::filesystem; #endif */ bool write_text(std::string filename, std::vector s) { std::ofstream f; f.open(filename); if (f.is_open()) { for (size_t i=0; i read_text(std::string filename) { std::vector s; std::string line; std::ifstream f(filename); if (f.is_open()) { while (getline(f, line)) { if (line.empty()) { s.push_back(""); } else { s.push_back(line); } } f.close(); } return s; } std::string getFileExt(const std::string& s) { size_t i = s.rfind('.', s.length()); if (i != std::string::npos) { return(s.substr(i, s.length() - i)); } return(""); } std::string setFileExt(const std::string& s, const std::string& ext) { size_t i = s.rfind('.', s.length()); if (i != std::string::npos) { return(s.substr(0, i) + ext); } return(s + ext); } std::string noext(std::string filename) { const size_t p = filename.rfind('.'); if (std::string::npos != p) { filename.erase(p); } return filename; } std::string basename(std::string filename) { const size_t i = filename.find_last_of("\\/"); if (std::string::npos != i) { filename.erase(0, i + 1); } return filename; } std::string basename_noext(std::string filename) { filename = basename(filename); filename = noext(filename); return filename; } std::string dirname(std::string filename) { const size_t i = filename.find_last_of("\\/"); if (std::string::npos != i) { return( filename.substr(0, i) ); } else { return (""); } } bool file_exists(const std::string& name) { std::ifstream f(name.c_str()); return f.good(); } bool path_exists(std::string path) { /* filesyst::path filepath = path; return filesyst::exists(filepath); */ struct stat info; stat(path.c_str(), &info); if (info.st_mode & S_IFDIR) { return true; } return false; } bool canWrite(std::string filename) { FILE *fp = fopen(filename.c_str(), "w"); if (fp == NULL) { return false; } fclose(fp); remove(filename.c_str()); return true; } std::string get_path(const std::string filename) { size_t found = filename.find_last_of("/\\"); std::string result = filename.substr(0, found); return result; } bool filepath_exists(const std::string& name) { std::string p = get_path(name); return path_exists(p); } /* # c++17 #include bool SpatRaster::differentFilenames(std::vector outf) { std::vector inf = filenames(); for (size_t i=0; i inf, std::vector outf, std::string &msg) { #ifdef _WIN32 for (size_t j=0; j outf.size()) { msg = "duplicate filenames"; return false; } return true; } bool can_write(std::vector filenames, std::vector srcnames, bool overwrite, std::string &msg) { if (!differentFilenames(srcnames, filenames, msg)) { return false; } for (size_t i=0; i exts = {".vat.dbf", ".vat.cpg", ".json", ".aux.xml"}; for (size_t j=0; j characters = {'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K', 'L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z','a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z' }; std::uniform_int_distribution rand_nr(0, characters.size()-1); std::string randname; randname.reserve(15); for (int i = 0; i < 15; i++) { randname += characters[rand_nr(my_rgen)]; } std::string filename = tmpdir + "/spat_" + fname + "_" + randname + ext; if (file_exists(filename)) { std::this_thread::sleep_for(std::chrono::milliseconds(1)); filename = tempFile(tmpdir, fname, ext); } return filename; } /* std::string tempFile(std::string tmpdir, unsigned pid, std::string ext) { std::vector characters = {'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','G','H','I','J','K', 'L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z','a','b','c','d','e','f','g','h','i','j','k','l','m', 'n','o','p','q','r','s','t','u','v','w','x','y','z' }; std::uniform_int_distribution<> distrib(0, characters.size()-1); auto draw = [ characters, &distrib, &generator ]() { return characters[ distrib(generator) ]; }; std::string filename(15, 0); std::generate_n(filename.begin(), 15, draw); filename = tmpdir + "/spat_" + filename + "_" + std::to_string(pid) + ext; if (file_exists(filename)) { std::this_thread::sleep_for(std::chrono::milliseconds(1)); return tempFile(tmpdir, pid, ext); } return filename; } */ terra/src/sort.h0000644000176200001440000000264214536376240013334 0ustar liggesusers #ifndef SORT_GUARD #define SORT_GUARD #include std::vector sort_order_nan_a(const std::vector &x); std::vector sort_order_nan_d(const std::vector &x); std::vector sort_order_nal_a(const std::vector &x); std::vector sort_order_nal_d(const std::vector &x); std::vector sort_order_nas_a(const std::vector &x); std::vector sort_order_nas_d(const std::vector &x); template std::vector sort_order_a(const std::vector &x){ std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return (x[i] < x[j]); }); return p; } template std::vector sort_order_d(const std::vector &x){ std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return (x[i] > x[j]); }); return p; } template void permute(std::vector &x, const std::vector &p) { std::vector done(x.size()); for (std::size_t i = 0; i < x.size(); ++i) { if (done[i]) { continue; } done[i] = true; size_t prev_j = i; size_t j = p[i]; while (i != j) { std::swap(x[prev_j], x[j]); done[j] = true; prev_j = j; j = p[j]; } } } #endif terra/src/geodesic.h0000644000176200001440000013031114536376240014122 0ustar liggesusers/** * \file geodesic.h * \brief API for the geodesic routines in C * * This an implementation in C of the geodesic algorithms described in * - C. F. F. Karney, * * Algorithms for geodesics, * J. Geodesy 87, 43--55 (2013); * DOI: * 10.1007/s00190-012-0578-z; * addenda: * geod-addenda.html. * . * The principal advantages of these algorithms over previous ones (e.g., * Vincenty, 1975) are * - accurate to round off for |f| < 1/50; * - the solution of the inverse problem is always found; * - differential and integral properties of geodesics are computed. * * The shortest path between two points on the ellipsoid at (\e lat1, \e * lon1) and (\e lat2, \e lon2) is called the geodesic. Its length is * \e s12 and the geodesic from point 1 to point 2 has forward azimuths * \e azi1 and \e azi2 at the two end points. * * Traditionally two geodesic problems are considered: * - the direct problem -- given \e lat1, \e lon1, \e s12, and \e azi1, * determine \e lat2, \e lon2, and \e azi2. This is solved by the function * geod_direct(). * - the inverse problem -- given \e lat1, \e lon1, and \e lat2, \e lon2, * determine \e s12, \e azi1, and \e azi2. This is solved by the function * geod_inverse(). * * The ellipsoid is specified by its equatorial radius \e a (typically in * meters) and flattening \e f. The routines are accurate to round off with * double precision arithmetic provided that |f| < 1/50; for the * WGS84 ellipsoid, the errors are less than 15 nanometers. (Reasonably * accurate results are obtained for |f| < 1/5.) For a prolate * ellipsoid, specify \e f < 0. * * The routines also calculate several other quantities of interest * - \e S12 is the area between the geodesic from point 1 to point 2 and the * equator; i.e., it is the area, measured counter-clockwise, of the * quadrilateral with corners (\e lat1,\e lon1), (0,\e lon1), (0,\e lon2), * and (\e lat2,\e lon2). * - \e m12, the reduced length of the geodesic is defined such that if * the initial azimuth is perturbed by \e dazi1 (radians) then the * second point is displaced by \e m12 \e dazi1 in the direction * perpendicular to the geodesic. On a curved surface the reduced * length obeys a symmetry relation, \e m12 + \e m21 = 0. On a flat * surface, we have \e m12 = \e s12. * - \e M12 and \e M21 are geodesic scales. If two geodesics are * parallel at point 1 and separated by a small distance \e dt, then * they are separated by a distance \e M12 \e dt at point 2. \e M21 * is defined similarly (with the geodesics being parallel to one * another at point 2). On a flat surface, we have \e M12 = \e M21 * = 1. * - \e a12 is the arc length on the auxiliary sphere. This is a * construct for converting the problem to one in spherical * trigonometry. \e a12 is measured in degrees. The spherical arc * length from one equator crossing to the next is always 180°. * * If points 1, 2, and 3 lie on a single geodesic, then the following * addition rules hold: * - \e s13 = \e s12 + \e s23 * - \e a13 = \e a12 + \e a23 * - \e S13 = \e S12 + \e S23 * - \e m13 = \e m12 \e M23 + \e m23 \e M21 * - \e M13 = \e M12 \e M23 − (1 − \e M12 \e M21) \e * m23 / \e m12 * - \e M31 = \e M32 \e M21 − (1 − \e M23 \e M32) \e * m12 / \e m23 * * The shortest distance returned by the solution of the inverse problem is * (obviously) uniquely defined. However, in a few special cases there are * multiple azimuths which yield the same shortest distance. Here is a * catalog of those cases: * - \e lat1 = −\e lat2 (with neither point at a pole). If \e azi1 = \e * azi2, the geodesic is unique. Otherwise there are two geodesics and the * second one is obtained by setting [\e azi1, \e azi2] → [\e azi2, \e * azi1], [\e M12, \e M21] → [\e M21, \e M12], \e S12 → −\e * S12. (This occurs when the longitude difference is near ±180° * for oblate ellipsoids.) * - \e lon2 = \e lon1 ± 180° (with neither point at a pole). If \e * azi1 = 0° or ±180°, the geodesic is unique. Otherwise * there are two geodesics and the second one is obtained by setting [\e * azi1, \e azi2] → [−\e azi1, −\e azi2], \e S12 → * −\e S12. (This occurs when \e lat2 is near −\e lat1 for * prolate ellipsoids.) * - Points 1 and 2 at opposite poles. There are infinitely many geodesics * which can be generated by setting [\e azi1, \e azi2] → [\e azi1, \e * azi2] + [\e d, −\e d], for arbitrary \e d. (For spheres, this * prescription applies when points 1 and 2 are antipodal.) * - \e s12 = 0 (coincident points). There are infinitely many geodesics which * can be generated by setting [\e azi1, \e azi2] → [\e azi1, \e azi2] + * [\e d, \e d], for arbitrary \e d. * * These routines are a simple transcription of the corresponding C++ classes * in GeographicLib. The * "class data" is represented by the structs geod_geodesic, geod_geodesicline, * geod_polygon and pointers to these objects are passed as initial arguments * to the member functions. Most of the internal comments have been retained. * However, in the process of transcription some documentation has been lost * and the documentation for the C++ classes, GeographicLib::Geodesic, * GeographicLib::GeodesicLine, and GeographicLib::PolygonAreaT, should be * consulted. The C++ code remains the "reference implementation". Think * twice about restructuring the internals of the C code since this may make * porting fixes from the C++ code more difficult. * * Copyright (c) Charles Karney (2012-2021) and licensed * under the MIT/X11 License. For more information, see * https://geographiclib.sourceforge.io/ * * This library was distributed with * GeographicLib 1.52. **********************************************************************/ #if !defined(GEODESIC_H) #define GEODESIC_H 1 /** * The major version of the geodesic library. (This tracks the version of * GeographicLib.) **********************************************************************/ #define GEODESIC_VERSION_MAJOR 1 /** * The minor version of the geodesic library. (This tracks the version of * GeographicLib.) **********************************************************************/ #define GEODESIC_VERSION_MINOR 52 /** * The patch level of the geodesic library. (This tracks the version of * GeographicLib.) **********************************************************************/ #define GEODESIC_VERSION_PATCH 0 /** * Pack the version components into a single integer. Users should not rely on * this particular packing of the components of the version number; see the * documentation for GEODESIC_VERSION, below. **********************************************************************/ #define GEODESIC_VERSION_NUM(a,b,c) ((((a) * 10000 + (b)) * 100) + (c)) /** * The version of the geodesic library as a single integer, packed as MMmmmmpp * where MM is the major version, mmmm is the minor version, and pp is the * patch level. Users should not rely on this particular packing of the * components of the version number. Instead they should use a test such as * @code{.c} #if GEODESIC_VERSION >= GEODESIC_VERSION_NUM(1,40,0) ... #endif * @endcode **********************************************************************/ #define GEODESIC_VERSION \ GEODESIC_VERSION_NUM(GEODESIC_VERSION_MAJOR, \ GEODESIC_VERSION_MINOR, \ GEODESIC_VERSION_PATCH) #if !defined(GEOD_DLL) #if defined(_MSC_VER) && defined(PROJ_MSVC_DLL_EXPORT) #define GEOD_DLL __declspec(dllexport) #elif defined(__GNUC__) #define GEOD_DLL __attribute__ ((visibility("default"))) #else #define GEOD_DLL #endif #endif #if defined(PROJ_RENAME_SYMBOLS) #include "proj_symbol_rename.h" #endif #if defined(__cplusplus) extern "C" { #endif /** * The struct containing information about the ellipsoid. This must be * initialized by geod_init() before use. **********************************************************************/ struct geod_geodesic { double a; /**< the equatorial radius */ double f; /**< the flattening */ /**< @cond SKIP */ double f1, e2, ep2, n, b, c2, etol2; double A3x[6], C3x[15], C4x[21]; /**< @endcond */ }; /** * The struct containing information about a single geodesic. This must be * initialized by geod_lineinit(), geod_directline(), geod_gendirectline(), * or geod_inverseline() before use. **********************************************************************/ struct geod_geodesicline { double lat1; /**< the starting latitude */ double lon1; /**< the starting longitude */ double azi1; /**< the starting azimuth */ double a; /**< the equatorial radius */ double f; /**< the flattening */ double salp1; /**< sine of \e azi1 */ double calp1; /**< cosine of \e azi1 */ double a13; /**< arc length to reference point */ double s13; /**< distance to reference point */ /**< @cond SKIP */ double b, c2, f1, salp0, calp0, k2, ssig1, csig1, dn1, stau1, ctau1, somg1, comg1, A1m1, A2m1, A3c, B11, B21, B31, A4, B41; double C1a[6+1], C1pa[6+1], C2a[6+1], C3a[6], C4a[6]; /**< @endcond */ unsigned caps; /**< the capabilities */ }; /** * The struct for accumulating information about a geodesic polygon. This is * used for computing the perimeter and area of a polygon. This must be * initialized by geod_polygon_init() before use. **********************************************************************/ struct geod_polygon { double lat; /**< the current latitude */ double lon; /**< the current longitude */ /**< @cond SKIP */ double lat0; double lon0; double A[2]; double P[2]; int polyline; int crossings; /**< @endcond */ unsigned num; /**< the number of points so far */ }; /** * Initialize a geod_geodesic object. * * @param[out] g a pointer to the object to be initialized. * @param[in] a the equatorial radius (meters). * @param[in] f the flattening. **********************************************************************/ void GEOD_DLL geod_init(struct geod_geodesic* g, double a, double f); /** * Solve the direct geodesic problem. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] azi1 azimuth at point 1 (degrees). * @param[in] s12 distance from point 1 to point 2 (meters); it can be * negative. * @param[out] plat2 pointer to the latitude of point 2 (degrees). * @param[out] plon2 pointer to the longitude of point 2 (degrees). * @param[out] pazi2 pointer to the (forward) azimuth at point 2 (degrees). * * \e g must have been initialized with a call to geod_init(). \e lat1 * should be in the range [−90°, 90°]. The values of \e lon2 * and \e azi2 returned are in the range [−180°, 180°]. Any of * the "return" arguments \e plat2, etc., may be replaced by 0, if you do not * need some quantities computed. * * If either point is at a pole, the azimuth is defined by keeping the * longitude fixed, writing \e lat = ±(90° − ε), and * taking the limit ε → 0+. An arc length greater that 180° * signifies a geodesic which is not a shortest path. (For a prolate * ellipsoid, an additional condition is necessary for a shortest path: the * longitudinal extent must not exceed of 180°.) * * Example, determine the point 10000 km NE of JFK: @code{.c} struct geod_geodesic g; double lat, lon; geod_init(&g, 6378137, 1/298.257223563); geod_direct(&g, 40.64, -73.78, 45.0, 10e6, &lat, &lon, 0); printf("%.5f %.5f\n", lat, lon); @endcode **********************************************************************/ void GEOD_DLL geod_direct(const struct geod_geodesic* g, double lat1, double lon1, double azi1, double s12, double* plat2, double* plon2, double* pazi2); /** * The general direct geodesic problem. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] azi1 azimuth at point 1 (degrees). * @param[in] flags bitor'ed combination of geod_flags(); \e flags & * GEOD_ARCMODE determines the meaning of \e s12_a12 and \e flags & * GEOD_LONG_UNROLL "unrolls" \e lon2. * @param[in] s12_a12 if \e flags & GEOD_ARCMODE is 0, this is the distance * from point 1 to point 2 (meters); otherwise it is the arc length * from point 1 to point 2 (degrees); it can be negative. * @param[out] plat2 pointer to the latitude of point 2 (degrees). * @param[out] plon2 pointer to the longitude of point 2 (degrees). * @param[out] pazi2 pointer to the (forward) azimuth at point 2 (degrees). * @param[out] ps12 pointer to the distance from point 1 to point 2 * (meters). * @param[out] pm12 pointer to the reduced length of geodesic (meters). * @param[out] pM12 pointer to the geodesic scale of point 2 relative to * point 1 (dimensionless). * @param[out] pM21 pointer to the geodesic scale of point 1 relative to * point 2 (dimensionless). * @param[out] pS12 pointer to the area under the geodesic * (meters2). * @return \e a12 arc length from point 1 to point 2 (degrees). * * \e g must have been initialized with a call to geod_init(). \e lat1 * should be in the range [−90°, 90°]. The function value \e * a12 equals \e s12_a12 if \e flags & GEOD_ARCMODE. Any of the "return" * arguments, \e plat2, etc., may be replaced by 0, if you do not need some * quantities computed. * * With \e flags & GEOD_LONG_UNROLL bit set, the longitude is "unrolled" so * that the quantity \e lon2 − \e lon1 indicates how many times and in * what sense the geodesic encircles the ellipsoid. **********************************************************************/ double GEOD_DLL geod_gendirect(const struct geod_geodesic* g, double lat1, double lon1, double azi1, unsigned flags, double s12_a12, double* plat2, double* plon2, double* pazi2, double* ps12, double* pm12, double* pM12, double* pM21, double* pS12); /** * Solve the inverse geodesic problem. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] lat2 latitude of point 2 (degrees). * @param[in] lon2 longitude of point 2 (degrees). * @param[out] ps12 pointer to the distance from point 1 to point 2 * (meters). * @param[out] pazi1 pointer to the azimuth at point 1 (degrees). * @param[out] pazi2 pointer to the (forward) azimuth at point 2 (degrees). * * \e g must have been initialized with a call to geod_init(). \e lat1 and * \e lat2 should be in the range [−90°, 90°]. The values of * \e azi1 and \e azi2 returned are in the range [−180°, 180°]. * Any of the "return" arguments, \e ps12, etc., may be replaced by 0, if you * do not need some quantities computed. * * If either point is at a pole, the azimuth is defined by keeping the * longitude fixed, writing \e lat = ±(90° − ε), and * taking the limit ε → 0+. * * The solution to the inverse problem is found using Newton's method. If * this fails to converge (this is very unlikely in geodetic applications * but does occur for very eccentric ellipsoids), then the bisection method * is used to refine the solution. * * Example, determine the distance between JFK and Singapore Changi Airport: @code{.c} struct geod_geodesic g; double s12; geod_init(&g, 6378137, 1/298.257223563); geod_inverse(&g, 40.64, -73.78, 1.36, 103.99, &s12, 0, 0); printf("%.3f\n", s12); @endcode **********************************************************************/ void GEOD_DLL geod_inverse(const struct geod_geodesic* g, double lat1, double lon1, double lat2, double lon2, double* ps12, double* pazi1, double* pazi2); /** * The general inverse geodesic calculation. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] lat2 latitude of point 2 (degrees). * @param[in] lon2 longitude of point 2 (degrees). * @param[out] ps12 pointer to the distance from point 1 to point 2 * (meters). * @param[out] pazi1 pointer to the azimuth at point 1 (degrees). * @param[out] pazi2 pointer to the (forward) azimuth at point 2 (degrees). * @param[out] pm12 pointer to the reduced length of geodesic (meters). * @param[out] pM12 pointer to the geodesic scale of point 2 relative to * point 1 (dimensionless). * @param[out] pM21 pointer to the geodesic scale of point 1 relative to * point 2 (dimensionless). * @param[out] pS12 pointer to the area under the geodesic * (meters2). * @return \e a12 arc length from point 1 to point 2 (degrees). * * \e g must have been initialized with a call to geod_init(). \e lat1 and * \e lat2 should be in the range [−90°, 90°]. Any of the * "return" arguments \e ps12, etc., may be replaced by 0, if you do not need * some quantities computed. **********************************************************************/ double GEOD_DLL geod_geninverse(const struct geod_geodesic* g, double lat1, double lon1, double lat2, double lon2, double* ps12, double* pazi1, double* pazi2, double* pm12, double* pM12, double* pM21, double* pS12); /** * Initialize a geod_geodesicline object. * * @param[out] l a pointer to the object to be initialized. * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] azi1 azimuth at point 1 (degrees). * @param[in] caps bitor'ed combination of geod_mask() values specifying the * capabilities the geod_geodesicline object should possess, i.e., which * quantities can be returned in calls to geod_position() and * geod_genposition(). * * \e g must have been initialized with a call to geod_init(). \e lat1 * should be in the range [−90°, 90°]. * * The geod_mask values are [see geod_mask()]: * - \e caps |= GEOD_LATITUDE for the latitude \e lat2; this is * added automatically, * - \e caps |= GEOD_LONGITUDE for the latitude \e lon2, * - \e caps |= GEOD_AZIMUTH for the latitude \e azi2; this is * added automatically, * - \e caps |= GEOD_DISTANCE for the distance \e s12, * - \e caps |= GEOD_REDUCEDLENGTH for the reduced length \e m12, * - \e caps |= GEOD_GEODESICSCALE for the geodesic scales \e M12 * and \e M21, * - \e caps |= GEOD_AREA for the area \e S12, * - \e caps |= GEOD_DISTANCE_IN permits the length of the * geodesic to be given in terms of \e s12; without this capability the * length can only be specified in terms of arc length. * . * A value of \e caps = 0 is treated as GEOD_LATITUDE | GEOD_LONGITUDE | * GEOD_AZIMUTH | GEOD_DISTANCE_IN (to support the solution of the "standard" * direct problem). * * When initialized by this function, point 3 is undefined (l->s13 = l->a13 = * NaN). **********************************************************************/ void GEOD_DLL geod_lineinit(struct geod_geodesicline* l, const struct geod_geodesic* g, double lat1, double lon1, double azi1, unsigned caps); /** * Initialize a geod_geodesicline object in terms of the direct geodesic * problem. * * @param[out] l a pointer to the object to be initialized. * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] azi1 azimuth at point 1 (degrees). * @param[in] s12 distance from point 1 to point 2 (meters); it can be * negative. * @param[in] caps bitor'ed combination of geod_mask() values specifying the * capabilities the geod_geodesicline object should possess, i.e., which * quantities can be returned in calls to geod_position() and * geod_genposition(). * * This function sets point 3 of the geod_geodesicline to correspond to point * 2 of the direct geodesic problem. See geod_lineinit() for more * information. **********************************************************************/ void GEOD_DLL geod_directline(struct geod_geodesicline* l, const struct geod_geodesic* g, double lat1, double lon1, double azi1, double s12, unsigned caps); /** * Initialize a geod_geodesicline object in terms of the direct geodesic * problem specified in terms of either distance or arc length. * * @param[out] l a pointer to the object to be initialized. * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] azi1 azimuth at point 1 (degrees). * @param[in] flags either GEOD_NOFLAGS or GEOD_ARCMODE to determining the * meaning of the \e s12_a12. * @param[in] s12_a12 if \e flags = GEOD_NOFLAGS, this is the distance * from point 1 to point 2 (meters); if \e flags = GEOD_ARCMODE, it is * the arc length from point 1 to point 2 (degrees); it can be * negative. * @param[in] caps bitor'ed combination of geod_mask() values specifying the * capabilities the geod_geodesicline object should possess, i.e., which * quantities can be returned in calls to geod_position() and * geod_genposition(). * * This function sets point 3 of the geod_geodesicline to correspond to point * 2 of the direct geodesic problem. See geod_lineinit() for more * information. **********************************************************************/ void GEOD_DLL geod_gendirectline(struct geod_geodesicline* l, const struct geod_geodesic* g, double lat1, double lon1, double azi1, unsigned flags, double s12_a12, unsigned caps); /** * Initialize a geod_geodesicline object in terms of the inverse geodesic * problem. * * @param[out] l a pointer to the object to be initialized. * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lat1 latitude of point 1 (degrees). * @param[in] lon1 longitude of point 1 (degrees). * @param[in] lat2 latitude of point 2 (degrees). * @param[in] lon2 longitude of point 2 (degrees). * @param[in] caps bitor'ed combination of geod_mask() values specifying the * capabilities the geod_geodesicline object should possess, i.e., which * quantities can be returned in calls to geod_position() and * geod_genposition(). * * This function sets point 3 of the geod_geodesicline to correspond to point * 2 of the inverse geodesic problem. See geod_lineinit() for more * information. **********************************************************************/ void GEOD_DLL geod_inverseline(struct geod_geodesicline* l, const struct geod_geodesic* g, double lat1, double lon1, double lat2, double lon2, unsigned caps); /** * Compute the position along a geod_geodesicline. * * @param[in] l a pointer to the geod_geodesicline object specifying the * geodesic line. * @param[in] s12 distance from point 1 to point 2 (meters); it can be * negative. * @param[out] plat2 pointer to the latitude of point 2 (degrees). * @param[out] plon2 pointer to the longitude of point 2 (degrees); requires * that \e l was initialized with \e caps |= GEOD_LONGITUDE. * @param[out] pazi2 pointer to the (forward) azimuth at point 2 (degrees). * * \e l must have been initialized with a call, e.g., to geod_lineinit(), * with \e caps |= GEOD_DISTANCE_IN (or \e caps = 0). The values of \e lon2 * and \e azi2 returned are in the range [−180°, 180°]. Any of * the "return" arguments \e plat2, etc., may be replaced by 0, if you do not * need some quantities computed. * * Example, compute way points between JFK and Singapore Changi Airport * the "obvious" way using geod_direct(): @code{.c} struct geod_geodesic g; double s12, azi1, lat[101],lon[101]; int i; geod_init(&g, 6378137, 1/298.257223563); geod_inverse(&g, 40.64, -73.78, 1.36, 103.99, &s12, &azi1, 0); for (i = 0; i < 101; ++i) { geod_direct(&g, 40.64, -73.78, azi1, i * s12 * 0.01, lat + i, lon + i, 0); printf("%.5f %.5f\n", lat[i], lon[i]); } @endcode * A faster way using geod_position(): @code{.c} struct geod_geodesic g; struct geod_geodesicline l; double lat[101],lon[101]; int i; geod_init(&g, 6378137, 1/298.257223563); geod_inverseline(&l, &g, 40.64, -73.78, 1.36, 103.99, 0); for (i = 0; i <= 100; ++i) { geod_position(&l, i * l.s13 * 0.01, lat + i, lon + i, 0); printf("%.5f %.5f\n", lat[i], lon[i]); } @endcode **********************************************************************/ void GEOD_DLL geod_position(const struct geod_geodesicline* l, double s12, double* plat2, double* plon2, double* pazi2); /** * The general position function. * * @param[in] l a pointer to the geod_geodesicline object specifying the * geodesic line. * @param[in] flags bitor'ed combination of geod_flags(); \e flags & * GEOD_ARCMODE determines the meaning of \e s12_a12 and \e flags & * GEOD_LONG_UNROLL "unrolls" \e lon2; if \e flags & GEOD_ARCMODE is 0, * then \e l must have been initialized with \e caps |= GEOD_DISTANCE_IN. * @param[in] s12_a12 if \e flags & GEOD_ARCMODE is 0, this is the * distance from point 1 to point 2 (meters); otherwise it is the * arc length from point 1 to point 2 (degrees); it can be * negative. * @param[out] plat2 pointer to the latitude of point 2 (degrees). * @param[out] plon2 pointer to the longitude of point 2 (degrees); requires * that \e l was initialized with \e caps |= GEOD_LONGITUDE. * @param[out] pazi2 pointer to the (forward) azimuth at point 2 (degrees). * @param[out] ps12 pointer to the distance from point 1 to point 2 * (meters); requires that \e l was initialized with \e caps |= * GEOD_DISTANCE. * @param[out] pm12 pointer to the reduced length of geodesic (meters); * requires that \e l was initialized with \e caps |= GEOD_REDUCEDLENGTH. * @param[out] pM12 pointer to the geodesic scale of point 2 relative to * point 1 (dimensionless); requires that \e l was initialized with \e caps * |= GEOD_GEODESICSCALE. * @param[out] pM21 pointer to the geodesic scale of point 1 relative to * point 2 (dimensionless); requires that \e l was initialized with \e caps * |= GEOD_GEODESICSCALE. * @param[out] pS12 pointer to the area under the geodesic * (meters2); requires that \e l was initialized with \e caps |= * GEOD_AREA. * @return \e a12 arc length from point 1 to point 2 (degrees). * * \e l must have been initialized with a call to geod_lineinit() with \e * caps |= GEOD_DISTANCE_IN. The value \e azi2 returned is in the range * [−180°, 180°]. Any of the "return" arguments \e plat2, * etc., may be replaced by 0, if you do not need some quantities * computed. Requesting a value which \e l is not capable of computing * is not an error; the corresponding argument will not be altered. * * With \e flags & GEOD_LONG_UNROLL bit set, the longitude is "unrolled" so * that the quantity \e lon2 − \e lon1 indicates how many times and in * what sense the geodesic encircles the ellipsoid. * * Example, compute way points between JFK and Singapore Changi Airport using * geod_genposition(). In this example, the points are evenly space in arc * length (and so only approximately equally spaced in distance). This is * faster than using geod_position() and would be appropriate if drawing the * path on a map. @code{.c} struct geod_geodesic g; struct geod_geodesicline l; double lat[101], lon[101]; int i; geod_init(&g, 6378137, 1/298.257223563); geod_inverseline(&l, &g, 40.64, -73.78, 1.36, 103.99, GEOD_LATITUDE | GEOD_LONGITUDE); for (i = 0; i <= 100; ++i) { geod_genposition(&l, GEOD_ARCMODE, i * l.a13 * 0.01, lat + i, lon + i, 0, 0, 0, 0, 0, 0); printf("%.5f %.5f\n", lat[i], lon[i]); } @endcode **********************************************************************/ double GEOD_DLL geod_genposition(const struct geod_geodesicline* l, unsigned flags, double s12_a12, double* plat2, double* plon2, double* pazi2, double* ps12, double* pm12, double* pM12, double* pM21, double* pS12); /** * Specify position of point 3 in terms of distance. * * @param[in,out] l a pointer to the geod_geodesicline object. * @param[in] s13 the distance from point 1 to point 3 (meters); it * can be negative. * * This is only useful if the geod_geodesicline object has been constructed * with \e caps |= GEOD_DISTANCE_IN. **********************************************************************/ void GEOD_DLL geod_setdistance(struct geod_geodesicline* l, double s13); /** * Specify position of point 3 in terms of either distance or arc length. * * @param[in,out] l a pointer to the geod_geodesicline object. * @param[in] flags either GEOD_NOFLAGS or GEOD_ARCMODE to determining the * meaning of the \e s13_a13. * @param[in] s13_a13 if \e flags = GEOD_NOFLAGS, this is the distance * from point 1 to point 3 (meters); if \e flags = GEOD_ARCMODE, it is * the arc length from point 1 to point 3 (degrees); it can be * negative. * * If flags = GEOD_NOFLAGS, this calls geod_setdistance(). If flags = * GEOD_ARCMODE, the \e s13 is only set if the geod_geodesicline object has * been constructed with \e caps |= GEOD_DISTANCE. **********************************************************************/ void GEOD_DLL geod_gensetdistance(struct geod_geodesicline* l, unsigned flags, double s13_a13); /** * Initialize a geod_polygon object. * * @param[out] p a pointer to the object to be initialized. * @param[in] polylinep non-zero if a polyline instead of a polygon. * * If \e polylinep is zero, then the sequence of vertices and edges added by * geod_polygon_addpoint() and geod_polygon_addedge() define a polygon and * the perimeter and area are returned by geod_polygon_compute(). If \e * polylinep is non-zero, then the vertices and edges define a polyline and * only the perimeter is returned by geod_polygon_compute(). * * The area and perimeter are accumulated at two times the standard floating * point precision to guard against the loss of accuracy with many-sided * polygons. At any point you can ask for the perimeter and area so far. * * An example of the use of this function is given in the documentation for * geod_polygon_compute(). **********************************************************************/ void GEOD_DLL geod_polygon_init(struct geod_polygon* p, int polylinep); /** * Clear the polygon, allowing a new polygon to be started. * * @param[in,out] p a pointer to the object to be cleared. **********************************************************************/ void GEOD_DLL geod_polygon_clear(struct geod_polygon* p); /** * Add a point to the polygon or polyline. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in,out] p a pointer to the geod_polygon object specifying the * polygon. * @param[in] lat the latitude of the point (degrees). * @param[in] lon the longitude of the point (degrees). * * \e g and \e p must have been initialized with calls to geod_init() and * geod_polygon_init(), respectively. The same \e g must be used for all the * points and edges in a polygon. \e lat should be in the range * [−90°, 90°]. * * An example of the use of this function is given in the documentation for * geod_polygon_compute(). **********************************************************************/ void GEOD_DLL geod_polygon_addpoint(const struct geod_geodesic* g, struct geod_polygon* p, double lat, double lon); /** * Add an edge to the polygon or polyline. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in,out] p a pointer to the geod_polygon object specifying the * polygon. * @param[in] azi azimuth at current point (degrees). * @param[in] s distance from current point to next point (meters). * * \e g and \e p must have been initialized with calls to geod_init() and * geod_polygon_init(), respectively. The same \e g must be used for all the * points and edges in a polygon. This does nothing if no points have been * added yet. The \e lat and \e lon fields of \e p give the location of the * new vertex. **********************************************************************/ void GEOD_DLL geod_polygon_addedge(const struct geod_geodesic* g, struct geod_polygon* p, double azi, double s); /** * Return the results for a polygon. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] p a pointer to the geod_polygon object specifying the polygon. * @param[in] reverse if non-zero then clockwise (instead of * counter-clockwise) traversal counts as a positive area. * @param[in] sign if non-zero then return a signed result for the area if * the polygon is traversed in the "wrong" direction instead of returning * the area for the rest of the earth. * @param[out] pA pointer to the area of the polygon (meters2); * only set if \e polyline is non-zero in the call to geod_polygon_init(). * @param[out] pP pointer to the perimeter of the polygon or length of the * polyline (meters). * @return the number of points. * * The area and perimeter are accumulated at two times the standard floating * point precision to guard against the loss of accuracy with many-sided * polygons. Arbitrarily complex polygons are allowed. In the case of * self-intersecting polygons the area is accumulated "algebraically", e.g., * the areas of the 2 loops in a figure-8 polygon will partially cancel. * There's no need to "close" the polygon by repeating the first vertex. Set * \e pA or \e pP to zero, if you do not want the corresponding quantity * returned. * * More points can be added to the polygon after this call. * * Example, compute the perimeter and area of the geodesic triangle with * vertices (0°N,0°E), (0°N,90°E), (90°N,0°E). @code{.c} double A, P; int n; struct geod_geodesic g; struct geod_polygon p; geod_init(&g, 6378137, 1/298.257223563); geod_polygon_init(&p, 0); geod_polygon_addpoint(&g, &p, 0, 0); geod_polygon_addpoint(&g, &p, 0, 90); geod_polygon_addpoint(&g, &p, 90, 0); n = geod_polygon_compute(&g, &p, 0, 1, &A, &P); printf("%d %.8f %.3f\n", n, P, A); @endcode **********************************************************************/ unsigned GEOD_DLL geod_polygon_compute(const struct geod_geodesic* g, const struct geod_polygon* p, int reverse, int sign, double* pA, double* pP); /** * Return the results assuming a tentative final test point is added; * however, the data for the test point is not saved. This lets you report a * running result for the perimeter and area as the user moves the mouse * cursor. Ordinary floating point arithmetic is used to accumulate the data * for the test point; thus the area and perimeter returned are less accurate * than if geod_polygon_addpoint() and geod_polygon_compute() are used. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] p a pointer to the geod_polygon object specifying the polygon. * @param[in] lat the latitude of the test point (degrees). * @param[in] lon the longitude of the test point (degrees). * @param[in] reverse if non-zero then clockwise (instead of * counter-clockwise) traversal counts as a positive area. * @param[in] sign if non-zero then return a signed result for the area if * the polygon is traversed in the "wrong" direction instead of returning * the area for the rest of the earth. * @param[out] pA pointer to the area of the polygon (meters2); * only set if \e polyline is non-zero in the call to geod_polygon_init(). * @param[out] pP pointer to the perimeter of the polygon or length of the * polyline (meters). * @return the number of points. * * \e lat should be in the range [−90°, 90°]. **********************************************************************/ unsigned GEOD_DLL geod_polygon_testpoint(const struct geod_geodesic* g, const struct geod_polygon* p, double lat, double lon, int reverse, int sign, double* pA, double* pP); /** * Return the results assuming a tentative final test point is added via an * azimuth and distance; however, the data for the test point is not saved. * This lets you report a running result for the perimeter and area as the * user moves the mouse cursor. Ordinary floating point arithmetic is used * to accumulate the data for the test point; thus the area and perimeter * returned are less accurate than if geod_polygon_addedge() and * geod_polygon_compute() are used. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] p a pointer to the geod_polygon object specifying the polygon. * @param[in] azi azimuth at current point (degrees). * @param[in] s distance from current point to final test point (meters). * @param[in] reverse if non-zero then clockwise (instead of * counter-clockwise) traversal counts as a positive area. * @param[in] sign if non-zero then return a signed result for the area if * the polygon is traversed in the "wrong" direction instead of returning * the area for the rest of the earth. * @param[out] pA pointer to the area of the polygon (meters2); * only set if \e polyline is non-zero in the call to geod_polygon_init(). * @param[out] pP pointer to the perimeter of the polygon or length of the * polyline (meters). * @return the number of points. **********************************************************************/ unsigned GEOD_DLL geod_polygon_testedge(const struct geod_geodesic* g, const struct geod_polygon* p, double azi, double s, int reverse, int sign, double* pA, double* pP); /** * A simple interface for computing the area of a geodesic polygon. * * @param[in] g a pointer to the geod_geodesic object specifying the * ellipsoid. * @param[in] lats an array of latitudes of the polygon vertices (degrees). * @param[in] lons an array of longitudes of the polygon vertices (degrees). * @param[in] n the number of vertices. * @param[out] pA pointer to the area of the polygon (meters2). * @param[out] pP pointer to the perimeter of the polygon (meters). * * \e lats should be in the range [−90°, 90°]. * * Arbitrarily complex polygons are allowed. In the case self-intersecting * of polygons the area is accumulated "algebraically", e.g., the areas of * the 2 loops in a figure-8 polygon will partially cancel. There's no need * to "close" the polygon by repeating the first vertex. The area returned * is signed with counter-clockwise traversal being treated as positive. * * Example, compute the area of Antarctica: @code{.c} double lats[] = {-72.9, -71.9, -74.9, -74.3, -77.5, -77.4, -71.7, -65.9, -65.7, -66.6, -66.9, -69.8, -70.0, -71.0, -77.3, -77.9, -74.7}, lons[] = {-74, -102, -102, -131, -163, 163, 172, 140, 113, 88, 59, 25, -4, -14, -33, -46, -61}; struct geod_geodesic g; double A, P; geod_init(&g, 6378137, 1/298.257223563); geod_polygonarea(&g, lats, lons, (sizeof lats) / (sizeof lats[0]), &A, &P); printf("%.0f %.2f\n", A, P); @endcode **********************************************************************/ void GEOD_DLL geod_polygonarea(const struct geod_geodesic* g, double lats[], double lons[], int n, double* pA, double* pP); /** * mask values for the \e caps argument to geod_lineinit(). **********************************************************************/ enum geod_mask { GEOD_NONE = 0U, /**< Calculate nothing */ GEOD_LATITUDE = 1U<<7 | 0U, /**< Calculate latitude */ GEOD_LONGITUDE = 1U<<8 | 1U<<3, /**< Calculate longitude */ GEOD_AZIMUTH = 1U<<9 | 0U, /**< Calculate azimuth */ GEOD_DISTANCE = 1U<<10 | 1U<<0, /**< Calculate distance */ GEOD_DISTANCE_IN = 1U<<11 | 1U<<0 | 1U<<1,/**< Allow distance as input */ GEOD_REDUCEDLENGTH= 1U<<12 | 1U<<0 | 1U<<2,/**< Calculate reduced length */ GEOD_GEODESICSCALE= 1U<<13 | 1U<<0 | 1U<<2,/**< Calculate geodesic scale */ GEOD_AREA = 1U<<14 | 1U<<4, /**< Calculate reduced length */ GEOD_ALL = 0x7F80U| 0x1FU /**< Calculate everything */ }; /** * flag values for the \e flags argument to geod_gendirect() and * geod_genposition() **********************************************************************/ enum geod_flags { GEOD_NOFLAGS = 0U, /**< No flags */ GEOD_ARCMODE = 1U<<0, /**< Position given in terms of arc distance */ GEOD_LONG_UNROLL = 1U<<15 /**< Unroll the longitude */ }; #if defined(__cplusplus) } #endif #endif terra/src/patches.cpp0000644000176200001440000001277614727150326014335 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" void patch_search_wrap(const std::vector &m, std::vector &patches, const int &i, const long &ncol, const int &patch, const size_t &dirs) { // DFS std::vector directions, dirfirst, dirlast; if (dirs==4) { directions = {-ncol, ncol, -1, 1}; dirfirst = {-ncol, ncol, ncol-1, 1}; dirlast = {-ncol, ncol, -1, 1-ncol}; } else { directions = {-ncol, ncol, -1, 1, -ncol-1, -ncol+1, ncol-1, ncol+1}; dirfirst = {-ncol, ncol, ncol-1, 1, -1, -ncol+1, ncol+ncol-1, ncol+1}; dirlast = {-ncol, ncol, -1, 1-ncol, -ncol-1, -ncol-ncol+1, ncol-1, 1}; } size_t ncell = m.size(); patches[i] = patch; if ((i % ncol) == 0) { //firstcol for (size_t d=0; d= 0 && j < ncell && (!std::isnan(m[j])) && std::isnan(patches[j]) && m[j] == m[i]) { patch_search_wrap(m, patches, j, ncol, patch, dirs); } } } else if (((i+1) % ncol) == 0) { // lastcol for (size_t d=0; d= 0 && j < ncell && (!std::isnan(m[j])) && std::isnan(patches[j]) && m[j] == m[i]) { patch_search_wrap(m, patches, j, ncol, patch, dirs); } } } else { for (size_t d=0; d= 0 && j < ncell && (!std::isnan(m[j])) && std::isnan(patches[j]) && m[j] == m[i]) { patch_search_wrap(m, patches, j, ncol, patch, dirs); } } } } void patch_search(const std::vector &m, std::vector &patches, const int &i, const long &ncol, const int &patch, const size_t &dirs) { // DFS std::vector directions, dirfirst, dirlast; if (dirs==4) { directions = {-ncol, ncol, -1, 1}; dirfirst = {-ncol, ncol, 1}; dirlast = {-ncol, ncol, -1}; } else { directions = {-ncol, ncol, -1, 1, -ncol-1, -ncol+1, ncol-1, ncol+1}; dirfirst = {-ncol, ncol, 1, -ncol+1, ncol+1}; dirlast = {-ncol, ncol, -1, -ncol-1, ncol-1}; } size_t ncell = m.size(); patches[i] = patch; if ((i % ncol) == 0) { //firstcol for (size_t d=0; d= 0 && j < ncell && (!std::isnan(m[j])) && std::isnan(patches[j]) && m[j] == m[i]) { patch_search(m, patches, j, ncol, patch, dirs); } } } else if (((i+1) % ncol) == 0) { // lastcol for (size_t d=0; d= 0 && j < ncell && (!std::isnan(m[j])) && std::isnan(patches[j]) && m[j] == m[i]) { patch_search(m, patches, j, ncol, patch, dirs); } } } else { for (size_t d=0; d= 0 && j < ncell && (!std::isnan(m[j])) && std::isnan(patches[j]) && m[j] == m[i]) { patch_search(m, patches, j, ncol, patch, dirs); } } } } SpatRaster SpatRaster::patches(size_t dirs, SpatOptions &opt) { SpatRaster out = geometry(1, false); if (!hasValues()) { out.setError("cannot compute surfaceArea for a raster with no values"); return out; } if (nlyr() != 1) { out.setError("can only compute surfaceArea for a single raster layer"); return out; } if (!((dirs == 4) || (dirs == 8))) { out.setError("directions should be 4 or 8"); return out; } if (!canProcessInMemory(opt)) { out.setError("cannot do this for large rasters"); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t patch = 1; size_t nc = ncol(); std::vector v; /* std::vector patches(out.bs.nrows[0] * nc, NAN); for (size_t i = 0; i < out.bs.n; i++) { if (i > 0) { readValues(v, out.bs.row[i]-1, out.bs.nrows[i]+1, 0, nc); std::vector old_p(patches.end()-nc, patches.end()); patches = std::vector(v.size(), NAN); for (size_t j=0; j patches(nrow() * nc, NAN); readValues(v, 0, nrow(), 0, nc); if (is_global_lonlat()) { for (size_t j=0; j. #ifndef VECMATH_GUARD #define VECMATH_GUARD #include #include #include #include #include #include "NA.h" #include #include #include #include bool haveFun(std::string fun); std::function&, bool)> getFun(std::string fun); bool bany(const std::vector& v); bool ball(const std::vector& v); template std::vector flatten(const std::vector>& v) { std::size_t total_size = 0; for (const auto& sub : v) total_size += sub.size(); std::vector result; result.reserve(total_size); for (const auto& sub : v) result.insert(result.end(), sub.begin(), sub.end()); return result; } static inline double interpolate(double x, double y1, double y2, unsigned x1, unsigned x2) { double denom = (x2-x1); return y1 + (x-x1) * (y2-y1)/denom; } static inline std::vector vquantile(std::vector v, const std::vector& probs, bool narm) { size_t n = v.size(); if (n==0) { return std::vector(probs.size(), NAN); } if (n == 1) { return std::vector(probs.size(), v[0]); } //na_omit(v); v.erase(std::remove_if(std::begin(v), std::end(v), [](const double& value) { return std::isnan(value); }), std::end(v)); if (((!narm) && (v.size() < n)) || v.empty()) { return std::vector(probs.size(), NAN); } n = v.size(); std::sort(v.begin(), v.end()); size_t pn = probs.size(); std::vector q(pn); for (size_t i = 0; i < pn; ++i) { double x = probs[i] * (n-1); unsigned x1 = std::floor(x); unsigned x2 = std::ceil(x); if (x1 == x2) { q[i] = v[x1]; } else { q[i] = interpolate(x, v[x1], v[x2], x1, x2); } } return q; } template std::vector vunique(std::vector d) { std::sort(d.begin(), d.end()); d.erase(std::unique(d.begin(), d.end()), d.end()); return d; } template std::vector vtostring(std::vector& v) { std::vector s; std::transform(std::begin(v), std::end(v), std::back_inserter(s), [](double d) { return std::to_string(d); } ); return s; } template T vmedian(std::vector& v, bool narm) { size_t n = v.size(); std::vector vv; vv.reserve(n); for (size_t i=0; i::value; } } n = vv.size(); if (n == 0) { return(NA::value); } if (n == 1) { return(vv[0]); } size_t n2 = n / 2; if (n % 2) { std::nth_element(vv.begin(), vv.begin()+n2, vv.end()); return vv[n2]; } else { std::sort(vv.begin(), vv.end()); return (vv[n2] + vv[n2-1]) / 2; } } template T vsum(const std::vector& v, bool narm) { T x = v[0]; if (narm) { for (size_t i=1; i::value; return(x); } else { x += v[i]; } } } return x; } template T vsum2(const std::vector& v, bool narm) { T x = v[0] * v[0]; if (narm) { for (size_t i=1; i::value; return(x); } else { x += v[i] * v[i]; } } } return x; } template T vprod(const std::vector& v, bool narm) { T x = v[0]; if (narm) { for (size_t i=1; i::value; return(x); } else { x *= v[i]; } } } } return x; } template double vmean(const std::vector& v, bool narm) { double x = 0; unsigned d = 0; if (narm) { for (size_t i=0; i 0) { x /= (double) d; } else { x = NAN; } return x; } template double vsd(const std::vector& v, bool narm) { double m = vmean(v, narm); if (std::isnan(m)) return m; double x = 0; size_t n = 0; for (size_t i=0; i double vsdpop(const std::vector& v, bool narm) { double m = vmean(v, narm); if (std::isnan(m)) return m; //double x = v[0]; double x = 0; size_t n = 0; for (size_t i=0; i T vmin(const std::vector& v, bool narm) { T x = v[0]; if (narm) { for (size_t i=1; i::value; } else { x = std::min(x, v[i]); } } } return x; } template T vfirst(const std::vector& v, bool narm) { if (narm) { for (size_t i=0; i T vmax(const std::vector& v, bool narm) { T x = v[0]; if (narm) { for (size_t i=1; i::value; } else { x = std::max(x, v[i]); } } } return x; } template double vwhich(const std::vector& v, bool narm) { double out; for (size_t i=0; i T vwhichmin(const std::vector& v, bool narm) { T x = v[0]; T out; if (is_NA(x)) { out = NA::value; } else { out = 0; } if (narm) { for (size_t i=1; i::value; } else { if (v[i] < x) { x = v[i]; out = i; } } } } if (is_NA(out)) { return out; } else { return (out + 1); // +1 for R } } template T vwhichmax(const std::vector& v, bool narm) { T x = v[0]; T out; if (is_NA(x)) { out = NA::value; } else { out = 0; } if (narm) { for (size_t i=1; i x) { x = v[i]; out = i; } } } } else { if (is_NA(x)) { return out; } for (size_t i=0; i::value; } else { if (v[i] > x) { x = v[i]; out = i; } } } } if (is_NA(out)) { return out; } else { return (out + 1); // +1 for R } } // problematic; should be ok for int and float but // won't work with bool values (nodata == 0) template T vall(const std::vector& v, bool narm) { T x; if (narm) { x = NA::value; for (size_t i=0; i::value : x; } else { x = 1; for (size_t i=0; i T vany(const std::vector& v, bool narm) { T x = NA::value; x = 0; if (narm) { for (size_t i=0; i::value; break; } else if (v[i] != 0) { x = 1; } } } return x; } template std::vector vrange(const std::vector& v, bool narm) { std::vector x = { v[0], v[0] }; if (narm) { for (size_t i=1; i::value; x[1] = NA::value; return(x); } else { x[0] = std::min(x[0], v[i]); x[1] = std::max(x[1], v[i]); } } } return x; } template T vmodal_old(std::vector& v, bool narm) { size_t n = v.size(); std::vector counts(n, 0); std::sort(v.begin(), v.end()); for (size_t i = 0; i < n; ++i) { counts[i] = 0; size_t j = 0; while ((j < i) && (v[i] != v[j])) { ++j; } ++(counts[j]); } size_t maxCount = 0; for (size_t i = 1; i < n; ++i) { if (counts[i] > counts[maxCount]) { maxCount = i; } } return v[maxCount]; } template T vmodal(std::vector& v, bool narm) { if (narm) { std::map count; for_each( v.begin(), v.end(), [&count]( double val ){ if(!std::isnan(val)) count[val]++; } ); if (count.size() == 0) return NAN; std::map::iterator mode = std::max_element(count.begin(), count.end(),[] (const std::pair& a, const std::pair& b)->bool{ return a.second < b.second; } ); return mode->first; } else { std::map count; for(size_t i=0; i::iterator mode = std::max_element(count.begin(), count.end(),[] (const std::pair& a, const std::pair& b)->bool{ return a.second < b.second; } ); return mode->first; } } template std::vector visna(const std::vector& v) { std::vector x(v.size(), false); for (size_t i=0; i std::vector visnotna(const std::vector& v) { std::vector x(v.size(), true); for (size_t i=0; i bool vany_notna(const std::vector& v) { for (size_t i=0; i bool vany_na(const std::vector& v) { for (size_t i=0; i void cumsum(std::vector& v, bool narm) { if (narm) { for (size_t i=1; i::value; } else { v[i] += v[i-1]; } } } } template void cumprod(std::vector& v, bool narm) { if (narm) { for (size_t i=1; i::value; } else { v[i] *= v[i-1]; } } } } template void cummax(std::vector& v, bool narm) { if (narm) { for (size_t i=1; i::value; } else { v[i] = std::max(v[i], v[i-1]); } } } } template void cummin(std::vector& v, bool narm) { if (narm) { for (size_t i=1; i::value; } else { v[i] = std::min(v[i], v[i-1]); } } } } /* #include template std::vector order(const std::vector &v) { std::vector idx(v.size()); std::iota(idx.begin(), idx.end(), 0); stable_sort(idx.begin(), idx.end(), [&v](size_t i, size_t j) {return v[i] < v[j];}); return idx; } */ template double expH(std::vector d, bool narm) { std::unordered_map counts; double s = 0; if (narm) { for (int v : d) { if (!is_NA(v)) { counts[v]++; s++; } } } else { for (int v : d) { if (is_NA(v)) { return NAN; } else { counts[v]++; s++; } } } if (s == 0) { return NAN; } double sump = 0; for (auto const& pair : counts) { double p = pair.second / s; sump += p * log(p); } return exp(-sump); } #endif terra/src/nearest.cpp0000644000176200001440000002307314734603055014337 0ustar liggesusers #include "spatRaster.h" #include "distance.h" #include "geodesic.h" #include "geosphere.h" //#include //#include //#include "recycle.h" //#include "math_utils.h" //#include "vecmath.h" //#include "file_utils.h" //#include "string_utils.h" //#include "crs.h" #include "sort.h" std::vector dn_bounds(const std::vector& vx, const std::vector& vy, const std::vector& rx, const double& ry, size_t& first, size_t& last, const bool& lonlat, const std::string &method) { std::vector d(rx.size(), std::numeric_limits::max()); size_t oldfirst = first; first = vx.size(); last = 0; if (lonlat) { std::function dfun; if (method == "haversine") { dfun = distance_hav; } else if (method == "cosine") { dfun = distance_cos; } else { dfun = distance_geo; } for (size_t i=0; i &d, const std::vector& vx, const std::vector& vy, const std::vector& rx, const std::vector& ry, const size_t& first, const size_t& last, const bool& lonlat, const std::vector& dlast, bool skip, const std::string& method, bool setNA) { std::vector clast; std::vector cell; const std::vector v; size_t rxs = rx.size(); d.reserve(rxs + dlast.size()); cell.reserve(rxs + dlast.size()); double inf = std::numeric_limits::infinity(); if (lonlat) { if (method == "geo") { double dd, azi1, azi2; struct geod_geodesic g; // get a and f from crs? double a = 6378137.0; double f = 1/298.257223563; geod_init(&g, a, f); if (skip) { for (size_t i=0; i dfun; if (method == "haversine") { dfun = distance_hav; } else if (method == "cosine") { dfun = distance_cos; } if (skip) { for (size_t i=0; i::max(); for (size_t i=0; i< v.size(); i++) { if (v[i] == mxval) { d[i] = NAN; cell[i] = NAN; } } } } } SpatRaster SpatRaster::dn_crds(std::vector& x, std::vector& y, const std::string& method, bool skip, bool setNA, std::string unit, SpatOptions &opt) { SpatRaster out = geometry(); if (x.empty()) { out.setError("no locations to compute distance from"); return(out); } const double toRad = 0.0174532925199433; std::vector pm = sort_order_d(y); permute(x, pm); permute(y, pm); bool lonlat = is_lonlat(); double m=1; if (!source[0].srs.m_dist(m, lonlat, unit)) { out.setError("invalid unit"); return(out); } unsigned nc = ncol(); opt.steps = std::max(opt.steps, (size_t) 4); opt.progress = opt.progress * 1.5; if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector cells; std::vector dlast; std::vector cols; cols.resize(ncol()); std::iota(cols.begin(), cols.end(), 0); std::vector tox = xFromCol(cols); if (lonlat && (method != "geo")) { for (double &d : x) d *= toRad; for (double &d : y) d *= toRad; for (double &d : tox) d *= toRad; } double oldfirst = 0; size_t first = 0; size_t last = x.size(); std::vector v; if (skip) { if (!readStart()) { out.setError(getError()); return(out); } for (size_t i = 0; i < out.bs.n; i++) { cells.resize((out.bs.nrows[i] -1) * nc) ; std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); std::vector> rxy = xyFromCell(cells); double toy = yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1); if (lonlat && (method != "geo")) { toy *= toRad; for (double &d : rxy[0]) d *= toRad; for (double &d : rxy[1]) d *= toRad; } readBlock(v, out.bs, i); dlast = dn_bounds(x, y, tox, toy, first, last, lonlat, method); std::vector d; dn_only(d, x, y, rxy[0], rxy[1], oldfirst, last, lonlat, dlast, true, method, setNA); oldfirst = first; if (m != 1) { for (double &v : d) v *= m; } if (!out.writeBlock(d, i)) return out; } readStop(); } else { for (size_t i = 0; i < out.bs.n; i++) { double toy = yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1); cells.resize((out.bs.nrows[i] -1) * nc) ; std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); std::vector> rxy = xyFromCell(cells); if (lonlat && (method != "geo")) { toy *= toRad; for (double &d : rxy[0]) d *= toRad; for (double &d : rxy[1]) d *= toRad; } dlast = dn_bounds(x, y, tox, toy, first, last, lonlat, method); std::vector d; dn_only(d, x, y, rxy[0], rxy[1], oldfirst, last, lonlat, dlast, false, method, setNA); oldfirst = first; if (m != 1) { for (double &v : d) v *= m; } if (!out.writeBlock(d, i)) return out; } } out.writeStop(); return(out); } SpatRaster SpatRaster::nearest(double target, double exclude, bool keepNA, std::string unit, bool remove_zero, std::string method, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { out.setError("SpatRaster has no values"); return out; } SpatOptions ops(opt); size_t nl = nlyr(); if (nl > 1) { std::vector nms = getNames(); if (ops.names.size() == nms.size()) { nms = opt.names; } out.source.resize(nl); for (size_t i=0; i lyr = {i}; SpatRaster r = subset(lyr, ops); ops.names = {nms[i]}; r = r.nearest(target, exclude, keepNA, unit, remove_zero, method, ops); out.source[i] = r.source[0]; } if (!opt.get_filename().empty()) { out = out.writeRaster(opt); } return out; } bool setNA = false; std::vector> p; if (!std::isnan(exclude)) { SpatRaster x; if (std::isnan(target)) { x = replaceValues({exclude}, {target}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 1, ops); p = x.as_points_value(1, ops); if (p.empty()) { return out.init({0}, opt); } return dn_crds(p[0], p[1], method, true, setNA, unit, opt); } else { x = replaceValues({exclude, target}, {NAN, NAN}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 1, ops); p = x.as_points_value(1, ops); out = replaceValues({NAN, exclude, target}, {target, NAN, NAN}, 1, false, NAN, false, ops); } } else if (!std::isnan(target)) { SpatRaster x = replaceValues({target}, {NAN}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 0, ops); p = x.as_points_value(1, ops); out = replaceValues({NAN, target}, {std::numeric_limits::max(), NAN}, 1, false, NAN, false, ops); setNA = true; } else { out = edges(false, "inner", 8, 0, ops); p = out.as_points_value(1, ops); } if (p.empty()) { return out.init({0}, opt); } return out.dn_crds(p[0], p[1], method, true, setNA, unit, opt); } terra/src/arith.cpp0000644000176200001440000012741714745035713014016 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include "spatRasterMultiple.h" #include "recycle.h" #include "math_utils.h" #include "vecmath.h" #include //#include "modal.h" /* // need to take care of NAs here. OK for NAN, but not for int types //template //void operator+(std::vector& a, const std::vector& b) { void operator+(std::vector& a, const std::vector& b) { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::plus()); } //template void operator-(std::vector& a, const std::vector& b) { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::minus()); } //template void operator/(std::vector& a, const std::vector& b) { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::divides()); } //template void operator*(std::vector& a, const std::vector& b) { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::multiplies()); } */ //template void operator%(std::vector& a, const std::vector& b) { // std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::modulus()); for (size_t i=0; i void operator>=(std::vector& a, const std::vector& b) { // std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::greater_equal()); for (size_t i=0; i= b[i]; } } } //template void operator<=(std::vector& a, const std::vector& b) { // std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::less_equal()); for (size_t i=0; i void operator>(std::vector& a, const std::vector& b) { // std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::greater()); for (size_t i=0; i b[i]; } } } //template void operator<(std::vector& a, const std::vector& b) { // std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::less()); for (size_t i=0; i f {"==", "!=", ">", "<", ">=", "<="}; logical = std::find(f.begin(), f.end(), oper) != f.end(); f = {"+", "-", "*", "^", "/", "%", "%%", "%/%"}; bool ok = logical || (std::find(f.begin(), f.end(), oper) != f.end()); if (ok) { if (oper == "%%") oper = "%"; if (logical) { if (reverse) { if (oper == ">") { oper = "<="; } else if (oper == "<") { oper = ">="; } else if (oper == ">=") { oper = "<"; } else if (oper == "<=") { oper = ">"; } reverse = false; } } else { falseNA = false; } } return ok; } //#include SpatRaster SpatRaster::arith(SpatRaster x, std::string oper, bool falseNA, SpatOptions &opt) { size_t nl = std::max(nlyr(), x.nlyr()); SpatRaster out = geometry(nl); if (!(hasValues() && x.hasValues())) { out.setError("raster has no values"); // or warn and treat as NA? return out; } bool logical = false; bool reverse = false; if (!smooth_operator(oper, logical, reverse, falseNA)) { out.setError("unknown arith function"); return out; } if (logical) { out.setValueType(3); } else if (oper != "/") { std::vector v = getValueType(false); std::vector vx = x.getValueType(false); bool is_int = true; for (size_t i = 0; i a, b; readBlock(a, out.bs, i); x.readBlock(b, out.bs, i); recycle(a,b); if (oper == "+") { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::plus()); } else if (oper == "-") { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::minus()); } else if (oper == "*") { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::multiplies()); } else if (oper == "/") { std::transform(a.begin(), a.end(), b.begin(), a.begin(), std::divides()); } else if (oper == "^") { for (size_t i=0; i=") { a >= b; } else if (oper == "<=") { a <= b; } else if (oper == ">") { a > b; } else if (oper == "<") { a < b; } if (falseNA) { for (double& d : a) if (!d) d = NAN; } if (!out.writeBlock(a, i)) return out; } out.writeStop(); readStop(); x.readStop(); return(out); } SpatRaster SpatRaster::arith(double x, std::string oper, bool reverse, bool falseNA, SpatOptions &opt) { SpatRaster out = geometry(nlyr()); if (!hasValues()) { out.setError("raster has no values"); // or warn and treat as NA? return out; } bool logical; if (!smooth_operator(oper, logical, reverse, falseNA)) { out.setError("unknown arith function"); return out; } if (logical) { out.setValueType(3); } else if (oper != "/") { std::vector v = getValueType(false); bool is_int = true; for (size_t i = 0; i a; readBlock(a, out.bs, i); if (std::isnan(x)) { std::fill(a.begin(), a.end(), NAN); //for (double& d : a) d = NAN; } else if (oper == "+") { // std::for_each(std::execution::par, a.begin(), a.end(), [&](double& d) { d += x; }); for (double& d : a) d += x; } else if (oper == "-") { if (reverse) { for (double& d : a) d = x - d; } else { for (double& d : a) d -= x; } } else if (oper == "*") { for(double& d : a) d *= x; } else if (oper == "/") { if (reverse) { for (double& d : a) d = x / d; } else { for (double& d : a) d /= x; } } else if (oper == "^") { if (reverse) { for (double& d : a) d = std::pow(x, d); } else { for (double& d : a) d = std::pow(d, x); } } else if (oper == "%") { if (reverse) { for (size_t i=0; i=") { for (double& d : a) if (!std::isnan(d)) d = d >= x; } else if (oper == "<=") { for (double& d : a) if (!std::isnan(d)) d = d <= x; } else if (oper == ">") { for (double& d : a) if (!std::isnan(d)) d = d > x; } else if (oper == "<") { for (double& d : a) if (!std::isnan(d)) d = d < x; } else { out.setError("unknown arith function"); return out; } if (falseNA) { for (double& d : a) if (!d) d = NAN; } if (!out.writeBlock(a, i)) return out; } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::is_true(bool falseNA, SpatOptions &opt) { return arith(1, "==", false, false, opt); } SpatRaster SpatRaster::is_false(bool falseNA, SpatOptions &opt) { return arith(1, "!=", false, falseNA, opt); } SpatRaster SpatRaster::arith(std::vector x, std::string oper, bool reverse, bool falseNA, SpatOptions &opt) { if (x.empty()) { SpatRaster out; out.setError("cannot compute with nothing"); return out; } if (!hasValues()) { SpatRaster out; out.setError("raster has no values"); // or warn and treat as NA? return out; } if (x.size() == 1) { return(arith(x[0], oper, reverse, falseNA, opt)); } size_t innl = nlyr(); size_t outnl = innl; if (x.size() > innl) { outnl = x.size(); } SpatRaster out = geometry(outnl); bool logical=false; if (!smooth_operator(oper, logical, reverse, falseNA)) { out.setError("unknown arith function"); return out; } if (logical) { out.setValueType(3); } else if (oper != "/") { std::vector v = getValueType(false); bool is_int = true; for (size_t i = 0; i v; readBlock(v, out.bs, i); if (outnl > innl) { recycle(v, outnl * out.bs.nrows[i] * nc); } //std::vector vv; size_t off = out.bs.nrows[i] * nc; for (size_t j=0; j=") { for (size_t k=0; k= x[j]; } } else if (oper == "<=") { for (size_t k=0; k") { for (size_t k=0; k x[j]; } } else if (oper == "<") { for (size_t k=0; k x, std::string oper, std::vector dim, bool reverse, SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) { out.setError("raster has no values"); // or warn and treat as NA? return out; } size_t nx = x.size(); if (nx == 0) { out.setError("cannot compute with nothing"); return out; } if (dim.size() != 2) { out.setError("incorrect dimensions"); return out; } if ((dim[1] * dim[0]) != nx) { out.setError("incorrect matrix dimensions (dim(m) != length(x))"); return out; } if (nx == 1) { return(arith(x[0], oper, reverse, false, opt)); } // single cell if (dim[0] < 2) { return(arith(x, oper, reverse, false, opt)); } if (dim[0] > ncell()) { out.setError("incorrect matrix dimensions (nrow > ncell(x))"); return out; } size_t nl = nlyr(); if (dim[1] > nl) { out.setError("incorrect matrix dimensions (ncol != nlyr(x))"); return out; } else if (dim[1] < nl) { recycle(x, nl * dim[0]); dim[1] = nl; } bool logical; bool falseNA=false; if (!smooth_operator(oper, logical, reverse, falseNA)) { out.setError("unknown arith function"); return out; } if (logical) { out.setValueType(3); } if (logical) { out.setValueType(3); } else if (oper != "/") { std::vector v = getValueType(false); bool is_int = true; for (size_t i = 0; i v; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; for (size_t j=0; j xj = {x.begin()+d, x.begin()+d+dim[0]}; size_t start = (out.bs.row[i] * nc) % xj.size(); if (start != 0) { std::rotate(xj.begin(), xj.begin()+start, xj.end()); } recycle(xj, off); if (oper == "+") { for (size_t k=0; k=") { for (size_t k=0; k= xj[k]; } } else if (oper == "<=") { for (size_t k=0; k") { for (size_t k=0; k xj[k]; } } else if (oper == "<") { for (size_t k=0; k int sign(T value) { return (T(0) < value) - (value < T(0)); } double dabs(double x) { return (x < 0 ? -1 * x : x); } SpatRaster SpatRaster::math(std::string fun, SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) return out; std::vector f = {"ceiling", "floor", "trunc", "sign", "log", "log10", "log2", "log1p", "exp", "expm1", "abs", "sqrt"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("unknown math function"); return out; } f = {"ceiling", "floor", "trunc", "sign"}; if (std::find(f.begin(), f.end(), fun) != f.end()) { out.setValueType(1); } std::function mathFun; if (fun == "sqrt") { mathFun = static_cast(sqrt); } else if (fun == "abs") { mathFun = dabs; } else if (fun == "log") { mathFun = static_cast(log); } else if (fun == "log2") { mathFun = static_cast(log2); } else if (fun == "log10") { mathFun = static_cast(log10); } else if (fun == "log1p") { mathFun = static_cast(log1p); } else if (fun == "exp") { mathFun = static_cast(exp); } else if (fun == "expm1") { mathFun = static_cast(expm1); } else if (fun == "sign") { mathFun = sign; } else if (fun == "ceiling") { mathFun = static_cast(ceil); } else if (fun == "floor") { mathFun = static_cast(floor); } else if (fun == "trunc") { mathFun = static_cast(trunc); } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); for(double& d : a) if (!std::isnan(d)) d = mathFun(d); if (!out.writeBlock(a, i)) return out; } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::math2(std::string fun, unsigned digits, SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) return out; std::vector f {"round", "signif"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("unknown math2 function"); return out; } if (digits == 0) out.setValueType(1); if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); if (fun == "round") { for(double& d : a) d = roundn(d, digits); } else if (fun == "signif") { for(double& d : a) if (!std::isnan(d)) d = signif(d, digits); } if (!out.writeBlock(a, i)) return out; } out.writeStop(); readStop(); return(out); } double sin_pi(double &x) { return sin(x * M_PI); } double cos_pi(double &x) { return sin(x * M_PI); } double tan_pi(double &x) { return sin(x * M_PI); } SpatRaster SpatRaster::trig(std::string fun, SpatOptions &opt) { SpatRaster out = geometry(); if (!hasValues()) return out; std::vector f {"acos", "asin", "atan", "cos", "sin", "tan", "acosh", "asinh", "atanh", "cosh", "cospi", "sinh", "sinpi", "tanh", "tanpi"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("unknown trig function"); return out; } std::function trigFun; if (fun == "sin") { trigFun = static_cast(sin); } else if (fun == "cos") { trigFun = static_cast(cos); } else if (fun == "tan") { trigFun = static_cast(tan); } else if (fun == "asin") { trigFun = static_cast(asin); } else if (fun == "acos") { trigFun = static_cast(acos); } else if (fun == "atan") { trigFun = static_cast(atan); } else if (fun == "sinh") { trigFun = static_cast(sinh); } else if (fun == "cosh") { trigFun = static_cast(cosh); } else if (fun == "tanh") { trigFun = static_cast(tanh); } else if (fun == "asinh") { trigFun = static_cast(asinh); } else if (fun == "acosh") { trigFun = static_cast(acosh); } else if (fun == "atanh") { trigFun = static_cast(atanh); } else if (fun == "sinpi") { trigFun = sin_pi; } else if (fun == "cospi") { trigFun = cos_pi; } else if (fun == "tanpi") { trigFun = tan_pi; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readValues(a, out.bs.row[i], out.bs.nrows[i], 0, ncol()); for (double& d : a) if (!std::isnan(d)) d = trigFun(d); if (!out.writeBlock(a, i)) return out; } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::atan_2(SpatRaster x, SpatOptions &opt) { size_t nl = std::max(nlyr(), x.nlyr()); SpatRaster out = geometry(nl); if ((!hasValues()) || (!x.hasValues())) { return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!x.readStart()) { out.setError(x.getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); x.readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector a, b; readValues(a, out.bs.row[i], out.bs.nrows[i], 0, ncol()); x.readValues(b, out.bs.row[i], out.bs.nrows[i], 0, ncol()); recycle(a, b); std::vector d(a.size()); for (size_t j=0; j std::vector operator|(const std::vector& a, const std::vector& b) { std::vector result; result.reserve(a.size()); std::transform(a.begin(), a.end(), b.begin(), std::back_inserter(result), std::logical_or()); for (size_t i=0; i std::vector operator&(const std::vector& a, const std::vector& b) { std::vector result; result.reserve(a.size()); std::transform(a.begin(), a.end(), b.begin(), std::back_inserter(result), std::logical_and()); for (size_t i=0; i& a, const std::vector& b) { for (size_t i=0; i& a, const std::vector& b) { for (size_t i=0; i a; readBlock(a, out.bs, i); for (size_t j=0; j a; readBlock(a, out.bs, i); for (size_t j=0; j f {"&", "|"}; if (std::find(f.begin(), f.end(), oper) == f.end()) { out.setError("unknown logic function"); return out; } if (!out.compare_geom(x, false, true, opt.get_tolerance(), true)) { return(out); } if (!readStart()) { out.setError(getError()); return(out); } if (!x.readStart()) { out.setError(x.getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); std::vector b; x.readBlock(b, out.bs, i); recycle(a, b); if (oper == "&") { logical_and(a, b); // replaces a } else if (oper == "|") { logical_or(a, b); // replaces a } if (!out.writeBlock(a, i)) return out; } out.writeStop(); readStop(); x.readStop(); return(out); } SpatRaster SpatRaster::logic(double x, std::string oper, SpatOptions &opt) { SpatRaster out = geometry(); out.setValueType(3); std::vector f {"&", "|", "istrue", "isfalse"}; if (std::find(f.begin(), f.end(), oper) == f.end()) { out.setError("unknown logic function"); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector v, m; for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); // x = NAN if (std::isnan(x)) { if (oper == "&") { for (size_t j=0; j x, std::string oper, SpatOptions &opt) { if (x.size() == 1) { return logic(x[0], oper, opt); } SpatRaster out = geometry(); out.setValueType(3); if (x.size() == 0) { out.setError("logical operator has length 0"); return out; } std::vector f {"&", "|", "istrue", "isfalse"}; if (std::find(f.begin(), f.end(), oper) == f.end()) { out.setError("unknown logic function"); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector v, m; for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); recycle(x, a.size()); if (oper == "&") { logical_and(a, x); } else if (oper == "|") { logical_or(a, x); } else if (oper == "istrue") { for(double& d : a) d = std::isnan(d) ? NAN : (d==1 ? 1 : 0); } else { //if (oper == "isfalse") { for(double& d : a) d = std::isnan(d) ? NAN : (d!=1 ? 1 : 0); } if (!out.writeBlock(a, i)) return out; } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::cum(std::string fun, bool narm, SpatOptions &opt) { SpatRaster out = geometry(); std::vector f {"sum", "prod", "min", "max"}; if (std::find(f.begin(), f.end(), fun) == f.end()) { out.setError("unknown cum function"); return out; } if (!hasValues()) { // out.setError("raster has no values"); return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nl = out.nlyr(); std::vector v(nl); size_t nc; for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); nc = out.bs.nrows[i] * out.ncol(); for (size_t j=0; j v, bool narm) { double m = vmean(v, narm); for (double& d : v) d = pow(d - m, 2); m = vmean(v, narm); return sqrt(m); } SpatRaster SpatRaster::summary_numb(std::string fun, std::vector add, bool narm, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { return out; } if (fun == "range") { return range(add, narm, opt); } out.source[0].names[0] = fun; std::function&, bool)> sumFun; if (fun == "std") { sumFun = vstdev; } else { if (!haveFun(fun)) { out.setError("unknown function argument"); return out; } sumFun = getFun(fun); } if (!readStart()) { out.setError(getError()); return(out); } opt.ncopies = std::max(opt.ncopies, nlyr() * 2); if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nl = nlyr(); std::vector v(nl); if (!add.empty()) v.insert( v.end(), add.begin(), add.end() ); for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); size_t nc = out.bs.nrows[i] * out.ncol(); std::vector b(nc); for (size_t j=0; j add; return summary_numb(fun, add, narm, opt); } SpatRaster SpatRaster::modal(std::vector add, std::string ties, bool narm, SpatOptions &opt) { SpatRaster out = geometry(1); out.source[0].names[0] = "modal" ; if (!hasValues()) { return out; } std::vector f {"lowest", "highest", "first", "random", "NA"}; //std::vector::iterator it; auto it = std::find(f.begin(), f.end(), ties); if (it == f.end()) { out.setError("unknown ties choice"); return out; } size_t ities = std::distance(f.begin(), it); if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } uint32_t seed = 1; std::default_random_engine rgen(seed); std::uniform_real_distribution dist (0.0,1.0); size_t nl = nlyr(); std::vector v(nl); v.insert( v.end(), add.begin(), add.end() ); for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); size_t nc = out.bs.nrows[i] * out.ncol(); std::vector b(nc); for (size_t j=0; j add, bool narm, SpatOptions &opt) { SpatRaster out = geometry(2); out.source[0].names.resize(2); out.source[0].names[0] = "range_min" ; out.source[0].names[1] = "range_max" ; if (!hasValues()) { return out; } if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nl = nlyr(); std::vector v(nl); v.insert( v.end(), add.begin(), add.end() ); for (size_t i = 0; i < out.bs.n; i++) { std::vector a; readBlock(a, out.bs, i); size_t nc = out.bs.nrows[i] * out.ncol(); std::vector b(nc * 2); for (size_t j=0; j rng = vrange(v, narm); b[j] = rng[0]; b[j+nc] = rng[1]; } if (!out.writeBlock(b, i)) return out; } out.writeStop(); readStop(); return(out); } SpatRaster SpatRasterStack::summary_numb(std::string fun, std::vector add, bool narm, SpatOptions &opt) { std::vector vnl = nlyr(); size_t nl = vmax(vnl, false); SpatRaster out = ds[0].geometry(nl); size_t ns = nsds(); if (fun == "range") { out.setError("parallel range not implemented, use min and max"); return out; } if (!ds[0].hasValues()) { return out; } std::function&, bool)> sumFun; if (fun == "std") { sumFun = vstdev; } else { if (!haveFun(fun)) { out.setError("unknown function argument"); return out; } sumFun = getFun(fun); } for (size_t i=0; i < ns; i++) { if (!ds[i].readStart()) { out.setError(ds[i].getError()); return(out); } } if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector v(ns); if (!add.empty()) v.insert( v.end(), add.begin(), add.end() ); std::vector> a(ns); for (size_t i=0; i < out.bs.n; i++) { size_t nc = out.bs.nrows[i] * out.ncol() * nl; for (size_t j=0; j < ns; j++) { ds[j].readBlock(a[j], out.bs, i); recycle(a[j], nc); } std::vector b(nc); for (size_t j=0; j add; return summary_numb(fun, add, narm, opt); } SpatRaster SpatRaster::isnan(bool falseNA, SpatOptions &opt) { SpatRaster out = geometry(); out.setValueType(3); if (!hasValues()) return out; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (falseNA) { for (size_t i=0; i v; readBlock(v, out.bs, i); for (double &d : v) d = std::isnan(d) ? 1 : NAN; if (!out.writeBlock(v, i)) return out; } } else { for (size_t i=0; i v; readBlock(v, out.bs, i); for (double &d : v) d = std::isnan(d); if (!out.writeBlock(v, i)) return out; } } readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::anynan(bool falseNA, SpatOptions &opt) { SpatRaster out = geometry(1); out.setValueType(3); if (!hasValues()) return out; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } double inval = falseNA ? NAN : 0; size_t nl = nlyr(); size_t nc = ncol(); for (size_t i=0; i v, w; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; w.resize(off, inval); for (size_t j=0; j v, w; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; w.resize(off, 1); for (size_t j=0; j v, w; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; w.resize(off, 1); for (size_t j=0; j v; readBlock(v, out.bs, i); for (double &d : v) d = std::isnan(d) ? NAN : 1; if (!out.writeBlock(v, i)) return out; } } else { for (size_t i=0; i v; readBlock(v, out.bs, i); for (double &d : v) d = !std::isnan(d); if (!out.writeBlock(v, i)) return out; } } readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::countnan(long n, SpatOptions &opt) { SpatRaster out = geometry(1); if (n > 0) { out.setValueType(3); } if (!hasValues()) return out; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } size_t nl = nlyr(); size_t nc = ncol(); if (n > ((long) nlyr())) { out.addWarning("n > nlyr(x)"); std::vector w; for (size_t i=0; i 0) { for (size_t i=0; i v, w; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; w.resize(off, 0); for (size_t j=0; j v, w; readBlock(v, out.bs, i); size_t off = out.bs.nrows[i] * nc; w.resize(off, 0); for (size_t j=0; j v; readBlock(v, out.bs, i); for (double &d : v) d = std::isfinite(d) ? 1 : NAN; if (!out.writeBlock(v, i)) return out; } } else { for (size_t i=0; i v; readBlock(v, out.bs, i); for (double &d : v) d = std::isfinite(d); if (!out.writeBlock(v, i)) return out; } } readStop(); out.writeStop(); return(out); } SpatRaster SpatRaster::isinfinite(bool falseNA, SpatOptions &opt) { SpatRaster out = geometry(); out.setValueType(3); if (!hasValues()) return out; if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } if (falseNA) { for (size_t i=0; i v; readBlock(v, out.bs, i); for (double &d : v) d = std::isinf(d) ? 1 : NAN; if (!out.writeBlock(v, i)) return out; } } else { for (size_t i=0; i v; readBlock(v, out.bs, i); for (double &d : v) d = std::isinf(d); if (!out.writeBlock(v, i)) return out; } } readStop(); out.writeStop(); return(out); } std::vector> SpatRaster::where(std::string what, bool values, SpatOptions &opt) { size_t nl = nlyr(); std::vector> out(nl); std::vector f {"min", "max"}; if (std::find(f.begin(), f.end(), what) == f.end()) { setError("unknown where function"); return out; } if (!hasValues()) { setError("SpatRaster has no values"); return out; } if (!readStart()) { return(out); } BlockSize bs = getBlockSize(opt); std::vector val; bool do_min = what == "min"; if (do_min) { val.resize(nl, std::numeric_limits::max()); } else { val.resize(nl, std::numeric_limits::lowest()); } for (size_t i=0; i v; readBlock(v, bs, i); size_t lyrsize = bs.nrows[i] * ncol(); size_t boff = i * lyrsize; for (size_t j=0; j val[j]) { val[j] = v[k]; out[j].resize(0); double cell = k - off + boff; out[j].push_back(cell); } else if (v[k] == val[j]) { double cell = k - off + boff; out[j].push_back(cell); } } } } if (values) { std::vector wval(out[j].size(), val[j]); out[j].insert(out[j].end(), wval.begin(), wval.end()); } } } readStop(); return(out); } terra/src/string_utils.h0000644000176200001440000000472114536376240015073 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifndef STRINGUTILS_GUARD #define STRINGUTILS_GUARD #include #include void unquote(std::string &s); std::string double_to_string(double x); std::vector double_to_string(const std::vector &x, std::string prep); std::vector string_to_charpnt(std::vector s); std::string concatenate(std::vector v, std::string delim); void lowercase(std::string &s); void lowercase(std::vector &ss); std::string lower_case(std::string s); std::string is_in_set_default(std::string s, std::vector ss, std::string defvalue, bool tolower); int where_in_set(std::string s, std::vector ss, bool tolower); bool is_in_vector(std::string s, std::vector ss); int where_in_vector(std::string s, const std::vector &ss, const bool &tolower); std::vector getlastpart (std::vector s, std::string delim); std::vector strsplit(std::string s, std::string delimiter); std::vector strsplit_first(std::string s, std::string delimiter); std::vector str2dbl(std::vector s); std::vector str2int(std::vector s); std::vector str2long(std::vector s); std::vector dbl2str(std::vector d); void lrtrim(std::string &s); std::string lrtrim_copy(std::string s); bool in_string(const std::string &x, std::string part); bool ends_on(std::string const &s, std::string const &end); void make_unique_names(std::vector &s); void make_valid_names(std::vector &s); void str_replace(std::string& str, const std::string& from, const std::string& to); size_t str_replace_all(std::string& str, const std::string& from, const std::string& to); #endif terra/src/Makevars.in0000644000176200001440000000007414536376240014272 0ustar liggesusersPKG_CPPFLAGS=@PKG_CPPFLAGS@ PKG_LIBS=@PKG_LIBS@ CXX_STD=CXX terra/src/spatTime.cpp0000644000176200001440000002032114720502767014460 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include #include #include #include "string_utils.h" typedef long long SpatTime_t; bool isleap(const long &year) { return (year % 4 == 0) && ((year % 400 == 0) || (year % 100 != 0 )); } SpatTime_t yeartime(const long &year) { // seconds per year // 365 * 24 * 3600 = 31536000 return isleap(year) ? 31622400 : 31536000; } SpatTime_t get_time(long year, unsigned month, unsigned day, int hr, int min, int sec) { static const unsigned mdays[2][12] = { {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334}, {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335} }; if (month > 12) { year += month / 12; month = ((month-1) % 12) + 1; } // the first day does not count, we start at 1970-01-01 // 24 * 3600 = 86400 SpatTime_t time = -86400; if (year < 1970) { for (long y = year; y < 1970; y++){ time -= yeartime(y); } } else { for (long y = 1970; y < year; y++) { time += yeartime(y); } } if (month == 0) month = 6; if (day == 0) day = 15; time += (mdays[isleap(year)][month-1] + day) * 86400; time += (hr * 3600) + (min * 60) + sec; return time; } SpatTime_t get_time_str(std::vector s) { std::vector d(6, 0); for (size_t i=0; i get_date(SpatTime_t x) { // seconds per month, shifted one month static const unsigned secdays[2][13] = { {0, 2678400, 5097600, 7776000, 10368000, 13046400, 15638400, 18316800, 20995200, 23587200, 26265600, 28857600, 31536000}, {0, 2678400, 5184000, 7862400, 10454400, 13132800, 15724800, 18403200, 21081600, 23673600, 26352000, 28944000, 31622400} }; // the first day does not count, we start at 1970-01-01 int year = 1970; if (x < 0) { while (x < 0) { year--; x += yeartime(year); } } else if (x > 0) { while (x >= 0) { x -= yeartime(year); year++; } year--; x += yeartime(year); } int month; int leap = isleap(year); for (month=1; month<13; month++) { if (x < (secdays[leap][month])) { break; } } x -= secdays[isleap(year)][month-1]; int day = x / 86400 + 1; x = x % 86400; int hour = x / 3600; x = x % 3600; int min = x / 60; int sec = x % 60; std::vector out= {year, month, day, hour, min, sec}; return out; } std::vector splitstr(std::string s, std::string delimiter){ std::vector out; size_t pos = 0; while ((pos = s.find(delimiter)) != std::string::npos) { out.push_back(s.substr(0, pos)); s.erase(0, pos + delimiter.length()); } out.push_back(s.substr(0, pos)); return out; } void replace_one_char(std::string& s, char from, char to) { for (size_t i = 0; i < s.size(); i++) { if (s[i] == from) { s[i] = to; } } } int getyear(std::string s) { int y; try { y = stoi(s); } catch(...) { y = 1970; } return y; } std::vector getymd(std::string s) { // s = std::regex_replace(s, std::regex("T"), " "); lowercase(s); replace_one_char(s, 't', ' '); size_t ncolon = std::count(s.begin(), s.end(), ':'); std::vector x; std::vector y; if (ncolon > 0) { x = splitstr(s, " "); s = x[0]; if (x.size() > 1) { x[1].erase(std::remove(x[1].begin(), x[1].end(), 'z'), x[1].end()); y = splitstr(x[1], ":"); } } size_t ndash = std::count(s.begin(), s.end(), '-'); if (ndash == 2) { x = splitstr(s, "-"); } x.insert(x.end(), y.begin(), y.end() ); std::vector out(x.size()); try { for (size_t i=0; i(6); } return out; } SpatTime_t get_time_string(std::string s) { /* std::vector ss; size_t ncolon = std::count(s.begin(), s.end(), ':'); if (ncolon > 0) { ss = splitstr(s, " "); s = ss[0]; } size_t ndash = std::count(s.begin(), s.end(), '-'); SpatTime_t time = 0; if (ndash == 2) { ss = splitstr(s, "-"); } else { return time; } */ std::vector d = getymd(s); return get_time(d[0], d[1], d[2], d[3], d[4], d[5]); } SpatTime_t time_from_hour(int syear, int smonth, int sday, int shour, double nhours) { SpatTime_t time = get_time(syear, smonth, sday, shour, 0, 0); time += nhours * 3600; return time; } void hours_to_time(std::vector &time, std::string origin) { std::vector ymd = getymd(origin); SpatTime_t otime = get_time(ymd[0], ymd[1], ymd[2], 0, 0, 0); for (SpatTime_t &d : time) d = otime + d * 3600; } SpatTime_t time_from_day(int syear, int smonth, int sday, double ndays) { SpatTime_t time = get_time(syear, smonth, sday, 0, 0, 0); time += ndays * 86400; return time; } SpatTime_t get_time_noleap(int syear, int smonth, int sday, int shour, int smin, int ssec, double n, std::string step) { static const int md[13] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 }; // set start to beginning of year double s = ssec + smin * 60 + shour * 3600 + (sday-1) * 24 * 3600; for (int i=0; i < smonth; i++) { s += (md[i] * 24 * 3600); } double ndays; if (step == "hours") { ndays = (n + s/3600) / 24; } else if (step == "minutes") { n += s/60; ndays = n / 1440; } else if (step == "seconds") { ndays = (n+s) / 86400; } else if (step == "days") { ndays = n + s/86400; } else { return 0; } int year = ndays / 365; double rem = ndays - year * 365; int month; for (month=1; month<13; month++) { if (rem < md[month]) { break; } } rem -= md[month-1]; int day = rem; rem -= day; day++; rem *= 24; int hr = rem; rem -= hr; int mn = rem * 60; rem -= mn; int sc = rem * 60; return get_time(year+syear, month, day, hr, mn, sc); } SpatTime_t get_time_360(int syear, int smonth, int sday, int shour, int smin, int ssec, double n, std::string step) { // set start to beginning of year double s = ssec + smin * 60 + shour * 3600 + (sday-1) * 24 * 3600 + (smonth-1) * 30; double ndays; if (step == "hours") { ndays = (n + s/3600) / 24; } else if (step == "minutes") { n += s/60; ndays = n / 1440; } else if (step == "seconds") { ndays = (n+s) / 86400; } else if (step == "days") { ndays = n + s/86400; } else { return 0; } int year = ndays / 360; double rem = ndays - year * 360; int month = rem / 30; rem -= month * 30; month++; int day = rem; rem -= day; day++; rem *= 24; int hr = rem; rem -= hr; int mn = rem * 60; rem -= mn; int sc = rem * 60; return get_time(year+syear, month, day, hr, mn, sc); } SpatTime_t time_from_day_360(int syear, int smonth, int sday, double ndays) { static const int md[13] = {0, 30, 60, 90, 120, 150, 180, 210, 240, 270, 300, 330, 360 }; int year = ndays / 360; //int doy = ndays % 360; int doy = ndays - (year * 360); int month; for (month=1; month<13; month++) { if (doy < md[month]) { break; } } month--; int day = doy - md[month]; SpatTime_t time = get_time(year+syear, month+smonth, day+sday, 0, 0, 0); return time; } SpatTime_t parse_time(std::string x) { lrtrim(x); std::vector s = strsplit(x, " "); if (s.size() == 1) { s = strsplit(x, "T"); } std::vector time; if ((!s[0].empty()) && (s[0].substr(0, 1) != "-")) { time = strsplit(s[0], "-"); //} else { // time = {s[0]}; } time.resize(3, "0"); // if (time.size() == 1) { // return stoll(time[0]); // } else if (time.size() != 3) { // return 0; // } if (s.size() > 1) { std::vector secs = strsplit(s[1], ":"); if (secs.size() == 3) { time.insert(time.end(), secs.begin(), secs.end()); } } return get_time_str(time); } terra/src/gdalio.h0000644000176200001440000000302114726671336013601 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . bool getGDALDataType(std::string datatype, GDALDataType &gdt); std::string gdalinfo(std::string filename, std::vector options, std::vector openopts); std::vector> sdinfo(std::string fname); std::vector get_metadata(std::string filename); std::vector get_metadata_sds(std::string filename); std::vector> parse_metadata_sds(std::vector meta); void getGDALdriver(std::string &filename, std::string &driver); bool getNAvalue(GDALDataType gdt, double & naval); GDALDataset* openGDAL(std::string filename, unsigned OpenFlag, std::vector allowed_drivers, std::vector open_options); char ** set_GDAL_options(std::string driver, double diskNeeded, bool writeRGB, std::vector gdal_options); terra/src/rasterize.cpp0000644000176200001440000006731614733425746014726 0ustar liggesusers #include "ogr_spatialref.h" #include "spatRaster.h" #include "file_utils.h" #include "gdal_alg.h" #include "ogrsf_frmts.h" //#include "spatFactor.h" #include "recycle.h" #include "sort.h" #include "gdalio.h" SpatRaster SpatRaster::rasterizePoints(std::vector&x, std::vector &y, std::string fun, std::vector &values, bool narm, double background, SpatOptions &opt) { SpatRaster out = geometry(1, false, false, false); if (!out.writeStart(opt, filenames())) { return out; } if (y.size() != x.size()) { out.setError("number of x and y coordinates do not match"); return out; } if ((fun == "count") && (values.size() != x.size()) && (!values.empty())) { out.setError("number of values does not match the number of points"); return out; } else if (values.size() != x.size()) { out.setError("number of values does not match the number of points"); return out; } size_t nc = ncol(); std::vector cells = cellFromXY(x, y, -9); // order for multiple chunks, but also to remove NAs (-9) std::vector so = sort_order_a(cells); permute(cells, so); permute(values, so); size_t cellcnt = 0; for (size_t i=0; i v(out.bs.nrows[i] * out.ncol(), 0); for (size_t j=cellcnt; j v(out.bs.nrows[i] * out.ncol(), 0); std::vector cnt = v; for (size_t j=cellcnt; j 0) { v[j] /= cnt[j]; } } } if (!out.writeValues(v, out.bs.row[i], out.bs.nrows[i])) return out; } } else if (fun == "sum") { for (size_t i=0; i < out.bs.n; i++) { double cmin = out.bs.row[i] * nc; double cmax = (out.bs.row[i]+out.bs.nrows[i]) * nc - 1; std::vector v(out.bs.nrows[i] * out.ncol(), background); std::vector newcell(out.bs.nrows[i] * out.ncol(), true); for (size_t j=cellcnt; j v(out.bs.nrows[i] * out.ncol(), background); std::vector newcell(out.bs.nrows[i] * out.ncol(), true); for (size_t j=cellcnt; j v(out.bs.nrows[i] * out.ncol(), background); std::vector newcell(out.bs.nrows[i] * out.ncol(), true); for (size_t j=cellcnt; j v(out.bs.nrows[i] * out.ncol(), background); std::vector newcell(out.bs.nrows[i] * out.ncol(), true); for (size_t j=cellcnt; j v(out.bs.nrows[i] * out.ncol(), background); for (size_t j=cellcnt; j v(out.bs.nrows[i] * out.ncol(), background); std::vector newcell(out.bs.nrows[i] * out.ncol(), true);; for (size_t j=cellcnt; j v(out.bs.nrows[i] * out.ncol(), background); for (size_t j=cellcnt; j &values, bool narm, double background, SpatOptions &opt) { if (values.empty()) { values = std::vector(x.nrow(), 1); } std::vector> pxy = x.coordinates(); return rasterizePoints(pxy[0], pxy[1], fun, values, narm, background, opt); } SpatRaster SpatRaster::rasterizeGeom(SpatVector x, std::string unit, std::string fun, SpatOptions &opt) { if (x.type() == "points") { std::vector v; return rasterizePoints(x, "count", v, false, 0.0, opt); } else { SpatRaster out = geometry(1, false, false, false); SpatOptions ops(opt); std::vector ss {"m", "km"}; if (std::find(ss.begin(), ss.end(), unit) == ss.end()) { out.setError("invalid unit (not 'm' or 'km')"); return out; } if ((x.type() == "lines")) { ss = {"count", "length", "crosses"}; if (std::find(ss.begin(), ss.end(), fun) == ss.end()) { out.setError("invalid value for 'fun' (not 'count', 'crosses', or 'length')"); return out; } } else { ss = {"area", "count"}; if (std::find(ss.begin(), ss.end(), fun) == ss.end()) { out.setError("invalid value for 'fun' (not 'area' or 'count')"); return out; } } SpatRaster empty = out.geometry(); SpatExtent e = out.getExtent(); double rsy = out.yres() / 2; double m = unit == "m" ? 1 : 1000; if (!x.is_lonlat()) { double tom = x.srs.to_meter(); tom = std::isnan(tom) ? 1 : tom; m *= tom; } out.setNames({fun}); opt.ncopies = std::max(opt.ncopies, (size_t)4) * 8; if (!out.writeStart(opt, filenames())) { return out; } for (size_t i=0; i < out.bs.n; i++) { e.ymax = yFromRow(out.bs.row[i]) + rsy; e.ymin = yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1) - rsy; SpatRaster tmp = empty.crop(e, "near", false, ops); SpatVector p = tmp.as_polygons(true, false, false, false, false, 0, ops); std::vector v(out.bs.nrows[i] * out.ncol(), 0); if (fun == "crosses") { std::vector r = p.relate(x, "crosses", true, true); size_t nx = x.size(); for (size_t j=0; j< r.size(); j++) { size_t k= j / nx; v[k] += r[j]; } } else { std::vector cell(p.size()); std::iota(cell.begin(), cell.end(), 0); p.df.add_column(cell, "cell"); p = p.intersect(x, true); std::vector stat; if (x.type() == "lines") { stat = p.length(); } else { stat = p.area("m", false, {}); } if (fun == "count") { for (size_t j=0; j v; readBlock(v, out.bs, i); if (!out.writeBlock(v, i)) return out; } out.writeStop(); readStop(); return(out); } /* gdalcopy GDALDatasetH hSrcDS = GDALOpenEx(out.source[0].filename.c_str(), GDAL_OF_RASTER | GDAL_OF_UPDATE, NULL, NULL, NULL); if(hSrcDS == NULL) { out.setError("cannot open dataset";) return false; } GDALDriverH hDriver = GDALGetDatasetDriver(hSrcDS); GDALDatasetH hDstDS = GDALCreateCopy( hDriver, filename.c_str(), hSrcDS, FALSE, NULL, NULL, NULL ); GDALClose(hSrcDS); if(hDstDS == NULL) { out.setError("cannot create dataset"; return false; } GDALClose(hDstDS); */ bool SpatRaster::getDSh(GDALDatasetH &rstDS, SpatRaster &out, std::string &filename, std::string &driver, double &naval, bool update, double background, SpatOptions &opt) { filename = opt.get_filename(); SpatOptions ops(opt); ops.ncopies += 4; if (filename.empty()) { if (canProcessInMemory(ops)) { driver = "MEM"; } else { filename = tempFile(opt.get_tempdir(), opt.tmpfile, ".tif"); opt.set_filenames({filename}); driver = "GTiff"; } } else { driver = opt.get_filetype(); getGDALdriver(filename, driver); if (driver.empty()) { out.setError("cannot guess file type from filename"); return false; } std::string msg; if (!can_write({filename}, filenames(), opt.get_overwrite(), msg)) { out.setError(msg); return false; } } if (opt.names.size() == nlyr()) { out.setNames(opt.names); } if (update) { out = hardCopy(opt); //size_t ns = source.size(); if (!out.open_gdal(rstDS, 0, true, opt)) { return false; } } else if (!out.create_gdalDS(rstDS, filename, driver, true, background, source[0].has_scale_offset, source[0].scale, source[0].offset, opt)) { out.setError("cannot create dataset"); return false; } GDALRasterBandH hBand = GDALGetRasterBand(rstDS, 1); GDALDataType gdt = GDALGetRasterDataType(hBand); getNAvalue(gdt, naval); int hasNA; double naflag = GDALGetRasterNoDataValue(hBand, &hasNA); naval = hasNA ? naflag : naval; return true; } bool SpatRaster::getDShMEM(GDALDatasetH &rstDS, SpatRaster &out, double &naval, double background, SpatOptions &opt) { SpatOptions ops(opt); if (opt.names.size() == nlyr()) { out.setNames(opt.names); } if (!out.create_gdalDS(rstDS, "", "MEM", true, background, source[0].has_scale_offset, source[0].scale, source[0].offset, ops)) { out.setError("cannot create dataset"); return false; } GDALRasterBandH hBand = GDALGetRasterBand(rstDS, 1); GDALDataType gdt = GDALGetRasterDataType(hBand); getNAvalue(gdt, naval); int hasNA; double naflag = GDALGetRasterNoDataValue(hBand, &hasNA); naval = hasNA ? naflag : naval; return true; } SpatRaster SpatRaster::rasterizeLyr(SpatVector x, double value, double background, bool touches, bool update, SpatOptions &opt) { // not working well in some cases. See #552 std::string gtype = x.type(); SpatRaster out; out.setNames({"ID"}); if ( !hasValues() ) update = false; if (update) { // all lyrs out = geometry(); } else { out = geometry(1); } GDALDataset *vecDS = x.write_ogr("", "lyr", "Memory", false, true, std::vector()); if (x.hasError()) { out.setError(x.getError()); return out; } OGRLayer *poLayer = vecDS->GetLayer(0); #if GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR <= 2 OGRLayerH hLyr = poLayer; #else OGRLayerH hLyr = poLayer->ToHandle(poLayer); #endif std::vector ahLayers; ahLayers.push_back( hLyr ); std::string driver, filename; GDALDatasetH rstDS; double naval; if (!getDSh(rstDS, out, filename, driver, naval, update, background, opt)) { return out; } if (std::isnan(value)) { // passing NULL instead may also work. value = naval; } std::vector bands(out.nlyr()); std::iota(bands.begin(), bands.end(), 1); std::vector values(out.nlyr(), value); char** papszOptions = NULL; CPLErr err; if (touches) { papszOptions = CSLSetNameValue(papszOptions, "ALL_TOUCHED", "TRUE"); } err = GDALRasterizeLayers(rstDS, static_cast(bands.size()), &(bands[0]), 1, &(ahLayers[0]), NULL, NULL, &(values[0]), papszOptions, NULL, NULL); CSLDestroy(papszOptions); // for (size_t i=0; i values, double background, bool touches, std::string fun, bool weights, bool update, bool minmax, SpatOptions &opt) { std::string gtype = x.type(); bool ispol = gtype == "polygons"; if (weights) update = false; if (weights && ispol) { SpatOptions sopts(opt); SpatRaster wout = geometry(1); field = ""; unsigned agx = 1000 / ncol(); agx = std::max((unsigned)10, agx); unsigned agy = 1000 / nrow(); agy = std::max((unsigned)10, agy); //unsigned agx = 100; //unsigned agy = 100; wout = wout.disaggregate({agx, agy}, sopts); double f = agx * agy; wout = wout.rasterize(x, field, {1/f}, background, touches, fun, false, false, false, sopts); wout = wout.aggregate({agx, agy}, "sum", true, opt); return wout; } // Rcpp::Rcout << "x" << std::endl; bool add = fun == "sum"; SpatRaster out; if ( !hasValues() ) update = false; if (update) { out = geometry(); } else { out = geometry(1); } if (field.empty()) { out.setNames({"layer"}); } else { out.setNames({field}); } size_t nGeoms = x.size(); if (nGeoms == 0) { if (update) { out = *this; } else { out = out.init({background}, opt); } return out; } if (ispol && touches && add) { add = false; out.addWarning("you cannot use 'sum' and 'touches' at the same time"); } if (!field.empty()) { int i = x.df.get_fieldindex(field); if (i < 0) { out.setError("field " + field + " not found"); return out; } std::string dt = x.df.get_datatype(field); if (dt == "double") { values = x.df.getD(i); } else if (dt == "long") { values = x.df.as_double(i); out.setValueType(1); } else if (dt == "bool") { values = x.df.as_double(i); out.setValueType(3); } else if (dt == "time") { // tbd values = x.df.as_double(i); } else { std::vector sv = x.df.as_string(i); SpatFactor f(sv); values.resize(f.v.size()); for (size_t j=0; j u(f.labels.size()); std::iota(u.begin(), u.end(), 0); std::vector nms = getNames(); out.setLabels(0, u, f.labels, field); } if (add) { add = false; addWarning("cannot add factors"); } } } if (values.size() != nGeoms) { recycle(values, nGeoms); } GDALDataset *vecDS = x.write_ogr("", "lyr", "Memory", false, true, std::vector()); if (x.hasError()) { out.setError(x.getError()); return out; } std::vector ogrGeoms; ogrGeoms.reserve(nGeoms); OGRLayer *poLayer = vecDS->GetLayer(0); poLayer->ResetReading(); OGRFeature *poFeature; while( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { OGRGeometry *copyGeom = poGeometry->clone(); ogrGeoms.push_back( copyGeom ); } OGRFeature::DestroyFeature( poFeature ); } GDALClose(vecDS); std::string errmsg, driver, filename; GDALDatasetH rstDS; double naval; if (add) { background = 0; } std::vector bands(out.nlyr()); std::iota(bands.begin(), bands.end(), 1); rep_each(values, out.nlyr()); SpatRaster temp = out; if (!out.writeStart(opt, filenames())) { return out; } bool hasError = false; SpatExtent e = temp.getExtent(); SpatRaster tmp; SpatOptions topt(opt); char** papszOptions = NULL; for (size_t i = 0; i < out.bs.n; i++) { if (out.bs.n > 1) { double halfres = temp.yres() / 2; e.ymax = temp.yFromRow(out.bs.row[i]) + halfres; e.ymin = temp.yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1) - halfres; if (update) { tmp = crop(e, "near", false, topt); } else { tmp = temp.crop(e, "near", false, topt); } } else { if (update) { tmp = hardCopy(topt); } else { tmp = temp; } } if (update) { std::string filename; if (!tmp.getDSh(rstDS, tmp, filename, driver, naval, update, background, topt)) { return tmp; } } else if (!tmp.getDShMEM(rstDS, tmp, naval, background, opt)) { return tmp; } if (i==1) for (double &d : values) d = std::isnan(d) ? naval : d; CPLErr err; if (ispol && touches && (nGeoms > 1)) { // first to get the touches if (i == 0) papszOptions = CSLSetNameValue(papszOptions, "ALL_TOUCHED", "TRUE"); err = GDALRasterizeGeometries(rstDS, static_cast(bands.size()), &(bands[0]), static_cast(ogrGeoms.size()), (OGRGeometryH *) &(ogrGeoms[0]), NULL, NULL, &(values[0]), papszOptions, NULL, NULL); if ( err != CE_None ) { tmp.setError("rasterization failed"); GDALClose(rstDS); hasError = true; break; } //GDALFlushCache(rstDS); // second time to fix the internal area err = GDALRasterizeGeometries(rstDS, static_cast(bands.size()), &(bands[0]), static_cast(ogrGeoms.size()), (OGRGeometryH *) &(ogrGeoms[0]), NULL, NULL, &(values[0]), NULL, NULL, NULL); } else { if (i == 0) { if (touches) { papszOptions = CSLSetNameValue(papszOptions, "ALL_TOUCHED", "TRUE"); } else if (add) { papszOptions = CSLSetNameValue(papszOptions, "MERGE_ALG", "ADD"); } } err = GDALRasterizeGeometries(rstDS, static_cast(bands.size()), &(bands[0]), static_cast(ogrGeoms.size()), (OGRGeometryH *) &(ogrGeoms[0]), NULL, NULL, &(values[0]), papszOptions, NULL, NULL); } if ( err != CE_None ) { tmp.setError("rasterization failed"); GDALClose(rstDS); hasError = true; break; } if (!tmp.from_gdalMEM(rstDS, false, true)) { tmp.setError("rasterization failed"); GDALClose(rstDS); hasError = true; break; } GDALClose(rstDS); std::vector v = tmp.getValues(-1, topt); if (!out.writeBlock(v, i)) return out; } CSLDestroy(papszOptions); for (size_t i=0; i SpatRaster::rasterizeCells(SpatVector &v, bool touches, bool small, SpatOptions &opt) { // note that this is only for lines and polygons SpatOptions ropt(opt); SpatRaster r = geometry(1); SpatExtent e = getExtent(); SpatExtent ev = v.getExtent(); if (ev.xmin >= ev.xmax) { double xr = 0.1 * xres(); ev.xmin -= xr; ev.xmax += xr; } if (ev.ymin >= ev.ymax) { double yr = 0.1 * yres(); ev.ymin -= yr; ev.ymax += yr; } e = e.intersect(ev); if ( !e.valid() ) { std::vector out(1, NAN); return out; } SpatRaster rc = r.crop(e, "out", false, ropt); std::vector feats(1, 1) ; SpatRaster rcr = rc.rasterize(v, "", feats, NAN, touches, "", false, false, false, ropt); SpatVector pts = rcr.as_points(false, true, false, ropt); std::vector cells; if (pts.empty()) { if (small) { pts = v.as_points(false, true); SpatDataFrame vd = pts.getGeometryDF(); std::vector x = vd.getD(0); std::vector y = vd.getD(1); cells = r.cellFromXY(x, y); cells.erase(std::remove_if(cells.begin(), cells.end(), [](const double& value) { return std::isnan(value); }), cells.end()); std::sort( cells.begin(), cells.end() ); cells.erase(std::unique(cells.begin(), cells.end()), cells.end()); if (cells.empty()) { cells.resize(1, NAN); } } else { cells.resize(1, NAN); } } else { SpatDataFrame vd = pts.getGeometryDF(); std::vector x = vd.getD(0); std::vector y = vd.getD(1); cells = r.cellFromXY(x, y); // cells.erase(std::unique(cells.begin(), cells.end()), cells.end()); if (cells.empty()) { cells.resize(1, NAN); } } return cells; } void SpatRaster::rasterizeCellsWeights(std::vector &cells, std::vector &weights, SpatVector &v, SpatOptions &opt) { // note that this is only for polygons SpatOptions ropt(opt); //opt.progress = nrow()+1; SpatRaster r = geometry(1); //std::vector fact = {10, 10}; SpatExtent e = getExtent(); SpatExtent ve = v.getExtent(); e = e.intersect(ve); if ( !e.valid() ) { return; } bool cropped = false; SpatRaster rc = r.crop(v.extent, "out", false, ropt); if ( ((ncol() > 1000) && ((ncol() / rc.ncol()) > 1.5)) || ((nrow() > 1000) && ((nrow() / rc.nrow()) > 1.5) )) { cropped = true; r = rc; } std::vector feats; r = r.rasterize(v, "", feats, NAN, false, "", true, false, false, ropt); std::vector> cv = r.cells_notna(ropt); if (cv[0].empty()) { weights.resize(1); weights[0] = NAN; cells.resize(1); cells[0] = NAN; } else { weights = cv[1]; if (cropped) { cv = r.xyFromCell(cv[0]); cells = cellFromXY(cv[0], cv[1]); } else { cells = cv[0]; } } return; } void SpatRaster::rasterizeCellsExact(std::vector &cells, std::vector &weights, SpatVector &v, SpatOptions &opt) { SpatOptions ropt(opt); opt.progress = nrow()+1; SpatRaster r = geometry(1); r = r.crop(v.extent, "out", false, ropt); // if (r.ncell() < 1000) { std::vector feats(1, 1) ; r = r.rasterize(v, "", feats, NAN, true, "", false, false, false, ropt); SpatVector pts = r.as_points(true, true, false, ropt); if (pts.empty()) { weights.resize(1); weights[0] = NAN; cells.resize(1); cells[0] = NAN; } else { SpatDataFrame vd = pts.getGeometryDF(); std::vector x = vd.getD(0); std::vector y = vd.getD(1); cells = cellFromXY(x, y); SpatVector rv = r.as_polygons(false, false, false, true, false, 0, ropt); std::vector csize = rv.area("m", true, {}); rv.df.add_column(csize, "area"); rv.df.add_column(cells, "cells"); rv = rv.crop(v); weights = rv.area("m", true, {}); for (size_t i=0; i feats(1, 1) ; SpatVector vv = v.as_lines(); SpatRaster b = r.rasterize(vv, "", feats, NAN, true, false, false, false, false, opt); SpatVector pts = b.as_points(true, true, opt); if (pts.nrow() > 0) { SpatDataFrame vd = pts.getGeometryDF(); std::vector x = vd.getD(0); std::vector y = vd.getD(1); cells = cellFromXY(x, y); SpatVector bv = b.as_polygons(false, false, false, true, opt); std::vector csize = bv.area("m", true, {}); bv.df.add_column(csize, "cellsize"); bv.df.add_column(cells, "cellnr"); bv = bv.crop(v); weights = bv.area("m", true, {}); for (size_t i=0; i 0) { SpatDataFrame vd = pts.getGeometryDF(); std::vector x = vd.getD(0); std::vector y = vd.getD(1); std::vector cells2 = cellFromXY(x, y); cells.insert(cells.end(), cells2.begin(), cells2.end()); weights.resize(weights.size() + cells2.size(), 1); } if (cells.size() == 0) { weights.resize(1); weights[0] = NAN; cells.resize(1); cells[0] = NAN; } } */ } void SpatRaster::rasterizeLinesLength(std::vector &cells, std::vector &weights, SpatVector &v, SpatOptions &opt) { if (v.type() != "lines") { setError("expected lines"); return; } /* double m = 1; if (!v.is_lonlat()) { double tom = v.srs.to_meter(); tom = std::isnan(tom) ? 1 : tom; m *= tom; } */ SpatOptions xopt(opt); xopt.ncopies = std::max(xopt.ncopies, (size_t)4) * 8; SpatRaster x = geometry(1); SpatExtent ev = v.getExtent(); x = x.crop(ev, "out", false, xopt); BlockSize bs = x.getBlockSize(xopt); SpatExtent e = x.getExtent(); double rsy = x.yres() / 2; for (size_t i=0; i < bs.n; i++) { e.ymax = yFromRow(bs.row[i]) + rsy; e.ymin = yFromRow(bs.row[i] + bs.nrows[i] - 1) - rsy; SpatRaster tmp = x.crop(e, "near", false, xopt); std::vector cell(tmp.ncell()); std::iota(cell.begin(), cell.end(), 0); std::vector> xy = tmp.xyFromCell(cell); cell = cellFromXY(xy[0], xy[1]); SpatVector p = tmp.as_polygons(true, false, false, false, false, 0, xopt); p.df.add_column(cell, "cell"); p = p.intersect(v, true); if (p.nrow() > 1) { cells.insert(cells.end(), p.df.dv[0].begin(), p.df.dv[0].end()); std::vector w = p.length(); double sm = std::accumulate(w.begin(), w.end(), 0.0); for (double &d : w) d /= sm; weights.insert(weights.end(), w.begin(), w.end()); } } } terra/src/distRaster.cpp0000644000176200001440000025320014752175740015024 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "distance.h" #include #include #include "geodesic.h" #include "recycle.h" #include "math_utils.h" #include "vecmath.h" #include "file_utils.h" #include "string_utils.h" #include "crs.h" #include "sort.h" #include "geosphere.h" inline void shortDistPoints(std::vector &d, const std::vector &x, const std::vector &y, const std::vector &px, const std::vector &py, const bool& lonlat, const std::string& method, const double &lindist) { if (lonlat) { distanceToNearest_lonlat(d, x, y, px, py, lindist, method); } else { distanceToNearest_plane(d, x, y, px, py, lindist); } } inline void shortDirectPoints(std::vector &d, std::vector &x, std::vector &y, std::vector &px, std::vector &py, const bool& lonlat, bool &from, bool °rees, const std::string &method) { if (lonlat) { directionToNearest_lonlat(d, x, y, px, py, degrees, from, method); } else { directionToNearest_plane(d, x, y, px, py, degrees, from); } } /* bool get_m(double &m, SpatSRS srs, bool lonlat, std::string unit) { m = 1; if (!lonlat) { m = srs.to_meter(); m = std::isnan(m) ? 1 : m; } std::vector ss {"m", "km"}; if (std::find(ss.begin(), ss.end(), unit) == ss.end()) { return false; } if (unit == "km") { m /= 1000; } return true; } */ std::vector dist_bounds(const std::vector& vx, const std::vector& vy, const std::vector& rx, const double& ry, size_t& first, size_t& last, const bool& lonlat, const std::string &method) { std::vector d(rx.size(), std::numeric_limits::max()); size_t oldfirst = first; first = vx.size(); last = 0; if (lonlat) { std::function dfun; if (method == "haversine") { dfun = distance_hav; } else if (method == "cosine") { dfun = distance_cos; } else { dfun = distance_geo; } for (size_t i=0; i &d, const std::vector& vx, const std::vector& vy, const std::vector& rx, const std::vector& ry, const size_t& first, const size_t& last, const bool& lonlat, const std::vector& dlast, bool skip, const std::vector& v, const std::string& method, bool setNA) { size_t rxs = rx.size(); d.reserve(rxs + dlast.size()); double inf = std::numeric_limits::infinity(); if (lonlat) { if (method == "geo") { double dd, azi1, azi2; struct geod_geodesic g; // get a and f from crs? double a = 6378137.0; double f = 1/298.257223563; geod_init(&g, a, f); if (skip) { for (size_t i=0; i dfun; if (method == "haversine") { dfun = distance_hav; } else if (method == "cosine") { dfun = distance_cos; } if (skip) { for (size_t i=0; i::max(); for (size_t i=0; i< v.size(); i++) { if (v[i] == mxval) { d[i] = NAN; } } } } } SpatRaster SpatRaster::distance_crds(std::vector& x, std::vector& y, const std::string& method, bool skip, bool setNA, std::string unit, double max_dist, SpatOptions &opt) { SpatRaster out = geometry(); if (x.empty()) { out.setError("no locations to compute distance from"); return(out); } const double toRad = 0.0174532925199433; std::vector pm = sort_order_d(y); permute(x, pm); permute(y, pm); bool lonlat = is_lonlat(); double m=1; if (!source[0].srs.m_dist(m, lonlat, unit)) { out.setError("invalid unit"); return(out); } unsigned nc = ncol(); if (nrow() > 1000) { opt.steps = std::max(opt.steps, (size_t) 4); opt.progress = opt.progress * 1.5; } if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector cells; std::vector dlast; std::vector cols; cols.resize(ncol()); std::iota(cols.begin(), cols.end(), 0); std::vector tox = xFromCol(cols); if (lonlat && (method != "geo")) { for (double &d : x) d *= toRad; for (double &d : y) d *= toRad; for (double &d : tox) d *= toRad; } double oldfirst = 0; size_t first = 0; size_t last = x.size(); std::vector v; if (skip) { if (!readStart()) { out.setError(getError()); return(out); } for (size_t i = 0; i < out.bs.n; i++) { cells.resize((out.bs.nrows[i] -1) * nc) ; std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); std::vector> rxy = xyFromCell(cells); double toy = yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1); if (lonlat && (method != "geo")) { toy *= toRad; for (double &d : rxy[0]) d *= toRad; for (double &d : rxy[1]) d *= toRad; } readBlock(v, out.bs, i); dlast = dist_bounds(x, y, tox, toy, first, last, lonlat, method); std::vector d; dist_only(d, x, y, rxy[0], rxy[1], oldfirst, last, lonlat, dlast, true, v, method, setNA); oldfirst = first; if (m != 1) { for (double &v : d) v *= m; } if (max_dist > 0) { for (double &v : d) v = v > max_dist ? NAN : v; } if (!out.writeBlock(d, i)) return out; } readStop(); } else { for (size_t i = 0; i < out.bs.n; i++) { double toy = yFromRow(out.bs.row[i] + out.bs.nrows[i] - 1); cells.resize((out.bs.nrows[i] -1) * nc) ; std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); std::vector> rxy = xyFromCell(cells); if (lonlat && (method != "geo")) { toy *= toRad; for (double &d : rxy[0]) d *= toRad; for (double &d : rxy[1]) d *= toRad; } dlast = dist_bounds(x, y, tox, toy, first, last, lonlat, method); std::vector d; dist_only(d, x, y, rxy[0], rxy[1], oldfirst, last, lonlat, dlast, false, v, method, setNA); oldfirst = first; if (m != 1) { for (double &v : d) v *= m; } if (max_dist > 0) { for (double &v : d) v = v > max_dist ? NAN : v; } if (!out.writeBlock(d, i)) return out; } } out.writeStop(); return(out); } SpatRaster SpatRaster::distance_vector(SpatVector p, bool rasterize, std::string unit, const std::string& method, SpatOptions &opt) { SpatRaster out = geometry(); if (source[0].srs.wkt.empty()) { out.setError("CRS not defined"); return(out); } if (!source[0].srs.is_same(p.srs, false)) { out.setError("CRS do not match"); return(out); } if (p.empty()) { out.setError("no locations to compute distance from"); return(out); } bool lonlat = is_lonlat(); if ((unit != "m") && (unit != "km")) { out.setError("invalid unit. Must be 'm' or 'km'"); return(out); } if (rasterize) { //SpatRaster SpatRaster::distance_rasterize(SpatVector p, double target, double exclude, std::string unit, const std::string& method, SpatOptions &opt) { // double target = NAN; if ((method != "geo") && (method != "cosine") && (method != "haversine")) { out.setError("invalid method. Must be 'geo', 'cosine' or 'haversine'"); return(out); } double exclude = NAN; SpatRaster x; SpatOptions ops(opt); std::string gtype = p.type(); bool poly = gtype == "polygons"; x = out.rasterize(p, "", {1}, NAN, false, "", false, false, false, ops); if (!lonlat) { return x.distance(NAN, 0, false, unit, false, method, false, -1, opt); } if (poly) { x = x.edges(false, "inner", 8, 0, ops); SpatRaster xp = x.replaceValues({0}, {exclude}, 1, false, NAN, false, ops); p = xp.as_points(false, true, false, opt); } else { // x = x.edges(false, "inner", 8, NAN, ops); p = x.as_points(false, true, false, opt); } std::vector> pxy = p.coordinates(); if (pxy.empty()) { out.setError("no locations to compute from"); return(out); } bool setNA = false; out = x.distance_crds(pxy[0], pxy[1], method, poly, setNA, unit, -1, opt); } else { if ((p.type() == "polygons") || (p.type() == "lines")) { if ((method != "geo") && (method != "cosine")) { out.setError("invalid method. Must be 'geo' or 'cosine'"); return(out); } if (p.nrow() > 1) { p = p.aggregate(true); } std::vector cells; unsigned nc = ncol(); if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { cells.resize(out.bs.nrows[i] * nc) ; std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); std::vector> rxy = xyFromCell(cells); SpatVector pnts; pnts.srs = source[0].srs; pnts.setPointsGeometry(rxy[0], rxy[1]); std::vector d = pnts.distance(p, false, unit, method); if (!out.writeBlock(d, i)) return out; } readStop(); out.writeStop(); } else { //p = p.aggregate(false); if ((method != "geo") && (method != "cosine") && (method != "haversine")) { out.setError("invalid method. Must be 'geo', 'cosine' or 'haversine'"); return(out); } std::vector> pxy = p.coordinates(); SpatOptions ops(opt); bool setNA = false; out = distance_crds(pxy[0], pxy[1], method, false, setNA, unit, -1, opt); } } return out; } SpatRaster SpatRaster::direction_rasterize(SpatVector p, bool from, bool degrees, double target, double exclude, const std::string &method, SpatOptions &opt) { SpatRaster out = geometry(); if (source[0].srs.wkt.empty()) { out.setError("CRS not defined"); return(out); } if (!source[0].srs.is_same(p.srs, false)) { out.setError("CRS do not match"); return(out); } bool lonlat = is_lonlat(); SpatRaster x; SpatOptions ops(opt); std::string gtype = p.type(); bool poly = gtype == "polygons"; x = out.rasterize(p, "", {1}, NAN, false, "", false, false, false, ops); if (poly) { x = x.edges(false, "inner", 8, 0, ops); SpatRaster xp = x.replaceValues({0}, {exclude}, 1, false, NAN, false, ops); p = xp.as_points(false, true, false, opt); } else { // x = x.edges(false, "inner", 8, NAN, ops); p = x.as_points(false, true, false, opt); } std::vector> pxy = p.coordinates(); if (pxy.empty()) { out.setError("no locations to compute from"); return(out); } unsigned nc = ncol(); if (!readStart()) { out.setError(getError()); return(out); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector v; std::vector cells(out.bs.nrows[i] * nc) ; std::vector vals; vals.resize(out.bs.nrows[i] * nc, NAN); std::iota(cells.begin(), cells.end(), out.bs.row[i] * nc); x.readBlock(v, out.bs, i); if (std::isnan(target)) { for (size_t j=0; j> xy = xyFromCell(cells); shortDirectPoints(vals, xy[0], xy[1], pxy[0], pxy[1], lonlat, from, degrees, method); if (!out.writeBlock(vals, i)) return out; } out.writeStop(); readStop(); return(out); } /* SpatRaster SpatRaster::distance_vector(SpatVector p, std::string unit, SpatOptions &opt) { SpatRaster out = geometry(); if (source[0].srs.wkt == "") { out.setError("CRS not defined"); return(out); } if (!source[0].srs.is_same(p.srs, false) ) { out.setError("CRS does not match"); return(out); } bool lonlat = is_lonlat(); double m=1; // if (!get_m(m, source[0].srs, lonlat, unit)) { if (!source[0].srs.m_dist(m, lonlat, unit)) { out.setError("invalid unit"); return(out); } if (p.size() == 0) { out.setError("no locations to compute distance from"); return(out); } p = p.aggregate(false); // bool lonlat = is_lonlat(); // m == 0 unsigned nc = ncol(); if (!out.writeStart(opt, filenames())) { readStop(); return out; } std::vector cells; for (size_t i = 0; i < out.bs.n; i++) { double s = out.bs.row[i] * nc; cells.resize(out.bs.nrows[i] * nc) ; std::iota(cells.begin(), cells.end(), s); std::vector> xy = xyFromCell(cells); SpatVector pv(xy[0], xy[1], points, ""); pv.srs = source[0].srs; std::vector d = p.distance(pv, false, unit); if (p.hasError()) { out.setError(p.getError()); out.writeStop(); return(out); } if (m != 1) { for (double &v : d) v *= m; } if (!out.writeBlock(d, i)) return out; } out.writeStop(); return(out); } */ SpatRaster SpatRaster::distance(double target, double exclude, bool keepNA, std::string unit, bool remove_zero, const std::string method, bool values, double threshold, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { out.setError("SpatRaster has no values"); return out; } SpatOptions ops(opt); size_t nl = nlyr(); if (nl > 1) { std::vector nms = getNames(); if (ops.names.size() == nms.size()) { nms = opt.names; } out.source.resize(nl); for (size_t i=0; i lyr = {i}; SpatRaster r = subset(lyr, ops); ops.names = {nms[i]}; r = r.distance(target, exclude, keepNA, unit, remove_zero, method, values, threshold, ops); out.source[i] = r.source[0]; } if (!opt.get_filename().empty()) { out = out.writeRaster(opt); } return out; } if (!(values || is_lonlat())) { // && std::isnan(target) && std::isnan(exclude)) { return proximity(target, exclude, keepNA, unit, false, threshold, remove_zero, opt); } bool setNA = false; std::vector> p; if (!std::isnan(exclude)) { SpatRaster x; if (std::isnan(target)) { x = replaceValues({exclude}, {target}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 1, ops); p = x.as_points_value(1, ops); if (p.empty()) { return out.init({0}, opt); } if (values) { std::vector> vv = extractXY(p[0], p[1], "", false); return distance_crds_vals(p[0], p[1], vv[0], method, true, setNA, unit, threshold, opt); } else { return distance_crds(p[0], p[1], method, true, setNA, unit, threshold, opt); } } else { x = replaceValues({exclude, target}, {NAN, NAN}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 1, ops); p = x.as_points_value(1, ops); out = replaceValues({NAN, exclude, target}, {target, NAN, NAN}, 1, false, NAN, false, ops); } } else if (!std::isnan(target)) { SpatRaster x = replaceValues({target}, {NAN}, 1, false, NAN, false, ops); x = x.edges(false, "inner", 8, 0, ops); p = x.as_points_value(1, ops); out = replaceValues({NAN, target}, {std::numeric_limits::max(), NAN}, 1, false, NAN, false, ops); setNA = true; } else { out = edges(false, "inner", 8, 0, ops); p = out.as_points_value(1, ops); } if (p.empty()) { return out.init({0}, opt); } if (values) { std::vector> vv = extractXY(p[0], p[1], "", false); out = out.distance_crds_vals(p[0], p[1], vv[0], method, true, setNA, unit, threshold, opt); } else { out = out.distance_crds(p[0], p[1], method, true, setNA, unit, threshold, opt); } return out; } SpatRaster SpatRaster::direction(bool from, bool degrees, double target, double exclude, const std::string &method, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { out.setError("SpatRaster has no values"); return out; } SpatOptions ops(opt); size_t nl = nlyr(); if (nl > 1) { out.source.resize(nl); std::vector nms = getNames(); if (ops.names.size() == nms.size()) { nms = opt.names; } for (size_t i=0; i lyr = {i}; SpatRaster r = subset(lyr, ops); ops.names = {nms[i]}; r = r.direction(from, degrees, target, exclude, method, ops); out.source[i] = r.source[0]; } if (!opt.get_filename().empty()) { out = out.writeRaster(opt); } return out; } if (!std::isnan(exclude)) { SpatOptions xopt(opt); SpatRaster x = replaceValues({exclude}, {NAN}, 1, false, NAN, false, xopt); out = x.edges(false, "inner", 8, target, ops); } else { out = edges(false, "inner", 8, target, ops); } SpatVector p = out.as_points(false, true, false, opt); if (p.empty()) { out.setError("no cells to compute direction from or to"); return(out); } return direction_rasterize(p, from, degrees, target, exclude, method, opt); } inline double minCostDist(std::vector &d) { d.erase(std::remove_if(d.begin(), d.end(), [](const double& v) { return std::isnan(v); }), d.end()); std::sort(d.begin(), d.end()); return d.empty() ? NAN : d[0]; } inline void DxDxyCost(const double &lat, const int &row, double xres, double yres, const int &dir, double &dx, double &dy, double &dxy, double distscale, const double mult=2) { double rlat = lat + row * yres * dir; dx = distance_lonlat(0, rlat, xres, rlat) / (mult * distscale); yres *= -dir; dy = distance_lonlat(0, 0, 0, yres); dxy = distance_lonlat(0, rlat, xres, rlat+yres); dy = std::isnan(dy) ? NAN : dy / (mult * distscale); dxy = std::isnan(dxy) ? NAN : dxy / (mult * distscale); } void cost_dist(std::vector &dist, std::vector &dabove, std::vector &v, std::vector &vabove, std::vector res, size_t nr, size_t nc, double lindist, bool geo, double lat, double latdir, bool global, bool npole, bool spole) { std::vector cd; double dx, dy, dxy; if (geo) { DxDxyCost(lat, 0, res[0], res[1], latdir, dx, dy, dxy, lindist); } else { dx = res[0] * lindist / 2; dy = res[1] * lindist / 2; dxy = sqrt(dx*dx + dy*dy); } //top to bottom //left to right //first cell, no cell left of it if (!std::isnan(v[0])) { if (global) { cd = {dist[0], dabove[0] + (v[0]+vabove[0]) * dy, dist[nc-1] + (v[0] + v[nc-1]) * dx, dabove[nc-1] + dxy * (vabove[nc-1]+v[0])}; } else { cd = {dist[0], dabove[0] + (v[0]+vabove[0]) * dy}; } dist[0] = minCostDist(cd); } for (size_t i=1; i -1; i--) { // other cells on first row if (!std::isnan(v[i])) { cd = {dabove[i]+(vabove[i]+v[i])*dy, dabove[i+1]+(vabove[i+1]+v[i])*dxy, dist[i+1]+(v[i+1]+v[i])*dx, dist[i]}; dist[i] = minCostDist(cd); } } for (size_t r=1; r=end; i--) { if (!std::isnan(v[i])) { cd = { dist[i+1]+(v[i+1]+v[i])*dx, dist[i-nc+1]+(v[i]+v[i-nc+1])*dxy, dist[i-nc]+(v[i]+v[i-nc])*dy, dist[i]}; dist[i] = minCostDist(cd); } } } if (spole) { double minp = *std::min_element(dist.end()-nc, dist.end()); minp += dy; size_t ds = dist.size(); for (size_t i=ds-nc; i(dist.begin()+off, dist.end()); vabove = std::vector(v.begin()+off, v.end()); } void grid_dist(std::vector &dist, std::vector &dabove, std::vector &v, std::vector &vabove, std::vector res, size_t nr, size_t nc, double lindist, bool geo, double lat, double latdir, bool global, bool npole, bool spole) { std::vector cd; double dx, dy, dxy; if (geo) { DxDxyCost(lat, 0, res[0], res[1], latdir, dx, dy, dxy, lindist, 1); } else { dx = res[0] * lindist; dy = res[1] * lindist; dxy = sqrt(dx*dx + dy*dy); } //top to bottom //left to right //first cell, no cell left of it if (!std::isnan(v[0])) { if (global) { cd = {dist[0], dabove[0] + dy, dist[nc-1] + dx, dabove[nc-1] + dxy}; } else { cd = {dist[0], dabove[0] + dy}; } dist[0] = minCostDist(cd); } for (size_t i=1; i -1; i--) { // other cells on first row if (!std::isnan(v[i])) { cd = {dabove[i]+dy, dabove[i+1]+dxy, dist[i+1]+dx, dist[i]}; dist[i] = minCostDist(cd); } } for (size_t r=1; r=end; i--) { if (!std::isnan(v[i])) { cd = { dist[i+1]+dx, dist[i-nc+1]+dxy, dist[i-nc]+dy, dist[i]}; dist[i] = minCostDist(cd); } } } if (spole) { double minp = *std::min_element(dist.end()-nc, dist.end()); minp += dy; size_t ds = dist.size(); for (size_t i=ds-nc; i(dist.begin()+off, dist.end()); vabove = std::vector(v.begin()+off, v.end()); } void block_is_same(bool& same, std::vector& x, std::vector& y) { if (!same) return; for (size_t i=0; i res = resolution(); SpatRaster first = geometry(); SpatRaster second = first; std::vector d, v, vv; if (!readStart()) { first.setError(getError()); return(first); } opt.progressbar = false; if (!first.writeStart(opt, filenames())) { return first; } size_t nc = ncol(); std::vector dabove(nc, NAN); std::vector vabove(nc, 0); double lat = 0; if (old.hasValues()) { if (!old.readStart()) { first.setError(getError()); return(first); } if (!first.writeStart(opt, filenames())) { readStop(); old.readStop(); return first; } for (size_t i = 0; i < first.bs.n; i++) { readBlock(v, first.bs, i); if (lonlat) { lat = yFromRow(first.bs.row[i]); } bool np = (i==0) && npole; bool sp = (i==first.bs.n-1) && spole; if (target != 0) { for (size_t j=0; j(nc, NAN); vabove = std::vector(nc, 0); if (!second.writeStart(opt, filenames())) { readStop(); first.readStop(); return second; } for (int i = second.bs.n; i>0; i--) { if (lonlat) { lat = yFromRow(second.bs.row[i-1] + second.bs.nrows[i-1] - 1); } bool sp = (i==1) && spole; //! reverse order bool np = (i==(int)second.bs.n) && npole; readBlock(v, second.bs, i-1); if (target != 0) { for (size_t j=0; j 1) { std::vector lyr = {0}; out = subset(lyr, ops); out = out.costDistance(target, m, maxiter, grid, opt); out.addWarning("distance computations are only done for the first input layer"); return out; } bool lonlat = is_lonlat(); bool global = is_global_lonlat(); int polar = ns_polar(); bool npole = (polar == 1) || (polar == 2); bool spole = (polar == -1) || (polar == 2); double scale; if (!lonlat) { scale = source[0].srs.to_meter(); scale = std::isnan(scale) ? 1 : scale; scale /= m; } else { scale = m; } std::vector res = resolution(); size_t i = 0; bool converged=false; while (i < maxiter) { out = costDistanceRun(out, converged, target, scale, lonlat, global, npole, spole, grid, ops); if (out.hasError()) return out; if (converged) break; converged = true; i++; } if (!filename.empty()) { out = out.writeRaster(opt); } if (i == maxiter) { out.addWarning("distance algorithm did not converge"); } return(out); } std::vector broom_dist_planar(std::vector &v, std::vector &above, std::vector res, size_t nr, size_t nc, double lindist) { double dx = res[0] * lindist; double dy = res[1] * lindist; double dxy = sqrt(dx * dx + dy *dy); std::vector dist(v.size(), 0); //left to right //first cell, no cell left of it if ( std::isnan(v[0]) ) { dist[0] = above[0] + dy; } //first row, no row above it, use "above" for (size_t i=1; i -1; i--) { if (std::isnan(v[i])) { dist[i] = std::min(std::min(std::min(dist[i+1] + dx, above[i+1] + dxy), above[i] + dy), dist[i]); } } // other rows for (size_t r=1; r=(r*nc); i--) { if (std::isnan(v[i])) { dist[i] = std::min(std::min(std::min(dist[i], dist[i+1] + dx), dist[i-nc] + dy), dist[i-nc+1] + dxy); } } } size_t off = (nr-1) * nc; above = std::vector(dist.begin()+off, dist.end()); return dist; } /* inline double minNArm(const double &a, const double &b) { if (std::isnan(a)) return b; if (std::isnan(b)) return a; return std::min(a, b); } */ inline void DxDxy(const double &lat, const int &row, const double &xres, double yres, const int &dir, const double &scale, double &dx, double &dy, double &dxy) { double rlat = lat + row * yres * dir; dx = distance_lonlat(0, rlat, xres, rlat) / scale; yres *= -dir; dy = distance_lonlat(0, rlat, 0, rlat+yres); dxy = distance_lonlat(0, rlat, xres, rlat+yres); dy = std::isnan(dy) ? std::numeric_limits::infinity() : dy / scale; dxy = std::isnan(dxy) ? std::numeric_limits::infinity() : dxy / scale; } void broom_dist_geo(std::vector &dist, std::vector &v, std::vector &above, std::vector res, size_t nr, size_t nc, double lat, double latdir, double scale, bool npole, bool spole) { double dx, dy, dxy; //top to bottom //left to right DxDxy(lat, 0, res[0], res[1], latdir, scale, dx, dy, dxy); //first cell, no cell left of it if ( std::isnan(v[0]) ) { dist[0] = std::min(above[0] + dy, dist[0]); } //first row, no row above it, use "above" for (size_t i=1; i -1; i--) { if (std::isnan(v[i])) { dist[i] = std::min(std::min(std::min(dist[i+1] + dx, above[i+1] + dxy), above[i] + dy), dist[i]); } } if (npole) { double minp = *std::min_element(dist.begin(), dist.begin()+nc); minp += dy; for (size_t i=0; i=(r*nc); i--) { if (std::isnan(v[i])) { dist[i] = std::min(std::min(std::min(dist[i], dist[i+1] + dx), dist[i-nc] + dy), dist[i-nc+1] + dxy); } } } if (spole) { double minp = *std::min_element(dist.end()-nc, dist.end()); minp += dy; size_t ds = dist.size(); for (size_t i=ds-nc; i(dist.begin()+off, dist.end()); } void broom_dist_geo_global(std::vector &dist, std::vector &v, std::vector &above, std::vector res, size_t nr, size_t nc, double lat, double latdir, double scale, bool npole, bool spole) { // double dy = distance_lonlat(0, 0, 0, res[1]); double dx, dy, dxy; size_t stopnc = nc - 1; //top to bottom //left to right DxDxy(lat, 0, res[0], res[1], latdir, scale, dx, dy, dxy); //first cell, no cell left of it if ( std::isnan(v[0]) ) { dist[0] = std::min(std::min(std::min(above[0] + dy, above[stopnc] + dxy), dist[stopnc] + dx), dist[0]); } //first row, no row above it, use "above" for (size_t i=1; i -1; i--) { if (std::isnan(v[i])) { dist[i] = std::min(std::min(std::min(dist[i+1] + dx, above[i+1] + dxy), above[i] + dy), dist[i]); } } if (npole) { double minp = *std::min_element(dist.begin(), dist.begin()+nc); minp += dy; for (size_t i=0; i=end; i--) { if (std::isnan(v[i])) { // dist[i] = std::min(std::min(std::min(dist[i], dist[i+1] + dx), dist[i-nc] + dy), dist[i-nc+1] + dxy); dist[i] = std::min(std::min(std::min(dist[i], dist[i+1] + dx), dist[i-nc] + dy), dist[i-nc+1] + dxy); } } } if (spole) { double minp = *std::min_element(dist.end()-nc, dist.end()); minp += dy; size_t ds = dist.size(); for (size_t i=ds-nc; i(dist.begin()+off, dist.end()); } SpatRaster SpatRaster::gridDistance(double m, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { out.setError("cannot compute distance for a raster with no values"); return out; } SpatOptions ops(opt); size_t nl = nlyr(); if (nl > 1) { out.source.resize(nl); for (size_t i=0; i lyr = {i}; SpatRaster r = subset(lyr, ops); r = r.gridDistance(m, ops); out.source[i] = r.source[0]; } if (!opt.get_filename().empty()) { out = out.writeRaster(opt); } return out; } SpatRaster first = out.geometry(); std::vector res = resolution(); size_t nc = ncol(); bool lonlat = is_lonlat(); std::vector d, v; std::vector above(nc, std::numeric_limits::infinity()); if (!readStart()) { out.setError(getError()); return(out); } if (lonlat) { bool global = is_global_lonlat(); int polar = ns_polar(); bool npole = (polar == 1) || (polar == 2); bool spole = (polar == -1) || (polar == 2); SpatRaster second = first; if (!first.writeStart(ops, filenames())) { return first; } for (size_t i = 0; i < first.bs.n; i++) { readBlock(v, first.bs, i); d.resize(v.size(), std::numeric_limits::infinity()); for (size_t j=0; j(ncol(), std::numeric_limits::infinity()); for (int i = second.bs.n; i>0; i--) { readBlock(v, second.bs, i-1); first.readBlock(d, second.bs, i-1); std::reverse(v.begin(), v.end()); std::reverse(d.begin(), d.end()); double lat = yFromRow(second.bs.row[i-1] + second.bs.nrows[i-1] - 1); bool sp = (i==1) && spole; //! reverse order bool np = (i==(int)second.bs.n) && npole; if (global) { broom_dist_geo_global(d, v, above, res, second.bs.nrows[i-1], nc, lat, 1, m, np, sp); } else { broom_dist_geo(d, v, above, res, second.bs.nrows[i-1], nc, lat, 1, m, np, sp); } std::reverse(d.begin(), d.end()); if (!second.writeValuesRect(d, second.bs.row[i-1], second.bs.nrows[i-1], 0, nc)) return second; } second.writeStop(); if (!second.readStart()) { readStop(); return(second); } if (!out.writeStart(opt, filenames())) { readStop(); return out; } above = std::vector(ncol(), std::numeric_limits::infinity()); for (size_t i = 0; i < out.bs.n; i++) { readBlock(v, out.bs, i); second.readBlock(d, out.bs, i); double lat = yFromRow(first.bs.row[i]); bool np = (i==0) && npole; bool sp = (i==out.bs.n-1) && spole; if (global) { broom_dist_geo_global(d, v, above, res, out.bs.nrows[i], nc, lat, -1, m, np, sp); } else { broom_dist_geo(d, v, above, res, out.bs.nrows[i], nc, lat, -1, m, np, sp); } if (!out.writeValues(d, out.bs.row[i], out.bs.nrows[i])) return out; } second.readStop(); out.writeStop(); readStop(); } else { double scale = source[0].srs.to_meter() / m; scale = std::isnan(scale) ? 1 : scale; if (!first.writeStart(ops, filenames())) { return first; } std::vector vv; for (size_t i = 0; i < first.bs.n; i++) { readBlock(v, first.bs, i); d = broom_dist_planar(v, above, res, first.bs.nrows[i], nc, scale); if (!first.writeValues(d, first.bs.row[i], first.bs.nrows[i])) return first; } first.writeStop(); if (!first.readStart()) { out.setError(first.getError()); return(out); } above = std::vector(ncol(), std::numeric_limits::infinity()); if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (int i = out.bs.n; i>0; i--) { readBlock(v, out.bs, i-1); std::reverse(v.begin(), v.end()); d = broom_dist_planar(v, above, res, out.bs.nrows[i-1], nc, scale); first.readBlock(vv, out.bs, i-1); std::transform(d.rbegin(), d.rend(), vv.begin(), vv.begin(), [](double a, double b) {return std::min(a,b);}); if (!out.writeValuesRect(vv, out.bs.row[i-1], out.bs.nrows[i-1], 0, nc)) return out; } out.writeStop(); readStop(); } return(out); } std::vector do_edge(const std::vector &d, const size_t nrow, const size_t ncol, const bool classes, const bool inner, const unsigned dirs, double falseval) { size_t n = nrow * ncol; std::vector val(n, falseval); int r[8] = { -1,0,0,1 , -1,-1,1,1}; int c[8] = { 0,-1,1,0 , -1,1,-1,1}; if (!classes) { if (inner) { // inner for (size_t i = 1; i < (nrow-1); i++) { for (size_t j = 1; j < (ncol-1); j++) { size_t cell = i*ncol+j; val[cell] = NAN; if ( !std::isnan(d[cell])) { val[cell] = falseval; for (size_t k=0; k< dirs; k++) { if ( std::isnan(d[cell + r[k] * ncol + c[k]])) { val[cell] = 1; break; } } } } } } else { //outer for (size_t i = 1; i < (nrow-1); i++) { for (size_t j = 1; j < (ncol-1); j++) { size_t cell = i*ncol+j; val[cell] = falseval; if (std::isnan(d[cell])) { val[cell] = NAN; for (size_t k=0; k < dirs; k++) { if ( !std::isnan(d[cell+ r[k] * ncol + c[k] ])) { val[cell] = 1; break; } } } } } } } else { // by class for (size_t i = 1; i < (nrow-1); i++) { for (size_t j = 1; j < (ncol-1); j++) { size_t cell = i*ncol+j; double test = d[cell+r[0]*ncol+c[0]]; val[cell] = std::isnan(test) ? NAN : falseval; for (size_t k=1; k &v, size_t nr, size_t nc, bool rowbefore, bool rowafter, bool cols) { if (rowbefore) { v.insert(v.begin(), v.begin(), v.begin()+nc); nr++; } if (rowafter) { v.insert(v.end(), v.end()-nc, v.end()); nr++; } if (cols) { for (size_t i=0; i &v, size_t nr, size_t nc, bool rows, bool cols) { if (rows) { v.erase(v.begin(), v.begin()+nc); v.erase(v.end()-nc, v.end()); nr -= 2; } if (cols) { nc -= 2; for (size_t i=0; i 1) { std::vector lyr = {0}; SpatOptions ops(opt); out = subset(lyr, ops); out = out.edges(classes, type, directions, falseval, opt); out.addWarning("boundary detection is only done for the first layer"); return out; } if (!hasValues()) { out.setError("SpatRaster has no values"); return out; } if ((directions != 4) && (directions != 8)) { out.setError("directions should be 4 or 8"); return(out); } if ((type != "inner") && (type != "outer")) { out.setError("directions should be 'inner' or 'outer'"); return(out); } bool inner = type == "inner"; size_t nc = ncol(); size_t nr = nrow(); if (!readStart()) { out.setError(getError()); return(out); } opt.minrows = 2; if (!out.writeStart(opt, filenames())) { readStop(); return out; } for (size_t i = 0; i < out.bs.n; i++) { std::vector v; //bool before = false; //bool after = false; if (i == 0) { if (out.bs.n == 1) { readValues(v, out.bs.row[i], out.bs.nrows[i], 0, nc); addrowcol(v, nr, nc, true, true, true); } else { readValues(v, out.bs.row[i], out.bs.nrows[i]+1, 0, nc); addrowcol(v, nr, nc, true, false, true); //after = true; } } else { //before = true; if (i == out.bs.n) { readValues(v, out.bs.row[i]-1, out.bs.nrows[i]+1, 0, nc); addrowcol(v, nr, nc, false, true, true); } else { readValues(v, out.bs.row[i]-1, out.bs.nrows[i]+2, 0, nc); addrowcol(v, nr, nc, false, false, true); //after = true; } } //before, after, std::vector vv = do_edge(v, out.bs.nrows[i]+2, nc+2, classes, inner, directions, falseval); striprowcol(vv, out.bs.nrows[i]+2, nc+2, true, true); if (!out.writeBlock(vv, i)) return out; } out.writeStop(); readStop(); return(out); } SpatRaster SpatRaster::buffer(double d, double background, SpatOptions &opt) { SpatRaster out = geometry(1); if (!hasValues()) { out.setError("SpatRaster has no values"); return out; } if (d <= 0) { out.setError("buffer should be > 0"); return out; } if (background == 1) { out.setError("the background value cannot be 1"); return out; } SpatOptions ops(opt); size_t nl = nlyr(); if (nl > 1) { std::vector nms = getNames(); if (ops.names.size() == nms.size()) { nms = opt.names; } out.source.resize(nl); for (size_t i=0; i lyr = {i}; SpatRaster r = subset(lyr, ops); ops.names = {nms[i]}; r = r.buffer(d, background, ops); out.source[i] = r.source[0]; } if (!opt.get_filename().empty()) { out = out.writeRaster(opt); } return out; } if (!is_lonlat()) { if (!std::isnan(background)) { out = proximity(NAN, NAN, false, "", true, d, true, ops); if (background == 0) { out = out.isnotnan(false, opt); } else { out = out.replaceValues({NAN}, {background}, 1, false, NAN, false, opt); } } else { out = proximity(NAN, NAN, false, "", true, d, true, opt); } } else { SpatRaster e = edges(false, "inner", 8, NAN, ops); SpatVector p = e.as_points(false, true, false, ops); p = p.buffer({d}, 10, "", "", NAN, false); p = p.aggregate(true); out = out.rasterize(p, "", {1}, background, false, "", false, false, true, opt); if (background == 0) { out.setValueType(3); } //out = out.disdir_vector_rasterize(p, false, true, false, false, NAN, NAN, "m", ops); //out = out.arith(d, "<=", false, opt); } if (source[0].srs.is_empty()) { out.addWarning("unknown CRS. Results may be wrong"); } return out; } SpatRaster SpatRaster::rst_area(bool mask, std::string unit, bool transform, int rcmax, SpatOptions &opt) { SpatRaster out = geometry(1); if (out.source[0].srs.wkt.empty()) { addWarning("unknown CRS. Results can be wrong"); transform = false; } std::vector f {"m", "km", "ha"}; if (std::find(f.begin(), f.end(), unit) == f.end()) { out.setError("invalid unit"); return out; } if (opt.names.empty()) { opt.names = {"area"}; } bool lonlat = is_lonlat(); SpatOptions mopt(opt); if (mask) { if (!hasValues()) { mask = false; } else { mopt.filenames = opt.filenames; opt.filenames = {""}; } } SpatOptions xopt(mopt); if (lonlat) { bool disagg = false; SpatExtent extent = getExtent(); if ((out.ncol() == 1) && ((extent.xmax - extent.xmin) > 180)) { disagg = true; std::vector fact = {1,2}; out = out.disaggregate(fact, xopt); } SpatExtent e = {extent.xmin, extent.xmin+out.xres(), extent.ymin, extent.ymax}; SpatRaster onecol = out.crop(e, "near", false, xopt); SpatVector p = onecol.as_polygons(false, false, false, false, false, 0, xopt); if (p.hasError()) { out.setError(p.getError()); return out; } std::vector a = p.area(unit, true, {}); size_t nc = out.ncol(); if (disagg) { if (!out.writeStart(xopt, filenames())) { return out; } } else { if (!out.writeStart(opt, filenames())) { return out; } } for (size_t i = 0; i < out.bs.n; i++) { std::vector v; v.reserve(out.bs.nrows[i] * nc); size_t r = out.bs.row[i]; for (size_t j=0; j fact = {1,2}; opt.overwrite=true; out = tmp.aggregate(fact, "sum", true, opt); } } else { if (transform) { transform = can_transform(source[0].srs.wkt, "EPSG:4326"); } if (transform) { bool resample = false; // SpatRaster empty = out.geometry(1); size_t rcx = std::max(rcmax, 10); size_t frow = 1, fcol = 1; SpatRaster target = out.geometry(1); if ((nrow() > rcx) || (ncol() > rcx)) { resample = true; frow = (nrow() / rcx) + 1; fcol = (ncol() / rcx) + 1; out = out.aggregate({frow, fcol}, "mean", false, xopt); xopt.ncopies *= 5; if (!out.writeStart(xopt, filenames())) { return out; } } else { opt.ncopies *= 5; if (!out.writeStart(opt, filenames())) { return out; } } SpatRaster empty = out.geometry(1); SpatExtent extent = out.getExtent(); double dy = out.yres() / 2; for (size_t i = 0; i < out.bs.n; i++) { double ymax = out.yFromRow(out.bs.row[i]) + dy; double ymin = out.yFromRow(out.bs.row[i] + out.bs.nrows[i]-1) - dy; SpatExtent e = {extent.xmin, extent.xmax, ymin, ymax}; SpatRaster chunk = empty.crop(e, "near", false, xopt); SpatVector p = chunk.as_polygons(false, false, false, false, false, 0, xopt); std::vector v = p.area(unit, true, {}); if (!out.writeBlock(v, i)) return out; out.writeStop(); } if (resample) { double divr = frow*fcol; out = out.arith(divr, "/", false, false, xopt); out = out.warper(target, "", "bilinear", false, false, true, opt); } } else { if (!out.writeStart(opt, filenames())) { return out; } double u = unit == "m" ? 1 : unit == "km" ? 1000000 : 10000; double m = out.source[0].srs.to_meter(); double a = std::isnan(m) ? 1 : m; a *= xres() * yres() / u; for (size_t i = 0; i < out.bs.n; i++) { std::vector v(out.bs.nrows[i]*ncol(), a); if (!out.writeBlock(v, i)) return out; } out.writeStop(); } } if (mask) { out = out.mask(*this, false, NAN, NAN, mopt); } return(out); } std::vector> SpatRaster::sum_area(std::string unit, bool transform, bool by_value, SpatOptions &opt) { if (source[0].srs.wkt.empty()) { addWarning("unknown CRS. Results can be wrong"); transform = false; } std::vector f {"m", "km", "ha"}; if (std::find(f.begin(), f.end(), unit) == f.end()) { setError("invalid unit"); return {{NAN}}; } if (transform) { //avoid very large polygon objects if (!is_lonlat()) { transform = can_transform(getSRS("wkt"), "+proj=longlat"); } } BlockSize bs = getBlockSize(opt); if (!readStart()) { return {{NAN}}; } size_t nc = ncol(); size_t nl = nlyr(); std::vector out(nl, 0); std::vector> m; if (by_value) { m.resize(nl); } if (is_lonlat()) { SpatRaster x = geometry(1); SpatExtent extent = x.getExtent(); if ((nc == 1) && ((extent.xmax - extent.xmin) > 180)) { std::vector fact= {1,2}; x = x.disaggregate(fact, opt); } SpatExtent e = {extent.xmin, extent.xmin+x.xres(), extent.ymin, extent.ymax}; SpatRaster onecol = x.crop(e, "near", false, opt); SpatVector p = onecol.as_polygons(false, false, false, false, false, 0, opt); std::vector ar = p.area(unit, true, {}); if (!hasValues()) { out.resize(1); for (size_t i=0; i v; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); size_t blockoff = bs.nrows[i] * nc; for (size_t lyr=0; lyr v = p.area(unit, true, {}); out[0] += accumulate(v.begin(), v.end(), 0.0); } } else { for (size_t i=0; i ar = p.area(unit, true, {}); std::vector v; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); size_t blockoff = bs.nrows[i] * nc; for (size_t lyr=0; lyr v; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); size_t blockoff = bs.nrows[i] * nc; for (size_t lyr=0; lyr> dout(nl); for (size_t i=0; i> SpatRaster::sum_area_group(SpatRaster group, std::string unit, bool transform, bool by_value, SpatOptions &opt) { if (source[0].srs.wkt.empty()) { addWarning("unknown CRS. Results can be wrong"); transform = false; } if (!(hasValues() && group.hasValues())) { setError("raster has no values"); return {{NAN}}; } std::vector f {"m", "km", "ha"}; if (std::find(f.begin(), f.end(), unit) == f.end()) { setError("invalid unit"); return {{NAN}}; } BlockSize bs = getBlockSize(opt); if (!readStart()) { return {{NAN}}; } if (!group.readStart()) { return {{NAN}}; } size_t nc = ncol(); size_t nl = nlyr(); std::vector>> m(nl); if (is_lonlat()) { SpatRaster x = geometry(1); SpatExtent extent = x.getExtent(); if ((nc == 1) && ((extent.xmax - extent.xmin) > 180)) { std::vector fact= {1,2}; x = x.disaggregate(fact, opt); } SpatExtent e = {extent.xmin, extent.xmin+x.xres(), extent.ymin, extent.ymax}; SpatRaster onecol = x.crop(e, "near", false, opt); SpatVector p = onecol.as_polygons(false, false, false, false, false, 0, opt); std::vector ar = p.area(unit, true, {}); for (size_t i=0; i v, g; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); group.readValues(g, bs.row[i], bs.nrows[i], 0, ncol()); size_t blockoff = bs.nrows[i] * nc; for (size_t lyr=0; lyr ar = p.area(unit, true, {}); std::vector v, g; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); group.readValues(g, bs.row[i], bs.nrows[i], 0, ncol()); size_t blockoff = bs.nrows[i] * nc; for (size_t lyr=0; lyr v, g; readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); group.readValues(g, bs.row[i], bs.nrows[i], 0, ncol()); size_t blockoff = bs.nrows[i] * nc; for (size_t lyr=0; lyr> out(nl); for (size_t i=0; i gm = it1.second; for (auto& it2:gm) { out[i].push_back(i); out[i].push_back(it1.first); out[i].push_back(it2.first); out[i].push_back(it2.second); } } } return out; } size_t get_k(const std::vector &r, std::default_random_engine &generator, std::uniform_int_distribution<> &U) { double dmin = 0; size_t k = 0; for (size_t j=0; j<8; j++) { if (r[j] > dmin) { dmin = r[j]; k = j + 1; } else if (r[j] == dmin) { if (U(generator)) { dmin = r[j]; k = j + 1; } } } return k; } void do_flowdir(std::vector &val, std::vector &d, size_t nrow, size_t ncol, double dx, double dy, unsigned seed, bool before, bool after) { if (!before) { // val.resize(val.size() + ncol, NAN); std::vector rna(ncol, NAN); d.insert(d.begin(), rna.begin(), rna.end()); nrow++; } if (!after) { // val.resize(val.size() + ncol, NAN); d.resize(d.size()+ncol, NAN); nrow++; } std::vector r(8); std::vector p = {0, 1, 2, 4, 8, 16, 32, 64, 128}; // pow(2, j) //std::vector p2 = {0, 1, 2, 3, 4, 5, 6, 7, 8}; double dxy = sqrt(dx * dx + dy * dy); std::default_random_engine generator(seed); std::uniform_int_distribution<> U(0, 1); size_t nc1 = ncol - 1; for (size_t row=1; row<(nrow-1); row++) { //first col size_t i = row * ncol; if (std::isnan(d[i])) { val.push_back( NAN ); } else { r[0] = (d[i] - d[i+1]) / dx; r[1] = (d[i] - d[i+1+ncol]) / dxy; r[2] = (d[i] - d[i+ncol]) / dy; r[3] = NAN; r[4] = NAN; r[5] = NAN; r[6] = (d[i] - d[i-ncol]) / dy; r[7] = (d[i] - d[i+1-ncol]) / dxy; size_t k = get_k(r, generator, U); val.push_back( p[k] ); } for (size_t col=1; col(val.begin()+ncol, val.end()-ncol); } else { val = std::vector(val.begin()+ncol, val.end()); } } else if (!after) { val = std::vector(val.begin(), val.end()-ncol); } */ // if (!after) { // val.resize(val.size() + ncol, NAN); // } } void do_TRI(std::vector &val, std::vector const &d, size_t nrow, size_t ncol, bool before, bool after) { if (!before) { val.resize(val.size() + ncol, NAN); } for (size_t row=1; row< (nrow-1); row++) { val.push_back(NAN); for (size_t col=1; col< (ncol-1); col++) { size_t i = row * ncol + col; val.push_back( (fabs(d[i-1-ncol]-d[i]) + fabs(d[i-1]-d[i]) + fabs(d[i-1+ncol]-d[i]) + fabs(d[i-ncol]-d[i]) + fabs(d[i+ncol]-d[i]) + fabs(d[i+1-ncol]-d[i]) + fabs(d[i+1]-d[i]) + fabs(d[i+1+ncol]-d[i])) / 8 ); } val.push_back(NAN); } if (!after) { val.resize(val.size() + ncol, NAN); } } inline double pow2(double x) { return pow(x, 2); } void do_TRI_riley(std::vector &val, std::vector const &d, size_t nrow, size_t ncol, bool before, bool after) { if (!before) { val.resize(val.size() + ncol, NAN); } for (size_t row=1; row< (nrow-1); row++) { val.push_back(NAN); for (size_t col=1; col< (ncol-1); col++) { size_t i = row * ncol + col; val.push_back( sqrt(pow2(d[i-1-ncol]-d[i]) + pow2(d[i-1]-d[i]) + pow2(d[i-1+ncol]-d[i]) + pow2(d[i-ncol]-d[i]) + pow2(d[i+ncol]-d[i]) + pow2(d[i+1-ncol]-d[i]) + pow2(d[i+1]-d[i]) + pow2(d[i+1+ncol]-d[i])) ); } val.push_back(NAN); } if (!after) { val.resize(val.size() + ncol, NAN); } } void do_TRI_rmsd(std::vector &val, std::vector const &d, size_t nrow, size_t ncol, bool before, bool after) { if (!before) { val.resize(val.size() + ncol, NAN); } for (size_t row=1; row< (nrow-1); row++) { val.push_back(NAN); for (size_t col=1; col< (ncol-1); col++) { size_t i = row * ncol + col; val.push_back( sqrt((pow2(d[i-1-ncol]-d[i]) + pow2(d[i-1]-d[i]) + pow2(d[i-1+ncol]-d[i]) + pow2(d[i-ncol]-d[i]) + pow2(d[i+ncol]-d[i]) + pow2(d[i+1-ncol]-d[i]) + pow2(d[i+1]-d[i]) + pow2(d[i+1+ncol]-d[i]))/8) ); } val.push_back(NAN); } if (!after) { val.resize(val.size() + ncol, NAN); } } void do_TPI(std::vector &val, const std::vector &d, const size_t nrow, const size_t ncol, bool before, bool after) { if (!before) { val.resize(val.size() + ncol, NAN); } for (size_t row=1; row< (nrow-1); row++) { val.push_back(NAN); for (size_t col=1; col< (ncol-1); col++) { size_t i = row * ncol + col; val.push_back( d[i] - (d[i-1-ncol] + d[i-1] + d[i-1+ncol] + d[i-ncol] + d[i+ncol] + d[i+1-ncol] + d[i+1] + d[i+1+ncol]) / 8 ); } val.push_back(NAN); } /* if (expand) { for (size_t i=1; i < (ncol-1); i++) { val[i+add] = d[i] - (d[i-1] + d[i-1+ncol] + d[i+ncol] + d[i+1] + d[i+1+ncol]) / 5; size_t j = i+(nrow-1) * ncol; val[j+add] = d[j] - (d[j-1-ncol] + d[j-1] + d[j-ncol] + d[j+1-ncol] + d[j+1]) / 5; } for (size_t row=1; row< (nrow-1); row++) { size_t i = row * ncol; val[i+add] = d[i] - (d[i-ncol] + d[i+ncol] + d[i+1-ncol] + d[i+1] + d[i+1+ncol]) / 5; i += ncol - 1; val[i+add] = d[i] - (d[i-ncol] + d[i] + d[i+ncol] + d[i-ncol]) / 5; } size_t i = 0; val[i+add] = d[i] - (d[i+ncol] + d[i+1] + d[i+1+ncol]) / 3; i = ncol-1; val[i+add] = d[i] - (d[i+ncol] + d[i-1] + d[i-1+ncol]) / 3; i = (nrow-1)*ncol; val[i+add] = d[i] - (d[i-ncol] + d[i+1] + d[i+1-ncol]) / 3; i = (nrow*ncol)-1; val[i+add] = d[i] - (d[i-ncol] + d[i-1] + d[i-1-ncol]) / 3; } */ if (!after) { val.resize(val.size() + ncol, NAN); } } void do_roughness(std::vector &val, const std::vector &d, size_t nrow, size_t ncol, bool before, bool after) { if (!before) { val.resize(val.size() + ncol, NAN); } int incol = ncol; int a[9] = { -1-incol, -1, -1+incol, -incol, 0, incol, 1-incol, 1, 1+incol }; double min, max, v; for (size_t row=1; row< (nrow-1); row++) { val.push_back(NAN); for (size_t col=1; col< (ncol-1); col++) { size_t i = row * ncol + col; min = d[i + a[0]]; max = d[i + a[0]]; for (size_t j = 1; j < 9; j++) { v = d[i + a[j]]; if (v > max) { max = v; } else if (v < min) { min = v; } } val.push_back(max - min); } val.push_back(NAN); } if (!after) { val.resize(val.size() + ncol, NAN); } } #ifndef M_PI #define M_PI (3.14159265358979323846) #endif void to_degrees(std::vector& x, size_t start) { double adj = 180 / M_PI; for (size_t i=start; i &val, const std::vector &d, unsigned ngb, unsigned nrow, unsigned ncol, double dx, double dy, bool geo, std::vector &gy, bool degrees, bool before, bool after) { size_t start = val.size(); if (!before) { val.resize(start + ncol, NAN); } std::vector ddx; if (geo) { ddx.resize(nrow); for (size_t i=0; i &val, const std::vector &d, unsigned ngb, unsigned nrow, unsigned ncol, double dx, double dy, bool geo, std::vector &gy, bool degrees, bool before, bool after) { size_t start = val.size(); if (!before) { val.resize(start + ncol, NAN); } std::vector ddx; if (geo) { ddx.resize(nrow); for (size_t i=0; i v, unsigned neighbors, bool degrees, unsigned seed, SpatOptions &opt) { //TPI, TRI, aspect, flowdir, slope, roughness //std::sort(v.begin(), v.end()); //v.erase(std::unique(v.begin(), v.end()), v.end()); SpatRaster out = geometry(v.size()); out.setNames(v); if (nlyr() > 1) { out.setError("terrain needs a single layer object"); return out; } bool aspslope = false; std::vector f {"TPI", "TRI", "TRIriley", "TRIrmsd", "aspect", "flowdir", "slope", "roughness"}; for (size_t i=0; i val(out.bs.nrows[i] * nc, NAN); if (!out.writeBlock(val, i)) return out; } return out; } std::vector y; for (size_t i = 0; i < out.bs.n; i++) { std::vector d; bool before= false; bool after = false; size_t rrow = out.bs.row[i]; size_t rnrw = out.bs.nrows[i]; if (i > 0) { rrow--; rnrw++; before=true; } if ((out.bs.row[i] + out.bs.nrows[i]) < nrow()) { rnrw++; after = true; } readValues(d, rrow, rnrw, 0, nc); if (lonlat && aspslope) { std::vector rows(rnrw); std::iota(rows.begin(), rows.end(), rrow); y = yFromRow(rows); yr = distance_lonlat(0, 0, 0, yres()); } std::vector val; val.reserve(out.bs.nrows[i] * ncol() * v.size()); for (size_t j =0; j angle, std::vector direction, bool normalize, SpatOptions &opt) { SpatRaster out = geometry(1); if ((nlyr() != 1) || (aspect.nlyr() != 1)) { out.setError("slope and aspect should have one layer"); return out; } if (angle.empty() || direction.empty()) { out.setError("you must provide a value for aspect and direction"); return out; } std::vector nms; if ((angle.size() > 1) || (direction.size() > 1)) { recycle(angle, direction); recycle(direction, angle); //nms = opt.names; SpatOptions ops(opt); ops.ncopies *= angle.size(); size_t nl = angle.size(); out.source.resize(nl); if (ops.names.size() == nl) { nms = opt.names; } else { nms.reserve(nl); for (unsigned i=0; i slp; std::vector asp; readBlock(slp, out.bs, i); aspect.readBlock(asp, out.bs, i); if (normalize) { for (size_t i=0; i #include #include #include #include #include std::vector sort_order_nan_a(const std::vector &x){ std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return ( std::isnan(x[i]) ? false : std::isnan(x[j]) ? true : x[i] < x[j]); }); return p; } std::vector sort_order_nan_d(const std::vector &x){ std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return ( std::isnan(x[i]) ? false : std::isnan(x[j]) ? true : x[i] > x[j]); }); return p; } std::vector sort_order_nal_a(const std::vector &x){ long NAL = std::numeric_limits::min(); std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return ( x[i] == NAL ? false : x[j] == NAL ? true : x[i] < x[j]); }); return p; } std::vector sort_order_nal_d(const std::vector &x){ long NAL = std::numeric_limits::min(); std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return ( x[i] == NAL ? false : x[j] == NAL ? true : x[i] > x[j]); }); return p; } std::vector sort_order_nas_a(const std::vector &x){ std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return ( x[i] == "____NA_+" ? false : x[j] == "____NA_+" ? true : x[i] < x[j]); }); return p; } std::vector sort_order_nas_d(const std::vector &x){ std::vector p(x.size()); std::iota(p.begin(), p.end(), 0); std::sort(p.begin(), p.end(), [&](std::size_t i, std::size_t j){ return ( x[i] == "____NA_+" ? false : x[j] == "____NA_+" ? true : x[i] > x[j]); }); return p; } terra/src/gcp.cpp0000644000176200001440000000214614536376240013450 0ustar liggesusers/* #include "gdalwarper.h" #include "gdal_priv.h" #include "cpl_string.h" #include #include "spatRaster.h" SpatRaster SpatRaster::applyGCP(std::vector fx, std::vector fy, std::vector tx, std::vector ty, SpatOptions &opt) { SpatRaster out; std::vector cls = cellFromXY(fx, fy); std::vector> rc = rowColFromCell(cls); GDAL_GCP *gcps = NULL; gcps = (GDAL_GCP *) CPLRealloc (gcps, (fx.size()) * sizeof(GDAL_GCP)); GDALInitGCPs(fx.size(), gcps); for (size_t i = 0; i < fx.size(); i++){ gcps[i].dfGCPPixel = rc[1][i]; gcps[i].dfGCPLine = rc[0][i]; gcps[i].dfGCPX = tx[i]; gcps[i].dfGCPY = ty[i]; gcps[i].dfGCPZ = (float) 0.0; } GDALDatasetH hSrcDS; //hDstDS, if (!open_gdal(hSrcDS, 0, false, opt)) { out.setError("bad"); return out; } std::string srccrs = getSRS("wkt"); const char *projection = srccrs.c_str(); GDALSetGCPs(hSrcDS, fx.size(), gcps, projection); //if (!get_output_bounds(hSrcDS, srccrs, srccrs, out)) { // GDALClose( hSrcDS ); // return out; //} return out; } */ terra/src/crs.cpp0000644000176200001440000002526114733327440013466 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include //#include "spatMessages.h" #include "spatRaster.h" #include "string_utils.h" #ifndef useGDAL bool SpatSRS::set(std::string txt, std::string &msg) { proj4 = txt; wkt = ""; return true; } #else #include "ogr_spatialref.h" #include // GDALDriver bool is_ogr_error(OGRErr err, std::string &msg) { if (err != OGRERR_NONE) { switch (err) { case OGRERR_NOT_ENOUGH_DATA: msg = "OGR: Not enough data"; case OGRERR_UNSUPPORTED_GEOMETRY_TYPE: msg = "OGR: Unsupported geometry type"; case OGRERR_CORRUPT_DATA: msg = "OGR: Corrupt data"; case OGRERR_FAILURE: msg = "OGR: Invalid index"; default: msg = "OGR: Error"; } return true; } return false; } bool wkt_from_spatial_reference(const OGRSpatialReference srs, std::string &wkt, std::string &msg) { char *cp; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OGRErr err = srs.exportToWkt(&cp, options); #else OGRErr err = srs.exportToWkt(&cp); #endif if (is_ogr_error(err, msg)) { CPLFree(cp); return false; } wkt = std::string(cp); CPLFree(cp); return true; } bool prj_from_spatial_reference(const OGRSpatialReference srs, std::string &prj, std::string &msg) { char *cp; OGRErr err = srs.exportToProj4(&cp); if (is_ogr_error(err, msg)) { CPLFree(cp); return false; } prj = std::string(cp); CPLFree(cp); return true; } bool string_from_spatial_reference(const OGRSpatialReference *srs, std::vector &out, std::string &msg) { out = std::vector(2, ""); char *cp; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=NO", "FORMAT=WKT2", NULL }; OGRErr err = srs->exportToWkt(&cp, options); #else OGRErr err = srs->exportToWkt(&cp); #endif if (is_ogr_error(err, msg)) { CPLFree(cp); return false; } out[0] = std::string(cp); err = srs->exportToProj4(&cp); if (is_ogr_error(err, msg)) { CPLFree(cp); return false; } out[1] = std::string(cp); CPLFree(cp); return true; } /* bool SpatSRS::set(OGRSpatialReference *poSRS, std::string &msg) { wkt=""; proj4=""; if (poSRS) { if (! wkt_from_spatial_reference(poSRS, wkt, msg)) { msg = "can't get wkt from srs"; return false; }; if (! prj_from_spatial_reference(poSRS, proj4, msg)) { msg = "can't get proj4 from srs"; return false; }; } return true; } */ double SpatSRS::to_meter() { double out; OGRSpatialReference x; if (wkt.size() < 2) { return NAN; } OGRErr erro = x.SetFromUserInput(wkt.c_str()); if (erro != OGRERR_NONE) { return NAN; } if (x.IsGeographic()) { return 0; } out = x.GetLinearUnits(); return out; } bool SpatSRS::m_dist(double &m, bool lonlat, std::string unit) { m = 1; if (!lonlat) { m = to_meter(); m = std::isnan(m) ? 1 : m; } std::vector ss {"m", "km"}; if (std::find(ss.begin(), ss.end(), unit) == ss.end()) { return false; } if (unit == "km") { m /= 1000; } return true; } bool SpatSRS::is_same(SpatSRS other, bool ignoreempty) { if (ignoreempty) { if (is_empty() || other.is_empty()) { return true; } } OGRSpatialReference x, y; OGRErr erro = x.SetFromUserInput(wkt.c_str()); if (erro != OGRERR_NONE) { return false; } erro = y.SetFromUserInput(other.wkt.c_str()); if (erro != OGRERR_NONE) { return false; } return x.IsSame(&y); } bool SpatSRS::is_same(std::string other, bool ignoreempty) { if (wkt.empty() && other.empty()) { return true; } else if (wkt.empty() || other.empty()) { return ignoreempty ? true : false; } OGRSpatialReference x, y; OGRErr erro = x.SetFromUserInput(wkt.c_str()); if (erro != OGRERR_NONE) { return false; } erro = y.SetFromUserInput(other.c_str()); if (erro != OGRERR_NONE) { return false; } return x.IsSame(&y); } bool SpatSRS::is_lonlat() { OGRSpatialReference x; if (wkt.size() < 2) { return false; } OGRErr erro = x.SetFromUserInput(wkt.c_str()); if (erro != OGRERR_NONE) { return false; } return x.IsGeographic(); } bool SpatSRS::set(std::string txt, std::string &msg) { wkt=""; proj4=""; lrtrim(txt); if (txt.empty()) { return true; } else { OGRSpatialReference srs; OGRErr e = srs.SetFromUserInput(txt.c_str()); if (is_ogr_error(e, msg)) { msg = "empty srs"; return false; } if (! wkt_from_spatial_reference(srs, wkt, msg)) { msg = "can't get wkt from srs"; return false; }; if (! prj_from_spatial_reference(srs, proj4, msg)) { msg = ""; //msg = "can't get proj4 from srs"; //return false; }; return true; } return false; } bool wkt_from_string(std::string input, std::string& wkt, std::string& msg) { lrtrim(input); wkt=""; bool success = false; if (!input.empty()) { OGRSpatialReference srs; OGRErr e = srs.SetFromUserInput(input.c_str()); if (is_ogr_error(e, msg)) { return false; } success = wkt_from_spatial_reference(srs, wkt, msg); } return success; } void EmptyErrorHandler(CPLErr eErrClass, int errNo, const char *msg) { // do nothing } bool can_transform(std::string fromCRS, std::string toCRS) { OGRSpatialReference source, target; const char *pszDefFrom = fromCRS.c_str(); OGRErr erro = source.SetFromUserInput(pszDefFrom); if (erro != OGRERR_NONE) { return false; } const char *pszDefTo = toCRS.c_str(); erro = target.SetFromUserInput(pszDefTo); if (erro != OGRERR_NONE) { return false; } OGRCoordinateTransformation *poCT; CPLPushErrorHandler(EmptyErrorHandler); try{ poCT = OGRCreateCoordinateTransformation(&source, &target); } catch(...) { return false; } CPLPopErrorHandler(); if (poCT == NULL) { OCTDestroyCoordinateTransformation(poCT); return false; } OCTDestroyCoordinateTransformation(poCT); return true; } SpatMessages transform_coordinates(std::vector &x, std::vector &y, std::string fromCRS, std::string toCRS) { SpatMessages m; OGRSpatialReference source, target; const char *pszDefFrom = fromCRS.c_str(); OGRErr erro = source.SetFromUserInput(pszDefFrom); if (erro != OGRERR_NONE) { m.setError("input crs is not valid"); return m; } const char *pszDefTo = toCRS.c_str(); erro = target.SetFromUserInput(pszDefTo); if (erro != OGRERR_NONE) { m.setError("output crs is not valid"); return m; } OGRCoordinateTransformation *poCT; poCT = OGRCreateCoordinateTransformation(&source, &target); if( poCT == NULL ) { m.setError( "Cannot do this coordinate transformation" ); return (m); } unsigned failcount = 0; for (size_t i=0; i < x.size(); i++) { if( !poCT->Transform( 1, &x[i], &y[i] ) ) { x[i] = NAN; y[i] = NAN; failcount++; } } OCTDestroyCoordinateTransformation(poCT); if (failcount > 0) { m.addWarning(std::to_string(failcount) + " failed transformations"); } return m; } std::vector SpatVector::project_xy(std::vector x, std::vector y, std::string fromCRS, std::string toCRS) { msg = transform_coordinates(x, y, fromCRS, toCRS); x.insert(x.end(), y.begin(), y.end()); return x; } void transform_coordinates_partial(std::vector &x, std::vector &y, OGRCoordinateTransformation *poCT) { std::vector X, Y; X.reserve(x.size()); Y.reserve(y.size()); std::vector fails; for (size_t i=0; i < x.size(); i++) { if( poCT->Transform( 1, &x[i], &y[i] ) ) { X.push_back(x[i]); Y.push_back(y[i]); } } x = X; y = Y; } SpatVector SpatVector::project(std::string crs, bool partial) { bool remove_empty = false; SpatVector s; s.reserve(size()); #ifndef useGDAL s.setError("GDAL is not available"); return(s); #else OGRSpatialReference source, target; std::string vsrs = getSRS("wkt"); const char *pszDefFrom = vsrs.c_str(); OGRErr erro = source.SetFromUserInput(pszDefFrom); if (erro != OGRERR_NONE) { s.setError("input crs is not valid"); return s; } const char *pszDefTo = crs.c_str(); erro = target.SetFromUserInput(pszDefTo); if (erro != OGRERR_NONE) { s.setError("output crs is not valid"); return s; } //CPLSetConfigOption("OGR_CT_FORCE_TRADITIONAL_GIS_ORDER", "YES"); OGRCoordinateTransformation *poCT; poCT = OGRCreateCoordinateTransformation(&source, &target); if( poCT == NULL ) { s.setError( "Cannot do this transformation" ); return(s); } s.setSRS(crs); s.df = df; std::vector keeprows; if (partial) { #if GDAL_VERSION_MAJOR >= 2 && GDAL_VERSION_MINOR > 1 poCT->SetEmitErrors(false); #endif std::string gt = type(); size_t minpts = gt == "polygons" ? 3 : (gt == "lines" ? 2 : 1); for (size_t i=0; i < size(); i++) { SpatGeom g = getGeom(i); SpatGeom gg; gg.gtype = g.gtype; bool empty = true; for (size_t j=0; j < g.size(); j++) { SpatPart p = g.getPart(j); transform_coordinates_partial(p.x, p.y, poCT); if (p.x.size() >= minpts) { SpatPart pp(p.x, p.y); if (p.hasHoles()) { for (size_t k=0; k < p.nHoles(); k++) { SpatHole h = p.getHole(k); transform_coordinates_partial(h.x, h.y, poCT); if (h.x.size() >= 3) { pp.addHole(h.x, h.y); } } } gg.addPart(pp); empty = false; } } if (empty) { if (remove_empty) { keeprows.push_back(i); } else { s.addGeom(gg); } } else { s.addGeom(gg); } } } else { for (size_t i=0; i < size(); i++) { SpatGeom g = getGeom(i); SpatGeom gg; gg.gtype = g.gtype; bool empty = true; for (size_t j=0; j < g.size(); j++) { SpatPart p = g.getPart(j); if (poCT->Transform(p.x.size(), &p.x[0], &p.y[0]) ) { SpatPart pp(p.x, p.y); if (p.hasHoles()) { for (size_t k=0; k < p.nHoles(); k++) { SpatHole h = p.getHole(k); if (poCT->Transform(h.x.size(), &h.x[0], &h.y[0])) { pp.addHole(h.x, h.y); } } } gg.addPart(pp); empty = false; } } if (empty) { if (remove_empty) { keeprows.push_back(i); } else { s.addGeom(gg); } } else { s.addGeom(gg); } } } OCTDestroyCoordinateTransformation(poCT); if (remove_empty) { s.df = df.subset_rows(keeprows); } else { s.df = df; } #endif return s; } #endif terra/src/spatSources.cpp0000644000176200001440000004046414720502767015217 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include "spatRaster.h" /* #include "string_utils.h" void SpatRasterSource::fsopen(std::string filename) { std::string grifile = setFileExt(filename, ".gri"); std::ofstream fstr(grifile, std::ios::out | std::ios::binary); *ofs = &fstr; } bool SpatRasterSource::fswrite(std::vector &v) { unsigned sz = v.size() * sizeof(double); bool result = (*ofs).write(reinterpret_cast(&v[0]), sz); return result; } void SpatRasterSource::fsclose() { (*ofs).close(); } */ SpatRasterSource::SpatRasterSource() { open_write = false; open_read = false; } SpatRaster SpatRaster::combineSources(SpatRaster &x, bool warn) { SpatRaster out = geometry(); if (!hasValues()) { if (!x.hasValues()) { if (out.compare_geom(x, false, false, 0.1)) { out.source.insert(out.source.end(), x.source.begin(), x.source.end()); out.setNames(out.getNames()); } else { out = x.deepCopy(); if (warn) { out.addWarning("both rasters were empty, but had different geometries. The first one was ignored"); } } } else { out = x.deepCopy(); if (warn) { out.addWarning("the first raster was empty and ignored"); } } return out; } if (!out.compare_geom(x, false, false, 0.1)) { return out; } out = deepCopy(); if (!x.hasValues()) { out.addWarning("you cannot add SpatRaster with no values to one that has values"); return(out); } out.checkTime(x); out.source.insert(out.source.end(), x.source.begin(), x.source.end()); // to make names unique (not great if called several times //out.setNames(out.getNames()); return(out); } void SpatRaster::combine(SpatRaster &x) { if (!compare_geom(x, false, false, 0.1)) { return; } bool hv = hasValues(); if (hv != x.hasValues()) { setError("combined sources must all have values; or none should have values"); return; } checkTime(x); source.insert(source.end(), x.source.begin(), x.source.end()); //setNames(getNames()); return; } void SpatRaster::checkTime(SpatRaster &x) { if (!hasTime()) { std::vector time; x.setTime(time, "remove", ""); return; } if (!x.hasTime()) { std::vector time; setTime(time, "remove", ""); return; } std::string s = source[0].timestep; std::string xs = x.source[0].timestep; if (s == xs) return; if ((s == "days") && (xs == "seconds")) { x.source[0].timestep = "days"; } else if ((s == "seconds") && (xs == "days")) { for (size_t i=0; i time; setTime(time, "remove", ""); x.setTime(time, "remove", ""); } } void SpatRaster::addSource(SpatRaster &x, bool warn, SpatOptions &opt) { if (!hasValues()) { if (!x.hasValues()) { if (compare_geom(x, false, true, 0.1, true)) { source.insert(source.end(), x.source.begin(), x.source.end()); } else { source = x.source; if (warn) { addWarning("both rasters were empty, but had different geometries. The first one was ignored"); } } } else { source = x.source; if (warn) { addWarning("the first raster was empty and was ignored"); } } return; } if (compare_geom(x, false, true, 0.1, true)) { if (!x.hasValues()) { x = x.init({NAN}, opt); } checkTime(x); source.insert(source.end(), x.source.begin(), x.source.end()); } } size_t SpatRaster::nsrc() { return source.size(); } int SpatRaster::sourceFromLyr(size_t lyr) { if (lyr >= nlyr()) { return(-1); } size_t nsrc = 0; size_t nlyrs = -1; for (size_t i=0; i= lyr) break; nsrc++; } return nsrc; } std::vector SpatRaster::nlyrBySource() { std::vector lyrs(source.size()); for (size_t i=0; i SpatRaster::lyrsBySource() { std::vector lyrs(nlyr()); size_t start = 0; for (size_t i=0; i SpatRaster::findLyr(size_t lyr) { std::vector sl(2); size_t nlyrs = 0; size_t start = 0; bool done = false; for (size_t i=0; i= lyr) { sl[0] = i; for (size_t j=start; j SpatRaster::getBands() { std::vector out; for (size_t i=0; i SpatRaster::sourcesFromLyrs(std::vector lyrs) { std::vector s(lyrs.size()); std::vector slyrs = lyrsBySource(); for (size_t i=0; i &v, size_t lyr) { size_t nc ; if (hasWindow) { nc = window.full_ncol * window.full_nrow; } else { nc = nrow * ncol; } size_t start = lyr * nc; v = std::vector(values.begin()+start, values.begin()+start+nc); } */ void SpatRasterSource::appendValues(std::vector &v, size_t lyr) { size_t nc ; if (hasWindow) { nc = window.full_ncol * window.full_nrow; } else { nc = nrow * ncol; } size_t start = lyr * nc; v.insert(v.end(), values.begin()+start, values.begin()+start+nc); } bool SpatRasterSource::in_order() { if (memory) return true; if (nlyr != nlyrfile) return false; for (size_t i=0; i SpatRasterSource::subset(std::vector lyrs) { SpatRasterSource SpatRasterSource::subset(std::vector lyrs) { size_t nl = lyrs.size(); bool all = true; if (lyrs.size() == nlyr) { for (size_t i=0; i validLayers( std::vector lyrs , size_t nl) { size_t s = lyrs.size(); for (size_t i=0; i= nl) { lyrs.erase(lyrs.begin() + j); } } /* or size_t s = lyrs.size() - 1; for (long i=s; i>=0; i--) { if ((lyrs[i] < 0) | (lyrs[i] >= nl)) { lyrs.erase(lyrs.begin() + i); } } */ return lyrs; } SpatRaster SpatRaster::subset(std::vector lyrs, SpatOptions &opt) { SpatRaster out = geometry(1); out.source.resize(0); size_t oldsize = lyrs.size(); lyrs = validLayers(lyrs, nlyr()); if (lyrs.empty()) { out.setError("no (valid) layer selected"); return(out); } else if (lyrs.size() != oldsize) { out.addWarning("ignored " + std::to_string(oldsize - lyrs.size()) + " invalid layer reference(s)"); } std::vector srcs = sourcesFromLyrs(lyrs); size_t ss = srcs[0]; std::vector slyr; std::vector lyrbys = nlyrBySource(); // SpatRasterSource rs; size_t offset = 0; for (size_t i=0; i rem; for (size_t i=1; i= 0; i--) { source.erase(source.begin()+i); } } SpatRaster SpatRaster::collapse_sources() { SpatRaster out; std::vector src; SpatRasterSource s = source[0]; for (size_t i=1; i. #include #include #include "spatVector.h" #ifdef useGDAL #include "gdal_priv.h" #endif #ifdef useRcpp #include #endif typedef long long int_64; class SpatCategories { public: virtual ~SpatCategories(){} SpatDataFrame d; int index = 0; bool combine(SpatCategories &x); bool concatenate(SpatCategories &x); }; class SpatWindow { public: virtual ~SpatWindow(){} SpatExtent full_extent; size_t full_ncol, full_nrow, off_row, off_col; bool expanded = false; std::vector expand; }; class SpatRasterSource { private: // std::ofstream ofs; public: #ifdef useGDAL GDALDataset* gdalconnection; #if GDAL_VERSION_MAJOR >= 3 && GDAL_VERSION_MINOR >= 1 GDALMDArrayH gdalmdarray; #endif #endif bool open_read=false; bool open_write=false; SpatRasterSource(); virtual ~SpatRasterSource(){} // void fsopen(std::string filename); // bool fswrite(std::vector &v); // void fsclose(); size_t ncol, nrow; size_t nlyr; size_t nlyrfile = 0; SpatExtent extent; bool extset=false; bool rotated=false; bool flipped=false; bool hasWindow=false; SpatWindow window; bool multidim = false; size_t m_ndims; std::vector m_dims; std::vector m_dimnames; // std::vector m_dimstart; // std::vector m_dimend; std::vector m_counts; std::vector m_order; std::vector m_subset; bool m_hasNA = false; double m_missing_value; std::vector> bmdata; std::vector smdata; //std::vector crs = std::vector(2, ""); SpatSRS srs; std::vector layers; // layer names std::vector names; // data source (sds) has one "variable name" / long_name std::string source_name; std::string source_name_long; std::vector time; std::string timestep = "seconds"; std::string timezone = ""; bool hasTime = false; std::vector depth; std::vector unit; bool hasUnit = false; //std::vector< std::vector values; std::vector values; //std::vector ivalues; //std::vector bvalues; // unsigned char datatype; std::vector blockrows; std::vector blockcols; std::vector hasRange; std::vector range_min; std::vector range_max; // std::vector hasAttributes; // std::vector atts; // std::vector attsIndex; std::vector hasCategories; std::vector cats; std::vector valueType; // 0:double; 1:int; 3:bool //std::vector dataType; std::vector hasColors; std::vector cols; SpatDataFrame legend; bool memory=true; bool hasValues=false; std::string filename; std::string driver; std::string dtype; std::vector open_ops; std::vector open_drivers; // user set for reading: bool hasNAflag = false; double NAflag = NAN; std::vector has_scale_offset; std::vector scale; std::vector offset; // std::vector subset(std::vector lyrs); SpatRasterSource subset(std::vector lyrs); // void getValues(std::vector &v, unsigned lyr, SpatOptions &opt); void appendValues(std::vector &v, size_t lyr); void setRange(); void resize(size_t n); void reserve(size_t n); bool in_order(); bool combine_sources(const SpatRasterSource &x); bool combine(SpatRasterSource &x); bool parameters_changed = false; void set_names_time_ncdf(std::vector metadata, std::vector> bandmeta, std::string &msg); void set_names_time_grib(std::vector> bandmeta, std::string &msg); void set_names_time_tif(std::vector> bandmeta, std::string &msg); std::vector> lyrTags; void addLyrTag(size_t slyr, std::string name, std::string value); }; class BlockSize { public: virtual ~BlockSize(){} std::vector row; std::vector nrows; size_t n; }; class SpatRaster { private: std::string copy_driver = ""; std::string copy_filename = ""; std::vector gdal_options; bool compute_stats = true; bool gdal_stats = false; bool gdal_approx = true; bool gdal_minmax = true; protected: SpatExtent window; public: #ifdef useRcpp SpatProgress pbar; bool progressbar = false; #endif //////////////////////////////////////////////////// // properties and property-like methods for entire object //////////////////////////////////////////////////// std::vector source; BlockSize bs; //BlockSize getBlockSize(unsigned n, double frac, unsigned steps=0); BlockSize getBlockSize(SpatOptions &opt); std::vector mem_needs(SpatOptions &opt); SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } void setMessage(std::string s) { msg.setMessage(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} std::string getMessage() { return msg.getMessage();} std::map user_tags; bool addTag(std::string name, std::string value); bool removeTag(std::string name); std::string getTag(std::string name); std::vector getTags(); void addLyrTags(std::vector lyrs, std::vector names, std::vector values); bool removeLyrTags(); bool removeLyrTag(size_t lyr, std::string name); std::string getLyrTag(size_t lyr, std::string name); std::vector getLyrTags(std::vector lyrs); std::vector> getAllLyrTags(); //double NA = std::numeric_limits::quiet_NaN(); size_t ncol(); size_t nrow(); SpatExtent getExtent(); void setExtent(SpatExtent e); // void setExtent(SpatExtent ext, bool keepRes=false, std::string snap=""); // also set it for sources? void setExtent(SpatExtent ext, bool keepRes, bool no_expand, std::string snap); SpatVector dense_extent(bool inside, bool geobounds); //std::vector getCRS(); //void setCRS(std::vector _crs); std::string getSRS(std::string x); bool setSRS(std::string crs); bool rgb=false; std::string rgbtype; std::vector rgblyrs; bool setRGB(int r, int g, int b, int alpha, std::string type); std::vector getRGB(); void removeRGB(); /* #ifdef useGDAL bool setSRS(OGRSpatialReference *poSRS, std::string &msg) { #endif */ bool is_lonlat(); bool could_be_lonlat(); bool is_global_lonlat(); int ns_polar(); std::vector is_flipped(); std::vector resolution(); SpatRaster setResolution(double xres, double yres); double ncell() { return nrow() * ncol(); } double size() { return ncol() * nrow() * nlyr() ; } std::vector is_rotated(); double xres(); double yres(); std::vector origin(); size_t nlyr(); // only no values allowed with a single SpatRasterSource bool hasValues(); std::vector getValues(long lyr, SpatOptions &opt); bool getValuesSource(size_t src, std::vector &out); bool setValues(std::vector &v, SpatOptions &opt); #ifdef useRcpp bool setValuesRcpp(Rcpp::NumericVector &v, SpatOptions &opt); #endif bool replaceCellValues(std::vector &cells, std::vector &v, bool bylyr, SpatOptions &opt); bool replaceCellValuesLayer(std::vector layers, std::vector &cells, std::vector &v, bool bylyr, SpatOptions &opt); void setRange(SpatOptions &opt, bool force); //////////////////////////////////////////////////// // property like methods for RasterSources //////////////////////////////////////////////////// std::vector filenames(); bool isSource(std::string filename); std::vector inMemory(); //////////////////////////////////////////////////// // property like methods for layers //////////////////////////////////////////////////// std::vector hasRange(); std::vector range_min(); std::vector range_max(); std::vector getValueType(bool unique); bool setValueType(unsigned char d); std::vector getNames(); bool setNames(std::vector names, bool make_valid=false); std::vector getSourceNames(); bool setSourceNames(std::vector); std::vector getLongSourceNames(); bool setLongSourceNames(std::vector); bool hasTime(); std::vector getTime(); std::string getTimeStep(); std::string getTimeZone(); std::vector getTimeStr(bool addstep, std::string timesep); bool setTime(std::vector time, std::string step, std::string zone); std::vector getDepth(); bool setDepth(std::vector depths); bool hasUnit(); std::vector getUnit(); bool setUnit(std::vector units); bool setNAflag(std::vector flag); std::vector getNAflag(); std::vector> getMetadata(bool layers); //////////////////////////////////////////////////// // constructors //////////////////////////////////////////////////// SpatRaster(); SpatRaster(size_t nr, size_t nc, size_t nl, SpatExtent ext, std::string crs); SpatRaster(std::vector rcl, std::vector ext, std::string crs); SpatRaster(std::vector fname, std::vector subds, std::vector subdsname, bool multi, std::vector drivers, std::vector options, std::vector xyz, bool noflip); SpatRaster(std::string fname, std::vector subds, std::vector subdsname, std::vector drivers, std::vector options); SpatRaster(SpatRasterSource &s); virtual ~SpatRaster(){} void setSource(SpatRasterSource &s); void setSources(std::vector &s); //SpatRaster(const SpatRaster& x); SpatRaster deepCopy(); SpatRaster hardCopy(SpatOptions &opt); SpatRaster geometry(long nlyrs=-1, bool properties=false, bool time=true, bool units=false, bool tags=false); SpatRaster geometry_opt(long nlyrs, bool properties, bool time, bool units, bool tags, bool datatype, SpatOptions &opt); bool constructFromFile(std::string fname, std::vector subds, std::vector subdsname, std::vector drivers, std::vector options, bool noflip); bool constructFromFileMulti(std::string fname, std::vector sub, std::vector subname, std::vector drivers, std::vector options, std::vector xyz); bool constructFromSDS(std::string filename, std::vector meta, std::vector subds, std::vector subdsname, std::vector options, std::string driver, bool noflip); //SpatRaster fromFiles(std::vector fname, std::vector subds, std::vector subdsname, std::string drivers, std::vector options); // bool constructFromNCDFsds(std::string filename, std::vector meta, std::vector subds, std::vector subdsname); void addSource(SpatRaster &x, bool warn, SpatOptions &opt); void checkTime(SpatRaster &x); SpatRaster combineSources(SpatRaster &x, bool warn); void combine(SpatRaster &x); SpatRaster subsetSource(size_t snr); SpatRaster subset(std::vector lyrs, SpatOptions &opt); SpatRaster replace(SpatRaster x, size_t layer, SpatOptions &opt); //////////////////////////////////////////////////// // helper methods //////////////////////////////////////////////////// std::vector getAllFiles(); void gdalogrproj_init(std::string path); bool compare_geom(SpatRaster &x, bool lyrs, bool crs, double tol, bool warncrs=false, bool ext=true, bool rowcol=true, bool res=false); bool compare_origin(std::vector x, double tol); bool shared_basegeom(SpatRaster &x, double tol, bool test_overlap); std::vector cellFromXY (std::vector x, std::vector y, double missing=NAN); double cellFromXY(double x, double y, double missing=NAN); std::vector cellFromRowCol(std::vector row, std::vector col); double cellFromRowCol(int_64 row, int_64 col); std::vector cellFromRowColCombine(std::vector row, std::vector col); double cellFromRowColCombine(int_64 row, int_64 col); std::vector yFromRow(const std::vector &row); double yFromRow(int_64 row); std::vector xFromCol(const std::vector &col); double xFromCol(int_64 col); std::vector colFromX(const std::vector &x); int_64 colFromX(double x); std::vector rowFromY(const std::vector &y); int_64 rowFromY(double y); void xyFromCell( std::vector> &xy ); std::vector> xyFromCell( std::vector &cell); std::vector> xyFromCell( double cell); std::vector> rowColFromCell(std::vector &cell); std::vector rowColFromY(std::vector &y); std::vector> rowColFromExtent(SpatExtent e); std::vector> coordinates(bool narm, bool nall, SpatOptions &opt); std::vector sourcesFromLyrs(std::vector lyrs); int sourceFromLyr(size_t lyr); std::vector findLyr(size_t lyr); std::vector getBands(); std::vector nlyrBySource(); std::vector lyrsBySource(); size_t nsrc(); SpatRaster makeCategorical(long layer, SpatOptions &opt); bool createCategories(size_t layer, SpatOptions &opt); std::vector hasCategories(); bool setCategories(size_t layer, SpatDataFrame d, size_t index); bool removeCategories(long layer); std::vector getCategories(); SpatCategories getLayerCategories(size_t layer); std::vector getLabels(size_t layer); bool setLabels(size_t layer, std::vector value, std::vector labels, std::string name); int getCatIndex(size_t layer); bool setCatIndex(size_t layer, int index); bool hasLegend(); bool setLegend(SpatDataFrame x); SpatDataFrame getLegend(); bool hasScaleOffset(); bool setScaleOffset(std::vector sc, std::vector of); std::vector> getScaleOffset(); //bool setAttrIndex(size_t layer, int i); //std::vector getAttrIndex(); //void createAttributes(size_t layer); //std::vector hasAttributes(); //void setAttributes(size_t layer, SpatDataFrame df); //std::vector getAttributes(); //SpatDataFrame getLayerAttributes(size_t layer); std::vector hasColors(); std::vector getColors(); bool setColors(size_t layer, SpatDataFrame cols); bool removeColors(size_t layer); double valuesCell(double); double valuesCell(int, int); std::vector valuesCell(std::vector); std::vector valuesRow(int); //////////////////////////////////////////////////// // read and write //////////////////////////////////////////////////// bool valid_sources(bool files=true, bool rotated=true); bool readStart(); std::vector readValuesR(size_t row, size_t nrows, size_t col, size_t ncols); void readValues(std::vector &out, size_t row, size_t nrows, size_t col, size_t ncols); void readValuesWhileWriting(std::vector &out, size_t row, size_t nrows, size_t col, size_t ncols); void readChunkMEM(std::vector &out, size_t src, size_t row, size_t nrows, size_t col, size_t ncols); void readBlock(std::vector &v, BlockSize bs, size_t i){ // inline readValues(v, bs.row[i], bs.nrows[i], 0, ncol()); } void readBlock2(std::vector> &v, BlockSize bs, size_t i); void readBlockIP(std::vector &x, BlockSize bs, size_t i); std::vector readExtent(SpatExtent e); bool readStop(); bool readAll(); bool writeStart(SpatOptions &opt, std::vector srcnames); bool writeBlock(std::vector &v, size_t i){ // inline // for debugging? // if (bs.row.size() <= i) { // setError("invalid block number"); return false; // } return writeValues(v, bs.row[i], bs.nrows[i]); } bool writeValues(std::vector &vals, size_t startrow, size_t nrows); bool writeValuesRect(std::vector &vals, size_t startrow, size_t nrows, size_t startcol, size_t ncols); bool writeValuesRectRast(SpatRaster &r, SpatOptions& opt); //bool writeValues2(std::vector> &vals, size_t startrow, size_t nrows); bool writeStop(); bool writeHDR(std::string filename); std::string make_vrt(std::vector filenames, std::vector options, SpatOptions &opt); bool write_aux_json(std::string filename); //bool writeStartGDAL(std::string filename, std::string driver, std::string datatype, bool overwrite, SpatOptions &opt); bool writeStartGDAL(SpatOptions &opt, const std::vector &srcnames); bool fillValuesGDAL(double fillvalue); bool writeValuesGDAL(std::vector &vals, size_t startrow, size_t nrows, size_t startcol, size_t ncols); bool writeStopGDAL(); bool getTempFile(std::string &filename, std::string &driver, SpatOptions& opt); bool readStartMulti(size_t src); bool readStopMulti(size_t src); bool readValuesMulti(std::vector &out, size_t src, size_t row, size_t nrows, size_t col, size_t ncols); //bool writeStartBinary(std::string filename, std::string datatype, std::string bandorder, bool overwrite); //bool writeValuesBinary(std::vector &vals, size_t startrow, size_t nrows, size_t startcol, size_t ncols); bool writeValuesMem(std::vector &vals, size_t startrow, size_t nrows); bool writeValuesMemRect(std::vector &vals, size_t startrow, size_t nrows, size_t startcol, size_t ncols); // binary (flat) source //std::vector readValuesBinary(size_t src, size_t row, size_t nrows, size_t col, size_t ncols); //std::vector readSampleBinary(size_t src, size_t srows, size_t scols); //std::vector> readCellsBinary(size_t src, std::vector cells); // gdal source std::vector readValuesGDAL(size_t src, size_t row, size_t nrows, size_t col, size_t ncols, int lyr = -1); std::vector readGDALsample(size_t src, size_t srows, size_t scols, bool overview); void readRowColGDAL(size_t src, std::vector> &out, size_t outstart, std::vector &rows, const std::vector &cols); // std::vector readRowColGDALFlat(size_t src, std::vector &rows, const std::vector &cols); // std::vector readRowColBlockFlat(size_t src, std::vector &rows, std::vector &cols); // std::vector> readRowColBlock(size_t src, std::vector &rows, std::vector &cols); void readRowColBlock(size_t src, std::vector> &out, size_t outstart, std::vector &rows, std::vector &cols); bool readStartGDAL(size_t src); bool readStopGDAL(size_t src); void readChunkGDAL(std::vector &data, size_t src, size_t row, size_t nrows, size_t col, size_t ncols); bool setWindow(SpatExtent x); bool removeWindow(); std::vector hasWindow(); void openFS(std::string const &filename); SpatRaster writeRaster(SpatOptions &opt); SpatRaster writeTempRaster(SpatOptions &opt); bool writeDelim(std::string filename, std::string delim, bool cell, bool xy, SpatOptions &opt); bool update_meta(bool names, bool crs, bool ext, SpatOptions &opt); //SpatRaster writeRasterGDAL(std::string filename, std::string format, std::string datatype, bool overwrite, SpatOptions &opt); //SpatRaster writeRasterBinary(std::string filename, std::string datatype, std::string bandorder, bool overwrite); //bool checkFormatRequirements(const std::string &driver, std::string &filename); bool canProcessInMemory(SpatOptions &opt); size_t chunkSize(SpatOptions &opt); void fill(double x); SpatRaster sources_to_disk(std::vector &tmpfs, bool unique, SpatOptions &opt); bool sources_from_file(); std::vector getFileBlocksize(); //////////////////////////////////////////////////// // main methods //////////////////////////////////////////////////// SpatRaster collapse_sources(); void collapse(); SpatRaster rectify(std::string method, SpatRaster aoi, unsigned useaoi, bool snap, SpatOptions &opt); std::vector adjacent(std::vector cells, std::string directions, bool include); std::vector adjacentMat(std::vector cells, std::vector mat, std::vector dim, bool include); SpatRaster aggregate(std::vector fact, std::string fun, bool narm, SpatOptions &opt); SpatExtent align(SpatExtent e, std::string snap); SpatRaster rst_area(bool mask, std::string unit, bool transform, int rcmax, SpatOptions &opt); std::vector> sum_area(std::string unit, bool transform, bool by_value, SpatOptions &opt); std::vector> sum_area_group(SpatRaster group, std::string unit, bool transform, bool by_value, SpatOptions &opt); SpatRaster surfaceArea(SpatOptions &opt); SpatRaster roll(size_t n, std::string fun, std::string type, bool circular, bool narm, SpatOptions &opt); SpatRaster arith(SpatRaster x, std::string oper, bool falseNA, SpatOptions &opt); SpatRaster arith(double x, std::string oper, bool reverse, bool falseNA, SpatOptions &opt); SpatRaster arith(std::vector x, std::string oper, bool reverse, bool falseNA, SpatOptions &opt); SpatRaster arith_m(std::vector x, std::string oper, std::vector dim, bool reverse, SpatOptions &opt); SpatRaster apply(std::vector ind, std::string fun, bool narm, std::vector nms, std::vector time, std::string timestep, std::string timezone, SpatOptions &opt); SpatRaster rapply(SpatRaster x, double first, double last, std::string fun, bool clamp, bool narm, bool circular, SpatOptions &opt); std::vector> rappvals(SpatRaster x, double first, double last, bool clamp, bool all, double fill, size_t startrow, size_t nrows, bool circular); SpatRaster fill_range(long limit, bool circular, SpatOptions &opt); SpatVector as_polygons(bool round, bool dissolve, bool values, bool narm, bool nall, int digits, SpatOptions &opt); SpatVector polygonize(bool round, bool values, bool narm, bool aggregate, int digits, SpatOptions &opt); SpatVector as_lines(SpatOptions &opt); SpatVector as_points(bool values, bool narm, bool nall, SpatOptions &opt); std::vector> as_points_value(const double& target, SpatOptions &opt); std::vector> cells_notna(SpatOptions &opt); std::vector cells_notna_novalues(SpatOptions &opt); SpatVector as_multipoints(bool narm, bool nall, SpatOptions &opt); SpatRaster atan_2(SpatRaster x, SpatOptions &opt); void bilinearValues(std::vector> &out, const std::vector &x, const std::vector &y); std::vector bilinearCells(const std::vector &x, const std::vector &y); void fourCellsFromXY(std::vector &out, const std::vector &x, const std::vector &y); SpatRaster buffer(double d, double background, SpatOptions &opt); SpatRaster clamp(std::vector low, std::vector high, bool usevalue, SpatOptions &opt); SpatRaster clamp_raster(SpatRaster &x, SpatRaster &y, std::vector low, std::vector high, bool usevalue, SpatOptions &opt); SpatRaster clamp_ts(bool min, bool max, SpatOptions &opt); SpatRaster combineCats(SpatRaster x, SpatOptions &opt); SpatRaster dropLevels(); SpatRaster cover(SpatRaster x, std::vector value, SpatOptions &opt); SpatRaster cover(std::vector value, SpatOptions &opt); SpatRaster crop(SpatExtent e, std::string snap, bool expand, SpatOptions &opt); SpatRaster cropmask(SpatVector &v, std::string snap, bool touches, bool expand, SpatOptions &opt); SpatRaster cum(std::string fun, bool narm, SpatOptions &opt); SpatRaster disaggregate(std::vector fact, SpatOptions &opt); SpatRaster proximity(double target, double exclude, bool keepNA, std::string unit, bool buffer, double maxdist, bool remove_zero, SpatOptions &opt); SpatRaster fillNA(double missing, double maxdist, int niter, SpatOptions &opt); SpatRaster distance(double target, double exclude, bool keepNA, std::string unit, bool remove_zero, std::string method, bool values, double threshold, SpatOptions &opt); SpatRaster nearest(double target, double exclude, bool keepNA, std::string unit, bool remove_zero, std::string method, SpatOptions &opt); // SpatRaster distance_spatvector(SpatVector p, std::string unit, const std::string& method, SpatOptions &opt); // SpatRaster distance_rasterize(SpatVector p, double target, double exclude, std::string unit, const std::string& method, SpatOptions &opt); SpatRaster distance_vector(SpatVector p, bool rasterize, std::string unit, const std::string& method, SpatOptions &opt); SpatRaster direction_rasterize(SpatVector p, bool from, bool degrees, double target, double exclude, const std::string& method, SpatOptions &opt); SpatRaster distance_crds(std::vector& x, std::vector& y, const std::string& method, bool skip, bool setNA, std::string unit,double threshold, SpatOptions &opt); SpatRaster distance_crds_vals(std::vector& x, std::vector& y, const std::vector& v, const std::string& method, bool skip, bool setNA, std::string unit, double threshold, SpatOptions &opt); SpatRaster dn_crds(std::vector& x, std::vector& y, const std::string& method, bool skip, bool setNA, std::string unit, SpatOptions &opt); SpatRaster direction(bool from, bool degrees, double target, double exclude, const std::string& method, SpatOptions &opt); SpatRaster direction_vector(SpatVector p, bool from, bool degrees, const std::string& method, SpatOptions &opt); SpatRaster clumps(int directions, bool zeroAsNA, SpatOptions &opt); SpatRaster patches(size_t directions, SpatOptions &opt); SpatRaster edges(bool classes, std::string type, unsigned directions, double falseval, SpatOptions &opt); SpatRaster extend(SpatExtent e, std::string snap, double fill, SpatOptions &opt); std::vector>> extractVector(SpatVector v, bool touches, bool small, std::string method, bool cells, bool xy, bool weights, bool exact, SpatOptions &opt); std::vector extractVectorFlat(SpatVector v, std::vector funs, bool narm, bool touches, bool small, std::string method, bool cells, bool xy, bool weights, bool exact, SpatOptions &opt); std::vector> extractBuffer(const std::vector &x, const std::vector &y, double b); // std::vector extract_interpolate(std::vector x, std::vector y, std::string algo); std::vector vectCells(SpatVector v, bool touches, bool small, std::string method, bool weights, bool exact, SpatOptions &opt); std::vector extCells(SpatExtent ext); std::vector> extractCell(std::vector &cell); // std::vector extractCellFlat(std::vector &cell); std::vector> extractXY(const std::vector &x, const std::vector &y, const std::string & method, const bool &cells); std::vector extractXYFlat(const std::vector &x, const std::vector &y, const std::string & method, const bool &cells); SpatRaster flip(bool vertical, SpatOptions &opt); SpatRaster filler(SpatRaster x, SpatOptions &opt); SpatRaster focal(std::vector w, std::vector m, double fillvalue, bool narm, bool naonly, bool naomit, std::string fun, bool expand, SpatOptions &opt); std::vector focal_values(std::vector w, double fillvalue, int_64 row, int_64 nrows, SpatOptions &opt); std::vector> freq(bool bylayer, bool round, int digits, SpatOptions &opt); std::vector count(double value, bool bylayer, bool round, int digits, SpatOptions &opt); bool get_aggregate_dims(std::vector &fact, std::string &message); std::vector get_aggregate_dims2(std::vector fact); std::vector > get_aggregates(std::vector &in, size_t nr, std::vector dim); // std::vector compute_aggregates(std::vector &in, unsigned nr, std::vector dim, std::function&, bool)> fun, bool narm); SpatDataFrame mglobal(std::vector funs, bool narm, SpatOptions &opt); SpatDataFrame global(std::string fun, bool narm, SpatOptions &opt); SpatDataFrame globalTF(std::string fun, SpatOptions &opt); SpatDataFrame global_weighted_mean(SpatRaster &weights, std::string fun, bool narm, SpatOptions &opt); SpatRaster gridDistance(double m, SpatOptions &opt); SpatRaster costDistanceRun(SpatRaster &old, bool &converged, double target, double m, bool lonlat, bool global, bool npole, bool spole, bool grid, SpatOptions &opt); SpatRaster costDistance(double target, double m, size_t maxiter, bool grid, SpatOptions &opt); SpatRaster init(std::string value, bool plusone, SpatOptions &opt); SpatRaster init(std::vector values, SpatOptions &opt); SpatRaster is_in(std::vector m, SpatOptions &opt); std::vector> is_in_cells(std::vector m, bool keepvalue, SpatOptions &opt); std::vector getDataType(bool unique, bool memtype); std::vector dataType(); SpatRaster isnot(bool falseNA, SpatOptions &opt); SpatRaster isnan(bool falseNA, SpatOptions &opt); SpatRaster isnotnan(bool falseNA, SpatOptions &opt); SpatRaster countnan(long n, SpatOptions &opt); SpatRaster isfinite(bool falseNA, SpatOptions &opt); SpatRaster isinfinite(bool falseNA, SpatOptions &opt); SpatRaster is_true(bool falseNA, SpatOptions &opt); SpatRaster is_false(bool falseNA, SpatOptions &opt); SpatRaster not_na(bool falseNA, SpatOptions &opt); SpatRaster allnan(bool falseNA, SpatOptions &opt); SpatRaster anynan(bool falseNA, SpatOptions &opt); SpatRaster nonan(bool falseNA, SpatOptions &opt); SpatRaster which(SpatOptions &opt); std::vector> layerCor(std::string fun, std::string use, bool asSample, SpatOptions &opt); std::vector line_cells(SpatGeom& g); SpatRaster logic(SpatRaster x, std::string oper, SpatOptions &opt); SpatRaster logic(double x, std::string oper, SpatOptions &opt); SpatRaster logic(std::vector x, std::string oper, SpatOptions &opt); SpatExtent ext_from_rc(int_64 r1, int_64 r2, int_64 c1, int_64 c2); SpatExtent ext_from_cell(double cell); std::vector get_tiles_extent(SpatRaster x, bool expand, std::vector buffer); std::vector make_tiles(SpatRaster x, bool expand, std::vector buffer, bool narm, std::string filename, SpatOptions &opt); std::vector get_tiles_extent_vect(SpatVector x, bool expand, std::vector buffer); std::vector make_tiles_vect(SpatVector x, bool expand, std::vector buffer, bool narm, std::string filename, SpatOptions &opt); SpatRaster mask(SpatRaster &x, bool inverse, double maskvalue, double updatevalue, SpatOptions &opt); SpatRaster mask(SpatRaster &x, bool inverse, std::vector maskvalues, double updatevalue, SpatOptions &opt); SpatRaster mask(SpatOptions &opt); SpatRaster mask(SpatVector &x, bool inverse, double updatevalue, bool touches, SpatOptions &opt); SpatRaster math(std::string fun, SpatOptions &opt); SpatRaster math2(std::string fun, unsigned digits, SpatOptions &opt); SpatRaster separate(std::vector classes, double keepvalue, double othervalue, bool round, int digits, SpatOptions &opt); SpatRaster modal(std::vector add, std::string ties, bool narm, SpatOptions &opt); std::vector polygon_cells(SpatGeom& g); SpatRaster quantile(std::vector probs, bool narm, SpatOptions &opt); SpatRaster stretch(std::vector minv, std::vector maxv, std::vector minq, std::vector maxq, std::vector smin, std::vector smax, SpatOptions &opt); SpatRaster reverse(SpatOptions &opt); SpatRaster range(std::vector add, bool narm, SpatOptions &opt); SpatRaster rasterizeLyr(SpatVector x, double value, double background, bool touches, bool update, SpatOptions &opt); SpatRaster rasterize(SpatVector x, std::string field, std::vector values, double background, bool touches, std::string fun, bool weights, bool update, bool minmax, SpatOptions &opt); SpatRaster rasterizeWindow(std::vector x, std::vector y, std::vector z, std::string algo, std::vector algops, SpatOptions &opt); std::vector> win_circle(std::vector x, std::vector y, std::vector z, std::vector win, SpatOptions &opt); std::vector> win_rect(std::vector x, std::vector y, std::vector z, std::vector win, SpatOptions &opt); std::vector rasterizeCells(SpatVector &v, bool touches, bool small, SpatOptions &opt); //std::vector> rasterizeCellsWeights(SpatVector &v, bool touches); SpatRaster rasterizeGeom(SpatVector x, std::string unit, std::string count, SpatOptions &opt); SpatRaster rasterizePoints(std::vector&x, std::vector &y, std::string fun, std::vector &values, bool narm, double background, SpatOptions &opt); SpatRaster rasterizePoints(SpatVector &x, std::string fun, std::vector &values, bool narm, double background, SpatOptions &opt); void rasterizeCellsWeights(std::vector &cells, std::vector &weights, SpatVector &v, SpatOptions &opt); void rasterizeCellsExact(std::vector &cells, std::vector &weights, SpatVector &v, SpatOptions &opt); void rasterizeLinesLength(std::vector &cells, std::vector &weights, SpatVector &v, SpatOptions &opt); SpatRaster replaceValues(std::vector from, std::vector to, long nl, bool setothers, double others, bool keepcats, SpatOptions &opt); SpatRaster reclassify(std::vector> rcl, unsigned openclosed, bool lowest, bool others, double othersValue, bool bylayer, bool brackets, bool keepcats, SpatOptions &opt); SpatRaster reclassify(std::vector rcl, size_t nc, unsigned openclosed, bool lowest, bool others, double othersValue, bool bylayer, bool brackets, bool keepcats, SpatOptions &opt); //SpatRaster classify_layers(std::vector> groups, std::vector id, SpatOptions &opt); //SpatRaster classify_layers(std::vector groups, size_t nc, std::vector id, SpatOptions &opt); SpatRaster intersect(SpatRaster &x, SpatOptions &opt); std::vector readSample(size_t src, size_t srows, size_t scols); SpatRaster rotate(bool left, SpatOptions &opt); std::vector sampleCells(double size, std::string method, bool replace, unsigned seed); SpatRaster sampleRegularRaster(double size, bool overview); SpatRaster sampleRowColRaster(size_t nr, size_t nc, bool warn); SpatRaster sampleRandomRaster(double size, bool replace, unsigned seed); std::vector> sampleRegularValues(double size, SpatOptions &opt); std::vector> sampleRowColValues(size_t nr, size_t nc, SpatOptions &opt); std::vector> sampleRandomValues(double size, bool replace, unsigned seed); SpatRaster sort(bool decreasing, bool order, SpatOptions &opt); SpatRaster scale(std::vector center, bool docenter, std::vector scale, bool doscale, SpatOptions &opt); SpatRaster scale_linear(double smin, double smax, SpatOptions &opt); SpatRaster similarity(std::vector x, SpatOptions &opt); SpatRaster terrain(std::vector v, unsigned neighbors, bool degrees, unsigned seed, SpatOptions &opt); // watershed2 ecor 20210317; EC 20210702 SpatRaster watershed2(int pp_offset,SpatOptions &opt); SpatRaster pitfinder2(SpatOptions &opt); SpatRaster NIDP2(SpatOptions &opt); SpatRaster flowAccu2(SpatOptions &opt); SpatRaster flowAccu2_weight(SpatRaster weight,SpatOptions &opt); // END watershed2 SpatRaster hillshade(SpatRaster aspect, std::vector angle, std::vector direction, bool normalize, SpatOptions &opt); SpatRaster selRange(SpatRaster x, int z, int recycleby, SpatOptions &opt); SpatRaster selectHighest(size_t n, bool low, SpatOptions &opt); SpatRaster shift(double x, double y, SpatOptions &opt); SpatRaster summary(std::string fun, bool narm, SpatOptions &opt); SpatRaster summary_numb(std::string fun, std::vector add, bool narm, SpatOptions &opt); std::vector> where(std::string what, bool values, SpatOptions &opt); SpatRaster transpose(SpatOptions &opt); SpatRaster trig(std::string fun, SpatOptions &opt); SpatRaster trim1(double value, size_t padding, SpatOptions &opt); SpatRaster trim2(double value, size_t padding, SpatOptions &opt); std::vector> unique(bool bylayer, double digits, bool narm, SpatOptions &opt); SpatRaster project1(std::string newcrs, std::string method, SpatOptions &opt); SpatRaster project2(SpatRaster &x, std::string method, SpatOptions &opt); void project3(SpatRaster &out, std::string method, SpatOptions &opt); #ifdef useGDAL bool getDSh(GDALDatasetH &rstDS, SpatRaster &out, std::string &filename, std::string &driver, double &naval, bool update, double background, SpatOptions &opt); bool getDShMEM(GDALDatasetH &rstDS, SpatRaster &out, double &naval, double background, SpatOptions &opt); bool open_gdal(GDALDatasetH &hDS, int src, bool update, SpatOptions &opt); bool create_gdalDS(GDALDatasetH &hDS, std::string filename, std::string driver, bool fill, double fillvalue, std::vector has_so, std::vector scale, std::vector offset, SpatOptions& opt); bool from_gdalMEM(GDALDatasetH hDS, bool set_geometry, bool get_values); bool as_gdalvrt(GDALDatasetH &hVRT, SpatOptions &opt); //bool as_gdalmem(GDALDatasetH &hVRT); #endif SpatRaster to_memory_copy(SpatOptions &opt); bool to_memory(SpatOptions &opt); SpatRaster weighted_mean(SpatRaster w, bool narm, SpatOptions &opt); SpatRaster weighted_mean(std::vector w, bool narm, SpatOptions &opt); SpatRaster warper(SpatRaster x, std::string crs, std::string method, bool mask, bool align, bool resample, SpatOptions &opt); SpatRaster warper_by_util(SpatRaster x, std::string crs, std::string method, bool mask, bool align, bool resample, SpatOptions &opt); SpatRaster resample(SpatRaster x, std::string method, bool mask, bool agg, SpatOptions &opt); SpatRaster applyGCP(std::vector fx, std::vector fy, std::vector tx, std::vector ty, SpatOptions &opt); SpatDataFrame zonal(SpatRaster z, SpatRaster g, std::string fun, bool narm, SpatOptions &opt); SpatDataFrame zonal_weighted(SpatRaster x, SpatRaster w, bool narm, SpatOptions &opt); SpatDataFrame zonal_poly(SpatVector x, std::string fun, bool weights, bool exact, bool touches, bool small, bool narm, SpatOptions &opt); SpatDataFrame zonal_poly_weighted(SpatVector x, SpatRaster w, bool weights, bool exact, bool touches, bool small, bool narm, SpatOptions &opt); std::vector> zonal_poly_table(SpatVector x, bool weights, bool exact, bool touches, bool small, bool narm, SpatOptions &opt); // SpatDataFrame zonal_old(SpatRaster x, std::string fun, bool narm, SpatOptions &opt); SpatRaster rgb2col(size_t r, size_t g, size_t b, SpatOptions &opt); SpatRaster rgb2hsx(std::string type, SpatOptions &opt); SpatRaster hsx2rgb(SpatOptions &opt); SpatRaster viewshed(std::vector obs, std::vector vals, double curvcoef, int mode, double maxdist, int heightmode, SpatOptions &opt); SpatRaster sieveFilter(int threshold, int connections, SpatOptions &opt); // SpatRaster panSharpen(SpatRaster pan, SpatOptions &opt); }; terra/src/math_utils.h0000644000176200001440000000433014536376240014512 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include #include #include #include double modal_value(std::vector values, unsigned ties, bool narm, std::default_random_engine rgen, std::uniform_real_distribution dist); void na_omit(std::vector &x); bool is_equal(double a, double b, double tolerance=10.0); bool about_equal(double a, double b, double tolerance); bool is_equal_relative(double a, double b, double tolerance); bool is_equal_range(double x, double y, double range, double tolerance); void vector_minmax(std::vector v, double &min, int &imin, double &max, int &imax); double roundn(double x, int n); double signif(double x, unsigned n); template void minmax(Iterator start, Iterator end, double &vmin, double &vmax) { vmin = std::numeric_limits::max(); vmax = std::numeric_limits::lowest(); bool none = true; for (Iterator v = start; v !=end; ++v) { if (!std::isnan(*v)) { if (*v > vmax) { vmax = *v; none = false; } if (*v < vmin) { vmin = *v; } } } if (none) { vmin = NAN; vmax = NAN; } } template void sort_unique_2d(std::vector &x, std::vector &y) { std::vector> v(x.size()); for (size_t i=0; i. #include "gdalwarper.h" #include "ogr_spatialref.h" #include "gdal_alg.h" #include "ogrsf_frmts.h" #include "gdal_utils.h" // for GDALWarp() in warper_by_util #include "spatRaster.h" #include "string_utils.h" #include "file_utils.h" #include "vecmath.h" #include "crs.h" #include "gdalio.h" #include "recycle.h" #include /* GDAL 3.10 std::vector SpatRaster::extract_interpolate(std::vector x, std::vector y, std::string algo) { GDALRIOResampleAlg eInterpolation = GRIORA_Bilinear ; size_t n = x.size(); std::vector out(n, NAN); double value; GDALDatasetH hDs; SpatOptions opt; if (!open_gdal(hDs, 0, false, opt)) { setError("cannot open dataset"); return(out); } GDALRasterBandH poBand = GDALGetRasterBand(hDs, 1); for (size_t i=0; igetGeometryType(); // if ( geomtype == wkbPolygon ) { OGRPolygon *poGeom = ( OGRPolygon * )poGeometry; OGRLinearRing *poRing = poGeom->getExteriorRing(); unsigned np = poRing->getNumPoints(); std::vector X(np); std::vector Y(np); for (size_t i=0; igetPoint(i, &ogrPt); X[i] = ogrPt.getX(); Y[i] = ogrPt.getY(); } SpatPart p(X, Y); unsigned nh = poGeom->getNumInteriorRings(); for (size_t i=0; igetInteriorRing(i); unsigned np = poHole->getNumPoints(); std::vector X(np); std::vector Y(np); for (size_t j=0; jgetPoint(j, &ogrPt); X[j] = ogrPt.getX(); Y[j] = ogrPt.getY(); } p.addHole(X, Y); } g.addPart(p); // } return g; } SpatVector SpatVector::buffer3(std::vector d, unsigned quadsegs) { SpatVector out; recycle(d, size()); GDALDataset* v = write_ogr("", "layer", "Memory", false, true, std::vector()); OGRLayer *poLayer = v->GetLayer(0); poLayer->ResetReading(); OGRFeature *poFeature; while( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { // using d[0] for now OGRGeometry *bufGeom = poGeometry->Buffer(d[0], quadsegs); SpatGeom g = getPolygonsGeom2(bufGeom); out.addGeom(g); } OGRFeature::DestroyFeature( poFeature ); } GDALClose(v); return out; } SpatVector SpatRaster::dense_extent(bool inside, bool geobounds) { SpatExtent e = getExtent(); if (geobounds && is_lonlat()) { if ((e.ymin <= -90) || (e.ymax >= 90)) { double fy = yres() / 10; // avoid Inf with Mercator SpatRaster g = geometry(); e.ymin= std::max(e.ymin, -90.0+fy); e.ymax= std::min(e.ymax, 90.0-fy); g.source[0].extent = e; return g.dense_extent(inside, false); } } std::vector rows, cols; if (nrow() < 51) { rows.resize(nrow()); std::iota(rows.begin(), rows.end(), 0); } else { rows = seq_steps((int_64) 0, (int_64) nrow()-1, 50); } if (ncol() < 51) { cols.resize(ncol()); std::iota(cols.begin(), cols.end(), 0); } else { cols = seq_steps((int_64) 0, (int_64) ncol()-1, 50); } std::vector xcol = xFromCol(cols) ; std::vector yrow = yFromRow(rows) ; double yr = yres() / 4; if (inside) { yrow.insert(yrow.begin(), e.ymax - yr); yrow.push_back(e.ymin + yr); std::vector y0(xcol.size(), e.ymin+yr); std::vector y1(xcol.size(), e.ymax-yr); } else { yrow.insert(yrow.begin(), e.ymax); yrow.push_back(e.ymin); std::vector y0(xcol.size(), e.ymin); std::vector y1(xcol.size(), e.ymax); } std::vector y0(xcol.size(), e.ymin); std::vector y1(xcol.size(), e.ymax); std::vector x0(yrow.size(), e.xmin); std::vector x1(yrow.size(), e.xmax); std::vector x = x0; std::vector y = yrow; x.insert(x.end(), xcol.begin(), xcol.end()); y.insert(y.end(), y0.begin(), y0.end()); std::reverse(yrow.begin(), yrow.end()); std::reverse(xcol.begin(), xcol.end()); x.insert(x.end(), x1.begin(), x1.end()); y.insert(y.end(), yrow.begin(), yrow.end() ); x.insert(x.end(), xcol.begin(), xcol.end()); y.insert(y.end(), y1.begin(), y1.end()); x.push_back(x[0]); y.push_back(y[0]); SpatVector v(x, y, polygons, getSRS("wkt")); return v; } #if GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR < 2 SpatRaster SpatRaster::warper(SpatRaster x, std::string crs, std::string method, bool mask, bool align, bool resample, SpatOptions &opt) { SpatRaster out; out.setError("Not supported for this old version of GDAL"); return(out); } #else bool get_output_bounds(const GDALDatasetH &hSrcDS, std::string srccrs, const std::string dstcrs, SpatRaster &r) { if ( hSrcDS == NULL ) { r.setError("data source is NULL"); return false; } // Get Source coordinate system. // const char *pszSrcWKT = GDALGetProjectionRef( hSrcDS ); const char *pszSrcWKT = srccrs.c_str(); if ( pszSrcWKT == NULL || strlen(pszSrcWKT) == 0 ) { r.setError("data source has no WKT"); return false; } OGRSpatialReference* oSRS = new OGRSpatialReference; std::string msg = ""; if (is_ogr_error(oSRS->SetFromUserInput( dstcrs.c_str() ), msg)) { r.setError(msg); return false; }; char *pszDstWKT = NULL; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; oSRS->exportToWkt( &pszDstWKT, options); #else oSRS->exportToWkt( &pszDstWKT ); #endif // Create a transformer that maps from source pixel/line coordinates // to destination georeferenced coordinates (not destination // pixel line). We do that by omitting the destination dataset // handle (setting it to NULL). void *hTransformArg; hTransformArg = GDALCreateGenImgProjTransformer( hSrcDS, pszSrcWKT, NULL, pszDstWKT, FALSE, 0, 1 ); if (hTransformArg == NULL ) { r.setError("cannot create TranformArg"); return false; } CPLFree(pszDstWKT); delete oSRS; double adfDstGeoTransform[6]; int nPixels=0, nLines=0; CPLErr eErr = GDALSuggestedWarpOutput( hSrcDS, GDALGenImgProjTransform, hTransformArg, adfDstGeoTransform, &nPixels, &nLines ); GDALDestroyGenImgProjTransformer( hTransformArg ); if ( eErr != CE_None ) { r.setError("cannot create warp output"); return false; } r.source[0].ncol = nPixels; r.source[0].nrow = nLines; r.source[0].extent.xmin = adfDstGeoTransform[0]; /* left x */ /* w-e pixel resolution */ r.source[0].extent.xmax = r.source[0].extent.xmin + adfDstGeoTransform[1] * nPixels; r.source[0].extent.ymax = adfDstGeoTransform[3]; // top y r.source[0].extent.ymin = r.source[0].extent.ymax + nLines * adfDstGeoTransform[5]; r.setSRS({dstcrs}); return true; } /* // Create output with same datatype as first input band. GDALDataType eDT = GDALGetRasterDataType(GDALGetRasterBand(hSrcDS,1)); GDALDataType eDT; getGDALDataType(datatype, eDT); // Create the output DS. GDALDriverH hDriver = GDALGetDriverByName( driver.c_str() ); if ( hDriver == NULL ) { msg = "empty driver"; return false; } if (driver == "MEM") { hDstDS = GDALCreate( hDriver, "", nPixels, nLines, nlyrs, eDT, NULL ); } else { hDstDS = GDALCreate( hDriver, filename.c_str(), nPixels, nLines, nlyrs, eDT, NULL ); } if ( hDstDS == NULL ) { msg = "cannot create output dataset"; return false; } // Write out the projection definition. GDALSetProjection( hDstDS, pszDstWKT ); GDALSetGeoTransform( hDstDS, adfDstGeoTransform ); // Copy the color table, if required. GDALColorTableH hCT; hCT = GDALGetRasterColorTable( GDALGetRasterBand(hSrcDS,1) ); if( hCT != NULL ) GDALSetRasterColorTable( GDALGetRasterBand(hDstDS,1), hCT ); CPLFree(pszDstWKT); delete oSRS; return true; } */ bool getAlgo(GDALResampleAlg &alg, std::string m) { if (m=="sum") { #if GDAL_VERSION_MAJOR >= 3 && GDAL_VERSION_MINOR >= 1 alg = GRA_Sum; return true; } #else return false; } #endif if (m=="rms") { #if GDAL_VERSION_MAJOR >= 3 && GDAL_VERSION_MINOR >= 3 alg = GRA_RMS; return true; } #else return false; } #endif if ( m == "near" ) { alg = GRA_NearestNeighbour; } else if (m=="bilinear") { alg = GRA_Bilinear; } else if (m=="cubic") { alg = GRA_Cubic; } else if (m=="cubicspline") { alg = GRA_CubicSpline; } else if (m=="lanczos") { alg = GRA_Lanczos; } else if (m=="average") { alg = GRA_Average; } else if (m=="mode") { alg = GRA_Mode; } else if (m=="max") { alg = GRA_Max; } else if (m=="min") { alg = GRA_Min; } else if (m=="median") { alg = GRA_Med; } else if (m=="q1") { alg = GRA_Q1; } else if (m=="q3") { alg = GRA_Q3; } else { return false; } return true; } bool is_valid_warp_method(const std::string &method) { std::vector m { "near", "bilinear", "cubic", "cubicspline", "lanczos", "average", "mode", "max", "min", "med", "q1", "q3", "sum", "rms"}; return (std::find(m.begin(), m.end(), method) != m.end()); } bool set_warp_options(GDALWarpOptions *psWarpOptions, GDALDatasetH &hSrcDS, GDALDatasetH &hDstDS, std::vector srcbands, std::vector dstbands, std::string method, std::string srccrs, std::string msg, bool verbose, bool threads) { if (srcbands.size() != dstbands.size()) { msg = "number of source bands must match number of dest bands"; return false; } int nbands = srcbands.size(); GDALResampleAlg a; if (!getAlgo(a, method)) { msg = method + " is not a valid method"; return false; } // Setup warp options. psWarpOptions->hSrcDS = hSrcDS; psWarpOptions->hDstDS = hDstDS; psWarpOptions->eResampleAlg = a; psWarpOptions->nBandCount = nbands; psWarpOptions->panSrcBands = (int *) CPLMalloc(sizeof(int) * nbands ); psWarpOptions->panDstBands = (int *) CPLMalloc(sizeof(int) * nbands ); psWarpOptions->padfSrcNoDataReal = (double *) CPLMalloc(sizeof(double) * nbands ); psWarpOptions->padfDstNoDataReal = (double *) CPLMalloc(sizeof(double) * nbands ); psWarpOptions->padfSrcNoDataImag = (double *) CPLMalloc(sizeof(double) * nbands ); psWarpOptions->padfDstNoDataImag = (double *) CPLMalloc(sizeof(double) * nbands ); GDALRasterBandH hBand; int hasNA; for (int i=0; ipanSrcBands[i] = (int) srcbands[i]+1; psWarpOptions->panDstBands[i] = (int) dstbands[i]+1; hBand = GDALGetRasterBand(hSrcDS, srcbands[i]+1); double naflag = GDALGetRasterNoDataValue(hBand, &hasNA); if (hasNA) { psWarpOptions->padfSrcNoDataReal[i] = naflag; psWarpOptions->padfDstNoDataReal[i] = naflag; hBand = GDALGetRasterBand(hDstDS, dstbands[i]+1); GDALSetRasterNoDataValue(hBand, naflag); } else { psWarpOptions->padfSrcNoDataReal[i] = NAN; psWarpOptions->padfDstNoDataReal[i] = NAN; } psWarpOptions->padfSrcNoDataImag[i] = 0; psWarpOptions->padfDstNoDataImag[i] = 0; } //psWarpOptions->pfnProgress = GDALTermProgress; psWarpOptions->papszWarpOptions = CSLSetNameValue( psWarpOptions->papszWarpOptions, "INIT_DEST", "NO_DATA"); psWarpOptions->papszWarpOptions = CSLSetNameValue( psWarpOptions->papszWarpOptions, "WRITE_FLUSH", "YES"); if (threads) { psWarpOptions->papszWarpOptions = CSLSetNameValue( psWarpOptions->papszWarpOptions, "NUM_THREADS", "ALL_CPUS"); } psWarpOptions->pTransformerArg = GDALCreateGenImgProjTransformer( hSrcDS, srccrs.c_str(), hDstDS, GDALGetProjectionRef(hDstDS), FALSE, 0.0, 1 ); psWarpOptions->pfnTransformer = GDALGenImgProjTransform; return true; } /* bool gdal_warper(GDALWarpOptions *psWarpOptions, GDALDatasetH &hSrcDS, GDALDatasetH &hDstDS) { GDALWarpOperation oOperation; if (oOperation.Initialize( psWarpOptions ) != CE_None) { return false; } if (oOperation.ChunkAndWarpImage(0, 0, GDALGetRasterXSize(hDstDS), GDALGetRasterYSize(hDstDS)) != CE_None) { return false; } return true; } */ SpatRaster SpatRaster::warper(SpatRaster x, std::string crs, std::string method, bool mask, bool align, bool resample, SpatOptions &opt) { size_t ns = nsrc(); bool fixext = false; for (size_t j=0; j res = x.resolution(); out = out.setResolution(res[0], res[1]); } if (!hasValues()) { return out; } SpatOptions mopt; if (mask) { mopt = opt; opt = SpatOptions(opt); } opt.ncopies += 4; if (!out.writeStart(opt, filenames())) { return out; } std::string errmsg; SpatExtent eout = out.getExtent(); // std::vector has_so = source[0].has_scale_offset; // std::vector scale = source[0].scale; // std::vector offset = source[0].offset; // for (size_t i=1; i has_so(nlyr(), false); std::vector scale(nlyr(), 1); std::vector offset(nlyr(), 0); double halfy = out.yres() / 2; for (size_t i = 0; i < out.bs.n; i++) { eout.ymax = out.yFromRow(out.bs.row[i]) + halfy; eout.ymin = out.yFromRow(out.bs.row[i] + out.bs.nrows[i]-1) - halfy; SpatRaster crop_out = out.crop(eout, "near", false, sopt); GDALDatasetH hDstDS; if (!crop_out.create_gdalDS(hDstDS, "", "MEM", false, NAN, has_so, scale, offset, sopt)) { return crop_out; } int bandstart = 0; for (size_t j=0; j srcbands = source[j].layers; std::vector dstbands(srcbands.size()); std::iota (dstbands.begin(), dstbands.end(), bandstart); bandstart += dstbands.size(); GDALWarpOptions *psWarpOptions = GDALCreateWarpOptions(); if (!set_warp_options(psWarpOptions, hSrcDS, hDstDS, srcbands, dstbands, method, srccrs, errmsg, opt.get_verbose(), opt.threads)) { if (hDstDS != NULL ) GDALClose((GDALDatasetH) hDstDS); out.setError(errmsg); return out; } //ok = gdal_warper(psWarpOptions, hSrcDS, hDstDS); bool ok=true; GDALWarpOperation oOperation; if (oOperation.Initialize(psWarpOptions) != CE_None) { ok = false; } else if (oOperation.ChunkAndWarpImage(0, 0, GDALGetRasterXSize(hDstDS), GDALGetRasterYSize(hDstDS)) != CE_None) { ok = false; } GDALDestroyGenImgProjTransformer(psWarpOptions->pTransformerArg); GDALDestroyWarpOptions(psWarpOptions); if (hSrcDS != NULL) GDALClose((GDALDatasetH) hSrcDS); if (!ok) { if (hDstDS != NULL) GDALClose((GDALDatasetH) hDstDS); out.setError("warp failure"); return out; } } bool ok = crop_out.from_gdalMEM(hDstDS, false, true); if (hDstDS != NULL) GDALClose((GDALDatasetH) hDstDS); if (!ok) { out.setError("cannot do this transformation (warp)"); return out; } // std::vector v = crop_out.getValues(-1, opt); // if (!out.writeBlock(v, i)) return out; if (!out.writeBlock(crop_out.source[0].values, i)) return out; } out.writeStop(); if (mask) { SpatVector v = dense_extent(true, true); v = v.project(out.getSRS("wkt"), true); if (v.nrow() > 0) { out = out.mask(v, false, NAN, true, mopt); } else { out.addWarning("masking failed"); } } return out; } /* SpatRaster SpatRaster::oldwarper(SpatRaster x, std::string crs, std::string method, bool mask, bool align, bool resample, SpatOptions &opt) { size_t ns = nsrc(); bool fixext = false; for (size_t j=0; j res = x.resolution(); out = out.setResolution(res[0], res[1]); } if (!hasValues()) { return out; } SpatOptions mopt; if (mask) { mopt = opt; opt = SpatOptions(opt); } opt.ncopies += 4; if (!out.writeStart(opt, filenames())) { return out; } std::string errmsg; SpatExtent eout = out.getExtent(); std::vector has_so = source[0].has_scale_offset; std::vector scale = source[0].scale; std::vector offset = source[0].offset; for (size_t i=1; i srcbands = source[j].layers; std::vector dstbands(srcbands.size()); std::iota (dstbands.begin(), dstbands.end(), bandstart); bandstart += dstbands.size(); GDALWarpOptions *psWarpOptions = GDALCreateWarpOptions(); bool ok = set_warp_options(psWarpOptions, hSrcDS, hDstDS, srcbands, dstbands, method, srccrs, errmsg, opt.get_verbose(), opt.threads); if (!ok) { if( hDstDS != NULL ) GDALClose( (GDALDatasetH) hDstDS ); out.setError(errmsg); return out; } //ok = gdal_warper(psWarpOptions, hSrcDS, hDstDS); GDALWarpOperation oOperation; if (oOperation.Initialize( psWarpOptions ) != CE_None) { ok = false; } else if (oOperation.ChunkAndWarpImage(0, 0, GDALGetRasterXSize(hDstDS), GDALGetRasterYSize(hDstDS)) != CE_None) { ok = false; } GDALDestroyGenImgProjTransformer( psWarpOptions->pTransformerArg ); GDALDestroyWarpOptions( psWarpOptions ); if( hSrcDS != NULL ) GDALClose( (GDALDatasetH) hSrcDS ); if (!ok) { if( hDstDS != NULL ) GDALClose( (GDALDatasetH) hDstDS ); out.setError("warp failure"); return out; } } bool ok = crop_out.from_gdalMEM(hDstDS, false, true); if( hDstDS != NULL ) GDALClose( (GDALDatasetH) hDstDS ); if (!ok) { out.setError("cannot do this transformation (warp)"); return out; } // std::vector v = crop_out.getValues(-1, opt); // if (!out.writeBlock(v, i)) return out; if (!out.writeBlock(crop_out.source[0].values, i)) return out; } out.writeStop(); if (mask) { SpatVector v = dense_extent(true, true); v = v.project(out.getSRS("wkt"), true); if (v.nrow() > 0) { out = out.mask(v, false, NAN, true, mopt); } else { out.addWarning("masking failed"); } } return out; } */ SpatRaster SpatRaster::warper_by_util(SpatRaster x, std::string crs, std::string method, bool mask, bool align, bool resample, SpatOptions &opt) { size_t ns = nsrc(); bool fixext = false; for (size_t j=0; j res = x.resolution(); out = out.setResolution(res[0], res[1]); } if (!hasValues()) { return out; } SpatOptions mopt; if (mask) { mopt = opt; opt = SpatOptions(opt); } opt.ncopies += 4; if (!out.writeStart(opt, filenames())) { return out; } std::string errmsg; SpatExtent eout = out.getExtent(); std::vector has_so = source[0].has_scale_offset; std::vector scale = source[0].scale; std::vector offset = source[0].offset; for (size_t i=1; i srcbands = source[j].layers; std::vector dstbands(srcbands.size()); std::iota (dstbands.begin(), dstbands.end(), bandstart); bandstart += dstbands.size(); bool ok = true; if (srcbands.size() != dstbands.size()) { errmsg = "number of source bands must match number of dest bands"; ok = false; } // int nbands = srcbands.size(); GDALResampleAlg a; if (!getAlgo(a, method)) { ok = false; if ((method=="sum") || (method=="rms")) { errmsg = method + " not available in your version of GDAL"; } else { errmsg = "unknown resampling algorithm"; } } if (!ok) { if( hDstDS != NULL ) GDALClose( (GDALDatasetH) hDstDS ); out.setError(errmsg); return out; } GDALWarpAppOptions *psWarpAppOptions = GDALWarpAppOptionsNew(nullptr, nullptr); GDALWarpAppOptionsSetProgress(psWarpAppOptions, NULL, NULL ); // assume we've validate method because of getAlgo() above GDALWarpAppOptionsSetWarpOption(psWarpAppOptions, "-r", method.c_str()); GDALWarpAppOptionsSetWarpOption(psWarpAppOptions, "INIT_DEST", "NO_DATA"); GDALWarpAppOptionsSetWarpOption(psWarpAppOptions, "WRITE_FLUSH", "YES"); if (opt.threads) { GDALWarpAppOptionsSetWarpOption(psWarpAppOptions, "NUM_THREADS", "ALL_CPUS"); } //-------------------------------------------------------------------------- hWarpedDS = GDALWarp("", hDstDS, 1 , &hSrcDS, psWarpAppOptions, 0); GDALWarpAppOptionsFree(psWarpAppOptions); if( hSrcDS != NULL ) GDALClose( (GDALDatasetH) hSrcDS ); } bool ok = crop_out.from_gdalMEM(hWarpedDS, false, true); if( hWarpedDS != NULL ) GDALClose( (GDALDatasetH) hWarpedDS ); if (!ok) { out.setError("cannot do this transformation (warp)"); return out; } std::vector v = crop_out.getValues(-1, opt); if (!out.writeBlock(v, i)) return out; } out.writeStop(); if (mask) { SpatVector v = dense_extent(true, true); v = v.project(out.getSRS("wkt"), true); if (v.nrow() > 0) { out = out.mask(v, false, NAN, true, mopt); } else { out.addWarning("masking failed"); } } return out; } #endif // GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR < 2 SpatRaster SpatRaster::resample(SpatRaster x, std::string method, bool mask, bool agg, SpatOptions &opt) { size_t nl = nlyr(); SpatRaster out = x.geometry(nl); out.setNames(getNames()); out.setNames(getNames()); std::vector f {"bilinear", "near"}; if (std::find(f.begin(), f.end(), method) == f.end()) { out.setError("unknown warp method"); return out; } if (!hasValues()) { return out; } std::string crsin = source[0].srs.wkt; std::string crsout = out.source[0].srs.wkt; bool do_prj = true; if ((crsin == crsout) || crsin.empty() || crsout.empty()) { do_prj = false; } if (!do_prj) { SpatExtent e = out.getExtent(); e = e.intersect(getExtent()); if (!e.valid()) { out.addWarning("No spatial overlap"); return out; } } if (agg) { if (do_prj) { // compare changes in true cell areas // if (some) output cells are much larger than input, we could // a) disaggregate "x", warp, and aggregate the results // b) or give a warning? } else { size_t xq = x.xres() / xres(); size_t yq = x.yres() / yres(); if (std::max(xq, yq) > 1) { xq = xq == 0 ? 1 : xq; yq = yq == 0 ? 1 : yq; std::vector agf = {yq, xq, 1}; SpatOptions agopt(opt); SpatRaster xx; if (method == "bilinear") { xx = aggregate(agf, "mean", true, agopt); } else { xx = aggregate(agf, "modal", true, agopt); } return xx.resample(x, method, mask, false, opt); } } } SpatOptions mopt; if (mask) { mopt = opt; opt = SpatOptions(opt); } size_t nc = out.ncol(); if (!out.writeStart(opt, filenames())) { return out; } for (size_t i = 0; i < out.bs.n; i++) { size_t firstcell = out.cellFromRowCol(out.bs.row[i], 0); size_t lastcell = out.cellFromRowCol(out.bs.row[i]+out.bs.nrows[i]-1, nc-1); std::vector cells(1+lastcell-firstcell); std::iota (std::begin(cells), std::end(cells), firstcell); std::vector> xy = out.xyFromCell(cells); if (do_prj) { #ifdef useGDAL out.msg = transform_coordinates(xy[0], xy[1], crsout, crsin); #else out.setError("GDAL is needed for crs transformation, but not available"); return out; #endif } std::vector> e = extractXY(xy[0], xy[1], method, false); std::vector v = flatten(e); if (!out.writeValues(v, out.bs.row[i], out.bs.nrows[i])) return out; } out.writeStop(); if (mask) { SpatVector v = dense_extent(true, true); v = v.project(out.getSRS("wkt"), true); if (v.nrow() > 0) { out = out.mask(v, false, NAN, true, mopt); } else { out.addWarning("masking failed"); } } return(out); } bool GCP_geotrans(GDALDataset *poDataset, double* adfGeoTransform) { int n = poDataset->GetGCPCount(); if (n == 0) return false; const GDAL_GCP *gcp; gcp = poDataset->GetGCPs(); return GDALGCPsToGeoTransform(n, gcp, adfGeoTransform, true); } //#include SpatRaster SpatRaster::rectify(std::string method, SpatRaster aoi, unsigned useaoi, bool snap, SpatOptions &opt) { SpatRaster out = geometry(0); if (nsrc() > 1) { out.setError("you can rectify only one data source at a time"); return(out); } if (!source[0].rotated) { out.setError("this source is not rotated"); return(out); } GDALDataset *poDataset = openGDAL(source[0].filename, GDAL_OF_RASTER | GDAL_OF_READONLY, source[0].open_drivers, source[0].open_ops); if( poDataset == NULL ) { setError("cannot read from " + source[0].filename); return out; } double gt[6]; if( poDataset->GetGeoTransform(gt) != CE_None ) { if (GCP_geotrans(poDataset, gt)) { poDataset->SetGeoTransform(gt); } else { out.setError("can't get the geotransform"); GDALClose( (GDALDatasetH) poDataset ); return out; } } GDALClose( (GDALDatasetH) poDataset ); // gt[1] = std::abs(gt[1]); //SpatExtent e = getExtent(); //std::vector x = {e.xmin, e.xmin, e.xmax, e.xmax }; //std::vector y = {e.ymin, e.ymax, e.ymin, e.ymax }; double nc = ncol(); double nr = nrow(); std::vector x = {0, 0, nc, nc}; std::vector y = {0, nr, 0, nr}; std::vector xx(4); std::vector yy(4); for (size_t i=0; i<4; i++) { xx[i] = gt[0] + x[i]*gt[1] + y[i]*gt[2]; yy[i] = gt[3] + x[i]*gt[4] + y[i]*gt[5]; } double xmin = vmin(xx, TRUE); double xmax = vmax(xx, TRUE); double ymin = vmin(yy, TRUE); double ymax = vmax(yy, TRUE); SpatExtent en(xmin, xmax, ymin, ymax); out = out.setResolution(fabs(gt[1]), fabs(gt[5])); out.setExtent(en, true, true, "out"); //SpatExtent e = out.getExtent(); if (useaoi == 1) { // use extent en = aoi.getExtent(); if (snap) { en = out.align(en, "near"); out.setExtent(en, false, true, "near"); } else { out.setExtent(en, false, true, ""); } } else if (useaoi == 2){ // extent and resolution out = aoi.geometry(0); } // else { // if (useaoi == 0) // no aoi //e = out.getExtent(); out = warper(out, "", method, false, false, true, opt); return(out); } SpatVector SpatRaster::polygonize(bool round, bool values, bool narm, bool aggregate, int digits, SpatOptions &opt) { SpatVector out; out.srs = source[0].srs; SpatOptions topt(opt); SpatRaster tmp; if (nlyr() > 1) { out.addWarning("only the first layer is polygonized when 'dissolve=TRUE'"); tmp = subset({0}, topt); } else { tmp = *this; } // bool usemask = false; SpatRaster mask; if (narm) { // usemask = true; SpatOptions mopt(topt); mopt.set_datatype("INT1U"); mask = tmp.isfinite(false, mopt); } if (round && (digits > 0)) { tmp = tmp.math2("round", digits, topt); round = false; } else if (tmp.source[0].extset) { tmp = tmp.hardCopy(topt); } /* } else if (tmp.sources_from_file()) { // for NAN and INT files. Should have a check for that //tmp = tmp.arith(0, "+", false, topt); // riskier tmp.readAll(); } */ GDALDatasetH rstDS; if (!tmp.open_gdal(rstDS, 0, false, topt)) { out.setError("cannot open dataset"); return out; } GDALDataset *srcDS=NULL; #if GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR <= 2 srcDS = (GDALDataset *) rstDS; #else srcDS = srcDS->FromHandle(rstDS); #endif GDALDataset *maskDS=NULL; GDALDatasetH rstMask; if (narm) { if (!mask.open_gdal(rstMask, 0, false, opt)) { out.setError("cannot open dataset"); return out; } #if GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR <= 2 maskDS = (GDALDataset *) rstMask; #else maskDS = srcDS->FromHandle(rstMask); #endif } GDALDataset *poDS = NULL; GDALDriver *poDriver = GetGDALDriverManager()->GetDriverByName( "Memory" ); if( poDriver == NULL ) { out.setError( "cannot create output driver"); return out; } poDS = poDriver->Create("", 0, 0, 0, GDT_Unknown, NULL ); if( poDS == NULL ) { out.setError("Creation of output dataset failed" ); return out; } std::vector nms = getNames(); std::string name = nms[0]; OGRSpatialReference *SRS = NULL; OGRLayer *poLayer; poLayer = poDS->CreateLayer(name.c_str(), SRS, wkbPolygon, NULL ); if( poLayer == NULL ) { out.setError( "Layer creation failed" ); return out; } if (SRS != NULL) SRS->Release(); OGRFieldDefn oField(name.c_str(), round ? OFTInteger : OFTReal); if( poLayer->CreateField( &oField ) != OGRERR_NONE ) { out.setError( "Creating field failed"); return out; } GDALRasterBand *poBand; poBand = srcDS->GetRasterBand(1); //int hasNA=1; //double naflag = poBand->GetNoDataValue(&hasNA); CPLErr err; if (narm) { GDALRasterBand *maskBand; maskBand = maskDS->GetRasterBand(1); if (round) { err = GDALPolygonize(poBand, maskBand, poLayer, 0, NULL, NULL, NULL); } else { err = GDALFPolygonize(poBand, maskBand, poLayer, 0, NULL, NULL, NULL); } GDALClose(maskDS); } else { if (round) { err = GDALPolygonize(poBand, NULL, poLayer, 0, NULL, NULL, NULL); } else { err = GDALFPolygonize(poBand, NULL, poLayer, 0, NULL, NULL, NULL); } } if (err == 4) { out.setError("polygonize error"); return out; } GDALClose(srcDS); std::vector fext; SpatVector fvct; out.read_ogr(poDS, "", "", fext, fvct, false, ""); GDALClose(poDS); if (aggregate && (out.nrow() > 0)) { out = out.aggregate(name, false); } if (!values) { out.df = SpatDataFrame(); } return out; } SpatRaster SpatRaster::rgb2col(size_t r, size_t g, size_t b, SpatOptions &opt) { SpatRaster out = geometry(1); if (nlyr() < 3) { out.setError("need at least three layers"); return out; } size_t mxlyr = std::max(std::max(r, g), b); if (nlyr() < mxlyr) { out.setError("layer number for R, G, B, cannot exceed nlyr()"); return out; } std::vector lyrs = {r, g, b}; SpatOptions ops(opt); SpatRaster tmp = subset(lyrs, ops); if (source[0].extset) { SpatOptions topt(opt); tmp = tmp.hardCopy(topt); return tmp.rgb2col(r, g, b, opt); } else { tmp = tmp.collapse_sources(); } std::string filename = opt.get_filename(); opt.set_datatype("INT1U"); std::string driver; if (filename.empty()) { if (canProcessInMemory(opt)) { driver = "MEM"; } else { filename = tempFile(opt.get_tempdir(), opt.tmpfile, ".tif"); opt.set_filenames({filename}); driver = "GTiff"; } } else { driver = opt.get_filetype(); getGDALdriver(filename, driver); if (driver.empty()) { out.setError("cannot guess file type from filename"); return out; } std::string errmsg; if (!can_write({filename}, filenames(), opt.get_overwrite(), errmsg)) { out.setError(errmsg); return out; } } GDALDatasetH hSrcDS, hDstDS; if (!tmp.open_gdal(hSrcDS, 0, false, ops)) { out.setError("cannot create dataset from source"); return out; } GDALRasterBandH R = GDALGetRasterBand(hSrcDS,1); GDALRasterBandH G = GDALGetRasterBand(hSrcDS,1); GDALRasterBandH B = GDALGetRasterBand(hSrcDS,1); GDALColorTableH hColorTable= GDALCreateColorTable(GPI_RGB); if (GDALComputeMedianCutPCT(R, G, B, NULL, 256, hColorTable, NULL, NULL) != CE_None) { out.setError("cannot create color table"); GDALClose(hSrcDS); return out; } if (!out.create_gdalDS(hDstDS, filename, driver, true, 0, {false}, {0.0}, {1.0}, opt)) { out.setError("cannot create new dataset"); GDALClose(hSrcDS); return out; } GDALRasterBandH hTarget = GDALGetRasterBand(hDstDS, 1); GDALSetRasterColorInterpretation(hTarget, GCI_PaletteIndex); if (GDALDitherRGB2PCT(R, G, B, hTarget, hColorTable, NULL, NULL) != CE_None) { out.setError("cannot set color table"); GDALClose(hSrcDS); GDALClose(hDstDS); return out; } GDALClose(hSrcDS); if (driver == "MEM") { if (!out.from_gdalMEM(hDstDS, false, true)) { out.setError("conversion failed (mem)"); GDALClose(hDstDS); return out; } SpatDataFrame cdf; cdf.add_column(1, "red"); cdf.add_column(1, "green"); cdf.add_column(1, "blue"); cdf.add_column(1, "alpha"); size_t nc = GDALGetColorEntryCount(hColorTable); cdf.reserve(nc); for (size_t i=0; ic1); cdf.iv[1].push_back(col->c2); cdf.iv[2].push_back(col->c3); cdf.iv[3].push_back(col->c4); } out.source[0].hasColors.resize(1); out.source[0].hasColors[0] = true; out.source[0].cols.resize(1); out.source[0].cols[0] = cdf; } else { if (GDALSetRasterColorTable(hTarget, hColorTable) != CE_None) { out.setError("cannot set color table"); GDALClose(hDstDS); return out; } } GDALClose(hDstDS); if (driver != "MEM") { out = SpatRaster(filename, {-1}, {""}, {}, {}); } return out; } #if GDAL_VERSION_MAJOR >= 3 && GDAL_VERSION_MINOR >= 1 SpatRaster SpatRaster::viewshed(const std::vector obs, const std::vector vals, const double curvcoef, const int mode, const double maxdist, const int heightmode, SpatOptions &opt) { SpatRaster out = geometry(1); if (could_be_lonlat()) { out.setError("the method does not support lon/lat data"); return out; } if (!hasValues()) { out.setError("input raster has no values"); return out; } GDALViewshedOutputType outmode; if (heightmode==1) { outmode = GVOT_NORMAL; //= heightmode; } else if (heightmode==2) { outmode = GVOT_MIN_TARGET_HEIGHT_FROM_DEM; } else if (heightmode==3) { outmode = GVOT_MIN_TARGET_HEIGHT_FROM_GROUND; } else { out.setError("invalid output type"); return out; } GDALViewshedMode emode; if (mode==1) { emode = GVM_Diagonal; } else if (mode==2) { emode = GVM_Edge; } else if (mode==3) { emode = GVM_Max; } else if (mode==4) { emode = GVM_Min; } else { out.setError("invalid mode"); return out; } double minval = -9999; if (source[0].hasRange[0]) { minval = source[0].range_min[0] - 9999; } SpatOptions topt(opt); SpatRaster x; if (nlyr() > 1) { out.addWarning("viewshed is only done for the first layer"); x = subset({0}, topt); x = x.replaceValues({NAN}, {minval}, 0, false, NAN, false, topt); } else { x = replaceValues({NAN}, {minval}, 0, false, NAN, false, topt); } std::string fname = opt.get_filename(); std::string driver; if (!fname.empty()) { driver = opt.get_filetype(); getGDALdriver(fname, driver); if (driver.empty()) { setError("cannot guess file type from filename"); return out; } std::string errmsg; if (!can_write({fname}, filenames(), opt.get_overwrite(), errmsg)) { out.setError(errmsg); return out; } } std::string filename = tempFile(topt.get_tempdir(), topt.tmpfile, ".tif"); driver = "GTiff"; GDALDatasetH hSrcDS; if (!x.open_gdal(hSrcDS, 0, false, topt)) { out.setError("cannot open input dataset"); return out; } GDALDriverH hDriver = GDALGetDriverByName( driver.c_str() ); if ( hDriver == NULL ) { out.setError("empty driver"); return out; } GIntBig diskNeeded = ncell() * 4; char **papszOptions = set_GDAL_options(driver, diskNeeded, false, topt.gdal_options); GDALRasterBandH hSrcBand = GDALGetRasterBand(hSrcDS, 1); GDALDatasetH hDstDS = GDALViewshedGenerate(hSrcBand, driver.c_str(), filename.c_str(), papszOptions, obs[0], obs[1], obs[2], obs[3], vals[0], vals[1], vals[2], vals[3], curvcoef, emode, maxdist, NULL, NULL, outmode, NULL); if (hDstDS != NULL) { GDALClose(hDstDS); GDALClose(hSrcDS); CSLDestroy( papszOptions ); out = SpatRaster(filename, {-1}, {""}, {}, {}); } else { GDALClose(hSrcDS); CSLDestroy( papszOptions ); out.setError("something went wrong"); } if (heightmode==1) { out.setValueType(3); out.setNames({"viewshed"}); } else if (heightmode==2) { out.setNames({"above_sea"}); } else { out.setNames({"above_land"}); } out = out.mask(*this, false, NAN, NAN, opt); return out; } #else SpatRaster SpatRaster::viewshed(const std::vector obs, const std::vector vals, const double curvcoef, const int mode, const double maxdist, const int heightmode, SpatOptions &opt) { SpatRaster out; out.setError("viewshed is not available for your version of GDAL. Need 3.1 or higher"); return out; } #endif std::string doubleToAlmostChar(double value){ std::stringstream ss ; ss << value; std::string out = ss.str(); return out; } SpatRaster SpatRaster::proximity(double target, double exclude, bool keepNA, std::string unit, bool buffer, double maxdist, bool remove_zero, SpatOptions &opt) { SpatRaster out = geometry(1); if (nlyr() > 1) { out.addWarning("only the first layer is processed"); } if (!hasValues()) { out.setError("input raster has no values"); return out; } if (source[0].extset) { SpatOptions topt(opt); SpatRaster etmp; if (nlyr() > 1) { etmp = etmp.subset({0}, topt); etmp = etmp.hardCopy(topt); } else { etmp = hardCopy(topt); } return etmp.proximity(target, exclude, keepNA, unit, buffer, maxdist, remove_zero, opt); } std::string filename = opt.get_filename(); std::string driver; if (filename.empty()) { if (canProcessInMemory(opt)) { driver = "MEM"; } else { filename = tempFile(opt.get_tempdir(), opt.tmpfile, ".tif"); opt.set_filenames({filename}); driver = "GTiff"; } } else { driver = opt.get_filetype(); getGDALdriver(filename, driver); if (driver.empty()) { setError("cannot guess file type from filename"); return out; } std::string errmsg; if (!can_write({filename}, filenames(), opt.get_overwrite(), errmsg)) { out.setError(errmsg); return out; } } // GDAL proximity algo fails with other drivers? See #1116 // driver = "MEM"; GDALDatasetH hSrcDS, hDstDS; GDALDriverH hDriver = GDALGetDriverByName( driver.c_str() ); if ( hDriver == NULL ) { out.setError("empty driver"); return out; } GIntBig diskNeeded = ncell() * 4; char **papszOptions = set_GDAL_options(driver, diskNeeded, false, opt.gdal_options); papszOptions = CSLSetNameValue(papszOptions, "DISTUNITS", "GEO"); SpatOptions ops(opt); SpatRaster x; bool mask = false; std::vector mvals; if ((!buffer) && (maxdist > 0)) { papszOptions = CSLSetNameValue(papszOptions, "MAXDIST", doubleToAlmostChar(maxdist).c_str()); } if (buffer) { if (remove_zero) { x = isnotnan(true, ops); } papszOptions = CSLSetNameValue(papszOptions, "MAXDIST", doubleToAlmostChar(maxdist).c_str()); papszOptions = CSLSetNameValue(papszOptions, "FIXED_BUF_VAL", doubleToAlmostChar(1.0).c_str()); } else if (std::isnan(target)) { if (std::isnan(exclude)) { // no exclusions x = isnotnan(false, ops); } else { // exclusion becomes target and is masked later x = replaceValues({exclude, NAN}, {0, 0}, 1, true, 1, false, ops); mvals.push_back(exclude); mask = true; } } else { //option for keepNA does not work, perhaps because of int conversion //papszOptions = CSLSetNameValue(papszOptions, "USE_INPUT_NODATA", "YES"); if (std::isnan(exclude)) { if (keepNA) { x = replaceValues({target, NAN}, {0, 0}, 1, true, 1, false, ops); mvals.push_back(exclude); mask = true; } else { x = replaceValues({target}, {0}, 1, true, 1, false, ops); } } else { x = replaceValues({exclude, target}, {0, 0}, 1, true, 1, false, ops); mvals.push_back(exclude); mask = true; } } if (x.hasValues()) { if (!x.open_gdal(hSrcDS, 0, false, ops)) { out.setError("cannot open input dataset"); return out; } } else if (!open_gdal(hSrcDS, 0, false, ops)) { out.setError("cannot open input dataset"); return out; } std::string tmpfile = tempFile(opt.get_tempdir(), opt.tmpfile, ".tif"); std::string fname = mask ? tmpfile : filename; if (!out.create_gdalDS(hDstDS, fname, driver, false, 0, {false}, {1}, {0}, ops)) { out.setError("cannot create new dataset"); GDALClose(hSrcDS); return out; } GDALRasterBandH hSrcBand = GDALGetRasterBand(hSrcDS, 1); GDALRasterBandH hTargetBand = GDALGetRasterBand(hDstDS, 1); if (GDALComputeProximity(hSrcBand, hTargetBand, papszOptions, NULL, NULL) != CE_None) { out.setError("proximity algorithm failed"); GDALClose(hSrcDS); GDALClose(hDstDS); CSLDestroy( papszOptions ); return out; } GDALClose(hSrcDS); CSLDestroy( papszOptions ); if (driver == "MEM") { if (!out.from_gdalMEM(hDstDS, false, true)) { out.setError("conversion failed (mem)"); GDALClose(hDstDS); return out; } GDALClose(hDstDS); } else { if (!mask) { double adfMinMax[2]; GDALComputeRasterMinMax(hTargetBand, true, adfMinMax); GDALSetRasterStatistics(hTargetBand, adfMinMax[0], adfMinMax[1], -9999, -9999); } GDALClose(hDstDS); out = SpatRaster(fname, {-1}, {""}, {}, {}); } if (mask) { out = out.mask(*this, false, mvals, NAN, opt); } return out; } SpatRaster SpatRaster::sieveFilter(int threshold, int connections, SpatOptions &opt) { if (nlyr() > 1) { SpatOptions sopt(opt); SpatRaster tmp = subset({0}, sopt); tmp = tmp.sieveFilter(threshold, connections, opt); tmp.addWarning("only the first layer was used"); return tmp; } SpatRaster out = geometry(1, true, true, true); if (!hasValues()) { out.setError("input raster has no values"); return out; } if (!((connections == 4) || (connections == 8))) { out.setError("connections should be 4 or 8"); return out; } if (threshold < 2) { out.setError("a threshold < 2 is not meaningful"); return out; } if (source[0].extset) { SpatOptions topt(opt); SpatRaster etmp = hardCopy(topt); return etmp.sieveFilter(threshold, connections, opt); } std::string tmp_filename = ""; std::string driver = "MEM"; SpatOptions ops(opt); if (!canProcessInMemory(ops)) { tmp_filename = tempFile(ops.get_tempdir(), ops.tmpfile, "_sieve.tif"); driver = "GTiff"; ops.set_filenames({tmp_filename}); } SpatOptions mopt(opt); SpatRaster mask = isnotnan(false, mopt); GDALDatasetH hSrcDS, hMskDS, hDstDS; if (!open_gdal(hSrcDS, 0, false, ops)) { out.setError("cannot open input dataset"); return out; } if (!mask.open_gdal(hMskDS, 0, false, ops)) { out.setError("cannot open mask dataset"); return out; } GDALDriverH hDriver = GDALGetDriverByName( driver.c_str() ); if ( hDriver == NULL ) { out.setError("empty driver"); return out; } //opt.datatype = "INT4S"; if (!out.create_gdalDS(hDstDS, tmp_filename, driver, true, 0, source[0].has_scale_offset, source[0].scale, source[0].offset, ops)) { out.setError("cannot create new dataset"); GDALClose(hSrcDS); return out; } GDALRasterBandH hSrcBand = GDALGetRasterBand(hSrcDS, 1); GDALRasterBandH hMskBand = GDALGetRasterBand(hMskDS, 1); GDALRasterBandH hTargetBand = GDALGetRasterBand(hDstDS, 1); if (GDALSieveFilter(hSrcBand, hMskBand, hTargetBand, threshold, connections, nullptr, NULL, NULL) != CE_None) { GDALClose(hSrcDS); GDALClose(hMskDS); GDALClose(hDstDS); out.setError("sieve failed"); return out; } GDALClose(hSrcDS); GDALClose(hMskDS); if (driver == "MEM") { if (!out.from_gdalMEM(hDstDS, false, true)) { out.setError("conversion failed (mem)"); } GDALClose(hDstDS); } else { GDALClose(hDstDS); out = SpatRaster(tmp_filename, {-1}, {""}, {}, {}); } opt.names = getNames(); out.source[0].source_name = {""}; return out.mask(mask, false, 0, NAN, opt); } bool getGridderAlgo(std::string algo, GDALGridAlgorithm &a) { if (algo == "nearest") { a = GGA_NearestNeighbor; } else if (algo == "invdistpow") { a = GGA_InverseDistanceToAPower; } else if (algo == "invdistpownear") { a = GGA_InverseDistanceToAPowerNearestNeighbor; } else if (algo == "mean") { a = GGA_MovingAverage; } else if (algo == "min") { a = GGA_MetricMinimum; } else if (algo == "max") { a = GGA_MetricMaximum; } else if (algo == "range") { a = GGA_MetricRange; } else if (algo == "count") { a = GGA_MetricCount; } else if (algo == "distto") { a = GGA_MetricAverageDistance; } else if (algo == "distbetween") { a = GGA_MetricAverageDistancePts; } else if (algo == "linear") { a = GGA_Linear; } else { return false; } return true; } void *metricOptions(std::vector op) { GDALGridDataMetricsOptions *poOptions = static_cast( CPLCalloc(sizeof(GDALGridDataMetricsOptions), 1)); #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 6 #else poOptions->nSizeOfStructure = sizeof(GDALGridDataMetricsOptions); #endif poOptions->dfRadius1 = op[0]; poOptions->dfRadius2 = op[1]; poOptions->dfAngle = op[2]; poOptions->nMinPoints = std::max(0.0, op[3]); poOptions->dfNoDataValue = op[4]; return poOptions; } void *invDistPowerOps(std::vector op) { GDALGridInverseDistanceToAPowerOptions *poOptions = static_cast( CPLCalloc(sizeof(GDALGridInverseDistanceToAPowerOptions), 1)); #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 6 #else poOptions->nSizeOfStructure = sizeof(GDALGridInverseDistanceToAPowerOptions); #endif poOptions->dfPower = op[0]; poOptions->dfSmoothing = op[1]; poOptions->dfRadius1 = op[2]; poOptions->dfRadius2 = op[3]; poOptions->dfAngle = op[4]; poOptions->nMaxPoints = std::max(0.0, op[5]); poOptions->nMinPoints = std::max(0.0, op[6]); poOptions->dfNoDataValue = op[7]; poOptions->dfAnisotropyRatio = 1; poOptions->dfAnisotropyAngle = 0; return poOptions; } void *invDistPowerNNOps(std::vector op) { GDALGridInverseDistanceToAPowerNearestNeighborOptions *poOptions = static_cast( CPLCalloc(sizeof(GDALGridInverseDistanceToAPowerNearestNeighborOptions), 1)); #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 6 #else poOptions->nSizeOfStructure = sizeof(GDALGridInverseDistanceToAPowerNearestNeighborOptions); //poOptions->nMaxPointsPerQuadrant = //poOptions->nMinPointsPerQuadrant = #endif poOptions->dfPower = op[0]; poOptions->dfSmoothing = op[1]; poOptions->dfRadius = op[2]; poOptions->nMaxPoints = std::max(0.0, op[3]); poOptions->nMinPoints = std::max(0.0, op[4]); poOptions->dfNoDataValue = op[5]; return poOptions; } void *moveAvgOps(std::vector op) { GDALGridMovingAverageOptions *poOptions = static_cast( CPLCalloc(sizeof(GDALGridMovingAverageOptions), 1)); #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 6 #else poOptions->nSizeOfStructure = sizeof(GDALGridMovingAverageOptions); #endif poOptions->dfRadius1 = op[0]; poOptions->dfRadius2 = op[1]; poOptions->dfAngle = op[2]; poOptions->nMinPoints = std::max(op[3], 0.0); poOptions->dfNoDataValue = op[4]; return poOptions; } void *nearngbOps(std::vector op) { GDALGridNearestNeighborOptions *poOptions = static_cast( CPLCalloc(sizeof(GDALGridNearestNeighborOptions), 1)); #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 6 #else poOptions->nSizeOfStructure = sizeof(GDALGridNearestNeighborOptions); #endif poOptions->dfRadius1 = op[0]; poOptions->dfRadius2 = op[1]; poOptions->dfAngle = op[2]; poOptions->dfNoDataValue = op[3]; return poOptions; } void *LinearOps(std::vector op) { GDALGridLinearOptions *poOptions = static_cast( CPLCalloc(sizeof(GDALGridLinearOptions), 1)); #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 6 #else poOptions->nSizeOfStructure = sizeof(GDALGridLinearOptions); #endif poOptions->dfRadius = op[0]; poOptions->dfNoDataValue = op[1]; return poOptions; } SpatRaster SpatRaster::rasterizeWindow(std::vector x, std::vector y, std::vector z, std::string algo, std::vector algops, SpatOptions &opt) { SpatRaster out = geometry(1); GDALGridAlgorithm eAlg; if (!getGridderAlgo(algo, eAlg)) { out.setError("unknown algorithm"); return out; } void *poOptions; if (is_in_vector(algo, {"min", "max", "range", "count", "distto", "distbetween"})) { if (algops.size() != 5) { out.setError("incorrect algorithm options"); return out; } poOptions = metricOptions(algops) ; } else if (algo == "mean") { if (algops.size() != 5) { out.setError("incorrect algorithm options"); return out; } poOptions = moveAvgOps(algops); } else if (algo == "invdistpow") { if (algops.size() != 8) { out.setError("incorrect algorithm options"); return out; } poOptions = invDistPowerOps(algops); } else if (algo == "invdistpownear") { if (algops.size() != 6) { out.setError("incorrect algorithm options"); return out; } poOptions = invDistPowerNNOps(algops); } else if (algo == "nearest") { if (algops.size() != 4) { out.setError("incorrect algorithm options"); return out; } poOptions = nearngbOps(algops); } else if (algo == "linear") { if (algops.size() != 2) { out.setError("incorrect algorithm options"); return out; } poOptions = LinearOps(algops); } else { out.setError("unknown algorithm"); return out; } SpatExtent e = out.getExtent(); if (!out.writeStart(opt, out.filenames())) { return out; } const char *old_count_value = CPLGetConfigOption("GDAL_GRID_POINT_COUNT_THRESHOLD", NULL); std::string n = std::to_string(x.size()); CPLSetConfigOption("GDAL_GRID_POINT_COUNT_THRESHOLD", n.c_str()); GUInt32 npts = x.size(); GDALGridContext *ctxt = GDALGridContextCreate(eAlg, poOptions, npts, &x[0], &y[0], &z[0], true); CPLFree( poOptions ); double rsy = out.yres() / 2; size_t ncs = out.ncol(); BlockSize bs = out.getBlockSize(opt); std::vector v; for (size_t i=0; i < bs.n; i++) { double ymax = yFromRow(bs.row[i]) + rsy; double ymin = yFromRow(bs.row[i] + bs.nrows[i] - 1) - rsy; v.resize(bs.nrows[i] * ncs); CPLErr eErr = GDALGridContextProcess(ctxt, e.xmin, e.xmax, ymin, ymax, ncs, bs.nrows[i], GDT_Float64, &v[0], NULL, NULL); if ( eErr != CE_None ) { out.setError("something went wrong"); GDALGridContextFree(ctxt); CPLSetConfigOption("GDAL_GRID_POINT_COUNT_THRESHOLD", old_count_value); return out; } std::vector f; f.reserve(v.size()); for (size_t j=0; j < bs.nrows[i]; j++) { unsigned start = (bs.nrows[i] - 1 - j) * ncs; f.insert(f.end(), v.begin()+start, v.begin()+start+ncs); } if (!out.writeBlock(f, i)) { GDALGridContextFree(ctxt); CPLSetConfigOption("GDAL_GRID_POINT_COUNT_THRESHOLD", old_count_value); return out; } } GDALGridContextFree(ctxt); CPLSetConfigOption("GDAL_GRID_POINT_COUNT_THRESHOLD", old_count_value); out.writeStop(); return out; } /* SpatRaster SpatRaster::fillna(int threshold, int connections, SpatOptions &opt) { CPLErr GDALFillNodata(GDALRasterBandH hTargetBand, GDALRasterBandH hMaskBand, doubledfMaxSearchDist, intbDeprecatedOption, intnSmoothingIterations, char**papszOptions, GDALProgressFuncpfnProgress, void*pProgressArg) */ SpatRaster SpatRaster::fillNA(double missing, double maxdist, int niter, SpatOptions &opt) { SpatRaster out = geometry(1, true, true, true); if (!hasValues()) { out.setError("input raster has no values"); return out; } if (maxdist <= 0) { out.setError("maxdist should be > 0"); return out; } if (niter < 0) { out.setError("niter should be >= 0"); return out; } std::string filename = opt.get_filename(); std::string driver; if (filename.empty()) { if (canProcessInMemory(opt)) { driver = "MEM"; } else { filename = tempFile(opt.get_tempdir(), opt.tmpfile, ".tif"); opt.set_filenames({filename}); driver = "GTiff"; } } else { driver = opt.get_filetype(); getGDALdriver(filename, driver); if (driver.empty()) { setError("cannot guess file type from filename"); return out; } std::string errmsg; if (!can_write({filename}, filenames(), opt.get_overwrite(), errmsg)) { out.setError(errmsg); return out; } } SpatOptions ops(opt); GDALDatasetH hSrcDS, hDstDS; if (!open_gdal(hSrcDS, 0, false, ops)) { out.setError("cannot open input dataset"); return out; } GDALDriverH hDriver = GDALGetDriverByName( driver.c_str() ); if ( hDriver == NULL ) { out.setError("empty driver"); return out; } //opt.datatype = "INT4S"; if (!out.create_gdalDS(hDstDS, filename, driver, true, 0, source[0].has_scale_offset, source[0].scale, source[0].offset, opt)) { out.setError("cannot create new dataset"); GDALClose(hSrcDS); return out; } GDALRasterBandH hSrcBand = GDALGetRasterBand(hSrcDS, 1); GDALRasterBandH hTargetBand = GDALGetRasterBand(hDstDS, 1); if (GDALFillNodata(hTargetBand, hSrcBand, maxdist, 0, niter, NULL, NULL, NULL) != CE_None) { out.setError("fillNA failed"); GDALClose(hSrcDS); GDALClose(hDstDS); return out; } GDALClose(hSrcDS); if (driver == "MEM") { if (!out.from_gdalMEM(hDstDS, false, true)) { out.setError("conversion failed (mem)"); } GDALClose(hDstDS); return out; } double adfMinMax[2]; GDALComputeRasterMinMax(hTargetBand, true, adfMinMax); GDALSetRasterStatistics(hTargetBand, adfMinMax[0], adfMinMax[1], -9999, -9999); GDALClose(hDstDS); return SpatRaster(filename, {-1}, {""}, {}, {}); } /* #include SpatRaster SpatRaster::panSharpen(SpatRaster pan, SpatOptions &opt) { SpatRaster out = geometry(); return out; } */ terra/src/spatFactor.cpp0000644000176200001440000000637414536376240015014 0ustar liggesusers#include #include #include #include #include #include "spatFactor.h" template std::vector unique_values(std::vector d) { std::sort(d.begin(), d.end()); d.erase(std::unique(d.begin(), d.end()), d.end()); //d.erase(std::remove(d.begin(), d.end(), na), d.end()); return d; } std::vector string_values(std::vector& v) { return v; } template std::vector string_values(std::vector& v) { std::vector result; std::transform(std::begin(v), std::end(v), std::back_inserter(result), [](T d) { std::string s = std::to_string(d); s.erase( s.find_last_not_of('0') + 1, std::string::npos ); s.erase( s.find_last_not_of('.') + 1, std::string::npos ); return s; } ); return result; } //void SpatFactor::compute_levels() { // levels = unique_values(v); // labels = string_values(levels); //} SpatFactor::SpatFactor(std::vector _values, std::vector _labels) { v = _values; labels = _labels; // is this needed? //levels.resize(labels.size()); //std::iota(levels.begin(), levels.end(), 0); } SpatFactor::SpatFactor(std::vector _values, std::vector _labels, bool _ordered) { v = _values; labels = _labels; ordered = _ordered; } SpatFactor::SpatFactor(std::vector _values) { std::vector u = unique_values(_values); size_t n = _values.size(); size_t un = u.size(); labels = string_values(u); //levels.resize(un); //std::iota(levels.begin(), levels.end(), 0); v.resize(n); for (size_t i=0; i _values) { std::vector u = unique_values(_values); size_t n = _values.size(); size_t un = u.size(); labels = string_values(u); //levels.resize(un); //std::iota(levels.begin(), levels.end(), 0); v.resize(n); for (size_t i=0; i _levels, std::vector _labels) { if (_levels.size() == _labels.size()) { levels = _levels; labels = _labels; } else { return false; } return true; } */ bool SpatFactor::set_labels(std::vector _labels) { //if (levels.size() == _labels.size()) { labels = _labels; //} else { // return false; //} return true; } SpatFactor SpatFactor::subset(std::vector i) { SpatFactor out; out.labels = labels; size_t n = i.size(); out.reserve(n); for (size_t j=0; j SpatFactor::getLabels() { std::vector out; size_t n = v.size(); size_t m = labels.size() + 1; out.reserve(n); for (size_t i=0; i. #include #include "spatVector.h" #include "distance.h" #include "geosphere.h" #include "geodesic.h" #include "vecmath.h" #include "crs.h" //#include "sort.h" #include "math_utils.h" #include "Rcpp.h" double polDistLonLat(SpatVector &p1, SpatVector &p2, std::string unit, std::string method) { std::vector inside = p1.relate(p2, "intersects", true, true); if (inside[0]) return 0; std::vector> xy = p2.coordinates(); std::vector x = xy[0]; std::vector y = xy[1]; size_t ng = p1.size(); size_t np = x.size(); double d = std::numeric_limits::infinity(); double r = 6378137; double m = 1; if (unit == "km") { r = 6378.137; m = 0.001; } std::function d2seg; if (method != "geo") { deg2rad(x); deg2rad(y); d2seg = dist2segment_cos; } else { d2seg = dist2segment_geo; } std::vector dout; std::vector vx, vy; if (p1.type() == "polygons") { for (size_t g=0; g SpatVector::distLonLat(SpatVector p, std::string unit, std::string method, bool transp) { std::vector> xy = p.coordinates(); std::vector x = xy[0]; std::vector y = xy[1]; size_t np = x.size(); size_t ng = size(); double inf = std::numeric_limits::infinity(); std::vector> d(np, std::vector(ng, inf)); /* std::vector inside = relate(p, "intersects", true, true); Rcpp::Rcout << inside.size() << " " << ng << " " << np << std::endl; for (size_t i=0; i inside = pointInPolygon(x, y); for (size_t i=0; i d2seg; if (method != "geo") { deg2rad(x); deg2rad(y); d2seg = dist2segment_cos; } else { d2seg = dist2segment_geo; } std::vector dout; std::vector vx, vy; if (type() == "polygons") { for (size_t g=0; g> pts = coordinates(); if (method != "geo") { deg2rad(pts[0]); deg2rad(pts[1]); } return pointdistance(x, y, pts[0], pts[1], false, m, true, method); } dout.reserve(np*ng); if (transp) { for (size_t i=0; i SpatVector::nearestDistLonLat(std::vector x, std::vector y, std::string unit, std::string method) { // for use with rasterize std::vector d; double r = 6378137; double m = 1; if (unit == "km") { r = 6378.137; m = 0.001; } std::vector inside; if (type() == "polygons") { // std::vector insect = relate(x, "intersects", true, true); inside = pointInPolygon(x, y); } std::function d2seg; if (method != "geo") { deg2rad(x); deg2rad(y); d2seg = dist2segment_cos; } else { d2seg = dist2segment_geo; } size_t np = x.size(); size_t ng = size(); double inf = std::numeric_limits::infinity(); d.resize(np, inf); std::vector vx, vy; if (type() == "polygons") { for (size_t g=0; g> pts = coordinates(); if (method != "geo") { deg2rad(pts[0]); deg2rad(pts[1]); } d = pointdistance(x, y, pts[0], pts[1], false, m, true, method); } return d; } } */ std::vector SpatVector::distance(SpatVector x, bool pairwise, std::string unit, const std::string method) { std::vector d; if (srs.is_empty() || x.srs.is_empty()) { setError("crs not defined"); return(d); } if (! srs.is_same(x.srs, false) ) { setError("crs do not match"); return(d); } size_t s = size(); size_t sx = x.size(); if ((s == 0) || (sx == 0)) { setError("empty SpatVector"); return(d); } if (pairwise && (s != sx ) && (s > 1) && (sx > 1)) { setError("For pairwise distance, the number of geometries must match, or one should have a single geometry"); return(d); } bool lonlat = is_lonlat(); double m=1; if (!srs.m_dist(m, lonlat, unit)) { setError("invalid unit"); return(d); } if ((method != "geo") && (method != "cosine")) { setError("invalid method. Must be 'geo' or 'cosine'"); return(d); } std::string gtype = type(); std::string xtype = x.type(); if ((gtype == "points") && (xtype == "points")) { std::vector> p = coordinates(); std::vector> px = x.coordinates(); return pointdistance(p[0], p[1], px[0], px[1], pairwise, m, lonlat, method); } else if ((gtype == "points") || (xtype == "points")) { if (lonlat) { // not ok for multi-points if (gtype == "points") { // std::vector> xy = coordinates(); return x.distLonLat(*this, unit, method, false); } else { // std::vector> xy = x.coordinates(); return distLonLat(x, unit, method, true); } } else { return geos_distance(x, pairwise, "", m); } } else { if (lonlat) { size_t n = size() * x.size(); d.reserve(n); /* std::vector> e1, e2; e1.reserve(n); for (size_t g=0; g> idx = get_index(e1, e2); */ for (size_t i=0; i> xy1 = tmp1.coordinates(); for (size_t j=0; j d1 = tmp2.distLonLat(xy1[0], xy1[1], unit, method, false); // std::vector> xy2 = tmp2.coordinates(); // std::vector d2 = tmp1.distLonLat(xy2[0], xy2[1], unit, method, false); // std::vector d1 = tmp2.distLonLat(tmp1, unit, method, false); // std::vector d2 = tmp1.distLonLat(tmp2, unit, method, false); // d.push_back(std::min(vmin(d1, false), vmin(d2, false))); double d1 = polDistLonLat(tmp2, tmp1, unit, method); double d2 = polDistLonLat(tmp1, tmp2, unit, method); d.push_back(std::min(d1, d2)); } } } else { d = geos_distance(x, pairwise, "", m); } } return d; } // distance to self std::vector SpatVector::distance(bool sequential, std::string unit, const std::string method) { std::vector d; if (srs.is_empty()) { setError("crs not defined"); return(d); } bool lonlat = is_lonlat(); double m=1; if (!srs.m_dist(m, lonlat, unit)) { setError("invalid unit"); return(d); } std::string gtype = type(); std::function dfun; if (gtype == "points") { if (lonlat) { if (method == "haversine") { dfun = distHaversine; } else if (method == "cosine") { dfun = distCosine; } else if (method == "geo") { dfun = distLonlat; } else { setError("invalid lonlat distance method. Should be 'geo', 'cosine', or 'haversine'"); return(d); } } if (sequential) { std::vector> p = coordinates(); size_t n = p[0].size(); d.reserve(n); d.push_back(0); n -= 1; if (lonlat) { for (size_t i=0; i> p = coordinates(); if (lonlat) { for (size_t i=0; i<(s-1); i++) { for (size_t j=(i+1); j> idx; n -= 1; SpatVector tmp1 = subset_rows(0); // std::vector> xy1 = tmp1.coordinates(); for (size_t i=0; i> xy2 = tmp2.coordinates(); // std::vector d1 = tmp2.distLonLat(xy1[0], xy1[1], unit, method, false); // std::vector d2 = tmp1.distLonLat(xy2[0], xy2[1], unit, method, false); // std::vector d1 = tmp2.distLonLat(tmp1, unit, method, false); // std::vector d2 = tmp1.distLonLat(tmp2, unit, method, false); // d.push_back(std::min(vmin(d1, false), vmin(d2, false))); double d1 = polDistLonLat(tmp2, tmp1, unit, method); double d2 = polDistLonLat(tmp1, tmp2, unit, method); d.push_back(std::min(d1, d2)); tmp1 = tmp2; // xy1 = xy2; } } else { size_t s = size(); size_t n = ((s-1) * s)/2; d.reserve(n); /* std::vector> ee, empty; ee.reserve(n); for (size_t g=0; g> idx = get_index(ee, empty); */ for (size_t i=0; i<(s-1); i++) { SpatVector tmp1 = subset_rows(long(i)); // std::vector> xy1 = tmp1.coordinates(); for (size_t j=(i+1); j> xy2 = tmp2.coordinates(); // std::vector d1 = tmp2.distLonLat(xy1[0], xy1[1], unit, method, false); // std::vector d2 = tmp1.distLonLat(xy2[0], xy2[1], unit, method, false); // std::vector d1 = tmp2.distLonLat(tmp1, unit, method, false); // std::vector d2 = tmp1.distLonLat(tmp2, unit, method, false); // d.push_back(std::min(vmin(d1, false), vmin(d2, false))); double d1 = polDistLonLat(tmp2, tmp1, unit, method); double d2 = polDistLonLat(tmp1, tmp2, unit, method); d.push_back(std::min(d1, d2)); } } } } else { return geos_distance(sequential, "", m); } } return d; } std::vector SpatVector::pointdistance(const std::vector& px, const std::vector& py, const std::vector& sx, const std::vector& sy, bool pairwise, double m, bool lonlat, const std::string method) { std::vector d; size_t szp = px.size(); size_t szs = sx.size(); if ((szp == 0) || (szs == 0)) { setError("empty SpatVector"); return(d); } if (pairwise && (szp != szs ) && (szs > 1) && (szp > 1)) { setError("Can only do pairwise distance if geometries match, or if one is a single geometry"); return(d); } // std::vector> p = coordinates(); // std::vector> px = x.coordinates(); size_t n = pairwise ? std::max(szs,szp) : szp*szs; d.reserve(n); std::function dfun; if (lonlat) { if (method == "haversine") { dfun = distHaversine; } else if (method == "cosine") { dfun = distCosine; } else if (method == "geo") { dfun = distLonlat; } else { setError("invalid lonlat distance method. Should be 'geo', 'cosine', or 'haversine'"); return(d); } } if (pairwise) { if (szp == szs) { if (lonlat) { for (size_t i = 0; i < szs; i++) { d.push_back( dfun(px[i], py[i], sx[i], sy[i]) * m); } } else { // not reached for (size_t i = 0; i < szs; i++) { d.push_back( distance_plane(px[i], py[i], sx[i], sy[i]) * m); } } } else if (szp == 1) { // to avoid recycling. if (lonlat) { for (size_t i = 0; i < szs; i++) { d.push_back( dfun(px[0], py[0], sx[i], sy[i]) * m); } } else { // not reached for (size_t i = 0; i < szs; i++) { d.push_back( distance_plane(px[0], py[0], sx[i], sy[i]) * m); } } } else { // if (szs == 1) { if (lonlat) { for (size_t i = 0; i < szp; i++) { d.push_back(dfun(px[i], py[i], sx[0], sy[0]) * m); } } else { // not reached for (size_t i = 0; i < szp; i++) { d.push_back( distance_plane(px[i], py[i], sx[0], sy[0]) * m); } } } } else { if (lonlat) { for (size_t i=0; i SpatVector::pointdistance_seq(const std::vector& px, const std::vector& py, double m, bool lonlat) { std::vector d; size_t szp = px.size(); d.reserve(szp); d.push_back(0); szp -= 1; if (lonlat) { for (size_t i = 0; i < szp; i++) { d.push_back( distance_lonlat(px[i], py[i], px[i+1], py[i+1]) ); } } else { // not reached for (size_t i = 0; i < szs; i++) { d.push_back( distance_plane(px[i], py[i], px[i+1], py[i+1]) * m); } } return d; } */ void make_dense_lonlat(std::vector &lon, std::vector &lat, const double &interval, const bool &adjust, geod_geodesic &g) { size_t np = lon.size(); if (np < 2) { return; } size_t sz = lon.size() * 5; std::vector xout, yout; xout.reserve(sz); yout.reserve(sz); for (size_t i=0; i<(np-1); i++) { if (xout.size() > sz) { sz += (np-i) * 10; xout.reserve(sz); yout.reserve(sz); } double d, azi1, azi2; //double hlat = lat[i] + (lat[i+1] - lat[i])/2; //double hlon = lon[i] + (lon[i+1] - lon[i])/2; //geod_inverse(&g, lat[i], lon[i], hlat, hlon, &d1, &azi1, &azi2); //geod_inverse(&g, hlat, hlon, lat[i+1], lon[i+1], &d2, &azi1, &azi2); //double d = d1 + d2; geod_inverse(&g, lat[i], lon[i], lat[i+1], lon[i+1], &d, &azi1, &azi2); size_t n = floor(d / interval); xout.push_back(lon[i]); yout.push_back(lat[i]); if (n < 2) { continue; } double step = adjust ? d / n : interval; double newlat, newlon; for (size_t j=1; j &x, std::vector &y, double &interval, bool &adjust) { size_t np = x.size(); if (np < 2) { return; } size_t sz = x.size() * 5; std::vector xout, yout; xout.reserve(sz); yout.reserve(sz); double pi2 = M_PI * 2; for (size_t i=0; i<(np-1); i++) { if (xout.size() > sz) { sz += (np-i) * 10; xout.reserve(sz); yout.reserve(sz); } double d = sqrt(pow((x[i+1] - x[i]),2) + pow((y[i+1] - y[i]), 2)); size_t n = floor(d / interval); xout.push_back(x[i]); yout.push_back(y[i]); if (n < 2) { continue; } double a = fmod(atan2(x[i+1]-x[i], y[i+1]-y[i]), pi2); double step = adjust ? d / n : interval; double distx = step * sin(a); double disty = step * cos(a); for (size_t j=1; j 0"); return out; } out.srs = srs; if (srs.is_empty()) { out.setError("crs not defined"); return(out); } size_t n = size(); out.reserve(n); if (is_lonlat() && (!ignorelonlat)) { double a = 6378137.0; double f = 1/298.257223563; struct geod_geodesic geod; geod_init(&geod, a, f); for (size_t i=0; i &x, const std::vector &y) { SpatPart p(x, y); double minx = vmin(x, false); double maxx = vmax(x, false); // need a better check but this should work for all normal cases if ((minx < -170) && (maxx > 170)) { for (size_t i=0; i d, unsigned quadsegs, bool no_multipolygons, bool wrap) { SpatVector out; out.reserve(size()); std::string vt = type(); if (vt != "points") { out.setError("geometry must be points"); return out; } size_t npts = size(); size_t n = quadsegs * 4; double step = 360.0 / n; SpatGeom g(polygons); g.addPart(SpatPart(0, 0)); // not good for multipoints // std::vector> xy = coordinates(); if (is_lonlat()) { std::vector brng(n); for (size_t i=0; i> xy = geoms[p].coordinates(); SpatVector tmp; for (size_t i=0; i 90) || (xy[1][i] < -90)) { tmp.addGeom(SpatGeom(polygons)); } else { std::vector ptx; std::vector pty; geod_inverse(&gd, xy[1][i], xy[0][i], 90, xy[0][i], &s12, &azi, &azi2); bool npole = s12 < d[p]; geod_inverse(&gd, xy[1][i], xy[0][i], -90, xy[0][i], &s12, &azi, &azi2); bool spole = s12 < d[p]; if (npole && spole) { ptx = std::vector {-180, 0, 180, 180, 180, 0, -180, -180, -180}; pty = std::vector { 90, 90, 90, 0, -90, -90, -90, 0, 90}; g.reSetPart(SpatPart(ptx, pty)); tmp.addGeom(g); //npole = false; //spole = false; } else { ptx.reserve(n); pty.reserve(n); if (wrap) { for (size_t j=0; j < n; j++) { geod_direct(&gd, xy[1][i], xy[0][i], brng[j], d[p], &lat, &lon, &azi); ptx.push_back(lon); pty.push_back(lat); } } else { for (size_t j=0; j < n; j++) { geod_direct(&gd, xy[1][i], 0, brng[j], d[p], &lat, &lon, &azi); ptx.push_back(lon+xy[0][i]); pty.push_back(lat); } } if (npole) { sort_unique_2d(ptx, pty); if (ptx[ptx.size()-1] < 180) { ptx.push_back(180); pty.push_back(pty[pty.size()-1]); } ptx.push_back(180); pty.push_back(90); ptx.push_back(-180); pty.push_back(90); if (ptx[0] > -180) { ptx.push_back(-180); pty.push_back(pty[0]); } ptx.push_back(ptx[0]); pty.push_back(pty[0]); g.reSetPart(SpatPart(ptx, pty)); tmp.addGeom(g); } else if (spole) { sort_unique_2d(ptx, pty); if (ptx[ptx.size()-1] < 180) { ptx.push_back(180); pty.push_back(pty[pty.size()-1]); } ptx.push_back(180); pty.push_back(-90); ptx.push_back(-180); pty.push_back(-90); if (ptx[0] > -180) { ptx.push_back(-180); pty.push_back(pty[0]); } ptx.push_back(ptx[0]); pty.push_back(pty[0]); g.reSetPart(SpatPart(ptx, pty)); tmp.addGeom(g); } else { ptx.push_back(ptx[0]); pty.push_back(pty[0]); if (wrap) { bool split = false; try { split = fix_date_line(g, ptx, pty); } catch(...) {} if (split & no_multipolygons) { for (size_t j=0; j 1) { tmp = tmp.aggregate(true); } out.addGeom(tmp.geoms[0]); } } else { // not used (GEOS used for planar). Would need to be fixed for multipoints std::vector> xy = coordinates(); std::vector cosb(n); std::vector sinb(n); std::vector px(n+1); std::vector py(n+1); for (size_t i=0; i range = {(unsigned)j, (unsigned)j+1}; SpatVector g = b.subset_rows(range); g = g.hull("convex"); part.addGeom(g.geoms[0]); } part = part.aggregate(true); return part.geoms[0]; } SpatVector lonlat_buf(SpatVector x, double dist, unsigned quadsegs, bool ispol, bool ishole) { /* if ((x.extent.ymin > -60) && (x.extent.ymax < 60) && ((x.extent.ymax - x.extent.ymin) < 1) && dist < 110000) { SpatSRS insrs = x.srs; x.setSRS("+proj=merc"); double f = 0.5 - (dist / 220000); double halfy = x.extent.ymin + f * (x.extent.ymax - x.extent.ymin); std::vector dd = destpoint_lonlat(0, halfy, 0, dist); dist = dd[1] - halfy; if (ishole) dist = -dist; x = x.buffer({dist}, quadsegs, "", "", NAN, false); x.srs = insrs; return x; } */ x = x.disaggregate(false); SpatVector tmp; tmp.reserve(x.size()); //Rcpp::Rcout << x.geoms.size() << std::endl; // double interval = std::max(1000.0, std::max(x.extent.ymax - x.extent.ymin, x.extent.xmax - x.extent.xmin) * 100); // m for (size_t i=0; i d(p.size(), dist); SpatVector b = p.point_buffer(d, quadsegs, true, false); if (b.size() <= p.size()) { SpatGeom g = hullify(b, ispol); tmp.addGeom(g); } else { SpatVector west, east, eastwest; for (size_t j =0; j 179.99)) { tmp.addGeom(b.geoms[j]); } else if (b.geoms[j].extent.xmax < 0) { west.addGeom(b.geoms[j]); } else { east.addGeom(b.geoms[j]); } } if (east.nrow() > 0) { SpatGeom geast = hullify(east, ispol); tmp.addGeom(geast); } if (west.nrow() > 0) { SpatGeom gwest = hullify(west, ispol); tmp.addGeom(gwest); } } } tmp = tmp.aggregate(true); tmp.fix_lonlat_overflow(); if (ispol) { if (dist < 0) { tmp = !ishole ? tmp.get_holes() : tmp.remove_holes(); } else { tmp = ishole ? tmp.get_holes() : tmp.remove_holes(); } } return tmp; } SpatVector SpatVector::buffer_lonlat(std::string vt, std::vector d, unsigned quadsegs) { SpatVector out; std::vector keep; keep.reserve(size()); if (vt == "points") { return point_buffer(d, quadsegs, false, true); } else if (vt == "polygons") { for (size_t i =0; i &lon, const std::vector &lat) { struct geod_polygon p; geod_polygon_init(&p, 0); size_t n = lat.size(); for (size_t i=0; i < n; i++) { //double lat = lat[i] > 90 ? 90 : lat[i] < -90 ? -90 : lat[i]; // for #397 double flat = lat[i] < -90 ? -90 : lat[i]; geod_polygon_addpoint(&g, &p, flat, lon[i]); } double area, P; geod_polygon_compute(&g, &p, 0, 1, &area, &P); return(area < 0 ? -area : area); } double area_polygon_plane(std::vector x, std::vector y) { // based on http://paulbourke.net/geometry/polygonmesh/source1.c size_t n = x.size(); double area = x[n-1] * y[0]; area -= y[n-1] * x[0]; for (size_t i=0; i < (n-1); i++) { area += x[i] * y[i+1]; area -= x[i+1] * y[i]; } area /= 2; return(area < 0 ? -area : area); } double area_lonlat(geod_geodesic &g, const SpatGeom &geom) { double area = 0; if (geom.gtype != polygons) return area; for (size_t i=0; i SpatVector::area(std::string unit, bool transform, std::vector mask) { if (type() != "polygons") { // area is zero std::vector out(nrow(), 0); return out; } if (nrow() == 0) { std::vector out(1, 0); return out; } size_t s = size(); size_t m = mask.size(); bool domask = false; if (m > 0) { if (s != mask.size()) { addWarning("mask size is not correct"); } else { domask = true; } } std::vector ar; ar.reserve(s); std::vector ss {"m", "km", "ha"}; if (std::find(ss.begin(), ss.end(), unit) == ss.end()) { setError("invalid unit"); return {NAN}; } double adj = unit == "m" ? 1 : unit == "km" ? 1000000 : 10000; if (srs.wkt.empty()) { addWarning("unknown CRS. Results can be wrong"); if (domask) { for (size_t i=0; i &lon, const std::vector &lat) { size_t n = lat.size(); double length = 0; for (size_t i=1; i < n; i++) { length += distance_lonlat(lon[i-1], lat[i-1], lon[i], lat[i]); } return (length); } double length_line_plane(std::vector x, std::vector y) { size_t n = x.size(); double length = 0; for (size_t i=1; i SpatVector::length() { size_t s = size(); std::vector r; r.reserve(s); double m = srs.to_meter(); m = std::isnan(m) ? 1 : m; if (srs.wkt.empty()) { addWarning("unknown CRS. Results can be wrong"); } if (m == 0) { struct geod_geodesic g; double a = 6378137; double f = 1 / 298.257223563; geod_init(&g, a, f); for (size_t i=0; i SpatVector::nseg() { size_t s = size(); std::vector r; r.reserve(s); for (size_t i=0; i 180))) { return; } SpatExtent world(-180, 180, -90, 90); std::string vt = type(); if (vt == "points") { for (size_t i=0; i 180) { geoms[i].parts[j].x[k] -= 360; } } } } } else { SpatExtent east(-360, -180, -180, 180); SpatExtent west(180, 360, -180, 180); for (size_t i=0; i 180) { SpatVector v(geoms[i]); if (geoms[i].extent.xmin >= 180) { v = v.shift(-360, 0); } else { SpatVector add = v.crop(west, false); add = add.shift(-360, 0); v = v.crop(world, false); v.geoms[i].addPart(add.geoms[0].parts[0]); } replaceGeom(v.geoms[0], i); } } } if ((extent.ymax > 90) || (extent.ymin < -90)) { SpatVector out = crop(world, false); geoms = out.geoms; extent = out.extent; df = out.df; srs = out.srs; } return; } terra/src/geosphere.h0000644000176200001440000000403214752174111014312 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . //double distance_cos(const double &lon1, const double &lat1, const double &lon2, const double &lat2, const double &r = 6378137); inline void deg2rad(std::vector &x) { const double f = 0.0174532925199433; for (double& d : x) d *= f; } inline void deg2rad(double &x) { const double f = 0.0174532925199433; x *= f; } inline double distance_cos(double lon1, double lat1, double lon2, double lat2) { const double r = 6378137.; return r * acos((sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(lon1-lon2))); } inline double distance_hav(double lon1, double lat1, double lon2, double lat2) { const double r = 6378137.; double dLat = lat2-lat1; double dLon = lon2-lon1; double a = sin(dLat/2.) * sin(dLat/2.) + cos(lat1) * cos(lat2) * sin(dLon/2.) * sin(dLon/2.); return 2. * atan2(sqrt(a), sqrt(1. - a)) * r; } double distance_geo(double lon1, double lat1, double lon2, double lat2); double direction_cos(double& lon1, double& lat1, double& lon2, double& lat2); double dist2segment_hav(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double r=6378137.); double dist2segment_cos(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double r=6378137.); double dist2segment_geo(double plon, double plat, double lon1, double lat1, double lon2, double lat2, double notused=0.); terra/src/spatVector.cpp0000644000176200001440000010301714756761344015037 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatVector.h" #include #include "string_utils.h" #include "math_utils.h" #include "vecmath.h" #include "recycle.h" #include #ifdef useGDAL #include "crs.h" #endif SpatHole::SpatHole() {} SpatHole::SpatHole(std::vector X, std::vector Y) { x = X; y = Y; extent.xmin = *std::min_element(X.begin(), X.end()); extent.xmax = *std::max_element(X.begin(), X.end()); extent.ymin = *std::min_element(Y.begin(), Y.end()); extent.ymax = *std::max_element(Y.begin(), Y.end()); } bool SpatPart::addHole(std::vector X, std::vector Y) { SpatHole h(X, Y); holes.push_back(h); // check if inside pol? return true; } bool SpatPart::addHole(SpatHole h) { holes.push_back(h); // check if inside pol? return true; } SpatPart::SpatPart() {} SpatPart::SpatPart(double X, double Y) { x.push_back(X); y.push_back(Y); extent.xmin = X; extent.xmax = X; extent.ymin = Y; extent.ymax = Y; } SpatPart::SpatPart(std::vector X, std::vector Y) { x = X; y = Y; extent.xmin = *std::min_element(X.begin(), X.end()); extent.xmax = *std::max_element(X.begin(), X.end()); extent.ymin = *std::min_element(Y.begin(), Y.end()); extent.ymax = *std::max_element(Y.begin(), Y.end()); } size_t SpatPart::ncoords() { size_t ncrds = x.size(); size_t nh = holes.size(); for (size_t k=0; k < nh; k++) { ncrds += holes[k].x.size(); } return ncrds; } SpatGeom::SpatGeom() {} SpatGeom::SpatGeom(SpatPart p, SpatGeomType type) { parts = {p}; gtype = type; extent = p.extent; } SpatGeom::SpatGeom(SpatGeomType g) { gtype = g; } bool SpatGeom::unite(SpatGeom g) { if (parts.empty()) { parts = g.parts; extent = g.extent; } else { parts.insert(parts.end(), g.parts.begin(), g.parts.end()); extent.unite(g.extent); } return true; } bool SpatGeom::addPart(SpatPart p) { parts.push_back(p); if (parts.size() > 1) { extent.unite(p.extent); } else { extent = p.extent; } return true; } bool SpatGeom::addHole(SpatHole h) { long i = parts.size()-1; if (i > -1) { parts[i].addHole(h); return true; } else { return false; } } bool SpatGeom::setPart(SpatPart p, unsigned i) { parts[i] = p; if (parts.size() > 1) { extent.unite(p.extent); } else { extent = p.extent; } return true; } bool SpatGeom::reSetPart(SpatPart p) { parts.resize(1); parts[0] = p; extent = p.extent; return true; } SpatPart SpatGeom::getPart(unsigned i) { return parts[i]; } size_t SpatGeom::ncoords() { size_t ncrds = 0; size_t np = parts.size(); for (size_t j=0; j> SpatGeom::coordinates() { std::vector> out(2); size_t np = size(); size_t ncrds = ncoords(); out[0].reserve(ncrds); out[1].reserve(ncrds); for (size_t j=0; j x = { e.xmin, e.xmin, e.xmax, e.xmax, e.xmin }; std::vector y = { e.ymin, e.ymax, e.ymax, e.ymin, e.ymin }; SpatPart p(x, y); SpatGeom g(p, polygons); setGeom(g); setSRS( {crs}); } SpatVector::SpatVector(std::vector x, std::vector y, SpatGeomType g, std::string crs) { if (x.empty()) return; if (g == points) { SpatPart p(x[0], y[0]); SpatGeom geom(p, g); setGeom(geom); for (size_t i=1; i SpatVector::getDv(unsigned i) { return df.getD(i); } std::vector SpatVector::getIv(unsigned i){ return df.getI(i); } std::vector SpatVector::getSv(unsigned i){ return df.getS(i); } std::vector SpatVector::getItype(){ return df.itype; } std::vector SpatVector::getIplace(){ return df.iplace; } std::vector SpatVector::get_names(){ return df.get_names(); } void SpatVector::set_names(std::vector s){ df.set_names(s); } unsigned SpatVector::ncol() { return df.ncol(); } unsigned SpatVector::nrow() { return geoms.size(); } size_t SpatVector::size() { return geoms.size(); } bool SpatVector::empty() { return geoms.empty(); } bool SpatVector::is_multipoint() { if (geoms[0].gtype != points) return false; for (size_t i=0; i 1) { return true; } } return false; } bool SpatVector::is_lonlat() { if (srs.is_lonlat()) { SpatExtent e = getExtent(); if ((e.xmin < -361) || (e.xmax > 361) || (e.ymin < -90.001) || (e.ymax > 90.001)) { addWarning("coordinates are out of range for lon/lat"); } return true; } return false; } bool SpatVector::could_be_lonlat() { if (srs.is_lonlat()) return true; SpatExtent e = getExtent(); return srs.could_be_lonlat(e); } SpatExtent SpatVector::getExtent(){ return extent; } /* void SpatVector::setPRJ(std::string PRJ){ crs[0] = PRJ; } std::string SpatVector::getPRJ(){ return crs[0]; } */ std::string SpatVector::type(){ if (size() == 0) { return "none"; } else { size_t n = size(); for (size_t i = 0; i 1) { extent.unite(p.extent); } else { extent = p.extent; } return true; } bool SpatVector::setGeom(SpatGeom p) { geoms.resize(1); geoms[0] = p; extent = p.extent; return true; } void SpatVector::reserve(size_t n) { geoms.reserve(n); } void SpatVector::computeExtent() { if (geoms.empty()) return; extent = geoms[0].extent; for (size_t i=1; i SpatVector::nullGeoms(){ std::vector ids; for (size_t i=0; i SpatVector::naGeoms(){ std::vector nas(geoms.size(), true); for (size_t i=0; i> SpatVector::coordinates() { std::vector> out(2); for (size_t i=0; i < size(); i++) { SpatGeom g = getGeom(i); for (size_t j=0; j < g.size(); j++) { SpatPart p = g.getPart(j); for (size_t q=0; q < p.x.size(); q++) { out[0].push_back( p.x[q] ); out[1].push_back( p.y[q] ); } if (p.hasHoles()) { for (size_t k=0; k < p.nHoles(); k++) { SpatHole h = p.getHole(k); for (size_t q=0; q < h.x.size(); q++) { out[0].push_back( h.x[q] ); out[1].push_back( h.y[q] ); } } } } } return out; } */ size_t SpatVector::ncoords() { size_t ncrds = 0; size_t ng = geoms.size(); for (size_t i=0; i> SpatVector::coordinates() { std::vector> out(2); size_t ncrds = ncoords(); out[0].reserve(ncrds); out[1].reserve(ncrds); size_t ng = size(); for (size_t i=0; i> SpatVector::getGeometry() { unsigned n = nxy(); std::vector> out(5); for (size_t i=0; i>out.size(); i++) { out[i].reserve(n); } for (size_t i=0; i < size(); i++) { SpatGeom g = getGeom(i); if (g.empty()) { // empty out[0].push_back(i+1); out[1].push_back(1); out[2].push_back(NAN); out[3].push_back(NAN); out[4].push_back(0); } for (size_t j=0; j < g.size(); j++) { SpatPart p = g.getPart(j); for (size_t q=0; q < p.x.size(); q++) { out[0].push_back(i+1); out[1].push_back(j+1); out[2].push_back(p.x[q]); out[3].push_back(p.y[q]); out[4].push_back(0); } if (p.hasHoles()) { for (size_t k=0; k < p.nHoles(); k++) { SpatHole h = p.getHole(k); for (size_t q=0; q < h.x.size(); q++) { out[0].push_back(i+1); out[1].push_back(j+1); out[2].push_back(h.x[q]); out[3].push_back(h.y[q]); out[4].push_back(k+1); } } } } } return out; } std::string nice_string(const double &x) { std::string s = std::to_string(x); s.erase(s.find_last_not_of('0') + 1, std::string::npos); s.erase(s.find_last_not_of('.') + 1, std::string::npos); return s; } std::vector SpatVector::getGeometryWKT() { std::vector out(size()); std::string wkt; for (size_t i=0; i < size(); i++) { SpatGeom g = getGeom(i); size_t n = g.size(); if (g.gtype == points) { if (n > 1) { wkt = "MULTIPOINT "; } else { wkt = "POINT "; } } else if (g.gtype == lines) { if (n > 1) { wkt = "MULTILINESTRING "; } else { wkt = "LINESTRING "; } } else if (g.gtype == polygons) { if (n > 1) { wkt = "MULTIPOLYGON "; } else { wkt = "POLYGON "; } } if (n == 0) { wkt += "EMPTY"; out[i] = wkt; continue; } if ((g.gtype == polygons) | (n > 1)) { wkt += "("; } for (size_t j=0; j < n; j++) { SpatPart p = g.getPart(j); if (j>0) wkt += ","; if ((g.gtype == polygons) & (n > 1)) { wkt += "("; } wkt += "(" + nice_string(p.x[0]) + " " + nice_string(p.y[0]); for (size_t q=1; q < p.x.size(); q++) { wkt += ", " + nice_string(p.x[q]) + " " + nice_string(p.y[q]); } wkt += ")"; if (p.hasHoles()) { for (size_t k=0; k < p.nHoles(); k++) { SpatHole h = p.getHole(k); wkt += ",(" + nice_string(h.x[0]) + " " + nice_string(h.y[0]); for (size_t q=1; q < h.x.size(); q++) { wkt += ", " + nice_string(h.x[q]) + " " + nice_string(h.y[q]); } wkt += ")"; } } if ((g.gtype == polygons) & (n > 1)) { wkt += ")"; } } if ((g.gtype == polygons) | (n > 1)) { wkt += ")"; } out[i] = wkt; } return out; } SpatGeomType SpatVector::getGType(std::string &type) { if (type == "points") { return points; } else if (type == "lines") { return lines; } else if (type == "polygons") { return polygons; } else { return null; } } void SpatVector::setGeometry(std::string type, std::vector gid, std::vector part, std::vector x, std::vector y, std::vector hole) { // it is assumed that values are sorted by gid, part, hole unsigned lastgeom = gid[0]; unsigned lastpart = part[0]; unsigned lasthole = hole[0]; bool isHole = lasthole > 0; bool isPoly = type == "polygons"; std::vector X, Y; SpatGeom g; g.gtype = getGType(type); for (size_t i=0; i 0; X.resize(0); Y.resize(0); if (lastgeom != gid[i]) { addGeom(g); g.parts.resize(0); lastgeom = gid[i]; } } if (!(std::isnan(x[i]) || std::isnan(y[i]))) { X.push_back(x[i]); Y.push_back(y[i]); } } if (X.empty()) { SpatPart p(NAN, NAN); g.addPart(p); } else { if (g.gtype == polygons) { if ((X[0] != X[X.size()-1]) || (Y[0] != Y[Y.size()-1])) { X.push_back(X[0]); Y.push_back(Y[0]); } if (isHole) { SpatHole h(X, Y); g.addHole(h); } else { SpatPart p(X, Y); g.addPart(p); } } else { SpatPart p(X, Y); g.addPart(p); } } addGeom(g); } /* void SpatVector::setPointsGeometry(std::vector &x, std::vector &y) { size_t n = x.size(); if (n == 0) return; reserve(n); SpatGeom g; g.gtype = points; SpatPart p(x[0],y[0]); g.addPart(p);; for (size_t i=0; i &x, std::vector &y) { size_t n = x.size(); //reserve(n) if (n == 0) return; SpatGeom g; g.gtype = points; SpatPart p(x[0],y[0]); g.addPart(p); geoms.resize(n, g); for (size_t i=1; i geo, std::string crs, bool keepgeom) { if (x.nrow() == 0) return; if ((x.itype[geo[0]] != 0) || (x.itype[geo[1]] != 0)) { setError("coordinates must be numeric"); return; } if (geo[0] == geo[1]) { setError("x and y coordinates are the same variable"); return; } setPointsGeometry(x.dv[x.iplace[geo[0]]], x.dv[x.iplace[geo[1]]]); setSRS( {crs} ); if (!keepgeom) { if (geo[0] > geo[1]) { x.remove_column(geo[0]); x.remove_column(geo[1]); } else { x.remove_column(geo[1]); x.remove_column(geo[0]); } } df = x; } void SpatVector::setLinesStartEnd(std::vector &x, std::string crs) { size_t n = x.size() / 4; if (n == 0) return; size_t n2 = 2 * n; size_t n3 = 3 * n; SpatGeom g; g.gtype = lines; SpatPart p({x[0], x[n]},{x[n2], x[n3]}); g.addPart(p); geoms.resize(n, g); for (size_t i=1; i range) { SpatVector out; int n = nrow(); std::vector r; r.reserve(range.size()); for (size_t i=0; i= 0) && (range[i] < n)) { r.push_back(range[i]); } } out.reserve(r.size()); for (size_t i=0; i < r.size(); i++) { out.addGeom( geoms[r[i]] ); } out.srs = srs; out.df = df.subset_rows(r); return out; } SpatVector SpatVector::subset_rows(std::vector range) { SpatVector out; unsigned n = nrow(); std::vector r; out.reserve(r.size()); for (size_t i=0; i range(1, i); return subset_rows(range); } SpatVector SpatVector::remove_rows(std::vector range) { std::sort(range.begin(), range.end()); range.erase(std::unique(range.begin(), range.end()), range.end()); std::reverse(range.begin(), range.end()); std::vector id(size()); std::iota(id.begin(), id.end(), 0); unsigned n = size(); for (size_t i=0; i range) { long nc = ncol(); std::vector valid; valid.reserve(range.size()); for (size_t i=0; i= 0) && (range[i] < nc)) { valid.push_back(range[i]); } } SpatVector out = *this; out.df = df.subset_cols(valid); return out; } SpatVector SpatVector::subset_cols(long i) { if (i < 0) { SpatVector out; out.geoms = geoms; out.srs = srs; return out; } std::vector range = {i}; return subset_cols(range); } SpatVector SpatVector::append(SpatVector x, bool ingnorecrs) { if (size() == 0) return x; if (x.empty()) return *this; SpatVector out; if (type() != x.type()) { out.setError("geom types do not match"); return out; } if (!(ingnorecrs)) { if (!srs.is_same(x.srs, true)) { out.setError("append: crs does not match"); return out; } } out = *this; out.reserve(out.size() + x.size()); for (size_t i=0; i 0) && (x.df.nrow() > 0)) { out.df.rbind(x.df); return out; } if (x.df.nrow() == 0) { out.df.add_rows(x.size()); } else { std::vector i; out.df = x.df.subset_rows(i); out.df.add_rows(size()); out.df.rbind(x.df); } return out; } SpatVector SpatVector::cbind(SpatDataFrame d) { if (nrow() != d.nrow()) { SpatVector out; out.setError("nrow does not match"); return out; } SpatVector out = *this; if (!out.df.cbind(d)) { out.setError("cbind failed"); } return out; } SpatVector SpatVector::as_points(bool multi, bool skiplast) { if (nrow() == 0) { SpatVector v; v.setError("input has no geometries"); return v; } if (geoms[0].gtype == points) { SpatVector v = *this; v.addWarning("returning a copy"); return v; } SpatVector v = *this; if (geoms[0].gtype == lines) { for (size_t i=0; i < v.geoms.size(); i++) { SpatGeom g; g.gtype = points; for (size_t j=0; j x, y; x.reserve(size()); y.reserve(size()); for (size_t i=0; i=0; i--) { if (v.geoms[i].parts.size() > 1) { for (size_t j=1; j &x, int digits) { for (double& d : x) d = roundn(d, digits); } void remove_duplicates(std::vector &x, std::vector &y, int digits) { if (digits > -1) { vecround(x, digits); vecround(y, digits); } size_t start = x.size() - 1; for (size_t i=start; i>0; i--) { if ((x[i] == x[i-1]) && (y[i] == y[i-1])) { x.erase(x.begin()+i); y.erase(y.begin()+i); } } } void SpatGeom::remove_duplicate_nodes(int digits) { size_t start = parts.size()-1; for (size_t i=start; i>0; i--) { remove_duplicates(parts[i].x, parts[i].y, digits); if (parts[i].x.size() < 4) { parts.erase(parts.begin()+i); continue; } if (parts[i].hasHoles()) { for (size_t j=0; j < parts[i].nHoles(); j++) { remove_duplicates(parts[i].holes[j].x, parts[i].holes[j].y, digits); if (parts[i].holes[j].x.size() < 4) { parts[i].holes.erase(parts[i].holes.begin()+j); } } } } } SpatVector SpatVector::remove_duplicate_nodes(int digits) { SpatVector v = *this; if (geoms[0].gtype == points) { v.addWarning("returning a copy"); return v; } for (size_t i=0; i 0) && (v[i].df.nrow() > 0)) { out.df.rbind(v[i].df); continue; } if (v[i].df.nrow() == 0) { out.df.add_rows(v[i].size()); } else { std::vector r0; out.df = v[i].df.subset_rows(r0); out.df.add_rows(out.size()-v[i].size()); out.df.rbind(v[i].df); } } return out; } bool SpatVectorCollection::setNames(std::vector nms, bool make_valid) { recycle(nms, size()); names = nms; return true; } SpatVector SpatVector::round(int digits) { SpatVector out = *this; size_t ng = out.size(); for (size_t i=0; i 0) { x = x.shift(-360, 0); SpatVector v(e, ""); out = out.erase(v); out = out.append(x, true); } e = {-360, -180, -91, 91}; x = out.crop(e, false); if (x.nrow() > 0) { x = x.shift(360, 0); SpatVector v(e, ""); out = out.erase(v); out = out.append(x, true); } return out; } SpatVector SpatVector::rotate_longitude(double longitude, bool left) { SpatVector out = *this; size_t ng = out.size(); for (size_t i=0; i longitude) { out.geoms[i].parts[j].x[k] = out.geoms[i].parts[j].x[k] - 360; } } } else { for (size_t k=0; k longitude) { out.geoms[i].parts[j].holes[k].x[h] = out.geoms[i].parts[j].holes[k].x[h] - 360; } } } else { for (size_t h=0; h>> SpatVector::linesList() { size_t ni = nrow(); std::vector>> out(ni); for (size_t i=0; i < ni; i++) { SpatGeom g = getGeom(i); size_t nj = g.size(); if (nj == 0) { // empty continue; } out[i].resize(2); size_t ncr = g.ncoords()+nj-1; out[i][0].reserve(ncr); out[i][1].reserve(ncr); for (size_t j=0; j 0) { out[i][0].push_back(NAN); out[i][1].push_back(NAN); } out[i][0].insert(out[i][0].end(), g.parts[j].x.begin(), g.parts[j].x.end()); out[i][1].insert(out[i][1].end(), g.parts[j].y.begin(), g.parts[j].y.end()); } } return out; } std::vector> SpatVector::linesNA() { size_t ni = nrow(); size_t n = ncoords() + ni; std::vector> out(2); out[0].reserve(n); out[1].reserve(n); for (size_t i=0; i < ni; i++) { SpatGeom g = getGeom(i); size_t nj = g.size(); for (size_t j=0; j>>> SpatVector::polygonsList() { size_t ni = nrow(); std::vector>>> out(ni); for (size_t i=0; i < ni; i++) { SpatGeom g = getGeom(i); size_t nj = g.size(); if (nj == 0) { // empty continue; } out[i].resize(nj); for (size_t j=0; j 0) { size_t ncr = g.parts[j].ncoords()+nk; out[i][j][0].reserve(ncr); out[i][j][1].reserve(ncr); out[i][j][0].insert(out[i][j][0].end(), g.parts[j].x.begin(), g.parts[j].x.end()); out[i][j][1].insert(out[i][j][1].end(), g.parts[j].y.begin(), g.parts[j].y.end()); for (size_t k=0; k= 3 && GDAL_VERSION_MINOR >= 1 #include "proj.h" #include "ogr_spatialref.h" #include "gdal_priv.h" #include "gdal.h" #include "crs.h" #include "string_utils.h" bool SpatRaster::constructFromFileMulti(std::string fname, std::vector sub, std::vector subname, std::vector drivers, std::vector options, std::vector xyz) { Rcpp::Rcout << "in" << std::endl; if (xyz.size() != 3) { setError("you must supply three dimension indices"); return false; } auto poDataset = std::unique_ptr( GDALDataset::Open(fname.c_str(), GDAL_OF_MULTIDIM_RASTER )); if( !poDataset ) { setError("not a good dataset"); return false; } auto poRootGroup = poDataset->GetRootGroup(); if( !poRootGroup ) { setError("no roots"); return false; } std::vector gnames; std::string subdsname = ""; char** papszOptions = NULL; gnames = poRootGroup->GetMDArrayNames(papszOptions); CSLDestroy(papszOptions); if (gnames.size() == 0) { setError("no subdatsets detected"); return false; } Rcpp::Rcout << "available: "; for (size_t i=0; i 0) { subdsname = subname[0]; if (std::find(gnames.begin(), gnames.end(), subdsname) == gnames.end()) { setError("subdatset name not found"); return false; } } else if (sub[0] >= 0) { if (sub[0] >= (int)gnames.size()) { setError("subdatset is out or range"); return false; } else { subdsname = gnames[sub[0]]; } } else { subdsname = gnames[0]; if (gnames.size() > 1) { std::string gn = ""; for (size_t i=1; iOpenMDArray(subdsname.c_str()); if( !poVar ) { setError("cannot find: " + subdsname); return false; } std::string wkt = ""; std::shared_ptr srs = poVar->GetSpatialRef(); if (srs != NULL) { char *cp; const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OGRErr err = srs->exportToWkt(&cp, options); if (err == OGRERR_NONE) { wkt = std::string(cp); } CPLFree(cp); } SpatRasterSource s; std::string msg; if (!s.srs.set({wkt}, msg)) { addWarning(msg); } std::vector dimcount; std::vector dimnames; std::vector dim_start, dim_end; GDALExtendedDataTypeH hDT = GDALExtendedDataTypeCreate(GDT_Float64); for ( const auto &poDim: poVar->GetDimensions() ) { dimcount.push_back(static_cast(poDim->GetSize())); dimnames.push_back(static_cast(poDim->GetName())); std::vector count = {dimcount[dimcount.size()-1]}; std::vector vals(count[0]); const auto indvar = poDim->GetIndexingVariable(); indvar->Read( std::vector{0}.data(), count.data(), nullptr, nullptr, GDALExtendedDataType::Create(GDT_Float64), &vals[0]); // to do: check for equal spacing if x or y dim dim_start.push_back(vals[0]); dim_end.push_back(vals[vals.size()-1]); Rcpp::Rcout << vals[0] << " - " << vals[vals.size()-1] << std::endl; } GDALExtendedDataTypeRelease(hDT); s.m_ndims = dimcount.size(); s.source_name = subdsname; s.source_name_long = poVar->GetAttribute("long_name")->ReadAsString(); s.m_hasNA = false; double NAval = poVar->GetNoDataValueAsDouble(&s.m_hasNA); if (s.m_hasNA) { s.m_missing_value = NAval; } SpatExtent e; if (xyz[0] < s.m_ndims) { s.nrow = dimcount[xyz[0]]; s.m_dimnames.push_back(dimnames[xyz[0]]); double res = (dim_start[xyz[0]] - dim_end[xyz[0]]) / (s.nrow-1); e.ymax = dim_start[xyz[0]] + 0.5 * res; e.ymin = dim_end[xyz[0]] - 0.5 * res; } else { setError("the second dimension is not valid"); return false; } if (xyz[1] < s.m_ndims) { s.ncol = dimcount[xyz[1]]; s.m_dimnames.push_back(dimnames[xyz[1]]); double res = (dim_end[xyz[1]] - dim_start[xyz[1]]) / (s.ncol-1); e.xmin = dim_start[xyz[1]] - 0.5 * res; e.xmax = dim_end[xyz[1]] + 0.5 * res; } else { setError("the first dimension is not valid"); return false; } if (s.m_ndims > 2) { if (xyz[2] < s.m_ndims) { s.nlyr = dimcount[xyz[2]]; s.m_dimnames.push_back(dimnames[xyz[2]]); } else { setError("the third dimension is not valid"); return false; } } s.m_dims = xyz; s.extent = e; if (s.m_ndims > 3) { for (size_t i=0; i(s.nlyr, poVar->GetUnit()); s.multidim = true; // layer names //std::vector nms(s.nlyr, ""); //s.names = nms; // time // extent s.m_counts = dimcount; setSource(s); for (size_t i=0; i &out, size_t src, size_t row, size_t nrows, size_t col, size_t ncols) { Rcpp::Rcout << "reading" << std::endl; std::vector offset(source[src].m_ndims, 0); std::vector dims = source[src].m_dims; offset[source[src].m_dims[0]] = col; offset[source[src].m_dims[1]] = row; offset[source[src].m_dims[2]] = 0; // std::vector count = source[src].m_counts; std::vector count(source[src].m_ndims, 1); count[source[src].m_dims[0]] = ncols; count[source[src].m_dims[1]] = nrows; count[source[src].m_dims[2]] = nlyr(); size_t n=1; for (size_t i=0; i temp; temp.resize(n); GDALMDArrayRead(source[src].gdalmdarray, &offset[0], &count[0], NULL, // step: defaults to 1,1,1 NULL, // stride: default to row-major convention hDT, &temp[0], NULL, // array start. Omitted 0 // array size in bytes. Omitted ); GDALExtendedDataTypeRelease(hDT); //tbd: row order should be reversed // size_t nc = nrows * ncols; // size_t nl = nlyr(); // out.resize(0); // out.reserve(n); // for (size_t i=0; i sub, std::vector subname, std::vector drivers, std::vector options, std::vector xyz) { setError("multidim is not supported by GDAL < 3.1"); return false; } bool SpatRaster::readStartMulti(size_t src) { setError("multidim is not supported by GDAL < 3.1"); return false; } bool SpatRaster::readStopMulti(size_t src) { setError("multidim is not supported by GDAL < 3.1"); return false; } bool SpatRaster::readValuesMulti(std::vector &out, size_t src, size_t row, size_t nrows, size_t col, size_t ncols) { setError("multidim is not supported by GDAL < 3.1"); return false; } //#endif terra/src/distance.cpp0000644000176200001440000004340514733362073014472 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifndef M_PI #define M_PI (3.14159265358979323846) #endif #include //#include #include #include "geodesic.h" #include "geosphere.h" #include "recycle.h" #include #include // Convert degrees to radians double toRad(double °) { return( deg * 0.0174532925199433 ); } double toDeg(double &rad) { return( rad * 57.2957795130823 ); } double distance_lonlat(const double &lon1, const double &lat1, const double &lon2, const double &lat2) { double a = 6378137.0; double f = 1/298.257223563; double s12, azi1, azi2; struct geod_geodesic g; geod_init(&g, a, f); geod_inverse(&g, lat1, lon1, lat2, lon2, &s12, &azi1, &azi2); return s12; } // to circumvent overloading problem when assigning to std::function double distLonlat(const double &lon1, const double &lat1, const double &lon2, const double &lat2) { double a = 6378137.0; double f = 1/298.257223563; double s12, azi1, azi2; struct geod_geodesic g; geod_init(&g, a, f); geod_inverse(&g, lat1, lon1, lat2, lon2, &s12, &azi1, &azi2); return s12; } double distCosine(double lon1, double lat1, double lon2, double lat2) { const double r = 6378137; lon1 = toRad(lon1); lon2 = toRad(lon2); lat1 = toRad(lat1); lat2 = toRad(lat2); return r * acos((sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(lon1-lon2))); } double distCosineRad(const double &lon1, const double &lat1, const double &lon2, const double &lat2) { const double r = 6378137; return r * acos((sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(lon1-lon2))); } double distHaversine(double lon1, double lat1, double lon2, double lat2) { const double r = 6378137; lon1 = toRad(lon1); lon2 = toRad(lon2); lat1 = toRad(lat1); lat2 = toRad(lat2); double dLat = lat2-lat1; double dLon = lon2-lon1; double a = sin(dLat/2.) * sin(dLat/2.) + cos(lat1) * cos(lat2) * sin(dLon/2.) * sin(dLon/2.); return 2. * atan2(sqrt(a), sqrt(1.-a)) * r; } /* double distHaversineRad(const double &lon1, const double &lat1, const double &lon2, const double &lat2) { const double r = 6378137; double dLat = lat2-lat1; double dLon = lon2-lon1; double a = sin(dLat/2.) * sin(dLat/2.) + cos(lat1) * cos(lat2) * sin(dLon/2.) * sin(dLon/2.); return 2. * atan2(sqrt(a), sqrt(1.-a)) * r; } */ std::vector distance_lonlat(std::vector &lon1, std::vector &lat1, std::vector &lon2, std::vector &lat2) { double a = 6378137.0; double f = 1/298.257223563; size_t n = std::max(std::max(std::max(lon1.size(), lat1.size()), lon2.size()), lat2.size()); recycle(lon1, n); recycle(lon2, n); recycle(lat1, n); recycle(lat2, n); std::vector r(n); double azi1, azi2; struct geod_geodesic g; geod_init(&g, a, f); for (size_t i=0; i < n; i++) { geod_inverse(&g, lat1[i], lon1[i], lat2[i], lon2[i], &r[i], &azi1, &azi2); } return r; } std::vector distance_lonlat_vd(std::vector &lon1, std::vector &lat1, double lon2, double lat2) { std::vector vlon2(lon1.size(), lon2); std::vector vlat2(lat1.size(), lat2); return distance_lonlat(lon1, lat1, vlon2, vlat2); } std::vector distance_lon(double &lon, std::vector &lat) { double a = 6378137.0; double f = 1/298.257223563; size_t n = lat.size(); std::vector r(n); double azi1, azi2; struct geod_geodesic g; geod_init(&g, a, f); for (size_t i=0; i < n; i++) { geod_inverse(&g, lat[i], 0, lat[i], lon, &r[i], &azi1, &azi2); } return r; } double distance_plane(const double &x1, const double &y1, const double &x2, const double &y2) { return( sqrt(pow((x2-x1),2) + pow((y2-y1), 2)) ); } std::vector distance_plane(std::vector &x1, std::vector &y1, std::vector &x2, std::vector &y2) { recycle(x1, x2); recycle(y1, y2); std::vector r (x1.size()); size_t n = x1.size(); for (size_t i=0; i < n; i++) { r[i] = distance_plane(x1[i], y1[i], x2[i], y2[i]); } return r; } std::vector distance_plane_vd(std::vector &x1, std::vector &y1, double x2, double y2) { std::vector vx2(x1.size(), x2); std::vector vy2(y1.size(), y2); return distance_plane(x1, y1, vx2, vy2); } /* double distPlane(double x1, double y1, double x2, double y2) { return( sqrt(pow((x2-x1),2) + pow((y2-y1), 2)) ); } */ double direction_lonlat(double lon1, double lat1, double lon2, double lat2, bool degrees) { double a = 6378137.0; double f = 1/298.257223563; double s12, azi1, azi2; struct geod_geodesic g; geod_init(&g, a, f); geod_inverse(&g, lat1, lon1, lat2, lon2, &s12, &azi1, &azi2); if (!degrees) { return(toRad(azi1)); } return( azi1) ; } std::vector direction_lonlat(std::vector lon1, std::vector lat1, std::vector lon2, std::vector lat2, bool degrees) { double a = 6378137.0; double f = 1/298.257223563; // lonlat1 and lonlat2 should have the same length std::vector azi1(lon1.size()); double s12, azi2; struct geod_geodesic g; geod_init(&g, a, f); size_t n = lat1.size(); if (degrees) { for (size_t i=0; i < n; i++) { geod_inverse(&g, lat1[i], lon1[i], lat2[i], lon2[i], &s12, &azi1[i], &azi2); } } else { for (size_t i=0; i < n; i++) { geod_inverse(&g, lat1[i], lon1[i], lat2[i], lon2[i], &s12, &azi1[i], &azi2); azi1[i] = toRad(azi1[i]); } } return azi1; } void directionToNearest_lonlat(std::vector &azi, std::vector &lon1, std::vector &lat1, std::vector &lon2, std::vector &lat2, bool& degrees, bool& from, const std::string &method) { if (method == "geo") { double a = 6378137.0; double f = 1/298.257223563; double azi1, azi2, s12, dist; size_t n = lon1.size(); size_t m = lon2.size(); azi.resize(n, NAN); struct geod_geodesic g; geod_init(&g, a, f); for (size_t i=0; i < n; i++) { if (std::isnan(lat1[i])) { azi[i] = NAN; continue; } geod_inverse(&g, lat1[i], lon1[i], lat2[0], lon2[0], &dist, &azi1, &azi2); size_t minj=0; azi[i] = azi1; for (size_t j=1; j direction_plane(std::vector x1, std::vector y1, std::vector x2, std::vector y2, bool degrees) { // xy1 and xy2 should have the same length std::vector r (x1.size()); //double a; size_t n = x1.size(); for (size_t i=0; i < n; i++) { r[i] = direction_plane(x1[i], y1[i], x2[i], y2[i], degrees); } return r; } void directionToNearest_plane(std::vector &r, const std::vector &x1, const std::vector &y1, const std::vector &x2, const std::vector &y2, bool& degrees, bool &from) { size_t n = x1.size(); size_t m = x2.size(); r.resize(n, NAN); double d, mind; size_t minj; for (size_t i = 0; i < n; i++) { r[i] = NAN; if (std::isnan(x1[i])) continue; // x2 must not be NAN mind = distance_plane(x1[i], y1[i], x2[0], y2[0]); minj = 0; for (size_t j = 1; j < m; j++) { d = distance_plane(x1[i], y1[i], x2[j], y2[j]); if (d < mind) { mind = d; minj = j; } } if (from) { r[i] = direction_plane(x2[minj], y2[minj], x1[i], y1[i], degrees); } else { r[i] = direction_plane(x1[i], y1[i], x2[minj], y2[minj], degrees); } } } std::vector destpoint_lonlat(double longitude, double latitude, double bearing, double distance) { double a = 6378137.0; double f = 1/298.257223563; struct geod_geodesic g; geod_init(&g, a, f); double lat2, lon2, azi2; geod_direct(&g, latitude, longitude, bearing, distance, &lat2, &lon2, &azi2); std::vector out = { lon2, lat2, azi2 }; return out; } std::vector > destpoint_lonlat(const std::vector &longitude, const std::vector &latitude, const std::vector &bearing, const std::vector &distance) { double a = 6378137.0; double f = 1/298.257223563; struct geod_geodesic g; geod_init(&g, a, f); size_t n = longitude.size(); std::vector > out(3, std::vector(n)); double lat2, lon2, azi2; for (size_t i=0; i < n; i++) { geod_direct(&g, latitude[i], longitude[i], bearing[i], distance[i], &lat2, &lon2, &azi2); out[0][i] = lon2; out[1][i] = lat2; out[2][i] = azi2; } return out; } std::vector > destpoint_lonlat(const double &longitude, const double &latitude, const std::vector &bearing, const double& distance, bool wrap) { double a = 6378137.0; double f = 1/298.257223563; struct geod_geodesic g; geod_init(&g, a, f); size_t n = bearing.size(); std::vector > out(3, std::vector(n)); double lat2, lon2, azi2; if (wrap) { for (size_t i=0; i < n; i++) { geod_direct(&g, latitude, longitude, bearing[i], distance, &lat2, &lon2, &azi2); out[0][i] = lon2; out[1][i] = lat2; out[2][i] = azi2; } } else { for (size_t i=0; i < n; i++) { geod_direct(&g, latitude, 0, bearing[i], distance, &lat2, &lon2, &azi2); out[0][i] = lon2 + longitude; out[1][i] = lat2; out[2][i] = azi2; } } return out; } std::vector destpoint_plane(double x, double y, double bearing, double distance) { bearing = bearing * M_PI / 180; x += distance * sin(bearing); y += distance * cos(bearing); std::vector out = {x, y}; return(out); } std::vector > destpoint_plane(std::vector x, std::vector y, std::vector bearing, std::vector distance) { size_t n = x.size(); std::vector > out; out.reserve(n); double xd, yd, b; for (size_t i=0; i < n; i++) { b = bearing[i] * M_PI / 180; xd = x[i] + distance[i] * sin(b); yd = y[i] + distance[i] * cos(b); out.push_back( {xd, yd }); } return(out); } void distanceToNearest_lonlat(std::vector &d, const std::vector &lon1, const std::vector &lat1, const std::vector &lon2, const std::vector &lat2, const double& adj_unit, std::string method) { int n = lon1.size(); int m = lon2.size(); if (method == "geo") { double a = 6378137.0; double f = 1/298.257223563; double azi1, azi2, s12; struct geod_geodesic g; geod_init(&g, a, f); for (int i=0; i < n; i++) { if (std::isnan(lat1[i])) { continue; } geod_inverse(&g, lat1[i], lon1[i], lat2[0], lon2[0], &d[i], &azi1, &azi2); for (int j=1; j dfun; if (method == "haversine") { dfun = distHaversine; } else { dfun = distCosine; } for (int i=0; i < n; i++) { if (!std::isnan(lat1[i])) { d[i] = dfun(lon1[i], lat1[i], lon2[0], lat2[0]); for (int j=1; j &d, const std::vector &lon1, const std::vector &lat1, const std::vector &lon2, const std::vector &lat2) { int n = lon1.size(); int m = lon2.size(); double s12; for (int i=0; i < n; i++) { if (std::isnan(lat1[i])) { continue; } d[i] = distCosine(lat1[i], lon1[i], lat2[0], lon2[0]); for (int j=1; j &d, const std::vector &x1, const std::vector &y1, const std::vector &x2, const std::vector &y2, const double& lindist) { int n = x1.size(); int m = x2.size(); for (int i=0; i < n; i++) { if (std::isnan(x1[i])) continue; d[i] = sqrt(pow((x2[0]-x1[i]),2) + pow((y2[0]-y1[i]), 2)); for (int j=1; j < m; j++) { double r = sqrt(pow((x2[j]-x1[i]),2) + pow((y2[j]-y1[i]), 2)); if (r < d[i]) { d[i] = r; } } d[i] *= lindist; } } void nearest_lonlat(std::vector &id, std::vector &d, std::vector &nlon, std::vector &nlat, const std::vector &lon1, const std::vector &lat1, const std::vector &lon2, const std::vector &lat2, const std::string method) { size_t n = lon1.size(); size_t m = lon2.size(); nlon.resize(n); nlat.resize(n); id.resize(n); d.resize(n); if (method == "geo") { double a = 6378137.0; double f = 1/298.257223563; double azi1, azi2, s12; struct geod_geodesic g; geod_init(&g, a, f); for (size_t i=0; i < n; i++) { if (std::isnan(lat1[i])) { nlon[i] = NAN; nlat[i] = NAN; id[i] = -1; d[i] = NAN; continue; } geod_inverse(&g, lat1[i], lon1[i], lat2[0], lon2[0], &d[i], &azi1, &azi2); nlon[i] = lon2[0]; nlat[i] = lat2[0]; id[i] = 0; for (size_t j=1; j dfun; if (method == "haversine") { dfun = distHaversine; } else { dfun = distCosine; } for (size_t i=0; i < n; i++) { if (std::isnan(lat1[i])) { nlon[i] = NAN; nlat[i] = NAN; id[i] = -1; d[i] = NAN; continue; } d[i] = dfun(lat1[i], lon1[i], lat2[0], lon2[0]); nlon[i] = lon2[0]; nlat[i] = lat2[0]; id[i] = 0; for (size_t j=1; j &id, std::vector &d, std::vector &nlon, std::vector &nlat, const std::vector &lon, const std::vector &lat, const std::string method) { size_t n = lon.size(); if (n <= 1) { nlon = lon; nlat = lat; if (nlon.size() == 1) { id.resize(1); id[0] = 0; } return; } nlon.resize(n); nlat.resize(n); id.resize(n); d.resize(n); if (method == "geo") { double a = 6378137.0; double f = 1/298.257223563; double azi1, azi2, s12; struct geod_geodesic g; geod_init(&g, a, f); for (size_t i=0; i < n; i++) { if (std::isnan(lat[i])) { id[i] = -1; d[i] = NAN; nlon[i] = NAN; nlat[i] = NAN; continue; } if (i>0) { geod_inverse(&g, lat[i], lon[i], lat[0], lon[0], &d[i], &azi1, &azi2); nlon[i] = lon[0]; nlat[i] = lat[0]; id[i] = 0; } else { geod_inverse(&g, lat[1], lon[1], lat[0], lon[0], &d[i], &azi1, &azi2); nlon[i] = lon[1]; nlat[i] = lat[1]; id[i] = 1; } for (size_t j=1; j < n; j++) { if (j == i) continue; geod_inverse(&g, lat[i], lon[i], lat[j], lon[j], &s12, &azi1, &azi2); if (s12 < d[i]) { d[i] = s12; id[i] = j; nlon[i] = lon[j]; nlat[i] = lat[j]; } } } } else { std::function dfun; if (method == "haversine") { dfun = distHaversine; } else if (method == "cosine") { dfun = distCosine; } else { dfun = distLonlat; } for (size_t i=0; i < n; i++) { if (std::isnan(lat[i])) { id[i] = -1; d[i] = NAN; nlon[i] = NAN; nlat[i] = NAN; continue; } if (i>0) { d[i] = dfun(lon[i], lat[i], lon[0], lat[0]); nlon[i] = lon[0]; nlat[i] = lat[0]; id[i] = 0; } else { d[i] = dfun(lon[1], lat[1], lon[0], lat[0]); nlon[i] = lon[1]; nlat[i] = lat[1]; id[i] = 1; } for (size_t j=1; j < n; j++) { if (j == i) continue; double s12 = dfun(lon[i], lat[i], lon[j], lat[j]); if (s12 < d[i]) { d[i] = s12; id[i] = j; nlon[i] = lon[j]; nlat[i] = lat[j]; } } } } } terra/src/recycle.h0000644000176200001440000000572014536376240013773 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include template void recycle(std::vector &v, unsigned n) { size_t s = v.size(); v.resize(n); for (size_t i=s; i void recycle(std::vector &v, unsigned n) { size_t s = v.size(); if (s > n) { v.resize(n); } else if (s < n) { v.reserve(n); for (size_t i=s; i void recycle(std::vector &x, std::vector &y) { size_t xsize = x.size(); size_t ysize = y.size(); if (xsize != ysize) { size_t n = std::max(xsize, ysize); if (xsize > ysize) { y.resize(n); for (size_t i=ysize; i void rep(std::vector &v, unsigned n) { size_t s = v.size(); v.reserve(n * s); for (size_t i=1; i void rep_each(std::vector &v, unsigned n) { if (n == 1) return; std::vector vv = v; size_t s = v.size(); v.resize(0); v.reserve(n * s); for (size_t j=0; j void rep_each_vect(std::vector &v, std::vector n) { std::vector vv = v; v.resize(0); size_t nsum = 0; for (size_t i=0; i std::vector seq(T start, T end, T increment) { std::vector out; //if (increment <= 0) return out; if ((start > end) && (increment > 0)) return out; if ((start < end) && (increment < 0)) return out; if (start == end) return {start}; size_t s = floor((end - start) / increment); out.reserve(s); for (size_t i=0; i<=s; i++) { T val = start + i * increment; out.push_back(val); } return out; } template std::vector seq_steps(T start, T end, size_t steps) { double increment = (end - start) / (double) steps; std::vector out; out.reserve(steps); for (size_t i=0; i<=steps; i++) { T val = start + i * increment; out.push_back(val); } return out; } terra/src/read_ogr.cpp0000644000176200001440000006501214756760124014464 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatVector.h" #include "file_utils.h" #include "ogrsf_frmts.h" #include "ogr_spatialref.h" #include "crs.h" #include "NA.h" #include "string_utils.h" std::string geomType(OGRLayer *poLayer) { std::string s = ""; poLayer->ResetReading(); OGRFeature *poFeature; while( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); const char* gname = poGeometry->getGeometryName(); s = gname; break; } OGRFeature::DestroyFeature( poFeature ); return s; } #include "Rcpp.h" SpatDataFrame readAttributes(OGRLayer *poLayer, bool as_proxy) { SpatDataFrame df; OGRFeatureDefn *poFDefn = poLayer->GetLayerDefn(); size_t nfields = poFDefn->GetFieldCount(); if (nfields == 0) return df; OGRFieldType ft; OGRFieldDefn *poFieldDefn; df.resize_cols(nfields); unsigned dtype; long longNA = NA::value; SpatTime_t timeNA = NA::value; for (size_t i = 0; i < nfields; i++ ) { poFieldDefn = poFDefn->GetFieldDefn(i); std::string fname = poFieldDefn->GetNameRef(); ft = poFieldDefn->GetType(); // OFTInteger64 may be too large if ((ft == OFTReal) || (ft == OFTInteger64)) { dtype = 0; } else if (ft == OFTInteger) { if (poFieldDefn->GetSubType() == OFSTBoolean) { dtype = 3; } else { dtype = 1; } } else if ((ft == OFTDate) || (ft == OFTDateTime)) { dtype = 4; } else { dtype = 2; } df.add_column(dtype, fname); } OGRFeature *poFeature; poLayer->ResetReading(); while( (poFeature = poLayer->GetNextFeature()) != NULL ) { for (size_t i = 0; i < nfields; i++ ) { poFieldDefn = poFDefn->GetFieldDefn( i ); unsigned j = df.iplace[i]; int not_null = poFeature->IsFieldSetAndNotNull(i); switch( poFieldDefn->GetType() ) { case OFTReal: if (not_null) { df.dv[j].push_back(poFeature->GetFieldAsDouble(i)); } else { df.dv[j].push_back(NAN); } break; case OFTInteger: if (poFieldDefn->GetSubType() == OFSTBoolean) { if (not_null) { df.bv[j].push_back(poFeature->GetFieldAsInteger(i)); } else { df.bv[j].push_back(2); } } else { if (not_null) { df.iv[j].push_back(poFeature->GetFieldAsInteger(i)); } else { df.iv[j].push_back(longNA); } } break; case OFTInteger64: if (not_null) { df.dv[j].push_back(poFeature->GetFieldAsInteger64(i)); } else { df.dv[j].push_back(NAN); } break; case OFTDate: if (i == 0) { df.tv[j].step = "days"; } if (not_null) { int pnYear, pnMonth, pnDay, pnHour, pnMinute, pnTZFlag; float pfSecond; poFeature->GetFieldAsDateTime(i, &pnYear, &pnMonth, &pnDay, &pnHour, &pnMinute, &pfSecond, &pnTZFlag); SpatTime_t d = get_time(pnYear, pnMonth, pnDay, 0, 0, 0); df.tv[j].x.push_back(d); } else { df.tv[j].x.push_back(timeNA); } break; case OFTDateTime: if (i == 0) { df.tv[j].step = "seconds"; } if (not_null) { int pnYear, pnMonth, pnDay, pnHour, pnMinute, pnTZFlag; float pfSecond; poFeature->GetFieldAsDateTime(i, &pnYear, &pnMonth, &pnDay, &pnHour, &pnMinute, &pfSecond, &pnTZFlag); SpatTime_t d = get_time(pnYear, pnMonth, pnDay, pnHour, pnMinute, (int)pfSecond); df.tv[j].x.push_back(d); } else { df.tv[j].x.push_back(timeNA); } break; // case OFTString: default: if (not_null) { df.sv[j].push_back(poFeature->GetFieldAsString(i)); } else { df.sv[j].push_back(df.NAS); } break; } } OGRFeature::DestroyFeature(poFeature); if (as_proxy) break; } return df; } /* std::string getDs_WKT(GDALDataset *poDataset) { std::string wkt = ""; char *cp; #if GDAL_VERSION_MAJOR >= 3 const OGRSpatialReference *srs = poDataset->GetSpatialRef(); const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OGRErr err = srs->exportToWkt(&cp, options); if (err == OGRERR_NONE) { wkt = std::string(cp); CPLFree(cp); } #else const char *pszSrc = GDALGetProjectionRef( poDataset ); if (pszSrc != NULL) { wkt = std::string(pszSrc); } // if (poDataset->GetProjectionRef() != NULL) { // OGRSpatialReference oSRS(poDataset->GetProjectionRef()); // OGRErr err = oSRS.exportToPrettyWkt(&cp); // if (err == OGRERR_NONE) { // wkt = std::string(cp); // CPLFree(cp); // } // } #endif return wkt; } std::string getDs_PRJ(GDALDataset *poDataset) { std::string prj = ""; #if GDAL_VERSION_MAJOR >= 3 char *cp; const OGRSpatialReference *srs = poDataset->GetSpatialRef(); OGRErr err = srs->exportToProj4(&cp); if (err == OGRERR_NONE) { prj = std::string(cp); CPLFree(cp); } #else if( poDataset->GetProjectionRef() != NULL ) { OGRSpatialReference oSRS(poDataset->GetProjectionRef()); char *pszPRJ = NULL; oSRS.exportToProj4(&pszPRJ); prj = pszPRJ; } #endif return prj; } */ SpatGeom emptyGeom() { SpatGeom g; g.gtype = null; g.extent.xmin=NAN; g.extent.xmax=NAN; g.extent.ymin=NAN; g.extent.ymax=NAN; return g; } SpatGeom getPointGeom(OGRGeometry *poGeometry) { SpatGeom g(points); if (poGeometry->IsEmpty()) { //SpatPart p(NAN, NAN); //g.addPart(p); return g; } #if GDAL_VERSION_NUM >= GDAL_COMPUTE_VERSION(2,3,0) OGRPoint *poPoint = poGeometry->toPoint(); #else OGRPoint *poPoint = (OGRPoint *) poGeometry; #endif double x = poPoint->getX(); double y = poPoint->getY(); SpatPart p(x, y); g.addPart(p); return g; } SpatGeom getMultiPointGeom(OGRGeometry *poGeometry) { OGRMultiPoint *poMultipoint = ( OGRMultiPoint * )poGeometry; unsigned ng = poMultipoint->getNumGeometries(); std::vector X(ng); std::vector Y(ng); SpatGeom g(points); for (size_t i=0; igetGeometryRef(i); #if GDAL_VERSION_NUM >= GDAL_COMPUTE_VERSION(2,3,0) OGRPoint *poPoint = poMpGeometry->toPoint(); #else OGRPoint *poPoint = (OGRPoint *) poMpGeometry; #endif double x = poPoint->getX(); double y = poPoint->getY(); SpatPart p(x, y); g.addPart(p); } return g; } SpatGeom getLinesGeom(OGRGeometry *poGeometry) { OGRLineString *poGeom = (OGRLineString *) poGeometry; unsigned np = poGeom->getNumPoints(); std::vector X(np); std::vector Y(np); OGRPoint ogrPt; for (size_t i=0; igetPoint(i, &ogrPt); X[i] = ogrPt.getX(); Y[i] = ogrPt.getY(); } SpatPart p(X, Y); SpatGeom g(lines); g.addPart(p); return g; } SpatGeom getMultiLinesGeom(OGRGeometry *poGeometry) { SpatGeom g(lines); OGRMultiLineString *poGeom = ( OGRMultiLineString * )poGeometry; unsigned ng = poGeom->getNumGeometries(); OGRPoint ogrPt; for (size_t i=0; igetGeometryRef(i); OGRLineString *poLine = ( OGRLineString * )poLineGeometry; unsigned np = poLine->getNumPoints(); std::vector X(np); std::vector Y(np); for (size_t j=0; jgetPoint(j, &ogrPt); X[j] = ogrPt.getX(); Y[j] = ogrPt.getY(); } SpatPart p(X, Y); g.addPart(p); } return g; } //#include "Rcpp.h" SpatGeom getPolygonsGeom(OGRGeometry *poGeometry) { SpatGeom g(polygons); OGRPoint ogrPt; // OGRwkbGeometryType geomtype = poGeometry->getGeometryType(); // if ( geomtype == wkbPolygon ) { OGRPolygon *poGeom = ( OGRPolygon * )poGeometry; OGRLinearRing *poRing = poGeom->getExteriorRing(); unsigned np = poRing->getNumPoints(); std::vector X(np); std::vector Y(np); for (size_t i=0; igetPoint(i, &ogrPt); X[i] = ogrPt.getX(); Y[i] = ogrPt.getY(); } SpatPart p(X, Y); unsigned nh = poGeom->getNumInteriorRings(); for (size_t i=0; igetInteriorRing(i); unsigned np = poHole->getNumPoints(); std::vector X(np); std::vector Y(np); for (size_t j=0; jgetPoint(j, &ogrPt); X[j] = ogrPt.getX(); Y[j] = ogrPt.getY(); } p.addHole(X, Y); } g.addPart(p); // } return g; } SpatGeom getMultiPolygonsGeom(OGRGeometry *poGeometry) { OGRMultiPolygon *poGeom = ( OGRMultiPolygon * )poGeometry; OGRPoint ogrPt; unsigned ng = poGeom->getNumGeometries(); SpatGeom g(polygons); for (size_t i=0; igetGeometryRef(i); OGRPolygon *poPolygon = ( OGRPolygon * )poPolygonGeometry; OGRLinearRing *poRing = poPolygon->getExteriorRing(); unsigned np = poRing->getNumPoints(); std::vector X(np); std::vector Y(np); for (size_t j=0; jgetPoint(j, &ogrPt); X[j] = ogrPt.getX(); Y[j] = ogrPt.getY(); } SpatPart p(X, Y); unsigned nh = poPolygon->getNumInteriorRings(); for (size_t j=0; jgetInteriorRing(j); np = poHole->getNumPoints(); std::vector X(np); std::vector Y(np); for (size_t k = 0; k < np; k++ ) { poHole->getPoint(k, &ogrPt); X[k] = ogrPt.getX(); Y[k] = ogrPt.getY(); } p.addHole(X, Y); } g.addPart(p); } return g; } std::vector SpatVector::layer_names(std::string filename) { std::vector out; if (filename.empty()) { setError("empty filename"); return out; } // a gdb is a folder... //if (!file_exists(filename)) { // setError("file does not exist"); // return out; //} GDALDataset *poDS = static_cast(GDALOpenEx(filename.c_str(), GDAL_OF_VECTOR, NULL, NULL, NULL )); if( poDS == NULL ) { setError("Cannot open this dataset" ); return out; } size_t n = poDS->GetLayerCount(); out.reserve(n); for (size_t i=0; iGetLayer(i); if (poLayer == NULL) { out.push_back(""); } else { out.push_back((std::string)poLayer->GetName()); } } GDALClose(poDS); return out; } bool layerQueryFilter(GDALDataset *&poDS, OGRLayer *&poLayer, std::string &layer, std::string &query, std::vector &ext, SpatVector &filter, std::string &errmsg, std::vector &wrms) { if (query.empty()) { if (layer.empty()) { #if GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR <= 2 // do nothing #else std::vector lyrnms; for ( auto&& poLayer: poDS->GetLayers() ) { lyrnms.push_back((std::string)poLayer->GetName()); } if (lyrnms.size() > 1) { std::string lyrsel = lyrnms[0]; lyrnms.erase(lyrnms.begin()); std::string ccat = concatenate(lyrnms, ", "); wrms.push_back("Reading layer: " + lyrsel + "\nOther layers: " + ccat); } #endif poLayer = poDS->GetLayer(0); if (poLayer == NULL) { errmsg = "dataset has no layers"; return false; } } else { poLayer = poDS->GetLayerByName(layer.c_str()); if (poLayer == NULL) { errmsg = layer + " is not a valid layer name"; #if GDAL_VERSION_MAJOR <= 2 && GDAL_VERSION_MINOR <= 2 // do nothing #else errmsg += "\nChoose one of: "; for ( auto&& poLayer: poDS->GetLayers() ) { errmsg += (std::string)poLayer->GetName() + ", "; } errmsg = errmsg.substr(0, errmsg.size()-2); #endif return false; } } } else { poLayer = poDS->ExecuteSQL(query.c_str(), NULL, NULL); if (poLayer == NULL) { errmsg = "Query failed"; return false; } } if (filter.nrow() > 0) { if (filter.type() != "polygons") { filter = filter.hull("convex"); } else if (filter.nrow() > 1) { filter = filter.aggregate(true); } GDALDataset *filterDS = filter.write_ogr("", "lyr", "Memory", false, true, std::vector()); if (filter.hasError()) { //setError(filter.getError()); GDALClose(filterDS); errmsg = "filter has error"; return false; } OGRLayer *fLayer = filterDS->GetLayer(0); fLayer->ResetReading(); OGRFeature *fFeature = fLayer->GetNextFeature(); if (fFeature != NULL ) { OGRGeometry *fGeometry = fFeature->StealGeometry(); poLayer->SetSpatialFilter(fGeometry); OGRGeometryFactory::destroyGeometry(fGeometry); } OGRFeature::DestroyFeature( fFeature ); GDALClose(filterDS); } else if (!ext.empty()) { poLayer->SetSpatialFilterRect(ext[0], ext[2], ext[1], ext[3]); } return true; } bool SpatVector::read_ogr(GDALDataset *&poDS, std::string layer, std::string query, std::vector ext, SpatVector filter, bool as_proxy, std::string what) { if (poDS == NULL) { setError("dataset is empty"); return false; } std::string crs = ""; OGRLayer *poLayer; poLayer = poDS->GetLayer(0); read_query = query; read_extent = ext; std::string errmsg; std::vector wrnmsg; if (!layerQueryFilter(poDS, poLayer, layer, query, ext, filter, errmsg, wrnmsg)) { setError(errmsg); return false; } else if (!wrnmsg.empty()) { for (size_t i=0; i < wrnmsg.size(); i++) addWarning(wrnmsg[i]); } OGRSpatialReference *poSRS = poLayer->GetSpatialRef(); if (poSRS) { char *psz = NULL; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OGRErr err = poSRS->exportToWkt(&psz, options); #else OGRErr err = poSRS->exportToWkt(&psz); #endif if (err == OGRERR_NONE) { crs = psz; } setSRS(crs); CPLFree(psz); } if (what != "geoms") { df = readAttributes(poLayer, as_proxy); } if (what == "attributes") { if (!query.empty()) { poDS->ReleaseResultSet(poLayer); } return true; } //const char* lname = poLayer->GetName(); OGRwkbGeometryType wkbgeom = wkbFlatten(poLayer->GetGeomType()); OGRFeature *poFeature; poLayer->ResetReading(); poFeature = poLayer->GetNextFeature(); if (poFeature != NULL) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { if (poGeometry->Is3D()) { addWarning("Z coordinates ignored"); } if (poGeometry->IsMeasured()) { addWarning("M coordinates ignored"); } } } source_layer = poLayer->GetName(); if (as_proxy) { SpatGeom g; if ((wkbgeom == wkbPoint) | (wkbgeom == wkbMultiPoint)) { //SpatPart p(0,0); OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { if ( wkbFlatten(poGeometry->getGeometryType()) == wkbPoint ) { g = getPointGeom(poGeometry); } else { g = getMultiPointGeom(poGeometry); } } else { g = emptyGeom(); } addGeom(g); OGRFeature::DestroyFeature( poFeature ); } else if (wkbgeom == wkbLineString || wkbgeom == wkbMultiLineString) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { if (wkbFlatten ( poGeometry ->getGeometryType() ) == wkbLineString) { g = getLinesGeom(poGeometry); } else { g = getMultiLinesGeom(poGeometry); } } else { g = emptyGeom(); } addGeom(g); OGRFeature::DestroyFeature( poFeature ); } else if ( wkbgeom == wkbPolygon || wkbgeom == wkbMultiPolygon) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { wkbgeom = wkbFlatten(poGeometry->getGeometryType()); if (wkbgeom == wkbPolygon) { g = getPolygonsGeom(poGeometry); } else if (wkbgeom == wkbMultiPolygon ) { g = getMultiPolygonsGeom(poGeometry); } // else ? } else { g = emptyGeom(); } addGeom(g); OGRFeature::DestroyFeature( poFeature ); } else if (wkbgeom == wkbUnknown) { long long fcnt = poLayer->GetFeatureCount(true); if (fcnt == 0) return true; if (fcnt < 0) { if ( (poFeature = poLayer->GetNextFeature()) != NULL ) { return true; } } const char *geomtypechar = OGRGeometryTypeToName(wkbgeom); std::string strgeomtype = geomtypechar; std::string s = "cannot read this geometry type: "+ strgeomtype; setError(s); return false; } else if (wkbgeom != wkbNone) { const char *geomtypechar = OGRGeometryTypeToName(wkbgeom); std::string strgeomtype = geomtypechar; std::string s = "cannot read this geometry type: "+ strgeomtype; setError(s); return false; } geom_count = poLayer->GetFeatureCount(); // not checking for multiple geom fields // int nGeomFieldCount = poLayer->GetLayerDefn()->GetGeomFieldCount(); OGREnvelope oExt; if (poLayer->GetExtent(&oExt, FALSE) == OGRERR_NONE) { extent.xmin = oExt.MinX; extent.xmax = oExt.MaxX; extent.ymin = oExt.MinY; extent.ymax = oExt.MaxY; } else { extent.xmin = NAN; extent.xmax = NAN; extent.ymin = NAN; extent.ymax = NAN; } is_proxy = true; return true; } OGRFeature::DestroyFeature( poFeature ); poLayer->ResetReading(); SpatGeom g; if ((wkbgeom == wkbPoint) | (wkbgeom == wkbMultiPoint)) { //SpatPart p(0,0); while( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { if ( wkbFlatten(poGeometry->getGeometryType()) == wkbPoint ) { g = getPointGeom(poGeometry); } else { g = getMultiPointGeom(poGeometry); } } else { g = emptyGeom(); } addGeom(g); OGRFeature::DestroyFeature( poFeature ); } } else if (wkbgeom == wkbLineString || wkbgeom == wkbMultiLineString) { while ( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { if (wkbFlatten ( poGeometry ->getGeometryType() ) == wkbLineString) { g = getLinesGeom(poGeometry); } else { g = getMultiLinesGeom(poGeometry); } } else { g = emptyGeom(); } addGeom(g); OGRFeature::DestroyFeature( poFeature ); } } else if ( wkbgeom == wkbPolygon || wkbgeom == wkbMultiPolygon) { while ( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { wkbgeom = wkbFlatten(poGeometry->getGeometryType()); if (wkbgeom == wkbPolygon) { g = getPolygonsGeom(poGeometry); } else if (wkbgeom == wkbMultiPolygon ) { g = getMultiPolygonsGeom(poGeometry); } } else { g = emptyGeom(); } addGeom(g); OGRFeature::DestroyFeature( poFeature ); } } else if (wkbgeom == wkbUnknown) { long long fcnt = poLayer->GetFeatureCount(true); if (fcnt == 0) return true; if (fcnt < 0) { if ( (poFeature = poLayer->GetNextFeature()) != NULL ) { return true; } } SpatVectorCollection sv; std::vector dempty; SpatVector filter2; sv.read_ogr(poDS, "", "", dempty, filter2); if (sv.size() > 0) { *this = sv.v[0]; if (sv.v.size() > 1) { std::string gt = type(); addWarning("returning " + gt + " ignoring additional geometry types. Use 'svc' to get all geometries"); } return true; } if (sv.hasError()) { setError(sv.getError()); } return false; } else if (wkbgeom != wkbNone) { const char *geomtypechar = OGRGeometryTypeToName(wkbgeom); std::string strgeomtype = geomtypechar; std::string s = "cannot read this geometry type: "+ strgeomtype; setError(s); return false; } if (!query.empty()) { poDS->ReleaseResultSet(poLayer); } return true; } bool SpatVector::read(std::string fname, std::string layer, std::string query, std::vector ext, SpatVector filter, bool as_proxy, std::string what, std::vector options) { char ** openops = NULL; for (size_t i=0; i opt = strsplit(options[i], "="); if (opt.size() == 2) { openops = CSLSetNameValue(openops, opt[0].c_str(), opt[1].c_str()); } } GDALDataset *poDS = static_cast(GDALOpenEx( fname.c_str(), GDAL_OF_VECTOR, NULL, openops, NULL )); if( poDS == NULL ) { if (!file_exists(fname)) { setError("file does not exist: " + fname); } else { setError("Cannot open this file as a SpatVector: " + fname); } return false; } bool success = read_ogr(poDS, layer, query, ext, filter, as_proxy, what); if (poDS != NULL) GDALClose( poDS ); source = fname; return success; } SpatVector SpatVector::fromDS(GDALDataset *poDS) { SpatVector out, fvct; std::vector fext; out.read_ogr(poDS, "", "", fext, fvct, false, ""); return out; } SpatVector::SpatVector(std::vector wkt) { OGRGeometryFactory ogr; SpatGeom g; bool haveGeomt = false; SpatGeomType geomt = null; for (size_t i=0; i cstr = { cstring }; OGRErr err = ogr.createFromWkt(&cstr[0], NULL, &poGeometry ); #else const char* pszWKT = wkt[i].c_str(); OGRErr err = ogr.createFromWkt( pszWKT, NULL, &poGeometry ); #endif if (err == OGRERR_NONE) { //const char* gname = poGeometry->getGeometryName(); if (poGeometry != NULL) { OGRwkbGeometryType gtype = wkbFlatten(poGeometry->getGeometryType()); if ( gtype == wkbPoint ) { g = getPointGeom(poGeometry); } else if ( gtype == wkbMultiPoint ) { g = getMultiPointGeom(poGeometry); } else if (gtype == wkbLineString) { g = getLinesGeom(poGeometry); } else if (gtype == wkbMultiLineString) { g = getMultiLinesGeom(poGeometry); } else if (gtype == wkbPolygon) { g = getPolygonsGeom(poGeometry); } else if (gtype == wkbMultiPolygon ) { g = getMultiPolygonsGeom(poGeometry); } else { const char *geomtypechar = OGRGeometryTypeToName(gtype); std::string strgeomtype = geomtypechar; std::string s = "cannot read geometry type: "+ strgeomtype; setError(s); return; } if (!haveGeomt) { haveGeomt = true; geomt = g.gtype; } else if (geomt != g.gtype) { setError("a SpatVector can only have a single geometry type"); return; } addGeom(g); OGRGeometryFactory::destroyGeometry(poGeometry); } } else { setError("not WKT"); return; } } } bool SpatVectorCollection::read_ogr(GDALDataset *&poDS, std::string layer, std::string query, std::vector extent, SpatVector filter) { OGRLayer *poLayer; poLayer = poDS->GetLayer(0); std::string errmsg; std::vector wrnmsg; if (!layerQueryFilter(poDS, poLayer, layer, query, extent, filter, errmsg, wrnmsg)) { setError(errmsg); return false; } else if (!wrnmsg.empty()) { for (size_t i=0; i < wrnmsg.size(); i++) addWarning(wrnmsg[i]); } std::string crs = ""; OGRSpatialReference *poSRS = poLayer->GetSpatialRef(); if (poSRS) { char *psz = NULL; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OGRErr err = poSRS->exportToWkt(&psz, options); #else OGRErr err = poSRS->exportToWkt(&psz); #endif if (err == OGRERR_NONE) { crs = psz; } CPLFree(psz); } //const char* lname = poLayer->GetName(); // OGRwkbGeometryType wkbgeom = wkbFlatten(poLayer->GetGeomType()); OGRFeature *poFeature; poLayer->ResetReading(); poFeature = poLayer->GetNextFeature(); if (poFeature != NULL) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { if (poGeometry->Is3D()) { addWarning("Z coordinates ignored"); } if (poGeometry->IsMeasured()) { addWarning("M coordinates ignored"); } } } std::string source_layer = poLayer->GetName(); OGRFeature::DestroyFeature( poFeature ); SpatDataFrame df = readAttributes(poLayer, false); poLayer->ResetReading(); SpatVector points, lines, polygons; std::vector pnt, lin, pol; SpatGeom g; size_t i = 0; while( (poFeature = poLayer->GetNextFeature()) != NULL ) { OGRGeometry *poGeometry = poFeature->GetGeometryRef(); if (poGeometry != NULL) { OGRwkbGeometryType wkb = wkbFlatten(poGeometry->getGeometryType()); if (wkb == wkbPoint ) { g = getPointGeom(poGeometry); points.addGeom(g); pnt.push_back(i); } else if ((wkb == wkbMultiPoint) || (wkb == wkbMultiPointZM) || (wkb == wkbMultiPointM)) { g = getMultiPointGeom(poGeometry); points.addGeom(g); pnt.push_back(i); } else if (wkb == wkbLineString) { g = getLinesGeom(poGeometry); lines.addGeom(g); lin.push_back(i); } else if ((wkb == wkbMultiLineString) || (wkb == wkbMultiLineStringZM) || (wkb == wkbMultiLineStringM)) { g = getMultiLinesGeom(poGeometry); lines.addGeom(g); lin.push_back(i); } else if (wkb == wkbPolygon) { g = getPolygonsGeom(poGeometry); polygons.addGeom(g); pol.push_back(i); } else if ((wkb == wkbMultiPolygon) || (wkb == wkbMultiPolygonZM) || (wkb == wkbMultiPolygonM)) { g = getMultiPolygonsGeom(poGeometry); polygons.addGeom(g); pol.push_back(i); } else { // g = emptyGeom(); } OGRFeature::DestroyFeature( poFeature ); i++; } } if (!query.empty()) { poDS->ReleaseResultSet(poLayer); } if (polygons.size() > 0) { polygons.setSRS(crs); polygons.read_query = query; polygons.read_extent= extent; polygons.source_layer = source_layer; if (df.ncol() > 0) polygons.df = df.subset_rows(pol); v.push_back(polygons); } if (lines.size() > 0) { lines.setSRS(crs); lines.read_query = query; lines.read_extent= extent; lines.source_layer = source_layer; if (df.ncol() > 0) lines.df = df.subset_rows(lin); v.push_back(lines); } if (points.size() > 0) { points.setSRS(crs); points.read_query = query; points.read_extent= extent; points.source_layer = source_layer; if (df.ncol() > 0) points.df = df.subset_rows(pnt); v.push_back(points); } return true; } bool SpatVectorCollection::read(std::string fname, std::string layer, std::string query, std::vector extent, SpatVector filter) { //OGRRegisterAll(); GDALDataset *poDS = static_cast(GDALOpenEx( fname.c_str(), GDAL_OF_VECTOR, NULL, NULL, NULL )); if( poDS == NULL ) { if (!file_exists(fname)) { setError("file does not exist: " + fname); } else { setError("Cannot open this file as a SpatVector: " + fname); } return false; } bool success = read_ogr(poDS, layer, query, extent, filter); if (poDS != NULL) GDALClose( poDS ); return success; } SpatVectorCollection::SpatVectorCollection(std::string filename, std::string layer, std::string query, std::vector extent, SpatVector filter) { read(filename, layer, query, extent, filter); } terra/src/spatVector.h0000644000176200001440000004100514756761010014470 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifndef SPATVECTOR_GUARD #define SPATVECTOR_GUARD #include "spatDataframe.h" #ifdef useGDAL #include "gdal_priv.h" #endif enum SpatGeomType { points, lines, polygons, null}; class SpatHole { public: virtual ~SpatHole(){} std::vector x, y; SpatExtent extent; //constructors SpatHole(); SpatHole(std::vector X, std::vector Y); //methods size_t size() { return x.size(); } bool empty() { return x.empty(); } }; class SpatPart { public: virtual ~SpatPart(){} std::vector x, y; //, z; std::vector< SpatHole > holes; // polygons only SpatExtent extent; //constructors SpatPart(); SpatPart(std::vector X, std::vector Y); SpatPart(double X, double Y); //methods size_t size() { return x.size(); } bool empty() { return x.empty(); } //holes, polygons only bool addHole(std::vector X, std::vector Y); bool addHole(SpatHole h); SpatHole getHole(unsigned i) { return( holes[i] ) ; } bool hasHoles() { return !holes.empty();} unsigned nHoles() { return holes.size();} size_t ncoords(); bool is_CCW(); }; class SpatGeom { public: //constructors SpatGeom(); SpatGeom(SpatGeomType g); SpatGeom(SpatPart p, SpatGeomType type); virtual ~SpatGeom(){} SpatGeomType gtype = null; std::vector parts; SpatExtent extent; //methods bool unite(SpatGeom g); bool addPart(SpatPart p); bool addHole(SpatHole h); bool setPart(SpatPart p, unsigned i); bool reSetPart(SpatPart p); SpatPart getPart(unsigned i); //double area_plane(); //double area_lonlat(double a, double f); //double length_plane(); //double length_lonlat(double a, double f); unsigned size() { return parts.size(); }; bool empty() { return parts.empty(); }; void remove_duplicate_nodes(int digits); size_t ncoords(); std::vector> coordinates(); void computeExtent(); void reserve(size_t n) { parts.reserve(n); } }; class SpatVectorCollection; class SpatVector { public: std::vector geoms; SpatExtent extent; SpatDataFrame df; //std::vector crs; SpatSRS srs; bool is_proxy = false; std::string read_query = ""; std::vector read_extent; std::string source = ""; std::string source_layer = ""; size_t geom_count = 0; SpatVector(); //SpatVector(const SpatVector &x); SpatVector(SpatGeom g); SpatVector(SpatExtent e, std::string crs); SpatVector(std::vector x, std::vector y, SpatGeomType g, std::string crs); SpatVector(std::vector wkt); virtual ~SpatVector(){} SpatGeom window; // for point patterns, must be polygon std::vector get_names(); void set_names(std::vector s); unsigned nrow(); unsigned ncol(); unsigned nxy(); SpatVector deepCopy() {return *this;} SpatExtent getExtent(); // bool is_geographic(); bool is_lonlat(); bool could_be_lonlat(); std::string type(); SpatGeomType getGType(std::string &type); bool is_multipoint(); //std::vector getCRS(); //void setCRS(std::vector _crs); bool setSRS(std::string _srs) { std::string msg; if (!srs.set(_srs, msg)){ addWarning("Cannot set SRS to vector: "+ msg); return false; } source = ""; return true; } std::string getSRS(std::string x) { return srs.get(x); } SpatGeom getGeom(unsigned i); bool addGeom(SpatGeom p); bool setGeom(SpatGeom p); bool replaceGeom(SpatGeom p, unsigned i); std::vector> getGeometry(); SpatDataFrame getGeometryDF(); std::vector getGeometryWKT(); void computeExtent(); size_t nparts(bool holes); size_t ncoords(); std::vector> coordinates(); SpatVector project(std::string crs, bool partial); std::vector project_xy(std::vector x, std::vector y, std::string fromCRS, std::string toCRS); SpatVector subset_cols(long i); SpatVector subset_cols(std::vector range); SpatVector subset_rows(long i); SpatVector subset_rows(std::vector range); SpatVector subset_rows(std::vector range); SpatVector remove_rows(std::vector range); void setGeometry(std::string type, std::vector gid, std::vector part, std::vector x, std::vector y, std::vector hole); void setPointsGeometry(std::vector &x, std::vector &y); void setPointsDF(SpatDataFrame &x, std::vector geo, std::string crs, bool keepgeom); void setLinesStartEnd(std::vector &x, std::string crs); std::vector area(std::string unit, bool transform, std::vector mask); void reserve(size_t n); std::vector length(); std::vector nseg(); std::vector distance(bool sequential, std::string unit, const std::string method); std::vector distance(SpatVector x, bool pairwise, std::string unit, const std::string method); std::vector pointdistance(const std::vector& px, const std::vector& py, const std::vector& sx, const std::vector& sy, bool pairwise, double m, bool lonlat, std::string method); // std::vector pointdistance_seq(const std::vector& px, const std::vector& py, double m, bool lonlat); // std::vector> get_index(SpatVector &p); std::vector distLonLat(SpatVector p, std::string unit, std::string method, bool transp); // std::vector distLonLat(std::vector x, std::vector y, std::string unit, std::string method, bool transp); //std::vector nearestDistLonLat(std::vector x, std::vector y, std::string unit, std::string method); std::vector> knearest(size_t k); size_t size(); bool empty(); SpatVector as_lines(); SpatVector as_points(bool multi, bool skiplast=false); SpatVector remove_holes(); SpatVector get_holes(); SpatVector set_holes(SpatVector x, size_t i); SpatVector remove_duplicate_nodes(int digits); bool read(std::string fname, std::string layer, std::string query, std::vector ext, SpatVector filter, bool as_proxy, std::string what, std::vector options); bool write(std::string filename, std::string lyrname, std::string driver, bool append, bool overwrite, std::vector); void make_CCW(); #ifdef useGDAL GDALDataset* write_ogr(std::string filename, std::string lyrname, std::string driver, bool append, bool overwrite, std::vector options); GDALDataset* GDAL_ds(); bool read_ogr(GDALDataset *&poDS, std::string layer, std::string query, std::vector ext, SpatVector filter, bool as_proxy, std::string what); SpatVector fromDS(GDALDataset *poDS); bool ogr_geoms(std::vector &ogrgeoms, std::string &message); bool delete_layers(std::string filename, std::vector layers, bool return_error); std::vector layer_names(std::string filename); #endif // attributes std::vector getDv(unsigned i); std::vector getIv(unsigned i); std::vector getSv(unsigned i); std::vector getItype(); std::vector getIplace(); void add_column(unsigned dtype, std::string name) { df.add_column(dtype, name); }; template bool add_column(std::vector x, std::string name) { return df.add_column(x, name); } bool add_column_bool(std::vector x, std::string name) { return df.add_column_bool(x, name); } bool add_column_time(std::vector x, std::string name, std::string step, std::string zone) { return df.add_column_time(x, name, step, zone); } bool add_column_factor(SpatFactor x, std::string name) { return df.add_column(x, name); } void remove_df() { SpatDataFrame empty; df = empty; }; bool set_df(SpatDataFrame x) { if (x.nrow() != nrow()) { setError("nrow dataframe does not match nrow geometry"); return false; } df = x; return true; }; bool remove_column(std::string field) { return df.remove_column(field); }; bool remove_column(int i) { return df.remove_column(i); }; std::vector get_datatypes() { return df.get_datatypes(); } SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} SpatVector append(SpatVector x, bool ignorecrs); SpatVector disaggregate(bool segments); SpatVector shift(double x, double y); SpatVector rescale(double fx, double fy, double x0, double y0); SpatVector transpose(); SpatVector flip(bool vertical); SpatVector rotate(double angle, std::vector x0, std::vector y0); SpatVector normalize_longitude(); SpatVector rotate_longitude(double longitude, bool left); std::vector> linesNA(); std::vector>> linesList(); std::vector>>> polygonsList(); //ogr std::vector is_valid(); SpatVector make_valid(); //geos SpatVector make_valid2(); std::vector geos_isvalid(); std::vector geos_isvalid_msg(); std::vector wkt(); std::vector wkb(); std::vector hex(); std::vector> wkb_raw(); SpatVector from_hex(std::vector x, std::string srs); SpatVector make_nodes(); SpatVector polygonize(); SpatVector normalize(); SpatVector boundary(); SpatVector line_merge(); SpatVector simplify(double tolerance, bool preserveTopology); SpatVector shared_paths(bool index); SpatVector shared_paths(SpatVector x, bool index); SpatVector snap(double tolerance); SpatVector snapto(SpatVector y, double tolerance); SpatVector thin(double threshold); SpatVector split_lines(SpatVector v); SpatVector allerretour(); SpatVectorCollection bienvenue(); SpatVector aggregate(bool dissolve); SpatVector aggregate(std::string field, bool dissolve); SpatVector buffer2(std::vector d, unsigned quadsegs); SpatVector buffer3(std::vector d, unsigned quadsegs); // SpatVector buffer4(double d); // SpatVector bufferclip(std::vector d, std::string jointype, double miter_limit, int precision, double arc_tolerance); SpatVector buffer(std::vector d, unsigned quadsegs, std::string capstyle, std::string joinstyle, double mitrelimit, bool singlesided); SpatVector buffer_lonlat(std::string vt, std::vector d, unsigned quadsegs); SpatVector point_buffer(std::vector d, unsigned quadsegs, bool no_multipolygons, bool wrap); SpatVector centroid(bool check_lonlat); SpatVector point_on_surface(bool check_lonlat); std::vector pointInPolygon(std::vector &x, std::vector &y); SpatVector crop(SpatExtent e, bool wrap); SpatVector crop(SpatVector e); SpatVector voronoi(SpatVector bnd, double tolerance, int onlyEdges); SpatVector voronoi_sphere(SpatVector bnd, double tolerance, int onlyEdges); SpatVector delaunay(double tolerance, int onlyEdges, bool constrained=false); SpatVector hull(std::string htype, std::string by="", double param=1, bool allowHoles=true, bool tight=true); SpatVector intersect(SpatVector v, bool values); SpatVector unite(SpatVector v); SpatVector unite(); SpatVector erase_agg(SpatVector v); SpatVector erase(SpatVector v); SpatVector erase(bool sequential); SpatVector elongate(double length, bool flat); SpatVector mask(SpatVector x, bool inverse); SpatVector gaps(); SpatVector cover(SpatVector v, bool identity, bool expand); SpatVectorCollection split(std::string field); SpatVector symdif(SpatVector v); SpatVector set_precision(double gridSize); std::vector> index_2d(SpatVector v); std::vector> index_sparse(SpatVector v); std::vector> which_relate(SpatVector v, std::string relation, bool narm); std::vector> which_relate(std::string relation, bool narm); std::vector is_related(SpatVector v, std::string relation); // std::vector relate(SpatVector v, std::string relation); std::vector relate(SpatVector v, std::string relation, bool prepared, bool index); std::vector relate(std::string relation, bool symmetrical); std::vector relateFirst(SpatVector v, std::string relation); std::vector equals_exact(SpatVector v, double tol); std::vector equals_exact(bool symmetrical, double tol); std::vector geos_distance(SpatVector v, bool parallel, std::string fun, double m); std::vector geos_distance(bool sequential, std::string fun, double m); SpatVector nearest_point(SpatVector v, bool parallel, const std::string method); SpatVector nearest_point(const std::string method); std::vector nearest_geometry(SpatVector v); SpatVector sample(unsigned n, std::string method, unsigned seed); SpatVector sample_geom(std::vector n, std::string method, unsigned seed); SpatVector clearance(); SpatVector width(); SpatVector unaryunion(); SpatVector cbind(SpatDataFrame d); void fix_lonlat_overflow(); SpatVector cross_dateline(bool &fixed); SpatVector densify(double interval, bool adjust, bool ignorelonlat); SpatVector round(int digits); std::vector nullGeoms(); std::vector naGeoms(); }; class SpatVectorCollection { public: virtual ~SpatVectorCollection(){} SpatVectorCollection(); SpatVectorCollection(std::string filename, std::string layer, std::string query, std::vector extent, SpatVector filter); SpatVectorCollection deepCopy() { return *this; } bool read(std::string fname, std::string layer, std::string query, std::vector extent, SpatVector filter); bool read_ogr(GDALDataset *&poDS, std::string layer, std::string query, std::vector extent, SpatVector filter); // SpatVectorCollection create(std::string filename); std::vector v; std::vector names; std::vector getNames() { return names;} bool setNames(std::vector nms, bool make_valid=false); SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings();} std::string getError() { return msg.getError();} size_t size() { return v.size(); } bool empty() { return v.empty(); } void reserve(size_t n) { v.reserve(n); names.reserve(n); } void resize(size_t n) { v.resize(n); names.resize(n); } void push_back(SpatVector x) { v.push_back(x); names.push_back(""); }; bool replace(SpatVector x, size_t i) { if (i < size()) { v[i] = x; return true; } else { return false; } } SpatVectorCollection subset(std::vector i) { SpatVectorCollection out; for (size_t j=0; j x, std::string srs); }; class SpatVectorProxy { public: SpatVector v; SpatVectorProxy(){} virtual ~SpatVectorProxy(){} SpatVectorProxy deepCopy() {return *this;} SpatVector query_filter(std::string query, std::vector extent, SpatVector filter); }; #endif // SPATVECTOR_GUARD terra/src/geos_spat.h0000644000176200001440000005161714755154005014333 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #define GEOS_USE_ONLY_R_API #include #if GEOS_VERSION_MAJOR == 3 # if GEOS_VERSION_MINOR >= 5 # define GEOS350 # endif # if GEOS_VERSION_MINOR >= 6 // for #1744 //# if GEOS_VERSION_PATCH >= 1 # define GEOS360 //# endif # endif # if GEOS_VERSION_MINOR >= 7 # define GEOS361 # define GEOS370 # endif # if GEOS_VERSION_MINOR >= 8 # define GEOS380 # endif # if GEOS_VERSION_MINOR >= 10 # define GEOS3100 # endif # if GEOS_VERSION_MINOR >= 11 # define GEOS3110 # endif # if GEOS_VERSION_MINOR >= 12 # define GEOS3120 # endif #else # if GEOS_VERSION_MAJOR > 3 # define GEOS350 # define GEOS361 # define GEOS370 # define GEOS380 # define GEOS310 # define GEOS3110 # define GEOS3120 # endif #endif #include "spatVector.h" #include #include #include #include using GeomPtr = std::unique_ptr >; static GeomPtr geos_ptr(GEOSGeometry* g, GEOSContextHandle_t hGEOSctxt) { auto deleter = std::bind(GEOSGeom_destroy_r, hGEOSctxt, std::placeholders::_1); return GeomPtr(g, deleter); } using PrepGeomPtr= std::unique_ptr >; static PrepGeomPtr geos_ptr(const GEOSPreparedGeometry* pg, GEOSContextHandle_t hGEOSctxt) { auto deleter = std::bind(GEOSPreparedGeom_destroy_r, hGEOSctxt, std::placeholders::_1); return PrepGeomPtr(pg, deleter); } using TreePtr= std::unique_ptr >; static TreePtr geos_ptr(GEOSSTRtree* t, GEOSContextHandle_t hGEOSctxt) { auto deleter = std::bind(GEOSSTRtree_destroy_r, hGEOSctxt, std::placeholders::_1); return TreePtr(t, deleter); } /* using wkbPtr = std::unique_ptr >; static wkbPtr geos_wkb(unsigned char wkb, GEOSContextHandle_t hGEOSctxt) { auto deleter = std::bind(GEOSFree_r, hGEOSctxt, std::placeholders::_1); return wkbPtr(wkb, deleter); } */ #ifdef useRcpp #include "Rcpp.h" template inline void warnNoCall(const char* fmt, Args&&... args ) { Rf_warningcall(R_NilValue, "%s", tfm::format(fmt, std::forward(args)... ).c_str()); } template inline void NORET errNoCall(const char* fmt, Args&&... args) { throw Rcpp::exception(tfm::format(fmt, std::forward(args)... ).c_str(), false); } static void __errorHandler(const char *fmt, ...) { char buf[BUFSIZ], *p; va_list ap; va_start(ap, fmt); size_t n = BUFSIZ; vsnprintf(buf, n, fmt, ap); // vsprintf(buf, fmt, ap); va_end(ap); p = buf + strlen(buf) - 1; if (strlen(buf) > 0 && *p == '\n') *p = '\0'; errNoCall(buf); return; } static void __warningHandler(const char *fmt, ...) { char buf[BUFSIZ], *p; va_list ap; va_start(ap, fmt); size_t n = BUFSIZ; vsnprintf(buf, n, fmt, ap); // vsprintf(buf, fmt, ap); va_end(ap); p = buf + strlen(buf) - 1; if (strlen(buf) > 0 && *p == '\n') *p = '\0'; warnNoCall(buf); return; } static void __checkInterruptFn(void*) { R_CheckUserInterrupt(); } static void __checkInterrupt() { // Adapted (in sf) from Rcpp/Interrupt.h if (!R_ToplevelExec(__checkInterruptFn, nullptr)) { GEOS_interruptRequest(); } } inline GEOSContextHandle_t geos_init(void) { #ifdef GEOS350 GEOSContextHandle_t ctxt = GEOS_init_r(); GEOSContext_setNoticeHandler_r(ctxt, __warningHandler); GEOSContext_setErrorHandler_r(ctxt, __errorHandler); GEOS_interruptRegisterCallback(__checkInterrupt); return ctxt; #else return initGEOS_r((GEOSMessageHandler) __warningHandler, (GEOSMessageHandler) __errorHandler); #endif } #else #include static void __errorHandler(const char *fmt, ...) { char buf[BUFSIZ], *p; va_list ap; va_start(ap, fmt); size_t n = BUFSIZ; vsnprintf(buf, n, fmt, ap); // vsprintf(buf, fmt, ap); va_end(ap); p = buf + strlen(buf) - 1; if(strlen(buf) > 0 && *p == '\n') *p = '\0'; std::cout << buf << std::endl; return; } static void __warningHandler(const char *fmt, ...) { char buf[BUFSIZ], *p; va_list ap; va_start(ap, fmt); size_t n = BUFSIZ; vsnprintf(buf, n, fmt, ap); // vsprintf(buf, fmt, ap); va_end(ap); p = buf + strlen(buf) - 1; if(strlen(buf) > 0 && *p == '\n') *p = '\0'; std::cout << buf << std::endl; return; } inline GEOSContextHandle_t geos_init(void) { #ifdef GEOS350 GEOSContextHandle_t ctxt = GEOS_init_r(); GEOSContext_setNoticeHandler_r(ctxt, __warningHandler); GEOSContext_setErrorHandler_r(ctxt, __errorHandler); return ctxt; #else return initGEOS_r((GEOSMessageHandler) __warningHandler, (GEOSMessageHandler) __errorHandler); #endif } #endif inline void geos_finish(GEOSContextHandle_t ctxt) { #ifdef GEOS350 GEOS_finish_r(ctxt); #else finishGEOS_r(ctxt); #endif } static void __warningIgnore(const char *fmt, ...) { return; } inline GEOSContextHandle_t geos_init2(void) { #ifdef GEOS350 GEOSContextHandle_t ctxt = GEOS_init_r(); GEOSContext_setNoticeHandler_r(ctxt, __warningIgnore); GEOSContext_setErrorHandler_r(ctxt, __errorHandler); return ctxt; #else return initGEOS_r((GEOSMessageHandler) __warningIgnore, (GEOSMessageHandler) __errorHandler); #endif } inline GEOSGeometry* geos_line(const std::vector &x, const std::vector &y, GEOSContextHandle_t hGEOSCtxt) { GEOSCoordSequence *pseq; size_t n = x.size(); if (n < 2) { pseq = GEOSCoordSeq_create_r(hGEOSCtxt, 0, 2); GEOSGeometry* g = GEOSGeom_createLineString_r(hGEOSCtxt, pseq); return g; } pseq = GEOSCoordSeq_create_r(hGEOSCtxt, n, 2); for (size_t i = 0; i < n; i++) { GEOSCoordSeq_setX_r(hGEOSCtxt, pseq, i, x[i]); GEOSCoordSeq_setY_r(hGEOSCtxt, pseq, i, y[i]); } GEOSGeometry* g = GEOSGeom_createLineString_r(hGEOSCtxt, pseq); return g; } inline GEOSGeometry* geos_linearRing(const std::vector &x, const std::vector &y, GEOSContextHandle_t hGEOSCtxt) { GEOSCoordSequence *pseq; size_t n = x.size(); if (n < 3) { pseq = GEOSCoordSeq_create_r(hGEOSCtxt, 0, 2); GEOSGeometry* g = GEOSGeom_createLinearRing_r(hGEOSCtxt, pseq); return g; } pseq = GEOSCoordSeq_create_r(hGEOSCtxt, n, 2); for (size_t i = 0; i < n; i++) { GEOSCoordSeq_setX_r(hGEOSCtxt, pseq, i, x[i]); GEOSCoordSeq_setY_r(hGEOSCtxt, pseq, i, y[i]); } GEOSGeometry* g = GEOSGeom_createLinearRing_r(hGEOSCtxt, pseq); return g; } inline GEOSGeometry* geos_polygon(SpatPart g, GEOSContextHandle_t hGEOSCtxt) { GEOSGeometry* shell = geos_linearRing(g.x, g.y, hGEOSCtxt); if (g.hasHoles()) { size_t nh=0; std::vector holes; holes.reserve(g.nHoles()); for (size_t k=0; k < g.nHoles(); k++) { SpatHole h = g.getHole(k); GEOSGeometry* glr = geos_linearRing(h.x, h.y, hGEOSCtxt); if (glr != NULL) { holes.push_back(glr); nh++; } } GEOSGeometry* geom = GEOSGeom_createPolygon_r(hGEOSCtxt, shell, &holes[0], nh); return geom; } else { GEOSGeometry* geom = GEOSGeom_createPolygon_r(hGEOSCtxt, shell, NULL, 0); return geom; } } inline std::vector geos_geoms(SpatVector *v, GEOSContextHandle_t hGEOSCtxt) { size_t n = v->size(); std::vector g; g.reserve(n); std::string vt = v->type(); if (vt == "points") { for (size_t i=0; igetGeom(i); size_t np = svg.size(); GEOSCoordSequence *pseq; std::vector geoms; geoms.reserve(np); for (size_t j = 0; j < np; j++) { //SpatPart svp = svg.getPart(j); pseq = GEOSCoordSeq_create_r(hGEOSCtxt, 1, 2); GEOSCoordSeq_setX_r(hGEOSCtxt, pseq, 0, svg.parts[j].x[0]); GEOSCoordSeq_setY_r(hGEOSCtxt, pseq, 0, svg.parts[j].y[0]); GEOSGeometry* pt = GEOSGeom_createPoint_r(hGEOSCtxt, pseq); if (pt != NULL) { geoms.push_back(pt); } } GEOSGeometry* gcol = (np == 1) ? geoms[0] : GEOSGeom_createCollection_r(hGEOSCtxt, GEOS_MULTIPOINT, &geoms[0], np); g.push_back( geos_ptr(gcol, hGEOSCtxt) ); } } else if (vt == "lines") { // gp = NULL; for (size_t i=0; igetGeom(i); size_t np = svg.size(); std::vector geoms; geoms.reserve(np); for (size_t j=0; j < np; j++) { //SpatPart svp = svg.getPart(j); // if (svg.parts[j].x.size() < 3) continue; GEOSGeometry* gp = geos_line(svg.parts[j].x, svg.parts[j].y, hGEOSCtxt); if (gp != NULL) { geoms.push_back(gp); } } GEOSGeometry* gcol = (geoms.size() == 1) ? geoms[0] : GEOSGeom_createCollection_r(hGEOSCtxt, GEOS_MULTILINESTRING, &geoms[0], np); g.push_back( geos_ptr(gcol, hGEOSCtxt) ); } } else { // polygons // std::vector> hx, hy; for (size_t i=0; igetGeom(i); size_t np = svg.size(); std::vector geoms; geoms.reserve(np); for (size_t j=0; j < np; j++) { SpatPart svp = svg.getPart(j); // if (svp.x.size() < 3) continue; GEOSGeometry* gp = geos_polygon(svp, hGEOSCtxt); if (gp != NULL) { geoms.push_back(gp); } } //Rcpp::Rcout << np << std::endl; GEOSGeometry* gcol = (geoms.size() == 1) ? geoms[0] : GEOSGeom_createCollection_r(hGEOSCtxt, GEOS_MULTIPOLYGON, &geoms[0], geoms.size()); g.push_back( geos_ptr(gcol, hGEOSCtxt)); } } return g; } inline SpatVector vect_from_geos(std::vector &geoms , GEOSContextHandle_t hGEOSCtxt, std::string vt) { SpatVector out; SpatVector v; size_t ng = geoms.size(); std::vector gid, gp, hole; std::vector x, y; bool xok, yok; if ((vt == "points") || (vt == "lines")) { for(size_t i = 0; i < ng; i++) { GEOSGeometry* g = geoms[i].get(); size_t np = GEOSGetNumGeometries_r(hGEOSCtxt, g); for(size_t j = 0; j &x, std::vector &y, std::vector &gid, std::vector &gp, std::vector &hole, std::string &msg) { const GEOSCoordSequence* crds = GEOSGeom_getCoordSeq_r(hGEOSCtxt, part); int npts = -1; npts = GEOSGetNumCoordinates_r(hGEOSCtxt, part); if (npts < 0) { msg = "GEOS exception 9"; return false; } if (npts == 0) { // for #813 x.push_back(NAN); y.push_back(NAN); gid.push_back(i); gp.push_back(j); hole.push_back(0); return true; } double xvalue = 0; double yvalue = 0; for (int p=0; p < npts; p++) { bool xok = GEOSCoordSeq_getX_r(hGEOSCtxt, crds, p, &xvalue); bool yok = GEOSCoordSeq_getY_r(hGEOSCtxt, crds, p, &yvalue); if (xok & yok) { x.push_back(xvalue); y.push_back(yvalue); gid.push_back(i); gp.push_back(j); hole.push_back(0); } } return true; } inline bool polysFromGeom(GEOSContextHandle_t hGEOSCtxt, const GEOSGeometry* part, const unsigned i, const unsigned j, std::vector &x, std::vector &y, std::vector &gid, std::vector &gp, std::vector &hole, std::string &msg) { const GEOSGeometry* ring = GEOSGetExteriorRing_r(hGEOSCtxt, part); const GEOSCoordSequence* crds = GEOSGeom_getCoordSeq_r(hGEOSCtxt, ring); int npts = -1; npts = GEOSGetNumCoordinates_r(hGEOSCtxt, ring); if (npts < 0) { msg = "exception 99"; return false; } if (npts == 0) { // for #813 x.push_back(NAN); y.push_back(NAN); gid.push_back(i); gp.push_back(j); hole.push_back(0); return true; } double xvalue = 0; double yvalue = 0; for (int p=0; p < npts; p++) { bool xok = GEOSCoordSeq_getX_r(hGEOSCtxt, crds, p, &xvalue); bool yok = GEOSCoordSeq_getY_r(hGEOSCtxt, crds, p, &yvalue); if (xok & yok) { x.push_back(xvalue); y.push_back(yvalue); gid.push_back(i); gp.push_back(j); hole.push_back(0); } } int nholes = GEOSGetNumInteriorRings_r(hGEOSCtxt, part); for (int h=0; h < nholes; h++) { const GEOSGeometry* ring = GEOSGetInteriorRingN_r(hGEOSCtxt, part, h); const GEOSCoordSequence* crds = GEOSGeom_getCoordSeq_r(hGEOSCtxt, ring); int npts = -1; npts = GEOSGetNumCoordinates_r(hGEOSCtxt, ring); if (npts < 0) { msg = "exception 123"; return false; } double xvalue = 0; double yvalue = 0; for (int p=0; p < npts; p++) { bool xok = GEOSCoordSeq_getX_r(hGEOSCtxt, crds, p, &xvalue); bool yok = GEOSCoordSeq_getY_r(hGEOSCtxt, crds, p, &yvalue); if (xok & yok) { x.push_back(xvalue); y.push_back(yvalue); gid.push_back(i); gp.push_back(j); hole.push_back(h+1); } } } return true; } inline void emptyGeom(const unsigned i, std::vector &x, std::vector &y, std::vector &gid, std::vector &gp, std::vector &hole) { x.push_back(NAN); y.push_back(NAN); gid.push_back(i); gp.push_back(0); hole.push_back(0); } inline SpatVectorCollection coll_from_geos(std::vector &geoms, GEOSContextHandle_t hGEOSCtxt, const std::vector &ids = std::vector(), bool keepnull=true, bool increment = true) { SpatVectorCollection out; std::vector pt_gid, pt_gp, pt_hole; std::vector ln_gid, ln_gp, ln_hole; std::vector pl_gid, pl_gp, pl_hole; std::vector pt_x, pt_y, ln_x, ln_y, pl_x, pl_y; std::vector pts_ids, lin_ids, pol_ids; bool track_ids = !ids.empty(); if (track_ids) { pol_ids.reserve(geoms.size()); } std::string msg; size_t ng = geoms.size(); size_t f = 0; for(size_t i = 0; i < ng; i++) { const GEOSGeometry* g = geoms[i].get(); char* geostype = GEOSGeomType_r(hGEOSCtxt, g); std::string gt = geostype; free(geostype); size_t np = GEOSGetNumGeometries_r(hGEOSCtxt, g); if (gt == "Point" || gt == "MultiPoint") { if (np == 0 && keepnull) { emptyGeom(f, pt_x, pt_y, pt_gid, pt_gp, pt_hole); } for(size_t j = 0; j. #ifndef SPATFACTOR_GUARD #define SPATFACTOR_GUARD class SpatFactor { public: virtual ~SpatFactor(){} SpatFactor(){} ; SpatFactor(size_t _size, unsigned _value) { v.resize(_size, _value); }; SpatFactor(std::vector _values, std::vector _labels, bool _ordered); SpatFactor(std::vector _values, std::vector _labels); SpatFactor(std::vector _values); SpatFactor(std::vector _values); std::vector v; //std::vector levels; std::vector labels; bool ordered = false; size_t size() { return v.size(); } bool empty() { return v.empty(); } //void compute_levels(); void push_back(unsigned x) { v.push_back(x); } bool set_labels(std::vector _labels); void reserve(size_t n) { v.reserve(n); } void resize(size_t n) { v.resize(n); } void resize(size_t n, unsigned x) {v.resize(n, x);} // template // SpatFactor(std::vector _v) { // set_values(_v); // } SpatFactor subset(std::vector i); std::string getLabel(size_t i); std::vector getLabels(); }; #endif terra/src/crs.h0000644000176200001440000000250714733327330013127 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . //#ifdef useGDAL #include "ogr_spatialref.h" bool can_transform(std::string fromCRS, std::string toCRS); SpatMessages transform_coordinates(std::vector &x, std::vector &y, std::string fromCRS, std::string toCRS); bool wkt_from_spatial_reference(const OGRSpatialReference *srs, std::string &wkt, std::string &msg); bool prj_from_spatial_reference(const OGRSpatialReference *srs, std::string &prj, std::string &msg); //std::vector srefs_from_string(std::string input); bool wkt_from_string(std::string input, std::string& wkt, std::string& msg); bool is_ogr_error(OGRErr err, std::string &msg); //#endif terra/src/spatBase.cpp0000644000176200001440000003563314730733427014450 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "string_utils.h" #include "math_utils.h" SpatOptions::SpatOptions() {} SpatOptions::SpatOptions(const SpatOptions &opt) { tempdir = opt.tempdir; memfrac = opt.memfrac; memmax = opt.memmax; memmin = opt.memmin; todisk = opt.todisk; tolerance = opt.tolerance; def_datatype = opt.def_datatype; def_filetype = opt.def_filetype; filenames = {""}; overwrite = false; progress = opt.progress; ncopies = opt.ncopies; verbose = opt.verbose; def_verbose = opt.def_verbose; statistics = opt.statistics; steps = opt.steps; minrows = opt.minrows; names = opt.names; //ncdfcopy = opt.ncdfcopy; gdal_options = opt.gdal_options; overwrite = opt.overwrite; hasNAflag = false; NAflag = NAN; datatype_set = opt.datatype_set; datatype = opt.datatype; filetype = opt.filetype; tmpfile = opt.tmpfile + "_2"; } SpatOptions SpatOptions::deepCopy() { return *this; } //SpatOptions SpatOptions::deepCopy(const SpatOptions &opt) { // return SpatOptions(opt); //} //void SpatOptions::set_def_bandorder(std::string d) { def_bandorder = d; } //std::string SpatOptions::get_def_bandorder() { return def_bandorder; } //void SpatOptions::set_bandorder(std::string d) { bandorder = d; } //std::string SpatOptions::get_bandorder() {if (bandorder != "") {return bandorder;} else {return def_datatype;}} void SpatOptions::set_def_datatype(std::string d) { #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 7 std::vector ss = {"INT1U", "INT2U", "INT4U", "INT8U", "INT2S", "INT4S", "INT8S", "FLT4S", "FLT8S"} ; #else std::vector ss = {"INT1U", "INT2U", "INT4U", "INT8U", "INT1S", "INT2S", "INT4S", "INT8S", "FLT4S", "FLT8S"}; #endif if (is_in_vector(d, ss)) def_datatype = d; } std::string SpatOptions::get_def_datatype() { return def_datatype; } void SpatOptions::set_datatype(std::string d) { #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 7 std::vector ss = {"INT1U", "INT2U", "INT4U", "INT8U", "INT2S", "INT4S", "INT8S", "FLT4S", "FLT8S"} ; #else std::vector ss = {"INT1U", "INT2U", "INT4U", "INT8U", "INT1S", "INT2S", "INT4S", "INT8S", "FLT4S", "FLT8S"}; #endif if (is_in_vector(d, ss)) { datatype = d; datatype_set = TRUE; } else { msg.addWarning(d + " is not a valid datatype"); } } std::string SpatOptions::get_datatype() {if (datatype.empty()) {return def_datatype;} else {return datatype;}} void SpatOptions::set_def_filetype(std::string d) { def_filetype = d; } std::string SpatOptions::get_def_filetype() { return def_filetype;} void SpatOptions::set_filetype(std::string d) { filetype = d; } std::string SpatOptions::get_filetype() { return filetype;} bool SpatOptions::get_overwrite() { return overwrite; } void SpatOptions::set_overwrite(bool b) { overwrite = b; } //bool SpatOptions::get_append() { return append; } //void SpatOptions::set_append(bool b) { append = b; } int SpatOptions::get_statistics() { return statistics; } void SpatOptions::set_statistics(int s) { if ((s> 0) && (s<7)) statistics = s; } //bool SpatOptions::get_ncdfcopy() { return ncdfcopy;} //void SpatOptions::set_ncdfcopy(bool x) { ncdfcopy = x; } void SpatOptions::set_def_verbose(bool v) { def_verbose = v; } bool SpatOptions::get_def_verbose() { return def_verbose; } bool SpatOptions::get_verbose() { return verbose; } void SpatOptions::set_verbose(bool v) { verbose = v; } bool SpatOptions::has_NAflag(double &flag) { flag = NAflag; return hasNAflag; } double SpatOptions::get_NAflag() { return NAflag; } void SpatOptions::set_NAflag(double flag) { NAflag = flag; hasNAflag = true; } size_t SpatOptions::get_progress() { return progress; } void SpatOptions::set_progress(size_t p) { progress = p; } bool SpatOptions::show_progress(size_t n) { return ((progress > 0) & (progress <= n)); } //void SpatOptions::set_filename(std::string f) { // f = lrtrim_copy(f); // filenames = {f}; //} void SpatOptions::set_filenames(std::vector f) { for (size_t i=0; i SpatOptions::get_filenames() { if (!filenames.empty() ) { return filenames; } else { return {""}; } } std::string SpatOptions::get_tempdir() { return tempdir; } void SpatOptions::set_tempdir(std::string d) { // check if exists? tempdir = d; } double SpatOptions::get_memfrac() { return memfrac; } void SpatOptions::set_memfrac(double d) { // allowing very high values for testing purposes if ((d >= 0) && (d <= 100)) { memfrac = d; } } double SpatOptions::get_memmax() { return memmax; } void SpatOptions::set_memmax(double d) { if (std::isnan(d) || (d <= 0)) { memmax = -1; } else { memmax = d * 1024 * 1024 * 1024 / 8; } } double SpatOptions::get_memmin() { return memmin; } void SpatOptions::set_memmin(double d) { if (std::isnan(d) || (d <= 0)) { memmin = 1024 * 1024 * 1024 / 8; } else { memmin = d * 1024 * 1024 * 1024 / 8; } } double SpatOptions::get_tolerance() { return tolerance; } void SpatOptions::set_tolerance(double d) { if (d > 0) { tolerance = d; } } bool SpatOptions::get_todisk() { return todisk; } void SpatOptions::set_todisk(bool b) { todisk = b; } void SpatOptions::set_steps(size_t n) { steps = std::max((size_t)1, n); } size_t SpatOptions::get_steps(){ return steps; } void SpatOptions::set_ncopies(size_t n) { ncopies = std::max((size_t)1, n); } size_t SpatOptions::get_ncopies(){ return ncopies; } void SpatOptions::set_offset(std::vector d) { offset = d ; } std::vector SpatOptions::get_offset() {return offset;} void SpatOptions::set_scale(std::vector d) {scale=d;} std::vector SpatOptions::get_scale(){return scale;} bool extent_operator(std::string oper) { std::vector f {"==", "!=", ">", "<", ">=", "<="}; return (std::find(f.begin(), f.end(), oper) != f.end()); } bool SpatExtent::compare(SpatExtent e, std::string oper, double tolerance) { if (!extent_operator(oper)) { return false; // not very useful } //double xr = (xmax - xmin) / tolerance; //double yr = (ymax - ymin) / tolerance; bool e1 = fabs(xmax - e.xmax) <= tolerance; bool e2 = fabs(xmin - e.xmin) <= tolerance; bool e3 = fabs(ymax - e.ymax) <= tolerance; bool e4 = fabs(ymin - e.ymin) <= tolerance; bool equal = (e1 && e2 && e3 && e4); if (oper == "==") { return equal; } else if (oper == "!=") { return (!equal); } if (oper == "<" || oper == "<=") { bool c1 = xmax < e.xmax; bool c2 = xmin > e.xmin; bool c3 = ymax < e.ymax; bool c4 = ymin > e.ymin; bool smaller = (c1 && c2 && c3 && c4); if (oper == "<") { return smaller; } else { return (equal || smaller); } } if (oper == ">" || oper == ">=") { bool c1 = xmax > e.xmax; bool c2 = xmin < e.xmin; bool c3 = ymax > e.ymax; bool c4 = ymin < e.ymin; bool larger = (c1 && c2 && c3 && c4); if (oper == ">") { return larger; } else { return (equal || larger); } } return false; } SpatExtent SpatExtent::round(int n) { double xn = roundn(xmin, n); double xx = roundn(xmax, n); double yn = roundn(ymin, n); double yx = roundn(ymax, n); SpatExtent e(xn, xx, yn, yx); return e; } SpatExtent SpatExtent::floor() { double xn = std::floor(xmin); double xx = std::ceil(xmax); double yn = std::floor(ymin); double yx = std::ceil(ymax); SpatExtent e(xn, xx, yn, yx); return e; } SpatExtent SpatExtent::ceil() { double xn = std::ceil(xmin); double xx = std::floor(xmax); double yn = std::ceil(ymin); double yx = std::floor(ymax); SpatExtent e(xn, xx, yn, yx); return e; } SpatExtent SpatRaster::getExtent() { if (source.empty()) { SpatExtent e; return e; } else { return source[0].extent; } } void SpatRaster::setExtent(SpatExtent e) { for (size_t i=0; i res = resolution(); double xrs = res[0]; double yrs = res[1]; unsigned nc = std::max(1.0, round( (ext.xmax - ext.xmin) / xrs )); unsigned nr = std::max(1.0, round( (ext.ymax - ext.ymin) / yrs )); ext.xmax = ext.xmin + nc * xrs; ext.ymax = ext.ymin + nr * yrs; for (size_t i=0; i e = asVector(); if (d == 0) { SpatExtent out = *this; return(out); } d = d < 0 ? -d : d; for (size_t i=0; i<4; i++) { double x = d * trunc(e[i] / d); if ((i == 0) | (i == 2)) { if (x > e[i]) { x -= d; } } else { if (x < e[i]) { x += d; } } e[i] = x; } SpatExtent out(e[0], e[1], e[2], e[3]); return(out) ; } SpatExtent SpatRaster::align(SpatExtent e, std::string snap) { snap = is_in_set_default(snap, std::vector {"near", "in", "out"}, "near", true); std::vector res = resolution(); std::vector orig = origin(); // snap points to cell boundaries double xmn, xmx, ymn, ymx; if (snap == "near") { xmn = round((e.xmin-orig[0]) / res[0]) * res[0] + orig[0]; xmx = round((e.xmax-orig[0]) / res[0]) * res[0] + orig[0]; ymn = round((e.ymin-orig[1]) / res[1]) * res[1] + orig[1]; ymx = round((e.ymax-orig[1]) / res[1]) * res[1] + orig[1]; } else if (snap == "out") { xmn = std::floor((e.xmin-orig[0]) / res[0]) * res[0] + orig[0]; xmx = std::ceil((e.xmax-orig[0]) / res[0]) * res[0] + orig[0]; ymn = std::floor((e.ymin-orig[1]) / res[1]) * res[1] + orig[1]; ymx = std::ceil((e.ymax-orig[1]) / res[1]) * res[1] + orig[1]; } else { //if (snap == "in") { xmn = std::ceil((e.xmin-orig[0]) / res[0]) * res[0] + orig[0]; xmx = std::floor((e.xmax-orig[0]) / res[0]) * res[0] + orig[0]; ymn = std::ceil((e.ymin-orig[1]) / res[1]) * res[1] + orig[1]; ymx = std::floor((e.ymax-orig[1]) / res[1]) * res[1] + orig[1]; if (xmn > xmx) std::swap(xmn, xmx); if (ymn > ymx) std::swap(ymn, ymx); } if (xmn == xmx) { if (xmn < e.xmin) { xmx = xmx + res[0]; } else { xmn = xmn - res[0]; } } if (ymn == ymx) { if (ymn < e.ymin) { ymx = ymx + res[1]; } else { ymn = ymn - res[1]; } } return SpatExtent(xmn, xmx, ymn, ymx); } std::vector SpatRaster::origin() { std::vector r = resolution(); SpatExtent extent = getExtent(); double x = extent.xmin - r[0] * (round(extent.xmin / r[0])); double y = extent.ymax - r[1] * (round(extent.ymax / r[1])); if (is_equal((r[0] + x), abs(x))) { x = fabs(x); } if (is_equal((r[1] + y), abs(y))) { y = fabs(y); } std::vector out {x, y}; return out; } bool SpatRaster::compare_geom(SpatRaster &x, bool lyrs, bool crs, double tol, bool warncrs, bool ext, bool rowcol, bool res) { tol = tol < 0 ? 0 : (tol > 0.5 ? 0.5 : tol); if (ext) { SpatExtent extent = getExtent(); double res = std::max(xres(), yres()); if (extent.compare(x.getExtent(), "!=", tol * res)) { setError("extents do not match"); return false; } } if (rowcol) { if (! ((nrow() == x.nrow()) && (ncol() == x.ncol())) ) { setError("number of rows and/or columns do not match"); return false; } } if (res) { if (! ((is_equal_relative(x.xres(), xres(), 0.0001)) && (is_equal_relative(x.yres(), yres(), 0.0001)))) { setError("resolution does not match"); return false; } } if (lyrs) { if (!(nlyr() == x.nlyr())) { setError("number of layers does not match" + std::to_string(nlyr()) + " != " + std::to_string(x.nlyr())); return false; } } if (crs) { if (!source[0].srs.is_equal(x.source[0].srs)) { if (warncrs) { addWarning("CRS do not match"); } else { setError("CRS do not match"); return false; } } } return true; } bool SpatCategories::combine(SpatCategories &x) { bool ok = d.rbind(x.d); if (!ok) { return(false); } d = d.unique(); std::vector ids = d.getI(0); size_t n = ids.size(); std::sort(ids.begin(), ids.end()); ids.erase(std::unique(ids.begin(), ids.end()), ids.end()); if (ids.size() < n) { return false; } return true; } bool SpatCategories::concatenate(SpatCategories &x) { std::vector ids = d.getI(0); std::vector xids = x.d.getI(0); std::vector labs = d.as_string(index); std::vector xlabs = x.d.as_string(x.index); size_t n = ids.size() * xids.size(); std::vector id1, id2; std::vector news; id1.reserve(n); id2.reserve(n); news.reserve(n); std::string nm = d.names[index] + "_" + x.d.names[index]; for (size_t i=0; i id(n); std::iota(id.begin(), id.end(), 0); SpatDataFrame dd; dd.add_column(id, "ID"); dd.add_column(news, nm); dd.add_column(id1, "idx"); dd.add_column(id2, "idy"); d = dd; return true; } #ifdef useRcpp void SpatProgress::init(size_t n, int nmin) { if ((nmin <= 0) || ((int)n < nmin)) { show = false; return; } show = true; std::string bar = "|---------|---------|---------|---------|"; Rcpp::Rcout << "\r" << bar << "\r"; R_FlushConsole(); nstep = n; step = 0; size_t width = bar.size(); double increment = (double) width / double(nstep); steps.resize(0); steps.reserve(nstep+1); for (size_t i=0; i 0) { for (int i=0; i. #include "spatRaster.h" #include "file_utils.h" #include "string_utils.h" #include "math_utils.h" #include "recycle.h" bool SpatRaster::writeValuesMem(std::vector &vals, size_t startrow, size_t nrows) { //if (source[0].has_scale_offset[0]) { // for (double &d : vals) d = d * source[0].scale[0] + source[0].offset[0]; //} if (vals.size() == size()) { source[0].values = std::move(vals); return true; } if (nlyr() == 1) { source[0].values.insert(source[0].values.end(), vals.begin(), vals.end()); return true; } if (source[0].values.empty()) { // && startrow != 0 && startcol != 0) { source[0].values = std::vector(size(), NAN); } size_t nc = ncell(); size_t ncols = ncol(); size_t chunk = nrows * ncols; for (size_t i=0; i &vals, size_t startrow, size_t nrows, size_t startcol, size_t ncols) { if (source[0].values.empty()) { // && startrow != 0 && startcol != 0) { source[0].values = std::vector(size(), NAN); } size_t nc = ncell(); size_t chunk = nrows * ncols; for (size_t i=0; i ff = filenames(); for (size_t i=0; i fnames = opt.get_filenames(); std::string msg; size_t nl = nlyr(); if (fnames.size() > 1) { if (fnames.size() != nl) { out.setError("the number of filenames should either be one, or equal to the number of layers"); return out; } else { bool overwrite = opt.get_overwrite(); std::string errmsg; if (!can_write(fnames, filenames(), overwrite, errmsg)) { out.setError(errmsg); return(out); } for (unsigned i=0; i v; readBlock(v, out.bs, i); if (!out.writeBlock(v, i)) { readStop(); out.writeStop(); return out; } } out.writeStop(); readStop(); return out; } SpatRaster SpatRaster::writeTempRaster(SpatOptions &opt) { SpatOptions xopt(opt); std::string fname = tempFile(xopt.get_tempdir(), xopt.tmpfile, "_temp_raster.tif"); xopt.set_filenames({fname}); return writeRaster(xopt); } bool SpatRaster::writeStart(SpatOptions &opt, const std::vector srcnames) { if (opt.names.size() == nlyr()) { setNames(opt.names); } std::vector fnames = opt.get_filenames(); if (fnames.size() > 1) { addWarning("only the first filename supplied is used"); } std::string filename = fnames[0]; if (filename.empty()) { if (!canProcessInMemory(opt)) { //std::string extension = ".tif"; //filename = tempFile(opt.get_tempdir(), opt.pid, extension); std::string driver; if (!getTempFile(filename, driver, opt)) { return false; } opt.set_filenames({filename}); //opt.gdal_options = {"COMPRESS=NONE"}; } } size_t nl = nlyr(); bs = getBlockSize(opt); if (!filename.empty()) { // open GDAL filestream #ifdef useGDAL if (! writeStartGDAL(opt, srcnames) ) { return false; } #else setError("GDAL is not available"); return false; #endif } else if ((nl == 1) && (bs.n > 1)) { source[0].values.reserve(ncell()); } if (source[0].open_write) { addWarning("file was already open"); } source[0].open_write = true; source[0].filename = filename; //bs = getBlockSize(opt); #ifdef useRcpp if (opt.verbose) { std::vector mems = mem_needs(opt); double gb = 1073741824 / 8; //{memneed, memavail, frac, csize, inmem} ; // << "max vect size : " << roundn(mems.max_size() / gb, 2) << " GB" << std::endl; Rcpp::Rcout<< "memory avail. : " << roundn(mems[1] / gb, 2) << " GB" << std::endl; Rcpp::Rcout<< "memory allow. : " << roundn(mems[2] * mems[1] / gb, 2) << " GB" << std::endl; Rcpp::Rcout<< "memory needed : " << roundn(mems[0] / gb, 3) << " GB" << " (" << opt.ncopies << " copies)" << std::endl; std::string inmem = mems[4] < 0.5 ? "false" : "true"; Rcpp::Rcout<< "in memory : " << inmem << std::endl; Rcpp::Rcout<< "block size : " << mems[3] << " rows" << std::endl; Rcpp::Rcout<< "n blocks : " << bs.n << std::endl; Rcpp::Rcout<< "pb : " << opt.get_progress() << std::endl << std::endl; } if (opt.progressbar) { pbar.init(bs.n, opt.get_progress()); progressbar = true; } else { progressbar = false; } #endif return true; } #ifdef useRcpp static void chkIntFn(void *dummy) { R_CheckUserInterrupt(); } bool checkInterrupt() { return (R_ToplevelExec(chkIntFn, NULL) == FALSE); } #endif bool SpatRaster::writeValues(std::vector &vals, size_t startrow, size_t nrows) { bool success = true; if (!source[0].open_write) { setError("cannot write (no open file)"); return false; } if ((startrow + nrows) > nrow()) { setError("incorrect start and/or nrows value"); return false; } size_t nv = nrows * ncol() * nlyr(); if (vals.size() != nv) { if (vals.size() > nv) { setError("too many values for writing: " + std::to_string(vals.size()) + " > " + std::to_string(nv)); } else { setError("too few values for writing: " + std::to_string(vals.size()) + " < " + std::to_string(nv)); } return false; } if (source[0].driver == "gdal") { #ifdef useGDAL success = writeValuesGDAL(vals, startrow, nrows, 0, ncol()); #else setError("GDAL is not available"); return false; #endif } else { success = writeValuesMem(vals, startrow, nrows); } //return success; #ifdef useRcpp if (checkInterrupt()) { pbar.interrupt(); setError("interrupted"); return(false); } if (progressbar) { pbar.stepit(); } #endif return success; } bool SpatRaster::writeValuesRect(std::vector &vals, size_t startrow, size_t nrows, size_t startcol, size_t ncols) { bool success = true; if (!source[0].open_write) { setError("cannot write (no open file)"); return false; } if ((startrow + nrows) > nrow()) { setError("incorrect start and/or nrows value"); return false; } if (source[0].driver == "gdal") { #ifdef useGDAL success = writeValuesGDAL(vals, startrow, nrows, startcol, ncols); #else setError("GDAL is not available"); return false; #endif } else { success = writeValuesMemRect(vals, startrow, nrows, startcol, ncols); } #ifdef useRcpp if (checkInterrupt()) { pbar.interrupt(); setError("aborted"); return(false); } if (progressbar) { pbar.stepit(); } #endif return success; } bool SpatRaster::writeValuesRectRast(SpatRaster &r, SpatOptions& opt) { bool success = true; if (!compare_geom(r, false, false, opt.get_tolerance(), false, false, false, true)) { return(false); } double hxr = xres() / 2; double hyr = yres() / 2; SpatExtent e = r.getExtent(); int_64 row1 = rowFromY(e.ymax - hyr); int_64 row2 = rowFromY(e.ymin + hyr); int_64 col1 = colFromX(e.xmin + hxr); int_64 col2 = colFromX(e.xmax - hxr); if ((row1 < 0) || (row2 < 0) || (col1 < 0) || (col2 < 0)) { setError("block outside raster"); return(false); } size_t ncols = col2-col1+1; size_t nrows = row2-row1+1; size_t startrow = row1; size_t startcol = col1; if ((startrow + nrows) > nrow()) { setError("incorrect start row and/or nrows value"); return false; } if ((startcol + ncols) > ncol()) { setError("incorrect start col and/or ncols value"); return false; } if (!source[0].open_write) { setError("cannot write (no open file)"); return false; } std::vector vals = r.getValues(-1, opt); recycle(vals, ncols * nrows * nlyr()); if ((nrows * ncols * nlyr()) != vals.size()) { setError("incorrect row/col size"); return false; } if (source[0].driver == "gdal") { #ifdef useGDAL success = writeValuesGDAL(vals, startrow, nrows, startcol, ncols); #else setError("GDAL is not available"); return false; #endif } else { success = writeValuesMemRect(vals, startrow, nrows, startcol, ncols); } #ifdef useRcpp if (checkInterrupt()) { pbar.interrupt(); setError("aborted"); return(false); } if (progressbar) { pbar.stepit(); } #endif return success; } /* bool SpatRaster::writeValues2(std::vector> &vals, size_t startrow, size_t nrows) { std::vector vv = flatten(vals); return writeValues(vv, startrow, nrows, 0, ncol()); } */ bool SpatRaster::writeStop(){ if (!source[0].open_write) { setError("cannot close a file that is not open"); return false; } source[0].open_write = false; bool success = true; source[0].memory = false; if (source[0].driver=="gdal") { #ifdef useGDAL success = writeStopGDAL(); //source[0].hasValues = true; #else return false; #endif } else { source[0].setRange(); //source[0].driver = "memory"; source[0].memory = true; if (!source[0].values.empty()) { source[0].hasValues = true; } } #ifdef useRcpp if (progressbar) { pbar.finish(); } /* if (progressbar) { pbar->increment(); pbar->cleanup(); delete pbar; } */ #endif return success; } #ifdef useRcpp bool SpatRaster::setValuesRcpp(Rcpp::NumericVector &v, SpatOptions &opt) { SpatRaster g = geometry(nlyr(), true, true, true); source = g.source; source[0].hasValues = true; source[0].memory = true; //source[0].names = getNames(); source[0].driver = "memory"; if (v.size() < g.size()) { std::vector vv = Rcpp::as >(v); *this = g.init(vv, opt); return (!hasError()); } else if (v.size() == g.size()) { source[0].values = Rcpp::as >(v); source[0].setRange(); } else { setError("incorrect number of values"); return false; } return true; } #endif bool SpatRaster::setValues(std::vector &v, SpatOptions &opt) { SpatRaster g = geometry(nlyr(), true, true, true); source = g.source; source[0].hasValues = true; source[0].memory = true; //source[0].names = getNames(); source[0].driver = "memory"; if (v.size() < g.size()) { *this = g.init(v, opt); return (!hasError()); } else if (v.size() == g.size()) { source[0].values = v; source[0].setRange(); } else { setError("incorrect number of values"); return false; } return true; } void SpatRaster::setRange(SpatOptions &opt, bool force) { for (size_t i=0; i(source[i].hasRange.size(), true); } } } void SpatRasterSource::setRange() { range_min.resize(nlyr); range_max.resize(nlyr); hasRange.resize(nlyr); if (nlyr==1) { minmax(values.begin(), values.end(), range_min[0], range_max[0]); hasRange[0] = true; return; } size_t nc = ncol * nrow; if (values.size() == (nc * nlyr)) { for (size_t i=0; i nms = getNames(); if (xy | cell) { std::vector add; if (xy) { add.push_back("x"); add.push_back("y"); } if (cell) { add.push_back("cell"); } nms.insert(nms.begin(), add.begin(), add.end()); } std::string s = concatenate(nms, delim); f << s << std::endl; BlockSize bs = getBlockSize(opt); for (size_t i=0; i v; readBlock(v, bs, i); //s = get_delim_string(v, delim); //f << s << std::endl; } f.close(); readStop(); return true; } terra/src/gdalio.cpp0000644000176200001440000007673514751030542014144 0ustar liggesusers#include #include "ogr_spatialref.h" #include "spatRaster.h" #include "string_utils.h" #include "file_utils.h" #include "crs.h" #include "vecmath.h" #include "cpl_port.h" #include "cpl_conv.h" // CPLFree() void getGDALdriver(std::string &filename, std::string &driver) { lrtrim(filename); lrtrim(driver); if (!driver.empty()) { if (driver == "RST") { filename = noext(filename) + ".rst"; } return; } std::string ext = getFileExt(filename); lowercase(ext); std::unordered_map drivers = { {".tif","GTiff"}, {".tiff","GTiff"}, {".nc","netCDF"}, {".cdf","netCDF"}, {".gpkg","GPKG"}, {".img","HFA"}, {".ige","HFA"}, {".bmp","BMP"}, {".flt","EHdr"}, {".grd","RRASTER"}, {".gri","RRASTER"}, {".sgrd","SAGA"}, {".sdat","SAGA"}, {".rst","RST"}, {".rdc","RST"}, {".envi","ENVI"}, {".asc","AAIGrid"}, {".bmp","BMP"}, // {".jpg","JPEG"}, or JPEG2000? {".png","PNG"}, {".gif","GIF"}, {".vrt","VRT"} }; auto i = drivers.find(ext); if (i != drivers.end()) { driver = i->second; } } bool SpatRaster::getTempFile(std::string &filename, std::string &driver, SpatOptions& opt) { driver = opt.get_def_filetype(); if (driver.empty() || (driver == "GTiff")) { driver = "GTiff"; filename = tempFile(opt.get_tempdir(), opt.tmpfile, ".tif"); return true; } filename = tempFile(opt.get_tempdir(), opt.tmpfile, ""); std::unordered_map exts = { {"GTiff", ".tif"}, {"NetCDF", ".nc"}, {"GPKG", ".gpkg"}, {"HFA", ".img"}, {"RRASTER", ".grd"}, {"SAGA", ".sgrd"}, {"RST", ".rst"}, {"ENVI", ".envi"}, {"AAIGrid", ".asc"}, }; auto i = exts.find(driver); if (i != exts.end()) { filename += i->second; } return true; } /* std::string sectostr(int x) { char buffer[20]; time_t now = x; tm *utc = gmtime(&now); strftime (buffer, 20, "%Y-%m-%d %H:%M:%S", utc); std::string s = buffer; return s; } */ GDALDataset* openGDAL(std::string filename, unsigned OpenFlag, std::vector allowed_drivers, std::vector open_options) { char ** openops = NULL; // for ncdf // openops = CSLSetNameValue(openops, "@HONOUR_VALID_RANGE", "NO"); for (size_t i=0; i opt = strsplit(open_options[i], "="); if (opt.size() == 2) { openops = CSLSetNameValue(openops, opt[0].c_str(), opt[1].c_str()); } } char ** drivers = NULL; for (size_t i=0; i(GDALOpenEx( filename.c_str(), OpenFlag, drivers, openops, NULL)); CSLDestroy(openops); CSLDestroy(drivers); return poDataset; } std::vector get_metadata(std::string filename) { std::vector out; std::vector ops; GDALDataset *poDataset = openGDAL(filename, GDAL_OF_RASTER | GDAL_OF_READONLY, ops, ops); if( poDataset == NULL ) { return out; } char **m = poDataset->GetMetadata(); if (m != NULL) { while (*m != nullptr) { out.push_back(*m++); } } GDALClose( (GDALDatasetH) poDataset ); return out; } std::vector get_metadata_sds(std::string filename) { std::vector meta; GDALDataset *poDataset = openGDAL(filename, GDAL_OF_RASTER | GDAL_OF_READONLY, meta, meta); if( poDataset == NULL ) { return meta; } char **metadata = poDataset->GetMetadata("SUBDATASETS"); if (metadata != NULL) { for (size_t i=0; metadata[i] != NULL; i++) { meta.push_back(metadata[i]); } } GDALClose( (GDALDatasetH) poDataset ); return meta; } std::vector> parse_metadata_sds(std::vector meta) { std::vector name, var, desc, nr, nc, nl; std::string ndelim = "NAME="; std::string ddelim = "DESC="; for (size_t i=0; i d = strsplit(dims, "x"); if (d.size() < 2) { nl.push_back("0"); nr.push_back("0"); nc.push_back("0"); } else if (d.size() == 2) { nl.push_back("1"); nr.push_back(d[0]); nc.push_back(d[1]); } else { size_t ds = d.size()-1; size_t nls = 0; try { nls = std::stol(d[ds-2]); for (size_t i=0; i<(ds-2); i++) { nls *= std::stol(d[i]); } } catch(...) {} nl.push_back(std::to_string(nls)); nr.push_back(d[ds-1]); nc.push_back(d[ds]); } //desc.push_back(std::string(pos, s.size())); s = s.substr(pos+2, s.size()); pos = s.find(' '); s = s.substr(0, pos); desc.push_back(s); // nr.push_back( std::to_string(sub.nrow())); // nc.push_back(std::to_string(sub.ncol())); // nl.push_back(std::to_string(sub.nlyr())); } else { desc.push_back(""); } } } std::vector> out(6); out[0] = name; out[1] = var; out[2] = desc; out[3] = nr; out[4] = nc; out[5] = nl; return out; } std::vector> sdinfo(std::string fname) { std::vector> out(6); std::vector ops; GDALDataset *poDataset = openGDAL(fname, GDAL_OF_RASTER | GDAL_OF_READONLY, ops, ops); if( poDataset == NULL ) { if (!file_exists(fname)) { out[0] = std::vector {"no such file"}; } else { out[0] = std::vector {"cannot open file"}; } return out; } char **metadata = poDataset->GetMetadata("SUBDATASETS"); if (metadata == NULL) { out[0] = std::vector {"no subdatasets"}; GDALClose( (GDALDatasetH) poDataset ); return out; } std::vector meta; for (size_t i=0; metadata[i] != NULL; i++) { meta.push_back(metadata[i]); } if (meta.empty()) { GDALClose( (GDALDatasetH) poDataset ); out[0] = std::vector {"no subdatasets"}; return out; } SpatRaster sub; std::vector name, var, desc, nr, nc, nl; std::string ndelim = "NAME="; std::string ddelim = "DESC="; for (size_t i=0; i filenames, std::vector options, SpatOptions &opt) { setError( "GDAL version >= 2.1 required for vrt"); return(""); } std::string gdalinfo(std::string filename, std::vector options, std::vector oo) { std::string out = "GDAL version >= 2.1 required for gdalinfo"; return out; } #else # include "gdal_utils.h" // requires >= 2.1 std::string SpatRaster::make_vrt(std::vector filenames, std::vector options, SpatOptions &opt) { std::string outfile = opt.get_filename(); if (outfile.empty()) { outfile = tempFile(opt.get_tempdir(), opt.tmpfile, ".vrt"); } else if (file_exists(outfile) && (!opt.get_overwrite())) { setError("output file exists. You can use 'overwrite=TRUE' to overwrite it"); return(""); } std::vector vops = string_to_charpnt(options); GDALBuildVRTOptions* vrtops = GDALBuildVRTOptionsNew(vops.data(), NULL); if (vrtops == NULL) { setError("options error"); return(""); } char **names = NULL; for (std::string& f : filenames) { names = CSLAddString(names, f.c_str()); } int pbUsageError; GDALDataset *ds = (GDALDataset *) GDALBuildVRT(outfile.c_str(), filenames.size(), NULL, names, vrtops, &pbUsageError); GDALBuildVRTOptionsFree(vrtops); CSLDestroy( names ); if(ds == NULL ) { setError("cannot create vrt. Error #"+ std::to_string(pbUsageError)); return(""); } size_t nSources = 0; char **fileList = ds->GetFileList(); if (fileList != NULL) { for (size_t i=0; fileList[i] != NULL; i++) { nSources++; } } GDALClose(ds); std::vector ufo = vunique(filenames); if (ufo.size() > nSources) { opt.msg.has_warning = true; opt.msg.warnings = {"vrt did not use " + std::to_string(ufo.size() - nSources) + " of the " + std::to_string(ufo.size()) + " files"}; } return outfile; } std::string gdalinfo(std::string filename, std::vector options, std::vector openopts) { // adapted from the 'sf' package by Edzer Pebesma et al std::string out = ""; char ** opops = NULL; for (size_t i=0; i opt = strsplit(openopts[i], "="); if (opt.size() == 2) { opops = CSLSetNameValue(opops, opt[0].c_str(), opt[1].c_str()); } } GDALDatasetH ds = GDALOpenEx(filename.c_str(), GA_ReadOnly, NULL, opops, NULL); //if (opops != NULL) CSLDestroy(opops); if (ds == NULL) return out; std::vector options_char = string_to_charpnt(options); GDALInfoOptions* opt = GDALInfoOptionsNew(options_char.data(), NULL); char *val = GDALInfo(ds, opt); out = val; CPLFree(val); GDALClose(ds); GDALInfoOptionsFree(opt); return out; } #endif bool getNAvalue(GDALDataType gdt, double &naval) { if (gdt == GDT_Float32) { naval = NAN; } else if (gdt == GDT_Int32) { naval = INT32_MIN; } else if (gdt == GDT_Float64) { naval = NAN; } else if (gdt == GDT_Int16) { naval = INT16_MIN; } else if (gdt == GDT_UInt32) { naval = UINT32_MAX; } else if (gdt == GDT_UInt16) { naval = UINT16_MAX; } else if (gdt == GDT_Byte) { naval = 255; #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 5 // no Int64 #else } else if (gdt == GDT_UInt64) { naval = 18446744073709549568.; //UINT64_MAX - 1101; } else if (gdt == GDT_Int64) { naval = INT64_MIN; #endif #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 7 // no INT1S #else } else if (gdt == GDT_Int8) { naval = -128; #endif } else { naval = NAN; return false; } return true; } bool getGDALDataType(std::string datatype, GDALDataType &gdt) { if (datatype=="FLT4S") { gdt = GDT_Float32; } else if (datatype == "INT4S") { gdt = GDT_Int32; } else if (datatype == "FLT8S") { gdt = GDT_Float64; } else if (datatype == "INT2S") { gdt = GDT_Int16; } else if (datatype == "INT4U") { gdt = GDT_UInt32; } else if (datatype == "INT2U") { gdt = GDT_UInt16; } else if (datatype == "INT1U") { gdt = GDT_Byte; #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 5 // no Int64 #else } else if (datatype == "INT8U") { gdt = GDT_UInt64; } else if (datatype == "INT8S") { gdt = GDT_Int64; #endif #if GDAL_VERSION_MAJOR <= 3 && GDAL_VERSION_MINOR < 7 // no Int8 #else } else if (datatype == "INT1S") { // GDAL 3.7 gdt = GDT_Int8; #endif } else { gdt = GDT_Float32; return false; } return true; } bool GDALsetSRS(GDALDatasetH &hDS, const std::string &crs) { OGRSpatialReferenceH hSRS = OSRNewSpatialReference( NULL ); OGRErr erro = OSRSetFromUserInput(hSRS, crs.c_str()); if (erro == 4) { return false ; } char *pszSRS_WKT = NULL; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OSRExportToWktEx( hSRS, &pszSRS_WKT, options); #else OSRExportToWkt( hSRS, &pszSRS_WKT ); #endif OSRDestroySpatialReference( hSRS ); GDALSetProjection( hDS, pszSRS_WKT ); CPLFree( pszSRS_WKT ); return true; } bool SpatRaster::as_gdalvrt(GDALDatasetH &hVRT, SpatOptions &opt) { // all sources should be on disk GDALDriverH hDrv = GDALGetDriverByName("MEM"); hVRT = GDALCreate(hDrv, "", ncol(), nrow(), nlyr(), GDT_Float64, NULL); std::vector rs = resolution(); SpatExtent extent = getExtent(); double adfGeoTransform[6] = { extent.xmin, rs[0], 0, extent.ymax, 0, -1 * rs[1] }; GDALSetGeoTransform(hVRT, adfGeoTransform); if (!GDALsetSRS(hVRT, source[0].srs.wkt)) { addWarning("cannot set SRS"); } char** papszOptions = NULL; SpatRaster RS; GDALDatasetH DS; for (size_t i=0; i 1) & (src < 0)) { if (canProcessInMemory(opt)) { fromfile = false; } else { // make VRT setError("right now this method can only handle one file source at a time"); return false; } } if (fromfile) { std::string f; //if (source[src].parameters_changed) { // make a copy to get the write the new crs or extent // can we use a VRT instead? // f = tempFile(opt.get_tempdir(), ".tif"); // SpatRaster tmp(source[src]); // SpatOptions topt(opt); // topt.set_filenames({f}); // tmp.writeRaster(topt); //} else { f = source[src].filename; //} //hDS = GDALOpenShared(f.c_str(), GA_ReadOnly); if (update) { hDS = openGDAL(f, GDAL_OF_RASTER | GDAL_OF_UPDATE | GDAL_OF_SHARED, source[src].open_drivers, source[src].open_ops); /* if (hDS != NULL) { // for user-set extents std::vector rs = resolution(); SpatExtent extent = getExtent(); double adfGeoTransform[6] = { extent.xmin, rs[0], 0, extent.ymax, 0, -1 * rs[1] }; GDALSetGeoTransform(hDS, adfGeoTransform); } */ } else { hDS = openGDAL(f, GDAL_OF_RASTER | GDAL_OF_READONLY | GDAL_OF_SHARED, source[src].open_drivers, source[src].open_ops); } return (hDS != NULL); } else { // in memory bool hasval = source[isrc].hasValues; size_t nl; if (src < 0) { nl = nlyr(); } else { nl = source[src].layers.size(); } size_t ncls = nrow() * ncol(); GDALDriverH hDrv = GDALGetDriverByName("MEM"); /*https://gis.stackexchange.com/questions/196048/how-to-reuse-memory-pointer-of-gdal-memory-driver char **papszOptions = NULL; hDS = GDALCreate(hDrv, "", ncol(), nrow(), 0, GDT_Float64, papszOptions); if (hDS == NULL) return false; std::vector vals; for(size_t i=0; i(source[0].values.begin() +off, source[0].values.begin() +off+ncls); char szPtrValue[128] = { '\0' }; int nRet = CPLPrintPointer( szPtrValue, reinterpret_cast(&vals[0]), sizeof(szPtrValue) ); szPtrValue[nRet] = 0; papszOptions = CSLSetNameValue(papszOptions, "DATAPOINTER", szPtrValue); GDALAddBand(hDS, GDT_Float64, papszOptions); } CSLDestroy(papszOptions); */ size_t nr = nrow(); size_t nc = ncol(); hDS = GDALCreate(hDrv, "", nc, nr, nl, GDT_Float64, NULL); if (hDS == NULL) return false; std::vector rs = resolution(); SpatExtent extent = getExtent(); double adfGeoTransform[6] = { extent.xmin, rs[0], 0, extent.ymax, 0, -1 * rs[1] }; GDALSetGeoTransform(hDS, adfGeoTransform); if (!GDALsetSRS(hDS, source[0].srs.wkt)) { setError("cannot set SRS"); return false; } CPLErr err = CE_None; if (hasval) { std::vector nms; if (src < 0) { nms = getNames(); } else { nms = source[src].names; } std::vector vv, vals; if (src < 0) { vv = getValues(-1, opt); } else { if (!getValuesSource(src, vv)) { setError("cannot read from source"); return false; } } for (size_t i=0; i < nl; i++) { GDALRasterBandH hBand = GDALGetRasterBand(hDS, i+1); GDALSetRasterNoDataValue(hBand, NAN); GDALSetDescription(hBand, nms[i].c_str()); size_t offset = ncls * i; vals = std::vector(vv.begin() + offset, vv.begin() + offset+ncls); err = GDALRasterIO(hBand, GF_Write, 0, 0, nc, nr, &vals[0], nc, nr, GDT_Float64, 0, 0); if (err != CE_None) { return false; } } } } return true; } bool SpatRaster::from_gdalMEM(GDALDatasetH hDS, bool set_geometry, bool get_values) { if (set_geometry) { SpatRasterSource s; s.ncol = GDALGetRasterXSize( hDS ); s.nrow = GDALGetRasterYSize( hDS ); s.nlyr = GDALGetRasterCount( hDS ); double adfGeoTransform[6]; if( GDALGetGeoTransform( hDS, adfGeoTransform ) != CE_None ) { setError("Cannot get geotransform"); return false; } double xmin = adfGeoTransform[0]; double xmax = xmin + adfGeoTransform[1] * s.ncol; double ymax = adfGeoTransform[3]; double ymin = ymax + s.nrow * adfGeoTransform[5]; s.extent = SpatExtent(xmin, xmax, ymin, ymax); s.memory = true; s.names = source[0].names; std::string wkt; #if GDAL_VERSION_MAJOR >= 3 std::string errmsg; OGRSpatialReferenceH srs = GDALGetSpatialRef( hDS ); if (srs == NULL) { return false; } const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; char *cp; OGRErr err = OSRExportToWktEx(srs, &cp, options); if (is_ogr_error(err, errmsg)) { CPLFree(cp); return false; } wkt = std::string(cp); CPLFree(cp); #else const char *pszSrc = GDALGetProjectionRef( hDS ); if (pszSrc != NULL) { wkt = std::string(pszSrc); } else { return false; } //OGRSpatialReferenceH srs = GDALGetProjectionRef( hDS ); //OGRSpatialReference oSRS(poDataset->GetProjectionRef()); //OGRErr err = oSRS.exportToPrettyWkt(&cp); #endif std::string msg; if (!s.srs.set({wkt}, msg)) { setError(msg); return false; } else if (!msg.empty()) { addWarning(msg); } setSource(s); } if (get_values) { source[0].values.resize(0); source[0].values.reserve(ncell() * nlyr()); CPLErr err = CE_None; int hasNA; size_t nl = nlyr(); for (size_t i=0; i < nl; i++) { GDALRasterBandH hBand = GDALGetRasterBand(hDS, i+1); std::vector lyrout( ncell() ); err = GDALRasterIO(hBand, GF_Read, 0, 0, ncol(), nrow(), &lyrout[0], ncol(), nrow(), GDT_Float64, 0, 0); if (err != CE_None ) { setError("CE_None"); return false; } //double naflag = -3.4e+38; double naflag = GDALGetRasterNoDataValue(hBand, &hasNA); if (hasNA && (!std::isnan(naflag))) { if (naflag < -3.4e+37) { naflag = -3.4e+37; for (size_t i=0; i gdal_options) { char ** gdalops = NULL; if (driver == "GTiff") { bool lzw = true; bool compressed = true; for (size_t i=0; i 4194304000)) { bool big = true; for (size_t i=0; i gopt = strsplit(gdal_options[i], "="); if (gopt.size() == 2) { gdalops = CSLSetNameValue(gdalops, gopt[0].c_str(), gopt[1].c_str() ); } } return gdalops; } bool SpatRaster::create_gdalDS(GDALDatasetH &hDS, std::string filename, std::string driver, bool fill, double fillvalue, std::vector has_so, std::vector scale, std::vector offset, SpatOptions& opt) { has_so.resize(nlyr(), false); const char *pszFormat = driver.c_str(); GDALDriverH hDrv = GDALGetDriverByName(pszFormat); double naflag = opt.NAflag; //NAN; GDALDataType gdt; char **papszOptions = NULL; if (driver != "MEM") { std::string datatype = opt.get_datatype(); if (!getGDALDataType(datatype, gdt)) { addWarning("unknown datatype = " + datatype); getGDALDataType("FLT4S", gdt); } int dsize = std::stoi(datatype.substr(3,1)); GIntBig diskNeeded = ncell() * nlyr() * dsize; std::string dname = dirname(filename); GIntBig diskAvailable = VSIGetDiskFreeSpace(dname.c_str()); if ((diskAvailable > -1) && (diskAvailable < diskNeeded)) { setError("insufficient disk space (perhaps from temporary files?)"); return(false); } papszOptions = set_GDAL_options(driver, diskNeeded, false, opt.gdal_options); if (datatype == "INT4S") { naflag = INT32_MIN; //-2147483648; } else if (datatype == "INT2S") { naflag = INT16_MIN; } else if (datatype == "INT4U") { naflag = UINT32_MAX; } else if (datatype == "INT2U") { naflag = UINT16_MAX; } else if (datatype == "INT1U") { naflag = 255; // ?; } else if (datatype == "INT1S") { naflag = -128; } } else { getGDALDataType(opt.get_datatype(), gdt); } const char *pszFilename = filename.c_str(); hDS = GDALCreate(hDrv, pszFilename, ncol(), nrow(), nlyr(), gdt, papszOptions ); CSLDestroy( papszOptions ); std::vector nms = getNames(); std::vector hasCats = hasCategories(); for (size_t i=0; i < nlyr(); i++) { GDALRasterBandH hBand = GDALGetRasterBand(hDS, i+1); GDALSetDescription(hBand, nms[i].c_str()); GDALSetRasterNoDataValue(hBand, naflag); //GDALSetRasterNoDataValue(hBand, -3.4e+38); if (fill) GDALFillRaster(hBand, fillvalue, 0); if (has_so[i]) { GDALSetRasterOffset(hBand, offset[i]); GDALSetRasterScale(hBand, scale[i]); } if (hasCats[i]) { std::vector cats = getLabels(i); char **names = NULL; for (size_t j = 0; j < cats.size(); j++) { names = CSLAddString(names, cats[j].c_str()); } CPLErr err = GDALSetRasterCategoryNames(hBand, names); if (err != CE_None) { addWarning("could not write categories"); } CSLDestroy( names ); } } std::vector rs = resolution(); SpatExtent e = getExtent(); double adfGeoTransform[6] = { e.xmin, rs[0], 0, e.ymax, 0, -1 * rs[1] }; GDALSetGeoTransform( hDS, adfGeoTransform); std::string wkt = getSRS("wkt"); if (!wkt.empty()) { OGRSpatialReferenceH hSRS = OSRNewSpatialReference( NULL ); OGRErr erro = OSRSetFromUserInput(hSRS, wkt.c_str()); if (erro == 4) { setError("CRS failure"); OSRDestroySpatialReference( hSRS ); return false; } char *pszSRS_WKT = NULL; #if GDAL_VERSION_MAJOR >= 3 const char *options[3] = { "MULTILINE=YES", "FORMAT=WKT2", NULL }; OSRExportToWktEx( hSRS, &pszSRS_WKT, options); #else OSRExportToWkt( hSRS, &pszSRS_WKT ); #endif GDALSetProjection( hDS, pszSRS_WKT ); CPLFree(pszSRS_WKT); OSRDestroySpatialReference( hSRS ); } return true; } std::vector SpatRaster::getAllFiles() { std::vector files; files.reserve(nsrc()*2); for (size_t src=0; src < nsrc(); src++) { if (source[src].memory) continue; GDALDataset *poDS = openGDAL(source[src].filename, GDAL_OF_RASTER | GDAL_OF_READONLY | GDAL_OF_VERBOSE_ERROR, source[src].open_drivers, source[src].open_ops); if( poDS == NULL ) { continue; } char **filelist = poDS->GetFileList(); if (filelist != NULL) { for (size_t i=0; filelist[i] != NULL; i++) { files.push_back(filelist[i]); } std::vector exts = {".vat.dbf", ".vat.cpg", ".json", ".aux.xml"}; for (size_t j=0; j lyrout( ncell() ); err = GDALRasterIO(hBand, GF_Read, 0, 0, ncol(), nrow(), &lyrout[0], ncol(), nrow(), GDT_Float64, 0, 0); if (err != CE_None ) { setError("CE_None"); return false; } //double naflag = -3.4e+38; double naflag = GDALGetRasterNoDataValue(hBand, &hasNA); if (hasNA) std::replace(lyrout.begin(), lyrout.end(), naflag, (double) NAN); source[0].values.insert(source[0].values.end(), lyrout.begin(), lyrout.end()); } source[0].hasValues = TRUE; source[0].memory = TRUE; source[0].driver = "memory"; source[0].setRange(); return true; } bool gdal_ds_create(SpatRaster x, GDALDatasetH &hDS, std::string filename, std::string driver, std::vector foptions, bool fill, std::string &msg) { msg = ""; char **papszOptions = NULL; for (size_t i=0; i < foptions.size(); i++) { std::vector wopt = strsplit(foptions[i], "="); if (wopt.size() == 2) { papszOptions = CSLSetNameValue( papszOptions, wopt[0].c_str(), wopt[1].c_str() ); } } const char *pszFormat = driver.c_str(); GDALDriverH hDrv = GDALGetDriverByName(pszFormat); const char *pszFilename = filename.c_str(); hDS = GDALCreate(hDrv, pszFilename, x.ncol(), x.nrow(), x.nlyr(), GDT_Float64, papszOptions ); CSLDestroy( papszOptions ); GDALRasterBandH hBand; std::vector nms = x.getNames(); for (size_t i=0; i < x.nlyr(); i++) { hBand = GDALGetRasterBand(hDS, i+1); GDALSetDescription(hBand, nms[i].c_str()); GDALSetRasterNoDataValue(hBand, NAN); //GDALSetRasterNoDataValue(hBand, -3.4e+38); if (fill) GDALFillRaster(hBand, NAN, 0); } std::vector rs = x.resolution(); SpatExtent e = x.getExtent(); double adfGeoTransform[6] = { e.xmin, rs[0], 0, e.ymax, 0, -1 * rs[1] }; GDALSetGeoTransform( hDS, adfGeoTransform); OGRSpatialReferenceH hSRS = OSRNewSpatialReference( NULL ); std::vector srs = x.getSRS(); std::string wkt = srs[1]; OGRErr erro = OSRSetFromUserInput(hSRS, wkt.c_str()); if (erro == 4) { msg = "CRS failure"; OSRDestroySpatialReference( hSRS ); return false; } char *pszSRS_WKT = NULL; OSRExportToWkt( hSRS, &pszSRS_WKT ); GDALSetProjection( hDS, pszSRS_WKT ); CPLFree(pszSRS_WKT); OSRDestroySpatialReference( hSRS ); return true; } bool SpatRaster::open_gdal(GDALDatasetH &hDS) { // needs to loop over sources. thus should vector of GDALDatasetH // for now just doing the first if (!source[0].hasValues) { return false; } else if (source[0].driver == "gdal") { std::string f = source[0].filename; hDS = GDALOpen(f.c_str(), GA_ReadOnly); return(hDS != NULL); } else { // in memory size_t nl = nlyr(); size_t ncls = nrow() * ncol(); GDALDriverH hDrv = GDALGetDriverByName("MEM"); //https://gis.stackexchange.com/questions/196048/how-to-reuse-memory-pointer-of-gdal-memory-driver // char **papszOptions = NULL; // hDS = GDALCreate(hDrv, "", ncol(), nrow(), 0, GDT_Float64, papszOptions); // if (hDS == NULL) return false; // std::vector vals; // for(size_t i=0; i(source[0].values.begin() +off, source[0].values.begin() +off+ncls); // char szPtrValue[128] = { '\0' }; // int nRet = CPLPrintPointer( szPtrValue, reinterpret_cast(&vals[0]), sizeof(szPtrValue) ); // szPtrValue[nRet] = 0; // papszOptions = CSLSetNameValue(papszOptions, "DATAPOINTER", szPtrValue); // GDALAddBand(hDS, GDT_Float64, papszOptions); // } // CSLDestroy(papszOptions); size_t nr = nrow(); size_t nc = ncol(); hDS = GDALCreate(hDrv, "", nc, nr, nl, GDT_Float64, NULL); if (hDS == NULL) return false; std::vector rs = resolution(); double adfGeoTransform[6] = { extent.xmin, rs[0], 0, extent.ymax, 0, -1 * rs[1] }; GDALSetGeoTransform(hDS, adfGeoTransform); OGRSpatialReferenceH hSRS = OSRNewSpatialReference( NULL ); std::string crs = srs.wkt; OGRErr erro = OSRSetFromUserInput(hSRS, crs.c_str()); if (erro == 4) { setError("CRS failure"); return false ; } char *pszSRS_WKT = NULL; OSRExportToWkt( hSRS, &pszSRS_WKT ); OSRDestroySpatialReference( hSRS ); GDALSetProjection( hDS, pszSRS_WKT ); CPLFree( pszSRS_WKT ); CPLErr err = CE_None; std::vector vals; std::vector nms = getNames(); for (size_t i=0; i < nl; i++) { GDALRasterBandH hBand = GDALGetRasterBand(hDS, i+1); GDALSetRasterNoDataValue(hBand, NAN); GDALSetDescription(hBand, nms[i].c_str()); size_t offset = ncls * i; vals = std::vector(source[0].values.begin() + offset, source[0].values.begin() + offset + ncls); err = GDALRasterIO(hBand, GF_Write, 0, 0, nc, nr, &vals[0], nc, nr, GDT_Float64, 0, 0 ); if (err != CE_None) { return false; } } } return true; } */ terra/src/distance.h0000644000176200001440000001146414733323566014143 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . // distance double distance_plane(const double &x1, const double &y1, const double &x2, const double &y2); std::vector distance_plane(std::vector &x1, std::vector &y1, std::vector &x2, std::vector &y2); std::vector distance_plane_vd(std::vector &x1, std::vector &y1, double x2, double y2); double distLonlat(const double &lon1, const double &lat1, const double &lon2, const double &lat2); double distance_lonlat(const double &lon1, const double &lat1, const double &lon2, const double &lat2); std::vector distance_lonlat(std::vector &lon1, std::vector &lat1, std::vector &lon2, std::vector &lat2) ; std::vector distance_lonlat_vd(std::vector &lon1, std::vector &lat1, double lon2, double lat2) ; std::vector distance_lon(double &lon, std::vector &lat); //double distance_haversine(double lon1, double lat1, double lon2, double lat2); double distHaversine(double lon1, double lat1, double lon2, double lat2); //double distHaversineRad(const double &lon1, const double &lat1, const double &lon2, const double &lat2); double distCosine(double lon1, double lat1, double lon2, double lat2); //double distCosineRad(const double &lon1, const double &lat1, const double &lon2, const double &lat2); // direction double direction_lonlat(double lon1, double lat1, double lon2, double lat2, bool degrees); std::vector direction_lonlat(std::vector lon1, std::vector lat1, std::vector lon2, std::vector lat2, bool degrees, const std::string& method); void directionToNearest_lonlat(std::vector &azi, std::vector &lon1, std::vector &lat1, std::vector &lon2, std::vector &lat2, bool °rees, bool &from, const std::string &method); void distanceCosineToNearest_lonlat(std::vector &d, const std::vector &lon1, const std::vector &lat1, const std::vector &lon2, const std::vector &lat2); double direction_plane(double x1, double y1, double x2, double y2, bool degrees); std::vector direction_plane(std::vector x1, std::vector y1, std::vector x2, std::vector y2, bool degrees); void directionToNearest_plane(std::vector &r, const std::vector &x1, const std::vector &y1, const std::vector &x2, const std::vector &y2, bool °rees, bool &from); // destination std::vector destpoint_lonlat(double longitude, double latitude, double bearing, double distance); std::vector> destpoint_lonlat(const std::vector& longitude, const std::vector& latitude, const std::vector& bearing, const std::vector& distance); std::vector> destpoint_lonlat(const double& longitude, const double& latitude, const std::vector& bearing, const double& distance, bool wrap=true); std::vector destpoint_plane(double x, double y, double bearing, double distance); std::vector > destpoint_plane(std::vector x, std::vector y, std::vector bearing, std::vector distance); double toRad(double °); void distanceToNearest_plane(std::vector &d, const std::vector &x1, const std::vector &y1, const std::vector &x2, const std::vector &y2, const double& lindist); void distanceToNearest_lonlat(std::vector &d, const std::vector &lon1, const std::vector &lat1, const std::vector &lon2, const std::vector &lat2, const double &adj_unit, const std::string& method); void nearest_lonlat(std::vector &id, std::vector &d, std::vector &nlon, std::vector &nlat, const std::vector &lon1, const std::vector &lat1, const std::vector &lon2, const std::vector &lat2, const std::string method); void nearest_lonlat_self(std::vector &id, std::vector &d, std::vector &nlon, std::vector &nlat, const std::vector &lon, const std::vector &lat, const std::string method); terra/src/ram.h0000644000176200001440000000134514536376240013123 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . double availableRAM(); terra/src/memory.cpp0000644000176200001440000000607414720502767014213 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatRaster.h" #include "ram.h" bool SpatRaster::canProcessInMemory(SpatOptions &opt) { if (opt.get_todisk()) return false; double demand = size() * opt.ncopies; if (demand < opt.get_memmin()) { return true; } double supply; if (opt.get_memmax() > 0) { supply = opt.get_memmax() * opt.get_memfrac(); //supply = std::min(supply, availableRAM()); } else { supply = availableRAM() * opt.get_memfrac(); } std::vector v; double maxsup = v.max_size(); //for 32 bit systems supply = std::min(supply, maxsup); return (demand < supply); } size_t SpatRaster::chunkSize(SpatOptions &opt) { double n = opt.ncopies; double frac = opt.get_memfrac(); double demand = size() * n; if (demand < opt.get_memmin()) { return nrow(); } double cells_in_row = ncol() * nlyr() * n; double supply; if (opt.get_memmax() > 0) { supply = opt.get_memmax() * opt.get_memfrac(); //supply = std::min(supply, availableRAM()); } else { supply = availableRAM() * opt.get_memfrac(); } double rows = supply * frac / cells_in_row; //double maxrows = 10000; //rows = std::min(rows, maxrows); size_t urows = floor(rows); urows = std::max(urows, (size_t)opt.minrows); if (urows < 1) return (1); if (urows < nrow()){ return(urows); } else { return (nrow()); } } std::vector SpatRaster::mem_needs(SpatOptions &opt) { //returning bytes unsigned n = opt.ncopies; double memneed = ncell() * (nlyr() * n); double memavail; if (opt.get_memmax() > 0) { memavail = opt.get_memmax(); //memavail = std::min(memavail, availableRAM()); } else { memavail = availableRAM(); } double frac = opt.get_memfrac(); double csize = chunkSize(opt); double inmem = canProcessInMemory(opt); std::vector out = {memneed, memavail, frac, csize, inmem} ; return out; } //BlockSize SpatRaster::getBlockSize(unsigned n, double frac, unsigned steps) { BlockSize SpatRaster::getBlockSize( SpatOptions &opt) { BlockSize bs; size_t cs = chunkSize(opt); bs.n = std::ceil(nrow() / double(cs)); size_t steps = opt.get_steps(); if (steps > 0) { if (steps > nrow()) { steps = nrow(); } bs.n = std::max(steps, bs.n); cs = nrow() / bs.n; } bs.row = std::vector(bs.n); bs.nrows = std::vector(bs.n, cs); size_t r = 0; for (size_t i =0; i //#include "spatRaster.h" #include "spatRasterMultiple.h" #include "spatGraph.h" #include //std::addressof #include "NA.h" #include "spatTime.h" //#include "spatVector2.h" //static void SpatRaster_finalizer( SpatRaster* ptr ){ //} /* Rcpp::List getBlockSizeR(SpatRaster* r, unsigned n, double frac) { SpatOptions opt; opt.ncopies = n; opt.set_memfrac(frac); BlockSize bs = r->getBlockSize(opt); Rcpp::List L = Rcpp::List::create(Rcpp::Named("row") = bs.row, Rcpp::Named("nrows") = bs.nrows, Rcpp::Named("n") = bs.n); return(L); } */ Rcpp::List getBlockSizeR(SpatRaster* r, SpatOptions* opt) { BlockSize bs = r->getBlockSize(*opt); Rcpp::List L = Rcpp::List::create(Rcpp::Named("row") = bs.row, Rcpp::Named("nrows") = bs.nrows, Rcpp::Named("n") = bs.n); return(L); } Rcpp::List getBlockSizeWrite(SpatRaster* r) { BlockSize bs = r->bs; Rcpp::List L = Rcpp::List::create(Rcpp::Named("row") = bs.row, Rcpp::Named("nrows") = bs.nrows, Rcpp::Named("n") = bs.n); return(L); } bool sameObject(SpatRaster* a, SpatRaster* b) { return a == b; } Rcpp::List getDataFrame(SpatDataFrame* v) { size_t n = v->ncol(); Rcpp::List out(n); if (n == 0) { return(out); } long longNA = NA::value; std::string stringNA = v->NAS; SpatTime_t timeNA = NA::value; std::vector nms = v->names; std::vector itype = v->itype; for (size_t i=0; i < n; i++) { if (itype[i] == 0) { out[i] = v->getD(i); } else if (itype[i] == 1) { //gives warning with NA #1031 // Rcpp::wrap(v->getI(i)); std::vector ints = v->getI(i); size_t n = ints.size(); Rcpp::IntegerVector iv(n, NA_INTEGER); for (size_t j=0; jgetS(i)); for (R_xlen_t j=0; j b = v->getB(i); Rcpp::LogicalVector d(b.size()); for (size_t j=0; j 1) { d[j] = NA_LOGICAL; } else { d[j] = b[j]; } } out[i] = d; } else if (itype[i] == 4){ SpatTime_v tx = v->getT(i); Rcpp::NumericVector tv = Rcpp::wrap(tx.x); for (R_xlen_t j=0; jgetF(i); } } out.names() = nms; // todo: deal with NAs in int and str return out; // Rcpp::df is nice, but no of variables is <= 20, // and no "stringsAsFactors"=false // Rcpp::DataFrame result(out); // result.attr("names") = v->names(); // return result; } Rcpp::List getVectorAttributes(SpatVector* v) { SpatDataFrame df = v->df; Rcpp::List lst = getDataFrame(&df); return lst; } /* Rcpp::List getRasterAttributes(SpatRaster* x) { Rcpp::List lst; if (x->nlyr() > 0) { SpatDataFrame df = x->source[0].cats[0]; lst = getDataFrame(&df); } return lst; } */ Rcpp::DataFrame get_geometryDF(SpatVector* v) { SpatDataFrame df = v->getGeometryDF(); Rcpp::DataFrame out = Rcpp::DataFrame::create( Rcpp::Named("id") = df.iv[0], Rcpp::Named("part") = df.iv[1], Rcpp::Named("x") = df.dv[0], Rcpp::Named("y") = df.dv[1], Rcpp::Named("hole") = df.iv[2] ); return out; } std::vector>> get_geometryList(SpatVector* v, const std::string xnm, const std::string ynm) { size_t ni = v->nrow(); std::vector>> out(ni); for (size_t i=0; i < ni; i++) { SpatGeom g = v->getGeom(i); size_t nj = g.size(); if (nj == 0) { // empty continue; } out[i].resize(nj); for (size_t j=0; j < nj; j++) { SpatPart p = g.getPart(j); size_t nk = p.nHoles(); out[i][j].reserve(nk + 1); Rcpp::DataFrame m = Rcpp::DataFrame::create( Rcpp::Named(xnm) = p.x, Rcpp::Named(ynm) = p.y ); out[i][j].push_back(m); for (size_t k=0; k("SpatVector2") .constructor() .field("x", &SpatVector2::X) .field("y", &SpatVector2::Y) .field("z", &SpatVector2::Z) .field("g", &SpatVector2::G) .field("p", &SpatVector2::P) .field("h", &SpatVector2::H) .method("from_old", &SpatVector2::from_old) .method("to_old", &SpatVector2::to_old) ; */ class_("SpatTime_v") .constructor() .field("step", &SpatTime_v::step) .field("zone", &SpatTime_v::zone) .field("x", &SpatTime_v::x) ; class_("SpatFactor") .constructor() .constructor, std::vector, bool>() // .constructor, std::vector>() .field("values", &SpatFactor::v) .field("labels", &SpatFactor::labels) .field("ordered", &SpatFactor::ordered) ; class_("SpatSRS") .constructor() .method("set", &SpatSRS::set) .method("is_lonlat", &SpatSRS::is_lonlat) .method("to_meter", &SpatSRS::to_meter) ; /* class_("SpatGraph") .constructor() ; */ class_("SpatExtent") .constructor() .constructor() .method("deepcopy", &SpatExtent::deepCopy, "deepCopy") .property("vector", &SpatExtent::asVector) .property("valid", &SpatExtent::valid) .property("valid_notempty", &SpatExtent::valid_notempty) .property("empty", &SpatExtent::empty) .method("align", &SpatExtent::align, "align") .method("intersect", &SpatExtent::intersect, "intersect") .method("as.points", &SpatExtent::asPoints, "as.points") .method("ceil", &SpatExtent::ceil, "ceil") .method("compare", &SpatExtent::compare, "compare") .method("floor", &SpatExtent::floor, "floor") .method("round", &SpatExtent::round, "round") .method("union", &SpatExtent::unite, "union") .method("sampleRandom", &SpatExtent::sampleRandom) .method("sampleRegular", &SpatExtent::sampleRegular) .method("sample", &SpatExtent::test_sample) ; /* class_("SpatWindow") .field_readonly("full_extent", &SpatWindow::full_extent) .field_readonly("full_nrow", &SpatWindow::full_nrow) .field_readonly("full_ncol", &SpatWindow::full_ncol) .field_readonly("off_row", &SpatWindow::off_row) .field_readonly("off_col", &SpatWindow::off_col) .field_readonly("expand", &SpatWindow::expand) ; */ class_("SpatMessages") .constructor() //.field("success", &SpatMessages::success) .field("has_error", &SpatMessages::has_error) .field("has_warning", &SpatMessages::has_warning) //.method("has_error", &SpatMessages::hasError) //.method("has_warning", &SpatMessages::hasWarning) ; class_("SpatOptions") .constructor() .method("deepcopy", &SpatOptions::deepCopy, "deepCopy") .property("tempdir", &SpatOptions::get_tempdir, &SpatOptions::set_tempdir ) .property("memfrac", &SpatOptions::get_memfrac, &SpatOptions::set_memfrac ) .property("memmax", &SpatOptions::get_memmax, &SpatOptions::set_memmax ) .property("memmin", &SpatOptions::get_memmin, &SpatOptions::set_memmin ) .property("tolerance", &SpatOptions::get_tolerance, &SpatOptions::set_tolerance ) .property("filenames", &SpatOptions::get_filenames, &SpatOptions::set_filenames ) .property("filetype", &SpatOptions::get_filetype, &SpatOptions::set_filetype ) .property("datatype", &SpatOptions::get_datatype, &SpatOptions::set_datatype ) .property("verbose", &SpatOptions::get_verbose, &SpatOptions::set_verbose ) .property("NAflag", &SpatOptions::get_NAflag, &SpatOptions::set_NAflag ) //.property("ncdfcopy", &SpatOptions::get_ncdfcopy, &SpatOptions::set_ncdfcopy ) .property("statistics", &SpatOptions::get_statistics, &SpatOptions::set_statistics ) .property("overwrite", &SpatOptions::get_overwrite, &SpatOptions::set_overwrite ) //.property("append", &SpatOptions::get_append, &SpatOptions::set_append ) .field("datatype_set", &SpatOptions::datatype_set) .field("threads", &SpatOptions::threads) .property("progress", &SpatOptions::get_progress, &SpatOptions::set_progress) .field("progressbar", &SpatOptions::progressbar) .property("ncopies", &SpatOptions::get_ncopies, &SpatOptions::set_ncopies) .property("def_filetype", &SpatOptions::get_def_filetype, &SpatOptions::set_def_filetype ) .property("def_datatype", &SpatOptions::get_def_datatype, &SpatOptions::set_def_datatype ) .property("def_verbose", &SpatOptions::get_def_verbose, &SpatOptions::set_def_verbose ) //.property("def_bandorder", &SpatOptions::get_def_bandorder, &SpatOptions::set_def_bandorder ) .property("todisk", &SpatOptions::get_todisk, &SpatOptions::set_todisk) .field("messages", &SpatOptions::msg, "messages") .field("gdal_options", &SpatOptions::gdal_options) .field("tmpfile", &SpatOptions::tmpfile ) .field("names", &SpatOptions::names) .property("steps", &SpatOptions::get_steps, &SpatOptions::set_steps) // .property("overwrite", &SpatOptions::set_overwrite, &SpatOptions::get_overwrite ) //.field("gdaloptions", &SpatOptions::gdaloptions) .property("scale", &SpatOptions::get_scale, &SpatOptions::set_scale) .property("offset", &SpatOptions::get_offset, &SpatOptions::set_offset) .method("has_error", &SpatOptions::hasError) .method("has_warning", &SpatOptions::hasWarning) .method("getError", &SpatOptions::getError) .method("getWarnings", &SpatOptions::getWarnings) ; class_("SpatDataFrame") .constructor() .field_readonly("itype", &SpatDataFrame::itype) .field_readonly("iplace", &SpatDataFrame::iplace) .property("names", &SpatDataFrame::get_names, &SpatDataFrame::set_names) .property("nrow", &SpatDataFrame::nrow, &SpatDataFrame::resize_rows, "nrow") .property("ncol", &SpatDataFrame::ncol, &SpatDataFrame::resize_cols, "ncol") .method("has_error", &SpatDataFrame::hasError) .method("has_warning", &SpatDataFrame::hasWarning) .method("getWarnings", &SpatDataFrame::getWarnings) .method("getError", &SpatDataFrame::getError) .method("add_column_double", (bool (SpatDataFrame::*)(std::vector, std::string name))( &SpatDataFrame::add_column)) .method("add_column_long", (bool (SpatDataFrame::*)(std::vector, std::string name))( &SpatDataFrame::add_column)) .method("add_column_string", (bool (SpatDataFrame::*)(std::vector, std::string name))( &SpatDataFrame::add_column)) .method("add_column_factor", (bool (SpatDataFrame::*)(SpatFactor, std::string name))( &SpatDataFrame::add_column)) .method("add_column_bool", (bool (SpatDataFrame::*)(std::vector, std::string name))( &SpatDataFrame::add_column_bool)) .method("add_column_time", &SpatDataFrame::add_column_time) .method("remove_column", (bool (SpatDataFrame::*)(std::string field))( &SpatDataFrame::remove_column)) .method("remove_column", (bool (SpatDataFrame::*)(int i))( &SpatDataFrame::remove_column)) .method("get_datatypes", &SpatDataFrame::get_datatypes) .method("get_timezones", &SpatDataFrame::get_timezones) .method("get_timesteps", &SpatDataFrame::get_timesteps) .method("subset_rows", (SpatDataFrame (SpatDataFrame::*)(std::vector))( &SpatDataFrame::subset_rows)) .method("subset_cols", (SpatDataFrame (SpatDataFrame::*)(std::vector))( &SpatDataFrame::subset_cols)) .method("remove_rows", &SpatDataFrame::remove_rows) .method("cbind", &SpatDataFrame::cbind) .method("rbind", &SpatDataFrame::rbind) .method("values", &getDataFrame) .method("unique", &SpatDataFrame::unique) //.method("one_string", &SpatDataFrame::one_string) .method("write", &SpatDataFrame::write_dbf) .field("messages", &SpatDataFrame::msg) .method("strwidth", &SpatDataFrame::strwidth) ; class_("SpatVectorCollection") .constructor() .constructor, SpatVector>() //.property("names", &SpatVectorCollection::get_names, &SpatVectorCollection::set_names) .method("deepcopy", &SpatVectorCollection::deepCopy, "deepCopy") .method("size", &SpatVectorCollection::size) .method("get", &SpatVectorCollection::get) .method("push_back", &SpatVectorCollection::push_back) .method("subset", &SpatVectorCollection::subset) .method("replace", &SpatVectorCollection::replace) .method("append", &SpatVectorCollection::append) .method("has_error", &SpatVectorCollection::hasError) .method("has_warning", &SpatVectorCollection::hasWarning) .method("getWarnings", &SpatVectorCollection::getWarnings) .method("getError", &SpatVectorCollection::getError) .method("from_hex_col", &SpatVectorCollection::from_hex_col) .method("setNames", &SpatVectorCollection::setNames, "setNames" ) .property("names", &SpatVectorCollection::getNames) ; class_("SpatCategories") .constructor() .field_readonly("df", &SpatCategories::d) .field("index", &SpatCategories::index) .method("combine", &SpatCategories::combine) ; /* class_("SpatVector") .constructor() .constructor() .constructor>() ; */ class_("SpatVector") .constructor() .constructor() .constructor>() // .method("pointInPolygon", &SpatVector::pointInPolygon) .method("deepcopy", &SpatVector::deepCopy) .method("wkt", &SpatVector::wkt) .method("wkb", &SpatVector::wkb) .method("wkb_raw", &SpatVector::wkb_raw) .method("hex", &SpatVector::hex) .method("from_hex", &SpatVector::from_hex) .method("make_nodes", &SpatVector::make_nodes) .method("boundary", &SpatVector::boundary) .method("polygonize", &SpatVector::polygonize) .method("normalize", &SpatVector::normalize) .method("normalize_longitude", &SpatVector::normalize_longitude) .method("rotate_longitude", &SpatVector::rotate_longitude) .method("line_merge", &SpatVector::line_merge) .method("simplify", &SpatVector::simplify) .method("thin", &SpatVector::thin) //.method("shared_paths", &SpatVector::shared_paths) .method("shared_paths", (SpatVector (SpatVector::*)(bool))( &SpatVector::shared_paths)) .method("shared_paths2", (SpatVector (SpatVector::*)(SpatVector, bool))( &SpatVector::shared_paths)) .method("snap", &SpatVector::snap) .method("snapto", &SpatVector::snapto) .method("spatial_index_2d", &SpatVector::index_2d) .method("spatial_index_sparse", &SpatVector::index_sparse) .field_readonly("is_proxy", &SpatVector::is_proxy ) .field_readonly("read_query", &SpatVector::read_query ) .field_readonly("read_extent", &SpatVector::read_extent ) .field_readonly("geom_count", &SpatVector::geom_count) .field_readonly("source", &SpatVector::source) .field_readonly("layer", &SpatVector::source_layer) .field_readonly("df", &SpatVector::df ) .method("has_error", &SpatVector::hasError) .method("has_warning", &SpatVector::hasWarning) .method("getError", &SpatVector::getError) .method("getWarnings", &SpatVector::getWarnings) .method("coordinates", &SpatVector::coordinates) .method("get_geometry", &SpatVector::getGeometry) .method("get_geometryDF", &get_geometryDF) .method("get_geometryList", &get_geometryList) .method("linesList", &SpatVector::linesList) .method("polygonsList", &SpatVector::polygonsList) .method("linesNA", &SpatVector::linesNA) .method("add_column_empty", (void (SpatVector::*)(unsigned dtype, std::string name))( &SpatVector::add_column)) .method("add_column_double", (bool (SpatVector::*)(std::vector, std::string name))( &SpatVector::add_column)) .method("add_column_long", (bool (SpatVector::*)(std::vector, std::string name))( &SpatVector::add_column)) .method("add_column_string", (bool (SpatVector::*)(std::vector, std::string name))( &SpatVector::add_column)) .method("add_column_factor", &SpatVector::add_column_factor) .method("add_column_bool", &SpatVector::add_column_bool) .method("add_column_time", &SpatVector::add_column_time) .method("remove_column", (bool (SpatVector::*)(std::string field))( &SpatVector::remove_column)) .method("remove_column", (bool (SpatVector::*)(int i))( &SpatVector::remove_column)) .method("remove_df", &SpatVector::remove_df) .method("set_df", &SpatVector::set_df) .method("get_datatypes", &SpatVector::get_datatypes) .method("set_holes", &SpatVector::set_holes) .method("get_holes", &SpatVector::get_holes) .method("remove_holes", &SpatVector::remove_holes) .method("append", &SpatVector::append) .method("cbind", &SpatVector::cbind) .method("rbind", &SpatVector::append) .method("area", &SpatVector::area) .method("as_lines", &SpatVector::as_lines) .method("as_points", &SpatVector::as_points) .method("couldBeLonLat", &SpatVector::could_be_lonlat) .method("get_crs", &SpatVector::getSRS) .method("set_crs", (bool (SpatVector::*)(std::string crs))( &SpatVector::setSRS)) //.method("prj", &SpatVector::getPRJ) // .method("get_index", &SpatVector::get_index) .method("distance_self", (std::vector (SpatVector::*)(bool, std::string, const std::string))( &SpatVector::distance)) .method("distance_other", (std::vector (SpatVector::*)(SpatVector, bool, std::string, const std::string))( &SpatVector::distance)) .method("point_distance", &SpatVector::pointdistance) // .method("geosdist_self", (std::vector (SpatVector::*)(bool, std::string))( &SpatVector::geos_distance)) // .method("geosdist_other", (std::vector (SpatVector::*)(SpatVector, bool, std::string))( &SpatVector::geos_distance)) .method("extent", &SpatVector::getExtent) .method("getDF", &getVectorAttributes) .method("getGeometryWKT", &SpatVector::getGeometryWKT) .method("isLonLat", &SpatVector::is_lonlat) .method("length", &SpatVector::length) .method("nsegments", &SpatVector::nseg) // .field("srs", &SpatVector::srs, "srs") .field("messages", &SpatVector::msg) .property("names", &SpatVector::get_names, &SpatVector::set_names) .method("nrow", &SpatVector::nrow) .method("ncol", &SpatVector::ncol) .method("project", &SpatVector::project) .method("project_xy", &SpatVector::project_xy) .method("read", &SpatVector::read) .method("setGeometry", &SpatVector::setGeometry) .method("setPointsXY", &SpatVector::setPointsGeometry) .method("setPointsDF", &SpatVector::setPointsDF) .method("setLinesStartEnd", &SpatVector::setLinesStartEnd) .method("size", &SpatVector::size) .method("subset_cols", ( SpatVector (SpatVector::*)(std::vector))( &SpatVector::subset_cols )) .method("subset_rows", ( SpatVector (SpatVector::*)(std::vector))( &SpatVector::subset_rows )) .method("remove_rows", &SpatVector::remove_rows) .method("type", &SpatVector::type) .method("naGeoms", &SpatVector::naGeoms) .method("nullGeoms", &SpatVector::nullGeoms) .method("write", &SpatVector::write) .method("delete_layers", &SpatVector::delete_layers) .method("layer_names", &SpatVector::layer_names) // .method("bienvenue", &SpatVector::bienvenue) // .method("allerretour", &SpatVector::allerretour) .method("geos_isvalid", &SpatVector::geos_isvalid) .method("geos_isvalid_msg", &SpatVector::geos_isvalid_msg) .method("aggregate", ( SpatVector (SpatVector::*)(std::string, bool))( &SpatVector::aggregate )) .method("aggregate_nofield", ( SpatVector (SpatVector::*)(bool))( &SpatVector::aggregate )) .method("disaggregate", &SpatVector::disaggregate) .method("buffer", &SpatVector::buffer) // .method("buffer2", &SpatVector::buffer2) // .method("buffer3", &SpatVector::buffer3) .method("centroid", &SpatVector::centroid) .method("point_on_surface", &SpatVector::point_on_surface) .method("make_valid2", &SpatVector::make_valid2) .method("flip", &SpatVector::flip) .method("transpose", &SpatVector::transpose) .method("shift", &SpatVector::shift) .method("rescale", &SpatVector::rescale) .method("rotate", &SpatVector::rotate) .method("erase_agg", &SpatVector::erase_agg) .method("erase", ( SpatVector (SpatVector::*)(SpatVector))( &SpatVector::erase )) .method("erase_self", ( SpatVector (SpatVector::*)(bool))( &SpatVector::erase )) .method("elongate", &SpatVector::elongate) .method("gaps", &SpatVector::gaps) .method("symdif", &SpatVector::symdif) .method("cover", &SpatVector::cover) .method("union", ( SpatVector (SpatVector::*)(SpatVector))( &SpatVector::unite )) .method("union_self", ( SpatVector (SpatVector::*)())( &SpatVector::unite )) .method("union_unary", &SpatVector::unaryunion) .method("intersect", &SpatVector::intersect) .method("delaunay", &SpatVector::delaunay) .method("voronoi", &SpatVector::voronoi) // .method("voronoi_sphere", &SpatVector::voronoi_sphere) .method("hull", &SpatVector::hull) .method("width", &SpatVector::width) .method("clearance", &SpatVector::clearance) .method("mask", &SpatVector::mask) .method("is_related", &SpatVector::is_related) .method("related_between", ( std::vector> (SpatVector::*)(SpatVector, std::string, bool))( &SpatVector::which_relate)) .method("related_within", ( std::vector> (SpatVector::*)(std::string, bool))( &SpatVector::which_relate)) // .method("relate_first", &SpatVector::relateFirst) // .method("relate_between", ( std::vector (SpatVector::*)(SpatVector, std::string, bool, bool))( &SpatVector::relate )) .method("relate_within", ( std::vector (SpatVector::*)(std::string, bool))( &SpatVector::relate )) .method("equals_between", ( std::vector (SpatVector::*)(SpatVector, double))( &SpatVector::equals_exact )) .method("equals_within", ( std::vector (SpatVector::*)(bool, double))( &SpatVector::equals_exact )) .method("crop_ext", ( SpatVector (SpatVector::*)(SpatExtent, bool))( &SpatVector::crop )) .method("crop_vct", ( SpatVector (SpatVector::*)(SpatVector))( &SpatVector::crop )) .method("near_between", (SpatVector (SpatVector::*)(SpatVector, bool, const std::string))( &SpatVector::nearest_point)) .method("near_within", (SpatVector (SpatVector::*)(const std::string))( &SpatVector::nearest_point)) // not used? .method("near_geom", &SpatVector::nearest_geometry) //.method("knearest", &SpatVector::knearest) .method("split", &SpatVector::split) .method("sample", &SpatVector::sample) .method("sampleGeom", &SpatVector::sample_geom) .method("remove_duplicate_nodes", &SpatVector::remove_duplicate_nodes) .method("cross_dateline", &SpatVector::cross_dateline) .method("fix_lonlat_overflow", &SpatVector::fix_lonlat_overflow) .method("densify", &SpatVector::densify) .method("round", &SpatVector::round) .method("make_CCW", &SpatVector::make_CCW) ; // class_("SpatRasterSource") // .field_readonly("cats", &SpatRasterSource::cats) /// .field_readonly("has_scale_offset", &SpatRasterSource::has_scale_offset) // .field_readonly("scale", &SpatRasterSource::scale) // .field_readonly("offset", &SpatRasterSource::offset) // .field_readonly("time", &SpatRasterSource::time) // .field("srs", &SpatRasterSource::srs, "srs") //.field_readonly("memory", &SpatRasterSource::memory) // .field_readonly("filename", &SpatRasterSource::filename) //.field_readonly("driver", &SpatRasterSource::driver) //.field_readonly("nrow", &SpatRasterSource::nrow) //.field_readonly("ncol", &SpatRasterSource::ncol) //.field_readonly("nlyr", &SpatRasterSource::nlyr) // .field_readonly("extent", &SpatRasterSource::extent) // .field_readonly("hasWindow", &SpatRasterSource::hasWindow) // .field_readonly("window", &SpatRasterSource::window) //.field_readonly("layers", &SpatRasterSource::layers) //.field_readonly("nlyrfile", &SpatRasterSource::nlyrfile) //.field_readonly("flipped", &SpatRasterSource::flipped) //.field_readonly("rotated", &SpatRasterSource::rotated) // .field_readonly("parameters_changed", &SpatRasterSource::parameters_changed) //; class_("SpatVectorProxy") .constructor() .field("v", &SpatVectorProxy::v ) .method("deepcopy", &SpatVectorProxy::deepCopy, "deepCopy") ; class_("SpatRaster") .constructor() // .constructor() .constructor, std::vector, std::vector, bool, std::vector, std::vector, std::vector, bool>() .constructor, std::vector, std::string>() //.finalizer(&SpatRaster_finalizer) //.method("fromFiles", &SpatRaster::fromFiles) .method("has_error", &SpatRaster::hasError) .method("has_warning", &SpatRaster::hasWarning) .method("getError", &SpatRaster::getError) .method("getWarnings", &SpatRaster::getWarnings) .method("getMessage", &SpatRaster::getMessage) .method("addTag", &SpatRaster::addTag) .method("getTags", &SpatRaster::getTags) .method("addLyrTags", &SpatRaster::addLyrTags) .method("getLyrTags", &SpatRaster::getLyrTags) .method("getAllFiles", &SpatRaster::getAllFiles) //.field("name", &SpatRaster::name) .method("getFileBlocksize", &SpatRaster::getFileBlocksize) .method("sources_to_disk", &SpatRaster::sources_to_disk, "sources_to_disk") .method("mem_needs", &SpatRaster::mem_needs, "mem_needs") .method("spatinit", &SpatRaster::gdalogrproj_init, "init") .method("addSource", &SpatRaster::addSource, "addSource") .method("replace", &SpatRaster::replace, "replace") .method("combineSources", &SpatRaster::combineSources, "combineSources") .method("compare_geom", &SpatRaster::compare_geom, "compare_geom") .method("couldBeLonLat", &SpatRaster::could_be_lonlat, "couldBeLonLat") .method("deepcopy", &SpatRaster::deepCopy, "deepCopy") .method("hardcopy", &SpatRaster::hardCopy) .method("get_crs", &SpatRaster::getSRS) .method("set_crs", (bool (SpatRaster::*)(std::string crs))( &SpatRaster::setSRS)) //.field_readonly("prj", &SpatRaster::prj) .property("extent", &SpatRaster::getExtent, &SpatRaster::setExtent ) .method("is_rotated", &SpatRaster::is_rotated) .method("is_flipped", &SpatRaster::is_flipped) .method("setWindow", &SpatRaster::setWindow, "") .method("removeWindow", &SpatRaster::removeWindow, "") .method("hasWindow", &SpatRaster::hasWindow, "") //.method("getRasterAtt", &getRasterAttributes, "get attributes") .method("filenames", &SpatRaster::filenames ) // .method("shared_basegeom", &SpatRaster::shared_basegeom) .field_readonly("rgb", &SpatRaster::rgb) .field_readonly("rgbtype", &SpatRaster::rgbtype) .method("setRGB", &SpatRaster::setRGB) .method("removeRGB", &SpatRaster::removeRGB) .method("getRGB", &SpatRaster::getRGB) //.method("setAttIndex", &SpatRaster::setAttrIndex, "setAttrIndex") //.method("getAttIndex", &SpatRaster::getAttrIndex, "getAttrIndex") //.method("hasAttributes", &SpatRaster::hasAttributes, "hasAttributes") //.method("getAttributes", &SpatRaster::getAttributes, "getAttributes") //.method("setAttributes", &SpatRaster::setAttributes, "setAttributes") //.method("createAttributes", &SpatRaster::createAttributes, "createAttributes") .method("makeCategorical", &SpatRaster::makeCategorical) .method("createCategories", &SpatRaster::createCategories) .method("hasCategories", &SpatRaster::hasCategories) .method("getCategories", &SpatRaster::getCategories) .method("setCategories", &SpatRaster::setCategories) .method("removeCategories", &SpatRaster::removeCategories) .method("getLabels", &SpatRaster::getLabels) .method("setLabels", &SpatRaster::setLabels) .method("getCatIndex", &SpatRaster::getCatIndex) .method("setCatIndex", &SpatRaster::setCatIndex) .method("getScaleOffset", &SpatRaster::getScaleOffset) .method("setScaleOffset", &SpatRaster::setScaleOffset) .method("hasColors", &SpatRaster::hasColors) .method("getColors", &SpatRaster::getColors) .method("setColors", &SpatRaster::setColors) .method("removeColors", &SpatRaster::removeColors) // need to keep this for raster .property("dataType", &SpatRaster::dataType) .method("getDataType", &SpatRaster::getDataType) .method("valueType", &SpatRaster::getValueType) .method("setValueType", &SpatRaster::setValueType) .property("hasRange", &SpatRaster::hasRange ) .property("hasValues", &SpatRaster::hasValues ) .property("inMemory", &SpatRaster::inMemory ) .method("isLonLat", &SpatRaster::is_lonlat, "isLonLat") .method("isGlobalLonLat", &SpatRaster::is_global_lonlat, "isGlobalLonLat") .property("names", &SpatRaster::getNames) .method("get_sourcenames_long", &SpatRaster::getLongSourceNames) .method("set_sourcenames_long", &SpatRaster::setLongSourceNames) .method("get_sourcenames", &SpatRaster::getSourceNames) .method("set_sourcenames", &SpatRaster::setSourceNames) .method("setNAflag", &SpatRaster::setNAflag) .method("getNAflag", &SpatRaster::getNAflag) .property("hasUnit", &SpatRaster::hasUnit) .property("hasTime", &SpatRaster::hasTime) .property("time", &SpatRaster::getTime) .property("timestep", &SpatRaster::getTimeStep) .property("timezone", &SpatRaster::getTimeZone) .method("settime", &SpatRaster::setTime) //.property("timestr", &SpatRaster::getTimeStr) .method("metadata", &SpatRaster::getMetadata) .property("depth", &SpatRaster::getDepth) .method("set_depth", &SpatRaster::setDepth) .property("units", &SpatRaster::getUnit) .method("set_units", &SpatRaster::setUnit) .method("size", &SpatRaster::size, "size") .method("nrow", &SpatRaster::nrow, "nrow") .method("ncol", &SpatRaster::ncol, "ncol") .method("nsrc", &SpatRaster::nsrc, "nsrc" ) .field("messages", &SpatRaster::msg, "messages") .method("nlyrBySource", &SpatRaster::nlyrBySource, "nlyrBySource" ) .method("lyrsBySource", &SpatRaster::lyrsBySource, "lyrsBySource" ) .method("getBands", &SpatRaster::getBands, "getBands" ) .method("nlyr", &SpatRaster::nlyr, "nlyr" ) .property("origin", &SpatRaster::origin) .property("range_min", &SpatRaster::range_min ) .property("range_max", &SpatRaster::range_max ) .property("res", &SpatRaster::resolution) // only if SpatRasterSource is exposed // .field_readonly("source", &SpatRaster::source ) .method("collapse_sources", &SpatRaster::collapse_sources) .method("make_vrt", &SpatRaster::make_vrt) .method("dense_extent", &SpatRaster::dense_extent) .method("setNames", &SpatRaster::setNames) .method("setTime", &SpatRaster::setTime) .method("setDepth", &SpatRaster::setDepth) .method("setUnit", &SpatRaster::setUnit) .method("set_resolution", &SpatRaster::setResolution) .method("subset", &SpatRaster::subset) .method("subsetSource", &SpatRaster::subsetSource) .method("cellFromXY", ( std::vector (SpatRaster::*)(std::vector,std::vector, double) )( &SpatRaster::cellFromXY )) .method("vectCells", &SpatRaster::vectCells) .method("extCells", &SpatRaster::extCells) .method("wmean_rast", (SpatRaster (SpatRaster::*)(SpatRaster, bool, SpatOptions&))( &SpatRaster::weighted_mean )) .method("wmean_vect", (SpatRaster (SpatRaster::*)(std::vector, bool, SpatOptions&))( &SpatRaster::weighted_mean )) .method("cellFromRowCol", ( std::vector (SpatRaster::*)(std::vector,std::vector) )( &SpatRaster::cellFromRowCol )) .method("cellFromRowColCombine", ( std::vector (SpatRaster::*)(std::vector,std::vector) )( &SpatRaster::cellFromRowColCombine )) .method("yFromRow", ( std::vector (SpatRaster::*)(const std::vector&) )( &SpatRaster::yFromRow )) .method("xFromCol", ( std::vector (SpatRaster::*)(const std::vector&) )( &SpatRaster::xFromCol )) .method("colFromX", ( std::vector (SpatRaster::*)(const std::vector&) )( &SpatRaster::colFromX )) .method("rowFromY", ( std::vector (SpatRaster::*)(const std::vector&) )( &SpatRaster::rowFromY )) .method("xyFromCell", ( std::vector< std::vector > (SpatRaster::*)(std::vector&) )( &SpatRaster::xyFromCell )) .method("crds", &SpatRaster::coordinates) .method("rowColFromCell", ( std::vector< std::vector > (SpatRaster::*)(std::vector) )( &SpatRaster::rowColFromCell )) .method("readStart", &SpatRaster::readStart) .method("readStop", &SpatRaster::readStop) .method("readAll", &SpatRaster::readAll) .method("readValues", &SpatRaster::readValuesR) .method("getValues", &SpatRaster::getValues) .method("getBlockSizeR", &getBlockSizeR) .method("getBlockSizeWrite", &getBlockSizeWrite) .method("same", &sameObject) #ifdef useRcpp .method("setValuesRcpp", &SpatRaster::setValuesRcpp) #endif .method("setValues", &SpatRaster::setValues) .method("replaceCellValues", &SpatRaster::replaceCellValues) .method("replaceCellValuesLayer", &SpatRaster::replaceCellValuesLayer) .method("setRange", &SpatRaster::setRange) .method("writeStart", &SpatRaster::writeStart) .method("writeStop", &SpatRaster::writeStop) .method("writeValues", &SpatRaster::writeValues) .method("writeRaster", &SpatRaster::writeRaster) .method("canProcessInMemory", &SpatRaster::canProcessInMemory) .method("chunkSize", &SpatRaster::chunkSize) // .method("to_memory", &SpatRaster::to_memory, "to_memory") .method("update_meta", &SpatRaster::update_meta) .method("adjacentMat", &SpatRaster::adjacentMat) .method("adjacent", &SpatRaster::adjacent) .method("aggregate", &SpatRaster::aggregate) .method("align", &SpatRaster::align) .method("apply", &SpatRaster::apply) .method("rapply", &SpatRaster::rapply) .method("rappvals", &SpatRaster::rappvals) .method("roll", &SpatRaster::roll) .method("fill_range", &SpatRaster::fill_range) .method("arith_rast", (SpatRaster (SpatRaster::*)(SpatRaster, std::string, bool, SpatOptions&) )( &SpatRaster::arith )) .method("arith_numb", (SpatRaster (SpatRaster::*)(std::vector, std::string, bool, bool,SpatOptions&) )( &SpatRaster::arith)) .method("arith_m", &SpatRaster::arith_m) .method("rst_area", &SpatRaster::rst_area) .method("sum_area", &SpatRaster::sum_area) .method("sum_area_group", &SpatRaster::sum_area_group) .method("surface_area", &SpatRaster::surfaceArea) .method("as_points", &SpatRaster::as_points) // .method("as_points_value", &SpatRaster::as_points_value) .method("cells_notna", &SpatRaster::cells_notna) .method("cells_notna_novalues", &SpatRaster::cells_notna_novalues) .method("as_multipoints", &SpatRaster::as_multipoints) .method("as_lines", &SpatRaster::as_lines) .method("as_polygons", &SpatRaster::as_polygons) .method("polygonize", &SpatRaster::polygonize) .method("atan2", &SpatRaster::atan_2) .method("bilinearValues", &SpatRaster::bilinearValues) .method("patches", &SpatRaster::clumps) .method("patches2", &SpatRaster::patches) .method("boundaries", &SpatRaster::edges) .method("buffer", &SpatRaster::buffer) .method("gridDistance", &SpatRaster::gridDistance) .method("costDistance", &SpatRaster::costDistance) .method("rastDistance", &SpatRaster::distance) .method("nearest", &SpatRaster::nearest) .method("vectDistance", &SpatRaster::distance_vector) .method("rastDirection", &SpatRaster::direction) .method("vectDirectionRasterize", &SpatRaster::direction_rasterize) // .method("vectDistanceDirect", &SpatRaster::distance_spatvector) // .method("vectDistanceRasterize", &SpatRaster::distance_rasterize) .method("get_tiles_ext", &SpatRaster::get_tiles_extent) .method("get_tiles_ext_vect", &SpatRaster::get_tiles_extent_vect) .method("make_tiles", &SpatRaster::make_tiles) .method("make_tiles_vect", &SpatRaster::make_tiles_vect) .method("ext_from_rc", &SpatRaster::ext_from_rc) .method("combineCats", &SpatRaster::combineCats) .method("droplevels", &SpatRaster::dropLevels) .method("clamp", &SpatRaster::clamp) .method("clamp_raster", &SpatRaster::clamp_raster) .method("clamp_ts", &SpatRaster::clamp_ts) .method("replaceValues", &SpatRaster::replaceValues) .method("classify", ( SpatRaster (SpatRaster::*)(std::vector, size_t, unsigned, bool, bool, double, bool, bool, bool, SpatOptions&) )( &SpatRaster::reclassify)) //.method("source_collapse", &SpatRaster::collapse, "collapse") .method("selRange", &SpatRaster::selRange) .method("separate", &SpatRaster::separate) .method("sort", &SpatRaster::sort) .method("intersect", &SpatRaster::intersect) .method("cover", ( SpatRaster (SpatRaster::*)(SpatRaster, std::vector, SpatOptions&) )( &SpatRaster::cover)) .method("cover_self", ( SpatRaster (SpatRaster::*)(std::vector, SpatOptions&) )( &SpatRaster::cover)) .method("crop", &SpatRaster::crop) .method("crop_mask", &SpatRaster::cropmask) .method("cum", &SpatRaster::cum) .method("disaggregate", &SpatRaster::disaggregate) .method("expand", &SpatRaster::extend) .method("extractCell", &SpatRaster::extractCell) // .method("extractXY", &SpatRaster::extractXY) // .method("extractXYFlat", &SpatRaster::extractXYFlat, "extractXYflat") .method("extractVector", &SpatRaster::extractVector) .method("extractVectorFlat", &SpatRaster::extractVectorFlat) .method("extractBuffer", &SpatRaster::extractBuffer) .method("flip", &SpatRaster::flip) .method("focal", &SpatRaster::focal) .method("focalValues", &SpatRaster::focal_values) .method("count", &SpatRaster::count) .method("freq", &SpatRaster::freq) .method("geometry", &SpatRaster::geometry) .method("get_aggregates", &SpatRaster::get_aggregates) .method("get_aggregate_dims", &SpatRaster::get_aggregate_dims2) .method("globalTF", &SpatRaster::globalTF) .method("mglobal", &SpatRaster::mglobal) .method("layerCor", &SpatRaster::layerCor) .method("global_weighted_mean", &SpatRaster::global_weighted_mean) .method("initf", ( SpatRaster (SpatRaster::*)(std::string, bool, SpatOptions&) )( &SpatRaster::init ), "init fun") .method("initv", ( SpatRaster (SpatRaster::*)(std::vector, SpatOptions&) )( &SpatRaster::init ), "init value") .method("is_in", &SpatRaster::is_in) .method("is_in_cells", &SpatRaster::is_in_cells) .method("anynan", &SpatRaster::anynan) .method("nonan", &SpatRaster::nonan) .method("allnan", &SpatRaster::allnan) .method("isnan", &SpatRaster::isnan) .method("countnan", &SpatRaster::countnan) .method("not_na", &SpatRaster::isnotnan) .method("isfinite", &SpatRaster::isfinite) .method("isinfinite", &SpatRaster::isinfinite) .method("is_true", &SpatRaster::is_true) .method("is_false", &SpatRaster::is_false) .method("logic_rast", ( SpatRaster (SpatRaster::*)(SpatRaster, std::string, SpatOptions&) )( &SpatRaster::logic )) .method("logic_numb", ( SpatRaster (SpatRaster::*)(std::vector, std::string, SpatOptions&) )( &SpatRaster::logic )) .method("mask_self", ( SpatRaster (SpatRaster::*)(SpatOptions&) )( &SpatRaster::mask)) .method("mask_raster", ( SpatRaster (SpatRaster::*)(SpatRaster&, bool, std::vector, double, SpatOptions&) )( &SpatRaster::mask)) .method("mask_vector", ( SpatRaster (SpatRaster::*)(SpatVector&, bool, double, bool, SpatOptions&) )( &SpatRaster::mask)) .method("math", &SpatRaster::math) .method("math2", &SpatRaster::math2) .method("modal", &SpatRaster::modal) .method("quantile", &SpatRaster::quantile) .method("rasterize", &SpatRaster::rasterize) .method("rasterizePointsV", ( SpatRaster (SpatRaster::*)(SpatVector&, std::string, std::vector&, bool, double, SpatOptions&) )( &SpatRaster::rasterizePoints)) .method("rasterizePointsXY", ( SpatRaster (SpatRaster::*)(std::vector&, std::vector&, std::string, std::vector&, bool, double, SpatOptions&) )( &SpatRaster::rasterizePoints)) .method("rasterizeLyr", &SpatRaster::rasterizeLyr) .method("rasterizeGeom", &SpatRaster::rasterizeGeom) .method("rasterizeWindow", &SpatRaster::rasterizeWindow) .method("wincircle", &SpatRaster::win_circle) .method("winrect", &SpatRaster::win_rect) .method("rgb2col", &SpatRaster::rgb2col) .method("rgb2hsx", &SpatRaster::rgb2hsx) .method("hsx2rgb", &SpatRaster::hsx2rgb) .method("reverse", &SpatRaster::reverse) .method("rotate", &SpatRaster::rotate) //.method("sampleCells", &SpatRaster::sampleCells, "sampleCells") .method("sampleRegularRaster", &SpatRaster::sampleRegularRaster) .method("sampleRowColRaster", &SpatRaster::sampleRowColRaster) .method("sampleRegularValues", &SpatRaster::sampleRegularValues) .method("sampleRowColValues", &SpatRaster::sampleRowColValues) .method("sampleRandomRaster", &SpatRaster::sampleRandomRaster) .method("sampleRandomValues", &SpatRaster::sampleRandomValues) .method("scale", &SpatRaster::scale) .method("scale_linear", &SpatRaster::scale_linear) .method("shift", &SpatRaster::shift) .method("similarity", &SpatRaster::similarity) .method("terrain", &SpatRaster::terrain) .method("hillshade", &SpatRaster::hillshade) .method("summary", &SpatRaster::summary) .method("summary_numb", &SpatRaster::summary_numb) .method("transpose", &SpatRaster::transpose) .method("trig", &SpatRaster::trig) .method("trim1", &SpatRaster::trim1) .method("trim", &SpatRaster::trim2) .method("unique", &SpatRaster::unique) .method("where", &SpatRaster::where) .method("sieve", &SpatRaster::sieveFilter) .method("view", &SpatRaster::viewshed) .method("proximity", &SpatRaster::proximity) .method("fillNA", &SpatRaster::fillNA) .method("rectify", &SpatRaster::rectify) .method("stretch", &SpatRaster::stretch) .method("warp", &SpatRaster::warper) .method("warp_by_util", &SpatRaster::warper_by_util) .method("resample", &SpatRaster::resample) .method("zonal", &SpatRaster::zonal) .method("zonal_weighted", &SpatRaster::zonal_weighted) .method("zonal_poly", &SpatRaster::zonal_poly) .method("zonal_poly_table", &SpatRaster::zonal_poly_table) .method("zonal_poly_weighted", &SpatRaster::zonal_poly_weighted) // .method("zonal_old", &SpatRaster::zonal_old) .method("watershed2", &SpatRaster::watershed2, "watershed2") //EC 20210311 // EC 20210702 .method("pitfinder2", &SpatRaster::pitfinder2, "pitfinder2") //EC 20220810 // EC 20220810 .method("NIDP2", &SpatRaster::NIDP2, "NIDP2") //EC 20231031 .method("flowAccu2", &SpatRaster::flowAccu2) //, "flowAccu2") //EC 20231031 .method("flowAccu2_weight", &SpatRaster::flowAccu2_weight) //, "flowAccu2_weight") //EC 20231114 ; class_("SpatRasterCollection") .constructor() .constructor, bool, std::vector>() .property("names", &SpatRasterCollection::get_names, &SpatRasterCollection::set_names) .method("deepcopy", &SpatRasterCollection::deepCopy) .method("dims", &SpatRasterCollection::dims) .method("extent", &SpatRasterCollection::getExtent) .method("has_error", &SpatRasterCollection::hasError) .method("has_warning", &SpatRasterCollection::hasWarning) .method("getError", &SpatRasterCollection::getError) .method("getWarnings", &SpatRasterCollection::getWarnings) //.field("messages", &SpatRasterCollection::msg, "messages") .field_readonly("x", &SpatRasterCollection::ds) .method("length", &SpatRasterCollection::size) .method("resize", &SpatRasterCollection::resize) .method("erase", &SpatRasterCollection::erase) .method("add", &SpatRasterCollection::push_back) .method("merge", &SpatRasterCollection::merge) .method("mosaic", &SpatRasterCollection::mosaic) .method("morph", &SpatRasterCollection::morph) .method("crop", &SpatRasterCollection::crop) .method("addTag", &SpatRasterCollection::addTag) .method("getTags", &SpatRasterCollection::getTags) .method("make_vrt", &SpatRasterCollection::make_vrt) ; class_("SpatRasterStack") .constructor() .constructor, bool, std::vector>() .constructor() .method("deepcopy", &SpatRasterStack::deepCopy) .method("has_error", &SpatRasterStack::hasError) .method("has_warning", &SpatRasterStack::hasWarning) .method("getError", &SpatRasterStack::getError) .method("getWarnings", &SpatRasterStack::getWarnings) .method("readStart", &SpatRasterStack::readStart) .method("readStop", &SpatRasterStack::readStop) .method("readAll", &SpatRasterStack::readAll) .method("nsds", &SpatRasterStack::nsds) .method("ncol", &SpatRasterStack::ncol) .method("nrow", &SpatRasterStack::nrow) .method("nlyr", &SpatRasterStack::nlyr) .method("res", &SpatRasterStack::resolution) .method("ext", &SpatRasterStack::getExtent) .method("filenames", &SpatRasterStack::filenames) .method("get_crs", &SpatRasterStack::getSRS) .property("names", &SpatRasterStack::get_names, &SpatRasterStack::set_names) .property("long_names", &SpatRasterStack::get_longnames, &SpatRasterStack::set_longnames) .property("units", &SpatRasterStack::get_units, &SpatRasterStack::set_units) .method("add", &SpatRasterStack::push_back) .method("resize", &SpatRasterStack::resize) .method("summary", &SpatRasterStack::summary) .method("summary_numb", &SpatRasterStack::summary_numb) .method("getsds", &SpatRasterStack::getsds) .method("replace", &SpatRasterStack::replace) .method("subset", &SpatRasterStack::subset) .method("collapse", &SpatRasterStack::collapse ) .method("extractCell", &SpatRasterStack::extractCell) .method("extractVector", &SpatRasterStack::extractVector) .method("crop", &SpatRasterStack::crop) .method("addTag", &SpatRasterStack::addTag) .method("getTags", &SpatRasterStack::getTags) ; } /* SpatRaster SQRT() { SpatRaster r = *this; std::transform(r.values.begin(), r.values.end(), r.values.begin(), (double(*)(double)) sqrt); return r; } SpatRaster SQRTfree(SpatRaster* g) { SpatRaster r = *g; std::transform(r.values.begin(), r.values.end(), r.values.begin(), (double(*)(double)) sqrt); return r; } */ terra/src/spatDataframe.h0000644000176200001440000001204614721435173015115 0ustar liggesusers// Copyright (c) 2018-2023 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #ifndef SPATDATAFRAME_GUARD #define SPATDATAFRAME_GUARD #include #include //#include "spatMessages.h" #include "spatBase.h" #include "spatTime.h" #include "spatFactor.h" #include #include class SpatDataFrame { public: SpatDataFrame(); virtual ~SpatDataFrame(){} SpatDataFrame skeleton(); SpatMessages msg; void setError(std::string s) { msg.setError(s); } void addWarning(std::string s) { msg.addWarning(s); } bool hasError() { return msg.has_error; } bool hasWarning() { return msg.has_warning; } std::vector getWarnings() { return msg.getWarnings(); } std::string getError() { return msg.getError(); } std::vector names; std::vector itype; //0 double, 1 long, 2 string, 3 bool, 4 time, 5 factor std::vector iplace; std::vector> dv; std::vector> iv; std::vector> sv; std::vector> bv; std::vector tv; std::vector fv; std::string NAS = "____NA_+"; long NAL = std::numeric_limits::min(); SpatTime_t NAT = std::numeric_limits::min(); unsigned nrow(); unsigned ncol(); SpatDataFrame subset_rows(std::vector range); SpatDataFrame subset_rows(std::vector range); SpatDataFrame subset_cols(std::vector range); SpatDataFrame subset_rows(unsigned i); SpatDataFrame subset_cols(unsigned i); std::vector getD(unsigned i); std::vector getI(unsigned i); std::vector getS(unsigned i); std::vector getB(unsigned i); SpatTime_v getT(unsigned i); SpatFactor getF(unsigned i); std::vector as_string(size_t v); std::vector as_long(size_t v); std::vector as_double(size_t v); double getDvalue(unsigned i, unsigned j); long getIvalue(unsigned i, unsigned j); std::string getSvalue(unsigned i, unsigned j); int8_t getBvalue(unsigned i, unsigned j); SpatTime_t getTvalue(unsigned i, unsigned j); SpatFactor getFvalue(unsigned i, unsigned j); void add_row(); void add_rows(size_t n); //void set_values(std::vector x, std::string name); //void set_values(std::vector x, std::string name); //void set_values(std::vector x, std::string name); void add_column(unsigned dtype, std::string name); bool add_column(std::vector x, std::string name); bool add_column(std::vector x, std::string name); bool add_column(std::vector x, std::string name); bool add_column(std::vector x, std::string name); bool add_column(std::vector x, std::string name); bool add_column(SpatTime_v x, std::string name); bool add_column(SpatFactor x, std::string name); bool add_column_bool(std::vector x, std::string name); bool add_column_bool(std::vector x, std::string name); bool add_column_time(std::vector x, std::string name, std::string step, std::string zone); void insert_column(std::vector, size_t i); void insert_column(std::vector, size_t i); void insert_column(std::vector, size_t i); void insert_column(std::vector, size_t i); void insert_column(SpatTime_v, size_t i); void insert_column(SpatFactor, size_t i); bool remove_column(std::string field); bool remove_column(int i); void resize_rows(unsigned n); void remove_rows(std::vector r); void resize_cols(unsigned n); void reserve(unsigned n); bool rbind(SpatDataFrame &x); bool cbind(SpatDataFrame &x); SpatDataFrame unique_col(int col); std::vector getIndex(int col, SpatDataFrame &x); std::vector get_names(); void set_names(std::vector nms); std::vector get_datatypes(); std::string get_datatype(std::string field); std::string get_datatype(int field); int get_fieldindex(std::string field); std::vector get_timesteps(); std::vector get_timezones(); bool field_exists(std::string field); bool write_dbf(std::string filename, bool overwrite, SpatOptions &opt); std::vector> to_strings(); std::vector one_string(); SpatDataFrame unique(); size_t strwidth(unsigned i); SpatDataFrame sortby(std::string field, bool descending); }; #endif //SPATDATAFRAME_GUARD terra/src/geodesic.c0000644000176200001440000021313314536376240014121 0ustar liggesusers/** * \file geodesic.c * \brief Implementation of the geodesic routines in C * * For the full documentation see geodesic.h. **********************************************************************/ /** @cond SKIP */ /* * This is a C implementation of the geodesic algorithms described in * * C. F. F. Karney, * Algorithms for geodesics, * J. Geodesy 87, 43--55 (2013); * https://doi.org/10.1007/s00190-012-0578-z * Addenda: https://geographiclib.sourceforge.io/geod-addenda.html * * See the comments in geodesic.h for documentation. * * Copyright (c) Charles Karney (2012-2021) and licensed * under the MIT/X11 License. For more information, see * https://geographiclib.sourceforge.io/ */ #include "geodesic.h" #include #include #include #if !defined(__cplusplus) #define nullptr 0 #endif #define GEOGRAPHICLIB_GEODESIC_ORDER 6 #define nA1 GEOGRAPHICLIB_GEODESIC_ORDER #define nC1 GEOGRAPHICLIB_GEODESIC_ORDER #define nC1p GEOGRAPHICLIB_GEODESIC_ORDER #define nA2 GEOGRAPHICLIB_GEODESIC_ORDER #define nC2 GEOGRAPHICLIB_GEODESIC_ORDER #define nA3 GEOGRAPHICLIB_GEODESIC_ORDER #define nA3x nA3 #define nC3 GEOGRAPHICLIB_GEODESIC_ORDER #define nC3x ((nC3 * (nC3 - 1)) / 2) #define nC4 GEOGRAPHICLIB_GEODESIC_ORDER #define nC4x ((nC4 * (nC4 + 1)) / 2) #define nC (GEOGRAPHICLIB_GEODESIC_ORDER + 1) typedef double real; typedef int boolx; static unsigned init = 0; static const int FALSE = 0; static const int TRUE = 1; static unsigned digits, maxit1, maxit2; static real epsilon, realmin, pi, degree, NaN, tiny, tol0, tol1, tol2, tolb, xthresh; static void Init(void) { if (!init) { digits = DBL_MANT_DIG; epsilon = DBL_EPSILON; realmin = DBL_MIN; #if defined(M_PI) pi = M_PI; #else pi = atan2(0.0, -1.0); #endif maxit1 = 20; maxit2 = maxit1 + digits + 10; tiny = sqrt(realmin); tol0 = epsilon; /* Increase multiplier in defn of tol1 from 100 to 200 to fix inverse case * 52.784459512564 0 -52.784459512563990912 179.634407464943777557 * which otherwise failed for Visual Studio 10 (Release and Debug) */ tol1 = 200 * tol0; tol2 = sqrt(tol0); /* Check on bisection interval */ tolb = tol0 * tol2; xthresh = 1000 * tol2; degree = pi/180; NaN = nan("0"); init = 1; } } enum captype { CAP_NONE = 0U, CAP_C1 = 1U<<0, CAP_C1p = 1U<<1, CAP_C2 = 1U<<2, CAP_C3 = 1U<<3, CAP_C4 = 1U<<4, CAP_ALL = 0x1FU, OUT_ALL = 0x7F80U }; static real sq(real x) { return x * x; } static real sumx(real u, real v, real* t) { volatile real s = u + v; volatile real up = s - v; volatile real vpp = s - up; up -= u; vpp -= v; if (t) *t = -(up + vpp); /* error-free sum: * u + v = s + t * = round(u + v) + t */ return s; } static real polyval(int N, const real p[], real x) { real y = N < 0 ? 0 : *p++; while (--N >= 0) y = y * x + *p++; return y; } /* mimic C++ std::min and std::max */ static real minx(real a, real b) { return (b < a) ? b : a; } static real maxx(real a, real b) { return (a < b) ? b : a; } static void swapx(real* x, real* y) { real t = *x; *x = *y; *y = t; } static void norm2(real* sinx, real* cosx) { #if defined(_MSC_VER) && defined(_M_IX86) /* hypot for Visual Studio (A=win32) fails monotonicity, e.g., with * x = 0.6102683302836215 * y1 = 0.7906090004346522 * y2 = y1 + 1e-16 * the test * hypot(x, y2) >= hypot(x, y1) * fails. See also * https://bugs.python.org/issue43088 */ real r = sqrt(*sinx * *sinx + *cosx * *cosx); #else real r = hypot(*sinx, *cosx); #endif *sinx /= r; *cosx /= r; } static real AngNormalize(real x) { x = remainder(x, (real)(360)); return x != -180 ? x : 180; } static real LatFix(real x) { return fabs(x) > 90 ? NaN : x; } static real AngDiff(real x, real y, real* e) { real t, d = AngNormalize(sumx(AngNormalize(-x), AngNormalize(y), &t)); /* Here y - x = d + t (mod 360), exactly, where d is in (-180,180] and * abs(t) <= eps (eps = 2^-45 for doubles). The only case where the * addition of t takes the result outside the range (-180,180] is d = 180 * and t > 0. The case, d = -180 + eps, t = -eps, can't happen, since * sum would have returned the exact result in such a case (i.e., given t * = 0). */ return sumx(d == 180 && t > 0 ? -180 : d, t, e); } static real AngRound(real x) { const real z = 1/(real)(16); volatile real y; if (x == 0) return 0; y = fabs(x); /* The compiler mustn't "simplify" z - (z - y) to y */ y = y < z ? z - (z - y) : y; return x < 0 ? -y : y; } static void sincosdx(real x, real* sinx, real* cosx) { /* In order to minimize round-off errors, this function exactly reduces * the argument to the range [-45, 45] before converting it to radians. */ real r, s, c; int q = 0; r = remquo(x, (real)(90), &q); /* now abs(r) <= 45 */ r *= degree; /* Possibly could call the gnu extension sincos */ s = sin(r); c = cos(r); switch ((unsigned)q & 3U) { case 0U: *sinx = s; *cosx = c; break; case 1U: *sinx = c; *cosx = -s; break; case 2U: *sinx = -s; *cosx = -c; break; default: *sinx = -c; *cosx = s; break; /* case 3U */ } if (x != 0) { *sinx += (real)(0); *cosx += (real)(0); } } static real atan2dx(real y, real x) { /* In order to minimize round-off errors, this function rearranges the * arguments so that result of atan2 is in the range [-pi/4, pi/4] before * converting it to degrees and mapping the result to the correct * quadrant. */ int q = 0; real ang; if (fabs(y) > fabs(x)) { swapx(&x, &y); q = 2; } if (x < 0) { x = -x; ++q; } /* here x >= 0 and x >= abs(y), so angle is in [-pi/4, pi/4] */ ang = atan2(y, x) / degree; switch (q) { /* Note that atan2d(-0.0, 1.0) will return -0. However, we expect that * atan2d will not be called with y = -0. If need be, include * * case 0: ang = 0 + ang; break; */ case 1: ang = (y >= 0 ? 180 : -180) - ang; break; case 2: ang = 90 - ang; break; case 3: ang = -90 + ang; break; default: break; } return ang; } static void A3coeff(struct geod_geodesic* g); static void C3coeff(struct geod_geodesic* g); static void C4coeff(struct geod_geodesic* g); static real SinCosSeries(boolx sinp, real sinx, real cosx, const real c[], int n); static void Lengths(const struct geod_geodesic* g, real eps, real sig12, real ssig1, real csig1, real dn1, real ssig2, real csig2, real dn2, real cbet1, real cbet2, real* ps12b, real* pm12b, real* pm0, real* pM12, real* pM21, /* Scratch area of the right size */ real Ca[]); static real Astroid(real x, real y); static real InverseStart(const struct geod_geodesic* g, real sbet1, real cbet1, real dn1, real sbet2, real cbet2, real dn2, real lam12, real slam12, real clam12, real* psalp1, real* pcalp1, /* Only updated if return val >= 0 */ real* psalp2, real* pcalp2, /* Only updated for short lines */ real* pdnm, /* Scratch area of the right size */ real Ca[]); static real Lambda12(const struct geod_geodesic* g, real sbet1, real cbet1, real dn1, real sbet2, real cbet2, real dn2, real salp1, real calp1, real slam120, real clam120, real* psalp2, real* pcalp2, real* psig12, real* pssig1, real* pcsig1, real* pssig2, real* pcsig2, real* peps, real* pdomg12, boolx diffp, real* pdlam12, /* Scratch area of the right size */ real Ca[]); static real A3f(const struct geod_geodesic* g, real eps); static void C3f(const struct geod_geodesic* g, real eps, real c[]); static void C4f(const struct geod_geodesic* g, real eps, real c[]); static real A1m1f(real eps); static void C1f(real eps, real c[]); static void C1pf(real eps, real c[]); static real A2m1f(real eps); static void C2f(real eps, real c[]); static int transit(real lon1, real lon2); static int transitdirect(real lon1, real lon2); static void accini(real s[]); static void acccopy(const real s[], real t[]); static void accadd(real s[], real y); static real accsum(const real s[], real y); static void accneg(real s[]); static void accrem(real s[], real y); static real areareduceA(real area[], real area0, int crossings, boolx reverse, boolx sign); static real areareduceB(real area, real area0, int crossings, boolx reverse, boolx sign); void geod_init(struct geod_geodesic* g, real a, real f) { if (!init) Init(); g->a = a; g->f = f; g->f1 = 1 - g->f; g->e2 = g->f * (2 - g->f); g->ep2 = g->e2 / sq(g->f1); /* e2 / (1 - e2) */ g->n = g->f / ( 2 - g->f); g->b = g->a * g->f1; g->c2 = (sq(g->a) + sq(g->b) * (g->e2 == 0 ? 1 : (g->e2 > 0 ? atanh(sqrt(g->e2)) : atan(sqrt(-g->e2))) / sqrt(fabs(g->e2))))/2; /* authalic radius squared */ /* The sig12 threshold for "really short". Using the auxiliary sphere * solution with dnm computed at (bet1 + bet2) / 2, the relative error in the * azimuth consistency check is sig12^2 * abs(f) * min(1, 1-f/2) / 2. (Error * measured for 1/100 < b/a < 100 and abs(f) >= 1/1000. For a given f and * sig12, the max error occurs for lines near the pole. If the old rule for * computing dnm = (dn1 + dn2)/2 is used, then the error increases by a * factor of 2.) Setting this equal to epsilon gives sig12 = etol2. Here * 0.1 is a safety factor (error decreased by 100) and max(0.001, abs(f)) * stops etol2 getting too large in the nearly spherical case. */ g->etol2 = 0.1 * tol2 / sqrt( maxx((real)(0.001), fabs(g->f)) * minx((real)(1), 1 - g->f/2) / 2 ); A3coeff(g); C3coeff(g); C4coeff(g); } static void geod_lineinit_int(struct geod_geodesicline* l, const struct geod_geodesic* g, real lat1, real lon1, real azi1, real salp1, real calp1, unsigned caps) { real cbet1, sbet1, eps; l->a = g->a; l->f = g->f; l->b = g->b; l->c2 = g->c2; l->f1 = g->f1; /* If caps is 0 assume the standard direct calculation */ l->caps = (caps ? caps : GEOD_DISTANCE_IN | GEOD_LONGITUDE) | /* always allow latitude and azimuth and unrolling of longitude */ GEOD_LATITUDE | GEOD_AZIMUTH | GEOD_LONG_UNROLL; l->lat1 = LatFix(lat1); l->lon1 = lon1; l->azi1 = azi1; l->salp1 = salp1; l->calp1 = calp1; sincosdx(AngRound(l->lat1), &sbet1, &cbet1); sbet1 *= l->f1; /* Ensure cbet1 = +epsilon at poles */ norm2(&sbet1, &cbet1); cbet1 = maxx(tiny, cbet1); l->dn1 = sqrt(1 + g->ep2 * sq(sbet1)); /* Evaluate alp0 from sin(alp1) * cos(bet1) = sin(alp0), */ l->salp0 = l->salp1 * cbet1; /* alp0 in [0, pi/2 - |bet1|] */ /* Alt: calp0 = hypot(sbet1, calp1 * cbet1). The following * is slightly better (consider the case salp1 = 0). */ l->calp0 = hypot(l->calp1, l->salp1 * sbet1); /* Evaluate sig with tan(bet1) = tan(sig1) * cos(alp1). * sig = 0 is nearest northward crossing of equator. * With bet1 = 0, alp1 = pi/2, we have sig1 = 0 (equatorial line). * With bet1 = pi/2, alp1 = -pi, sig1 = pi/2 * With bet1 = -pi/2, alp1 = 0 , sig1 = -pi/2 * Evaluate omg1 with tan(omg1) = sin(alp0) * tan(sig1). * With alp0 in (0, pi/2], quadrants for sig and omg coincide. * No atan2(0,0) ambiguity at poles since cbet1 = +epsilon. * With alp0 = 0, omg1 = 0 for alp1 = 0, omg1 = pi for alp1 = pi. */ l->ssig1 = sbet1; l->somg1 = l->salp0 * sbet1; l->csig1 = l->comg1 = sbet1 != 0 || l->calp1 != 0 ? cbet1 * l->calp1 : 1; norm2(&l->ssig1, &l->csig1); /* sig1 in (-pi, pi] */ /* norm2(somg1, comg1); -- don't need to normalize! */ l->k2 = sq(l->calp0) * g->ep2; eps = l->k2 / (2 * (1 + sqrt(1 + l->k2)) + l->k2); if (l->caps & CAP_C1) { real s, c; l->A1m1 = A1m1f(eps); C1f(eps, l->C1a); l->B11 = SinCosSeries(TRUE, l->ssig1, l->csig1, l->C1a, nC1); s = sin(l->B11); c = cos(l->B11); /* tau1 = sig1 + B11 */ l->stau1 = l->ssig1 * c + l->csig1 * s; l->ctau1 = l->csig1 * c - l->ssig1 * s; /* Not necessary because C1pa reverts C1a * B11 = -SinCosSeries(TRUE, stau1, ctau1, C1pa, nC1p); */ } if (l->caps & CAP_C1p) C1pf(eps, l->C1pa); if (l->caps & CAP_C2) { l->A2m1 = A2m1f(eps); C2f(eps, l->C2a); l->B21 = SinCosSeries(TRUE, l->ssig1, l->csig1, l->C2a, nC2); } if (l->caps & CAP_C3) { C3f(g, eps, l->C3a); l->A3c = -l->f * l->salp0 * A3f(g, eps); l->B31 = SinCosSeries(TRUE, l->ssig1, l->csig1, l->C3a, nC3-1); } if (l->caps & CAP_C4) { C4f(g, eps, l->C4a); /* Multiplier = a^2 * e^2 * cos(alpha0) * sin(alpha0) */ l->A4 = sq(l->a) * l->calp0 * l->salp0 * g->e2; l->B41 = SinCosSeries(FALSE, l->ssig1, l->csig1, l->C4a, nC4); } l->a13 = l->s13 = NaN; } void geod_lineinit(struct geod_geodesicline* l, const struct geod_geodesic* g, real lat1, real lon1, real azi1, unsigned caps) { real salp1, calp1; azi1 = AngNormalize(azi1); /* Guard against underflow in salp0 */ sincosdx(AngRound(azi1), &salp1, &calp1); geod_lineinit_int(l, g, lat1, lon1, azi1, salp1, calp1, caps); } void geod_gendirectline(struct geod_geodesicline* l, const struct geod_geodesic* g, real lat1, real lon1, real azi1, unsigned flags, real s12_a12, unsigned caps) { geod_lineinit(l, g, lat1, lon1, azi1, caps); geod_gensetdistance(l, flags, s12_a12); } void geod_directline(struct geod_geodesicline* l, const struct geod_geodesic* g, real lat1, real lon1, real azi1, real s12, unsigned caps) { geod_gendirectline(l, g, lat1, lon1, azi1, GEOD_NOFLAGS, s12, caps); } real geod_genposition(const struct geod_geodesicline* l, unsigned flags, real s12_a12, real* plat2, real* plon2, real* pazi2, real* ps12, real* pm12, real* pM12, real* pM21, real* pS12) { real lat2 = 0, lon2 = 0, azi2 = 0, s12 = 0, m12 = 0, M12 = 0, M21 = 0, S12 = 0; /* Avoid warning about uninitialized B12. */ real sig12, ssig12, csig12, B12 = 0, AB1 = 0; real omg12, lam12, lon12; real ssig2, csig2, sbet2, cbet2, somg2, comg2, salp2, calp2, dn2; unsigned outmask = (plat2 ? GEOD_LATITUDE : GEOD_NONE) | (plon2 ? GEOD_LONGITUDE : GEOD_NONE) | (pazi2 ? GEOD_AZIMUTH : GEOD_NONE) | (ps12 ? GEOD_DISTANCE : GEOD_NONE) | (pm12 ? GEOD_REDUCEDLENGTH : GEOD_NONE) | (pM12 || pM21 ? GEOD_GEODESICSCALE : GEOD_NONE) | (pS12 ? GEOD_AREA : GEOD_NONE); outmask &= l->caps & OUT_ALL; if (!( (flags & GEOD_ARCMODE || (l->caps & (GEOD_DISTANCE_IN & OUT_ALL))) )) /* Impossible distance calculation requested */ return NaN; if (flags & GEOD_ARCMODE) { /* Interpret s12_a12 as spherical arc length */ sig12 = s12_a12 * degree; sincosdx(s12_a12, &ssig12, &csig12); } else { /* Interpret s12_a12 as distance */ real tau12 = s12_a12 / (l->b * (1 + l->A1m1)), s = sin(tau12), c = cos(tau12); /* tau2 = tau1 + tau12 */ B12 = - SinCosSeries(TRUE, l->stau1 * c + l->ctau1 * s, l->ctau1 * c - l->stau1 * s, l->C1pa, nC1p); sig12 = tau12 - (B12 - l->B11); ssig12 = sin(sig12); csig12 = cos(sig12); if (fabs(l->f) > 0.01) { /* Reverted distance series is inaccurate for |f| > 1/100, so correct * sig12 with 1 Newton iteration. The following table shows the * approximate maximum error for a = WGS_a() and various f relative to * GeodesicExact. * erri = the error in the inverse solution (nm) * errd = the error in the direct solution (series only) (nm) * errda = the error in the direct solution (series + 1 Newton) (nm) * * f erri errd errda * -1/5 12e6 1.2e9 69e6 * -1/10 123e3 12e6 765e3 * -1/20 1110 108e3 7155 * -1/50 18.63 200.9 27.12 * -1/100 18.63 23.78 23.37 * -1/150 18.63 21.05 20.26 * 1/150 22.35 24.73 25.83 * 1/100 22.35 25.03 25.31 * 1/50 29.80 231.9 30.44 * 1/20 5376 146e3 10e3 * 1/10 829e3 22e6 1.5e6 * 1/5 157e6 3.8e9 280e6 */ real serr; ssig2 = l->ssig1 * csig12 + l->csig1 * ssig12; csig2 = l->csig1 * csig12 - l->ssig1 * ssig12; B12 = SinCosSeries(TRUE, ssig2, csig2, l->C1a, nC1); serr = (1 + l->A1m1) * (sig12 + (B12 - l->B11)) - s12_a12 / l->b; sig12 = sig12 - serr / sqrt(1 + l->k2 * sq(ssig2)); ssig12 = sin(sig12); csig12 = cos(sig12); /* Update B12 below */ } } /* sig2 = sig1 + sig12 */ ssig2 = l->ssig1 * csig12 + l->csig1 * ssig12; csig2 = l->csig1 * csig12 - l->ssig1 * ssig12; dn2 = sqrt(1 + l->k2 * sq(ssig2)); if (outmask & (GEOD_DISTANCE | GEOD_REDUCEDLENGTH | GEOD_GEODESICSCALE)) { if (flags & GEOD_ARCMODE || fabs(l->f) > 0.01) B12 = SinCosSeries(TRUE, ssig2, csig2, l->C1a, nC1); AB1 = (1 + l->A1m1) * (B12 - l->B11); } /* sin(bet2) = cos(alp0) * sin(sig2) */ sbet2 = l->calp0 * ssig2; /* Alt: cbet2 = hypot(csig2, salp0 * ssig2); */ cbet2 = hypot(l->salp0, l->calp0 * csig2); if (cbet2 == 0) /* I.e., salp0 = 0, csig2 = 0. Break the degeneracy in this case */ cbet2 = csig2 = tiny; /* tan(alp0) = cos(sig2)*tan(alp2) */ salp2 = l->salp0; calp2 = l->calp0 * csig2; /* No need to normalize */ if (outmask & GEOD_DISTANCE) s12 = (flags & GEOD_ARCMODE) ? l->b * ((1 + l->A1m1) * sig12 + AB1) : s12_a12; if (outmask & GEOD_LONGITUDE) { real E = copysign(1, l->salp0); /* east or west going? */ /* tan(omg2) = sin(alp0) * tan(sig2) */ somg2 = l->salp0 * ssig2; comg2 = csig2; /* No need to normalize */ /* omg12 = omg2 - omg1 */ omg12 = (flags & GEOD_LONG_UNROLL) ? E * (sig12 - (atan2( ssig2, csig2) - atan2( l->ssig1, l->csig1)) + (atan2(E * somg2, comg2) - atan2(E * l->somg1, l->comg1))) : atan2(somg2 * l->comg1 - comg2 * l->somg1, comg2 * l->comg1 + somg2 * l->somg1); lam12 = omg12 + l->A3c * ( sig12 + (SinCosSeries(TRUE, ssig2, csig2, l->C3a, nC3-1) - l->B31)); lon12 = lam12 / degree; lon2 = (flags & GEOD_LONG_UNROLL) ? l->lon1 + lon12 : AngNormalize(AngNormalize(l->lon1) + AngNormalize(lon12)); } if (outmask & GEOD_LATITUDE) lat2 = atan2dx(sbet2, l->f1 * cbet2); if (outmask & GEOD_AZIMUTH) azi2 = atan2dx(salp2, calp2); if (outmask & (GEOD_REDUCEDLENGTH | GEOD_GEODESICSCALE)) { real B22 = SinCosSeries(TRUE, ssig2, csig2, l->C2a, nC2), AB2 = (1 + l->A2m1) * (B22 - l->B21), J12 = (l->A1m1 - l->A2m1) * sig12 + (AB1 - AB2); if (outmask & GEOD_REDUCEDLENGTH) /* Add parens around (csig1 * ssig2) and (ssig1 * csig2) to ensure * accurate cancellation in the case of coincident points. */ m12 = l->b * ((dn2 * (l->csig1 * ssig2) - l->dn1 * (l->ssig1 * csig2)) - l->csig1 * csig2 * J12); if (outmask & GEOD_GEODESICSCALE) { real t = l->k2 * (ssig2 - l->ssig1) * (ssig2 + l->ssig1) / (l->dn1 + dn2); M12 = csig12 + (t * ssig2 - csig2 * J12) * l->ssig1 / l->dn1; M21 = csig12 - (t * l->ssig1 - l->csig1 * J12) * ssig2 / dn2; } } if (outmask & GEOD_AREA) { real B42 = SinCosSeries(FALSE, ssig2, csig2, l->C4a, nC4); real salp12, calp12; if (l->calp0 == 0 || l->salp0 == 0) { /* alp12 = alp2 - alp1, used in atan2 so no need to normalize */ salp12 = salp2 * l->calp1 - calp2 * l->salp1; calp12 = calp2 * l->calp1 + salp2 * l->salp1; } else { /* tan(alp) = tan(alp0) * sec(sig) * tan(alp2-alp1) = (tan(alp2) -tan(alp1)) / (tan(alp2)*tan(alp1)+1) * = calp0 * salp0 * (csig1-csig2) / (salp0^2 + calp0^2 * csig1*csig2) * If csig12 > 0, write * csig1 - csig2 = ssig12 * (csig1 * ssig12 / (1 + csig12) + ssig1) * else * csig1 - csig2 = csig1 * (1 - csig12) + ssig12 * ssig1 * No need to normalize */ salp12 = l->calp0 * l->salp0 * (csig12 <= 0 ? l->csig1 * (1 - csig12) + ssig12 * l->ssig1 : ssig12 * (l->csig1 * ssig12 / (1 + csig12) + l->ssig1)); calp12 = sq(l->salp0) + sq(l->calp0) * l->csig1 * csig2; } S12 = l->c2 * atan2(salp12, calp12) + l->A4 * (B42 - l->B41); } /* In the pattern * * if ((outmask & GEOD_XX) && pYY) * *pYY = YY; * * the second check "&& pYY" is redundant. It's there to make the CLang * static analyzer happy. */ if ((outmask & GEOD_LATITUDE) && plat2) *plat2 = lat2; if ((outmask & GEOD_LONGITUDE) && plon2) *plon2 = lon2; if ((outmask & GEOD_AZIMUTH) && pazi2) *pazi2 = azi2; if ((outmask & GEOD_DISTANCE) && ps12) *ps12 = s12; if ((outmask & GEOD_REDUCEDLENGTH) && pm12) *pm12 = m12; if (outmask & GEOD_GEODESICSCALE) { if (pM12) *pM12 = M12; if (pM21) *pM21 = M21; } if ((outmask & GEOD_AREA) && pS12) *pS12 = S12; return (flags & GEOD_ARCMODE) ? s12_a12 : sig12 / degree; } void geod_setdistance(struct geod_geodesicline* l, real s13) { l->s13 = s13; l->a13 = geod_genposition(l, GEOD_NOFLAGS, l->s13, nullptr, nullptr, nullptr, nullptr, nullptr, nullptr, nullptr, nullptr); } static void geod_setarc(struct geod_geodesicline* l, real a13) { l->a13 = a13; l->s13 = NaN; geod_genposition(l, GEOD_ARCMODE, l->a13, nullptr, nullptr, nullptr, &l->s13, nullptr, nullptr, nullptr, nullptr); } void geod_gensetdistance(struct geod_geodesicline* l, unsigned flags, real s13_a13) { (flags & GEOD_ARCMODE) ? geod_setarc(l, s13_a13) : geod_setdistance(l, s13_a13); } void geod_position(const struct geod_geodesicline* l, real s12, real* plat2, real* plon2, real* pazi2) { geod_genposition(l, FALSE, s12, plat2, plon2, pazi2, nullptr, nullptr, nullptr, nullptr, nullptr); } real geod_gendirect(const struct geod_geodesic* g, real lat1, real lon1, real azi1, unsigned flags, real s12_a12, real* plat2, real* plon2, real* pazi2, real* ps12, real* pm12, real* pM12, real* pM21, real* pS12) { struct geod_geodesicline l; unsigned outmask = (plat2 ? GEOD_LATITUDE : GEOD_NONE) | (plon2 ? GEOD_LONGITUDE : GEOD_NONE) | (pazi2 ? GEOD_AZIMUTH : GEOD_NONE) | (ps12 ? GEOD_DISTANCE : GEOD_NONE) | (pm12 ? GEOD_REDUCEDLENGTH : GEOD_NONE) | (pM12 || pM21 ? GEOD_GEODESICSCALE : GEOD_NONE) | (pS12 ? GEOD_AREA : GEOD_NONE); geod_lineinit(&l, g, lat1, lon1, azi1, /* Automatically supply GEOD_DISTANCE_IN if necessary */ outmask | ((flags & GEOD_ARCMODE) ? GEOD_NONE : GEOD_DISTANCE_IN)); return geod_genposition(&l, flags, s12_a12, plat2, plon2, pazi2, ps12, pm12, pM12, pM21, pS12); } void geod_direct(const struct geod_geodesic* g, real lat1, real lon1, real azi1, real s12, real* plat2, real* plon2, real* pazi2) { geod_gendirect(g, lat1, lon1, azi1, GEOD_NOFLAGS, s12, plat2, plon2, pazi2, nullptr, nullptr, nullptr, nullptr, nullptr); } static real geod_geninverse_int(const struct geod_geodesic* g, real lat1, real lon1, real lat2, real lon2, real* ps12, real* psalp1, real* pcalp1, real* psalp2, real* pcalp2, real* pm12, real* pM12, real* pM21, real* pS12) { real s12 = 0, m12 = 0, M12 = 0, M21 = 0, S12 = 0; real lon12, lon12s; int latsign, lonsign, swapp; real sbet1, cbet1, sbet2, cbet2, s12x = 0, m12x = 0; real dn1, dn2, lam12, slam12, clam12; real a12 = 0, sig12, calp1 = 0, salp1 = 0, calp2 = 0, salp2 = 0; real Ca[nC]; boolx meridian; /* somg12 > 1 marks that it needs to be calculated */ real omg12 = 0, somg12 = 2, comg12 = 0; unsigned outmask = (ps12 ? GEOD_DISTANCE : GEOD_NONE) | (pm12 ? GEOD_REDUCEDLENGTH : GEOD_NONE) | (pM12 || pM21 ? GEOD_GEODESICSCALE : GEOD_NONE) | (pS12 ? GEOD_AREA : GEOD_NONE); outmask &= OUT_ALL; /* Compute longitude difference (AngDiff does this carefully). Result is * in [-180, 180] but -180 is only for west-going geodesics. 180 is for * east-going and meridional geodesics. */ lon12 = AngDiff(lon1, lon2, &lon12s); /* Make longitude difference positive. */ lonsign = lon12 >= 0 ? 1 : -1; /* If very close to being on the same half-meridian, then make it so. */ lon12 = lonsign * AngRound(lon12); lon12s = AngRound((180 - lon12) - lonsign * lon12s); lam12 = lon12 * degree; if (lon12 > 90) { sincosdx(lon12s, &slam12, &clam12); clam12 = -clam12; } else sincosdx(lon12, &slam12, &clam12); /* If really close to the equator, treat as on equator. */ lat1 = AngRound(LatFix(lat1)); lat2 = AngRound(LatFix(lat2)); /* Swap points so that point with higher (abs) latitude is point 1 * If one latitude is a nan, then it becomes lat1. */ swapp = fabs(lat1) < fabs(lat2) ? -1 : 1; if (swapp < 0) { lonsign *= -1; swapx(&lat1, &lat2); } /* Make lat1 <= 0 */ latsign = lat1 < 0 ? 1 : -1; lat1 *= latsign; lat2 *= latsign; /* Now we have * * 0 <= lon12 <= 180 * -90 <= lat1 <= 0 * lat1 <= lat2 <= -lat1 * * longsign, swapp, latsign register the transformation to bring the * coordinates to this canonical form. In all cases, 1 means no change was * made. We make these transformations so that there are few cases to * check, e.g., on verifying quadrants in atan2. In addition, this * enforces some symmetries in the results returned. */ sincosdx(lat1, &sbet1, &cbet1); sbet1 *= g->f1; /* Ensure cbet1 = +epsilon at poles */ norm2(&sbet1, &cbet1); cbet1 = maxx(tiny, cbet1); sincosdx(lat2, &sbet2, &cbet2); sbet2 *= g->f1; /* Ensure cbet2 = +epsilon at poles */ norm2(&sbet2, &cbet2); cbet2 = maxx(tiny, cbet2); /* If cbet1 < -sbet1, then cbet2 - cbet1 is a sensitive measure of the * |bet1| - |bet2|. Alternatively (cbet1 >= -sbet1), abs(sbet2) + sbet1 is * a better measure. This logic is used in assigning calp2 in Lambda12. * Sometimes these quantities vanish and in that case we force bet2 = +/- * bet1 exactly. An example where is is necessary is the inverse problem * 48.522876735459 0 -48.52287673545898293 179.599720456223079643 * which failed with Visual Studio 10 (Release and Debug) */ if (cbet1 < -sbet1) { if (cbet2 == cbet1) sbet2 = sbet2 < 0 ? sbet1 : -sbet1; } else { if (fabs(sbet2) == -sbet1) cbet2 = cbet1; } dn1 = sqrt(1 + g->ep2 * sq(sbet1)); dn2 = sqrt(1 + g->ep2 * sq(sbet2)); meridian = lat1 == -90 || slam12 == 0; if (meridian) { /* Endpoints are on a single full meridian, so the geodesic might lie on * a meridian. */ real ssig1, csig1, ssig2, csig2; calp1 = clam12; salp1 = slam12; /* Head to the target longitude */ calp2 = 1; salp2 = 0; /* At the target we're heading north */ /* tan(bet) = tan(sig) * cos(alp) */ ssig1 = sbet1; csig1 = calp1 * cbet1; ssig2 = sbet2; csig2 = calp2 * cbet2; /* sig12 = sig2 - sig1 */ sig12 = atan2(maxx((real)(0), csig1 * ssig2 - ssig1 * csig2), csig1 * csig2 + ssig1 * ssig2); Lengths(g, g->n, sig12, ssig1, csig1, dn1, ssig2, csig2, dn2, cbet1, cbet2, &s12x, &m12x, nullptr, (outmask & GEOD_GEODESICSCALE) ? &M12 : nullptr, (outmask & GEOD_GEODESICSCALE) ? &M21 : nullptr, Ca); /* Add the check for sig12 since zero length geodesics might yield m12 < * 0. Test case was * * echo 20.001 0 20.001 0 | GeodSolve -i * * In fact, we will have sig12 > pi/2 for meridional geodesic which is * not a shortest path. */ if (sig12 < 1 || m12x >= 0) { /* Need at least 2, to handle 90 0 90 180 */ if (sig12 < 3 * tiny || // Prevent negative s12 or m12 for short lines (sig12 < tol0 && (s12x < 0 || m12x < 0))) sig12 = m12x = s12x = 0; m12x *= g->b; s12x *= g->b; a12 = sig12 / degree; } else /* m12 < 0, i.e., prolate and too close to anti-podal */ meridian = FALSE; } if (!meridian && sbet1 == 0 && /* and sbet2 == 0 */ /* Mimic the way Lambda12 works with calp1 = 0 */ (g->f <= 0 || lon12s >= g->f * 180)) { /* Geodesic runs along equator */ calp1 = calp2 = 0; salp1 = salp2 = 1; s12x = g->a * lam12; sig12 = omg12 = lam12 / g->f1; m12x = g->b * sin(sig12); if (outmask & GEOD_GEODESICSCALE) M12 = M21 = cos(sig12); a12 = lon12 / g->f1; } else if (!meridian) { /* Now point1 and point2 belong within a hemisphere bounded by a * meridian and geodesic is neither meridional or equatorial. */ /* Figure a starting point for Newton's method */ real dnm = 0; sig12 = InverseStart(g, sbet1, cbet1, dn1, sbet2, cbet2, dn2, lam12, slam12, clam12, &salp1, &calp1, &salp2, &calp2, &dnm, Ca); if (sig12 >= 0) { /* Short lines (InverseStart sets salp2, calp2, dnm) */ s12x = sig12 * g->b * dnm; m12x = sq(dnm) * g->b * sin(sig12 / dnm); if (outmask & GEOD_GEODESICSCALE) M12 = M21 = cos(sig12 / dnm); a12 = sig12 / degree; omg12 = lam12 / (g->f1 * dnm); } else { /* Newton's method. This is a straightforward solution of f(alp1) = * lambda12(alp1) - lam12 = 0 with one wrinkle. f(alp) has exactly one * root in the interval (0, pi) and its derivative is positive at the * root. Thus f(alp) is positive for alp > alp1 and negative for alp < * alp1. During the course of the iteration, a range (alp1a, alp1b) is * maintained which brackets the root and with each evaluation of * f(alp) the range is shrunk, if possible. Newton's method is * restarted whenever the derivative of f is negative (because the new * value of alp1 is then further from the solution) or if the new * estimate of alp1 lies outside (0,pi); in this case, the new starting * guess is taken to be (alp1a + alp1b) / 2. */ real ssig1 = 0, csig1 = 0, ssig2 = 0, csig2 = 0, eps = 0, domg12 = 0; unsigned numit = 0; /* Bracketing range */ real salp1a = tiny, calp1a = 1, salp1b = tiny, calp1b = -1; boolx tripn = FALSE; boolx tripb = FALSE; for (; numit < maxit2; ++numit) { /* the WGS84 test set: mean = 1.47, sd = 1.25, max = 16 * WGS84 and random input: mean = 2.85, sd = 0.60 */ real dv = 0, v = Lambda12(g, sbet1, cbet1, dn1, sbet2, cbet2, dn2, salp1, calp1, slam12, clam12, &salp2, &calp2, &sig12, &ssig1, &csig1, &ssig2, &csig2, &eps, &domg12, numit < maxit1, &dv, Ca); /* Reversed test to allow escape with NaNs */ if (tripb || !(fabs(v) >= (tripn ? 8 : 1) * tol0)) break; /* Update bracketing values */ if (v > 0 && (numit > maxit1 || calp1/salp1 > calp1b/salp1b)) { salp1b = salp1; calp1b = calp1; } else if (v < 0 && (numit > maxit1 || calp1/salp1 < calp1a/salp1a)) { salp1a = salp1; calp1a = calp1; } if (numit < maxit1 && dv > 0) { real dalp1 = -v/dv; real sdalp1 = sin(dalp1), cdalp1 = cos(dalp1), nsalp1 = salp1 * cdalp1 + calp1 * sdalp1; if (nsalp1 > 0 && fabs(dalp1) < pi) { calp1 = calp1 * cdalp1 - salp1 * sdalp1; salp1 = nsalp1; norm2(&salp1, &calp1); /* In some regimes we don't get quadratic convergence because * slope -> 0. So use convergence conditions based on epsilon * instead of sqrt(epsilon). */ tripn = fabs(v) <= 16 * tol0; continue; } } /* Either dv was not positive or updated value was outside legal * range. Use the midpoint of the bracket as the next estimate. * This mechanism is not needed for the WGS84 ellipsoid, but it does * catch problems with more eccentric ellipsoids. Its efficacy is * such for the WGS84 test set with the starting guess set to alp1 = * 90deg: * the WGS84 test set: mean = 5.21, sd = 3.93, max = 24 * WGS84 and random input: mean = 4.74, sd = 0.99 */ salp1 = (salp1a + salp1b)/2; calp1 = (calp1a + calp1b)/2; norm2(&salp1, &calp1); tripn = FALSE; tripb = (fabs(salp1a - salp1) + (calp1a - calp1) < tolb || fabs(salp1 - salp1b) + (calp1 - calp1b) < tolb); } Lengths(g, eps, sig12, ssig1, csig1, dn1, ssig2, csig2, dn2, cbet1, cbet2, &s12x, &m12x, nullptr, (outmask & GEOD_GEODESICSCALE) ? &M12 : nullptr, (outmask & GEOD_GEODESICSCALE) ? &M21 : nullptr, Ca); m12x *= g->b; s12x *= g->b; a12 = sig12 / degree; if (outmask & GEOD_AREA) { /* omg12 = lam12 - domg12 */ real sdomg12 = sin(domg12), cdomg12 = cos(domg12); somg12 = slam12 * cdomg12 - clam12 * sdomg12; comg12 = clam12 * cdomg12 + slam12 * sdomg12; } } } if (outmask & GEOD_DISTANCE) s12 = 0 + s12x; /* Convert -0 to 0 */ if (outmask & GEOD_REDUCEDLENGTH) m12 = 0 + m12x; /* Convert -0 to 0 */ if (outmask & GEOD_AREA) { real /* From Lambda12: sin(alp1) * cos(bet1) = sin(alp0) */ salp0 = salp1 * cbet1, calp0 = hypot(calp1, salp1 * sbet1); /* calp0 > 0 */ real alp12; if (calp0 != 0 && salp0 != 0) { real /* From Lambda12: tan(bet) = tan(sig) * cos(alp) */ ssig1 = sbet1, csig1 = calp1 * cbet1, ssig2 = sbet2, csig2 = calp2 * cbet2, k2 = sq(calp0) * g->ep2, eps = k2 / (2 * (1 + sqrt(1 + k2)) + k2), /* Multiplier = a^2 * e^2 * cos(alpha0) * sin(alpha0). */ A4 = sq(g->a) * calp0 * salp0 * g->e2; real B41, B42; norm2(&ssig1, &csig1); norm2(&ssig2, &csig2); C4f(g, eps, Ca); B41 = SinCosSeries(FALSE, ssig1, csig1, Ca, nC4); B42 = SinCosSeries(FALSE, ssig2, csig2, Ca, nC4); S12 = A4 * (B42 - B41); } else /* Avoid problems with indeterminate sig1, sig2 on equator */ S12 = 0; if (!meridian && somg12 > 1) { somg12 = sin(omg12); comg12 = cos(omg12); } if (!meridian && /* omg12 < 3/4 * pi */ comg12 > -(real)(0.7071) && /* Long difference not too big */ sbet2 - sbet1 < (real)(1.75)) { /* Lat difference not too big */ /* Use tan(Gamma/2) = tan(omg12/2) * * (tan(bet1/2)+tan(bet2/2))/(1+tan(bet1/2)*tan(bet2/2)) * with tan(x/2) = sin(x)/(1+cos(x)) */ real domg12 = 1 + comg12, dbet1 = 1 + cbet1, dbet2 = 1 + cbet2; alp12 = 2 * atan2( somg12 * ( sbet1 * dbet2 + sbet2 * dbet1 ), domg12 * ( sbet1 * sbet2 + dbet1 * dbet2 ) ); } else { /* alp12 = alp2 - alp1, used in atan2 so no need to normalize */ real salp12 = salp2 * calp1 - calp2 * salp1, calp12 = calp2 * calp1 + salp2 * salp1; /* The right thing appears to happen if alp1 = +/-180 and alp2 = 0, viz * salp12 = -0 and alp12 = -180. However this depends on the sign * being attached to 0 correctly. The following ensures the correct * behavior. */ if (salp12 == 0 && calp12 < 0) { salp12 = tiny * calp1; calp12 = -1; } alp12 = atan2(salp12, calp12); } S12 += g->c2 * alp12; S12 *= swapp * lonsign * latsign; /* Convert -0 to 0 */ S12 += 0; } /* Convert calp, salp to azimuth accounting for lonsign, swapp, latsign. */ if (swapp < 0) { swapx(&salp1, &salp2); swapx(&calp1, &calp2); if (outmask & GEOD_GEODESICSCALE) swapx(&M12, &M21); } salp1 *= swapp * lonsign; calp1 *= swapp * latsign; salp2 *= swapp * lonsign; calp2 *= swapp * latsign; if (psalp1) *psalp1 = salp1; if (pcalp1) *pcalp1 = calp1; if (psalp2) *psalp2 = salp2; if (pcalp2) *pcalp2 = calp2; if (outmask & GEOD_DISTANCE) *ps12 = s12; if (outmask & GEOD_REDUCEDLENGTH) *pm12 = m12; if (outmask & GEOD_GEODESICSCALE) { if (pM12) *pM12 = M12; if (pM21) *pM21 = M21; } if (outmask & GEOD_AREA) *pS12 = S12; /* Returned value in [0, 180] */ return a12; } real geod_geninverse(const struct geod_geodesic* g, real lat1, real lon1, real lat2, real lon2, real* ps12, real* pazi1, real* pazi2, real* pm12, real* pM12, real* pM21, real* pS12) { real salp1, calp1, salp2, calp2, a12 = geod_geninverse_int(g, lat1, lon1, lat2, lon2, ps12, &salp1, &calp1, &salp2, &calp2, pm12, pM12, pM21, pS12); if (pazi1) *pazi1 = atan2dx(salp1, calp1); if (pazi2) *pazi2 = atan2dx(salp2, calp2); return a12; } void geod_inverseline(struct geod_geodesicline* l, const struct geod_geodesic* g, real lat1, real lon1, real lat2, real lon2, unsigned caps) { real salp1, calp1, a12 = geod_geninverse_int(g, lat1, lon1, lat2, lon2, nullptr, &salp1, &calp1, nullptr, nullptr, nullptr, nullptr, nullptr, nullptr), azi1 = atan2dx(salp1, calp1); caps = caps ? caps : GEOD_DISTANCE_IN | GEOD_LONGITUDE; /* Ensure that a12 can be converted to a distance */ if (caps & (OUT_ALL & GEOD_DISTANCE_IN)) caps |= GEOD_DISTANCE; geod_lineinit_int(l, g, lat1, lon1, azi1, salp1, calp1, caps); geod_setarc(l, a12); } void geod_inverse(const struct geod_geodesic* g, real lat1, real lon1, real lat2, real lon2, real* ps12, real* pazi1, real* pazi2) { geod_geninverse(g, lat1, lon1, lat2, lon2, ps12, pazi1, pazi2, nullptr, nullptr, nullptr, nullptr); } real SinCosSeries(boolx sinp, real sinx, real cosx, const real c[], int n) { /* Evaluate * y = sinp ? sum(c[i] * sin( 2*i * x), i, 1, n) : * sum(c[i] * cos((2*i+1) * x), i, 0, n-1) * using Clenshaw summation. N.B. c[0] is unused for sin series * Approx operation count = (n + 5) mult and (2 * n + 2) add */ real ar, y0, y1; c += (n + sinp); /* Point to one beyond last element */ ar = 2 * (cosx - sinx) * (cosx + sinx); /* 2 * cos(2 * x) */ y0 = (n & 1) ? *--c : 0; y1 = 0; /* accumulators for sum */ /* Now n is even */ n /= 2; while (n--) { /* Unroll loop x 2, so accumulators return to their original role */ y1 = ar * y0 - y1 + *--c; y0 = ar * y1 - y0 + *--c; } return sinp ? 2 * sinx * cosx * y0 /* sin(2 * x) * y0 */ : cosx * (y0 - y1); /* cos(x) * (y0 - y1) */ } void Lengths(const struct geod_geodesic* g, real eps, real sig12, real ssig1, real csig1, real dn1, real ssig2, real csig2, real dn2, real cbet1, real cbet2, real* ps12b, real* pm12b, real* pm0, real* pM12, real* pM21, /* Scratch area of the right size */ real Ca[]) { real m0 = 0, J12 = 0, A1 = 0, A2 = 0; real Cb[nC]; /* Return m12b = (reduced length)/b; also calculate s12b = distance/b, * and m0 = coefficient of secular term in expression for reduced length. */ boolx redlp = pm12b || pm0 || pM12 || pM21; if (ps12b || redlp) { A1 = A1m1f(eps); C1f(eps, Ca); if (redlp) { A2 = A2m1f(eps); C2f(eps, Cb); m0 = A1 - A2; A2 = 1 + A2; } A1 = 1 + A1; } if (ps12b) { real B1 = SinCosSeries(TRUE, ssig2, csig2, Ca, nC1) - SinCosSeries(TRUE, ssig1, csig1, Ca, nC1); /* Missing a factor of b */ *ps12b = A1 * (sig12 + B1); if (redlp) { real B2 = SinCosSeries(TRUE, ssig2, csig2, Cb, nC2) - SinCosSeries(TRUE, ssig1, csig1, Cb, nC2); J12 = m0 * sig12 + (A1 * B1 - A2 * B2); } } else if (redlp) { /* Assume here that nC1 >= nC2 */ int l; for (l = 1; l <= nC2; ++l) Cb[l] = A1 * Ca[l] - A2 * Cb[l]; J12 = m0 * sig12 + (SinCosSeries(TRUE, ssig2, csig2, Cb, nC2) - SinCosSeries(TRUE, ssig1, csig1, Cb, nC2)); } if (pm0) *pm0 = m0; if (pm12b) /* Missing a factor of b. * Add parens around (csig1 * ssig2) and (ssig1 * csig2) to ensure * accurate cancellation in the case of coincident points. */ *pm12b = dn2 * (csig1 * ssig2) - dn1 * (ssig1 * csig2) - csig1 * csig2 * J12; if (pM12 || pM21) { real csig12 = csig1 * csig2 + ssig1 * ssig2; real t = g->ep2 * (cbet1 - cbet2) * (cbet1 + cbet2) / (dn1 + dn2); if (pM12) *pM12 = csig12 + (t * ssig2 - csig2 * J12) * ssig1 / dn1; if (pM21) *pM21 = csig12 - (t * ssig1 - csig1 * J12) * ssig2 / dn2; } } real Astroid(real x, real y) { /* Solve k^4+2*k^3-(x^2+y^2-1)*k^2-2*y^2*k-y^2 = 0 for positive root k. * This solution is adapted from Geocentric::Reverse. */ real k; real p = sq(x), q = sq(y), r = (p + q - 1) / 6; if ( !(q == 0 && r <= 0) ) { real /* Avoid possible division by zero when r = 0 by multiplying equations * for s and t by r^3 and r, resp. */ S = p * q / 4, /* S = r^3 * s */ r2 = sq(r), r3 = r * r2, /* The discriminant of the quadratic equation for T3. This is zero on * the evolute curve p^(1/3)+q^(1/3) = 1 */ disc = S * (S + 2 * r3); real u = r; real v, uv, w; if (disc >= 0) { real T3 = S + r3, T; /* Pick the sign on the sqrt to maximize abs(T3). This minimizes loss * of precision due to cancellation. The result is unchanged because * of the way the T is used in definition of u. */ T3 += T3 < 0 ? -sqrt(disc) : sqrt(disc); /* T3 = (r * t)^3 */ /* N.B. cbrt always returns the real root. cbrt(-8) = -2. */ T = cbrt(T3); /* T = r * t */ /* T can be zero; but then r2 / T -> 0. */ u += T + (T != 0 ? r2 / T : 0); } else { /* T is complex, but the way u is defined the result is real. */ real ang = atan2(sqrt(-disc), -(S + r3)); /* There are three possible cube roots. We choose the root which * avoids cancellation. Note that disc < 0 implies that r < 0. */ u += 2 * r * cos(ang / 3); } v = sqrt(sq(u) + q); /* guaranteed positive */ /* Avoid loss of accuracy when u < 0. */ uv = u < 0 ? q / (v - u) : u + v; /* u+v, guaranteed positive */ w = (uv - q) / (2 * v); /* positive? */ /* Rearrange expression for k to avoid loss of accuracy due to * subtraction. Division by 0 not possible because uv > 0, w >= 0. */ k = uv / (sqrt(uv + sq(w)) + w); /* guaranteed positive */ } else { /* q == 0 && r <= 0 */ /* y = 0 with |x| <= 1. Handle this case directly. * for y small, positive root is k = abs(y)/sqrt(1-x^2) */ k = 0; } return k; } real InverseStart(const struct geod_geodesic* g, real sbet1, real cbet1, real dn1, real sbet2, real cbet2, real dn2, real lam12, real slam12, real clam12, real* psalp1, real* pcalp1, /* Only updated if return val >= 0 */ real* psalp2, real* pcalp2, /* Only updated for short lines */ real* pdnm, /* Scratch area of the right size */ real Ca[]) { real salp1 = 0, calp1 = 0, salp2 = 0, calp2 = 0, dnm = 0; /* Return a starting point for Newton's method in salp1 and calp1 (function * value is -1). If Newton's method doesn't need to be used, return also * salp2 and calp2 and function value is sig12. */ real sig12 = -1, /* Return value */ /* bet12 = bet2 - bet1 in [0, pi); bet12a = bet2 + bet1 in (-pi, 0] */ sbet12 = sbet2 * cbet1 - cbet2 * sbet1, cbet12 = cbet2 * cbet1 + sbet2 * sbet1; real sbet12a; boolx shortline = cbet12 >= 0 && sbet12 < (real)(0.5) && cbet2 * lam12 < (real)(0.5); real somg12, comg12, ssig12, csig12; sbet12a = sbet2 * cbet1 + cbet2 * sbet1; if (shortline) { real sbetm2 = sq(sbet1 + sbet2), omg12; /* sin((bet1+bet2)/2)^2 * = (sbet1 + sbet2)^2 / ((sbet1 + sbet2)^2 + (cbet1 + cbet2)^2) */ sbetm2 /= sbetm2 + sq(cbet1 + cbet2); dnm = sqrt(1 + g->ep2 * sbetm2); omg12 = lam12 / (g->f1 * dnm); somg12 = sin(omg12); comg12 = cos(omg12); } else { somg12 = slam12; comg12 = clam12; } salp1 = cbet2 * somg12; calp1 = comg12 >= 0 ? sbet12 + cbet2 * sbet1 * sq(somg12) / (1 + comg12) : sbet12a - cbet2 * sbet1 * sq(somg12) / (1 - comg12); ssig12 = hypot(salp1, calp1); csig12 = sbet1 * sbet2 + cbet1 * cbet2 * comg12; if (shortline && ssig12 < g->etol2) { /* really short lines */ salp2 = cbet1 * somg12; calp2 = sbet12 - cbet1 * sbet2 * (comg12 >= 0 ? sq(somg12) / (1 + comg12) : 1 - comg12); norm2(&salp2, &calp2); /* Set return value */ sig12 = atan2(ssig12, csig12); } else if (fabs(g->n) > (real)(0.1) || /* No astroid calc if too eccentric */ csig12 >= 0 || ssig12 >= 6 * fabs(g->n) * pi * sq(cbet1)) { /* Nothing to do, zeroth order spherical approximation is OK */ } else { /* Scale lam12 and bet2 to x, y coordinate system where antipodal point * is at origin and singular point is at y = 0, x = -1. */ real y, lamscale, betscale; /* Volatile declaration needed to fix inverse case * 56.320923501171 0 -56.320923501171 179.664747671772880215 * which otherwise fails with g++ 4.4.4 x86 -O3 */ volatile real x; real lam12x = atan2(-slam12, -clam12); /* lam12 - pi */ if (g->f >= 0) { /* In fact f == 0 does not get here */ /* x = dlong, y = dlat */ { real k2 = sq(sbet1) * g->ep2, eps = k2 / (2 * (1 + sqrt(1 + k2)) + k2); lamscale = g->f * cbet1 * A3f(g, eps) * pi; } betscale = lamscale * cbet1; x = lam12x / lamscale; y = sbet12a / betscale; } else { /* f < 0 */ /* x = dlat, y = dlong */ real cbet12a = cbet2 * cbet1 - sbet2 * sbet1, bet12a = atan2(sbet12a, cbet12a); real m12b, m0; /* In the case of lon12 = 180, this repeats a calculation made in * Inverse. */ Lengths(g, g->n, pi + bet12a, sbet1, -cbet1, dn1, sbet2, cbet2, dn2, cbet1, cbet2, nullptr, &m12b, &m0, nullptr, nullptr, Ca); x = -1 + m12b / (cbet1 * cbet2 * m0 * pi); betscale = x < -(real)(0.01) ? sbet12a / x : -g->f * sq(cbet1) * pi; lamscale = betscale / cbet1; y = lam12x / lamscale; } if (y > -tol1 && x > -1 - xthresh) { /* strip near cut */ if (g->f >= 0) { salp1 = minx((real)(1), -(real)(x)); calp1 = - sqrt(1 - sq(salp1)); } else { calp1 = maxx((real)(x > -tol1 ? 0 : -1), (real)(x)); salp1 = sqrt(1 - sq(calp1)); } } else { /* Estimate alp1, by solving the astroid problem. * * Could estimate alpha1 = theta + pi/2, directly, i.e., * calp1 = y/k; salp1 = -x/(1+k); for f >= 0 * calp1 = x/(1+k); salp1 = -y/k; for f < 0 (need to check) * * However, it's better to estimate omg12 from astroid and use * spherical formula to compute alp1. This reduces the mean number of * Newton iterations for astroid cases from 2.24 (min 0, max 6) to 2.12 * (min 0 max 5). The changes in the number of iterations are as * follows: * * change percent * 1 5 * 0 78 * -1 16 * -2 0.6 * -3 0.04 * -4 0.002 * * The histogram of iterations is (m = number of iterations estimating * alp1 directly, n = number of iterations estimating via omg12, total * number of trials = 148605): * * iter m n * 0 148 186 * 1 13046 13845 * 2 93315 102225 * 3 36189 32341 * 4 5396 7 * 5 455 1 * 6 56 0 * * Because omg12 is near pi, estimate work with omg12a = pi - omg12 */ real k = Astroid(x, y); real omg12a = lamscale * ( g->f >= 0 ? -x * k/(1 + k) : -y * (1 + k)/k ); somg12 = sin(omg12a); comg12 = -cos(omg12a); /* Update spherical estimate of alp1 using omg12 instead of lam12 */ salp1 = cbet2 * somg12; calp1 = sbet12a - cbet2 * sbet1 * sq(somg12) / (1 - comg12); } } /* Sanity check on starting guess. Backwards check allows NaN through. */ if (!(salp1 <= 0)) norm2(&salp1, &calp1); else { salp1 = 1; calp1 = 0; } *psalp1 = salp1; *pcalp1 = calp1; if (shortline) *pdnm = dnm; if (sig12 >= 0) { *psalp2 = salp2; *pcalp2 = calp2; } return sig12; } real Lambda12(const struct geod_geodesic* g, real sbet1, real cbet1, real dn1, real sbet2, real cbet2, real dn2, real salp1, real calp1, real slam120, real clam120, real* psalp2, real* pcalp2, real* psig12, real* pssig1, real* pcsig1, real* pssig2, real* pcsig2, real* peps, real* pdomg12, boolx diffp, real* pdlam12, /* Scratch area of the right size */ real Ca[]) { real salp2 = 0, calp2 = 0, sig12 = 0, ssig1 = 0, csig1 = 0, ssig2 = 0, csig2 = 0, eps = 0, domg12 = 0, dlam12 = 0; real salp0, calp0; real somg1, comg1, somg2, comg2, somg12, comg12, lam12; real B312, eta, k2; if (sbet1 == 0 && calp1 == 0) /* Break degeneracy of equatorial line. This case has already been * handled. */ calp1 = -tiny; /* sin(alp1) * cos(bet1) = sin(alp0) */ salp0 = salp1 * cbet1; calp0 = hypot(calp1, salp1 * sbet1); /* calp0 > 0 */ /* tan(bet1) = tan(sig1) * cos(alp1) * tan(omg1) = sin(alp0) * tan(sig1) = tan(omg1)=tan(alp1)*sin(bet1) */ ssig1 = sbet1; somg1 = salp0 * sbet1; csig1 = comg1 = calp1 * cbet1; norm2(&ssig1, &csig1); /* norm2(&somg1, &comg1); -- don't need to normalize! */ /* Enforce symmetries in the case abs(bet2) = -bet1. Need to be careful * about this case, since this can yield singularities in the Newton * iteration. * sin(alp2) * cos(bet2) = sin(alp0) */ salp2 = cbet2 != cbet1 ? salp0 / cbet2 : salp1; /* calp2 = sqrt(1 - sq(salp2)) * = sqrt(sq(calp0) - sq(sbet2)) / cbet2 * and subst for calp0 and rearrange to give (choose positive sqrt * to give alp2 in [0, pi/2]). */ calp2 = cbet2 != cbet1 || fabs(sbet2) != -sbet1 ? sqrt(sq(calp1 * cbet1) + (cbet1 < -sbet1 ? (cbet2 - cbet1) * (cbet1 + cbet2) : (sbet1 - sbet2) * (sbet1 + sbet2))) / cbet2 : fabs(calp1); /* tan(bet2) = tan(sig2) * cos(alp2) * tan(omg2) = sin(alp0) * tan(sig2). */ ssig2 = sbet2; somg2 = salp0 * sbet2; csig2 = comg2 = calp2 * cbet2; norm2(&ssig2, &csig2); /* norm2(&somg2, &comg2); -- don't need to normalize! */ /* sig12 = sig2 - sig1, limit to [0, pi] */ sig12 = atan2(maxx((real)(0), csig1 * ssig2 - ssig1 * csig2), csig1 * csig2 + ssig1 * ssig2); /* omg12 = omg2 - omg1, limit to [0, pi] */ somg12 = maxx((real)(0), comg1 * somg2 - somg1 * comg2); comg12 = comg1 * comg2 + somg1 * somg2; /* eta = omg12 - lam120 */ eta = atan2(somg12 * clam120 - comg12 * slam120, comg12 * clam120 + somg12 * slam120); k2 = sq(calp0) * g->ep2; eps = k2 / (2 * (1 + sqrt(1 + k2)) + k2); C3f(g, eps, Ca); B312 = (SinCosSeries(TRUE, ssig2, csig2, Ca, nC3-1) - SinCosSeries(TRUE, ssig1, csig1, Ca, nC3-1)); domg12 = -g->f * A3f(g, eps) * salp0 * (sig12 + B312); lam12 = eta + domg12; if (diffp) { if (calp2 == 0) dlam12 = - 2 * g->f1 * dn1 / sbet1; else { Lengths(g, eps, sig12, ssig1, csig1, dn1, ssig2, csig2, dn2, cbet1, cbet2, nullptr, &dlam12, nullptr, nullptr, nullptr, Ca); dlam12 *= g->f1 / (calp2 * cbet2); } } *psalp2 = salp2; *pcalp2 = calp2; *psig12 = sig12; *pssig1 = ssig1; *pcsig1 = csig1; *pssig2 = ssig2; *pcsig2 = csig2; *peps = eps; *pdomg12 = domg12; if (diffp) *pdlam12 = dlam12; return lam12; } real A3f(const struct geod_geodesic* g, real eps) { /* Evaluate A3 */ return polyval(nA3 - 1, g->A3x, eps); } void C3f(const struct geod_geodesic* g, real eps, real c[]) { /* Evaluate C3 coeffs * Elements c[1] through c[nC3 - 1] are set */ real mult = 1; int o = 0, l; for (l = 1; l < nC3; ++l) { /* l is index of C3[l] */ int m = nC3 - l - 1; /* order of polynomial in eps */ mult *= eps; c[l] = mult * polyval(m, g->C3x + o, eps); o += m + 1; } } void C4f(const struct geod_geodesic* g, real eps, real c[]) { /* Evaluate C4 coeffs * Elements c[0] through c[nC4 - 1] are set */ real mult = 1; int o = 0, l; for (l = 0; l < nC4; ++l) { /* l is index of C4[l] */ int m = nC4 - l - 1; /* order of polynomial in eps */ c[l] = mult * polyval(m, g->C4x + o, eps); o += m + 1; mult *= eps; } } /* The scale factor A1-1 = mean value of (d/dsigma)I1 - 1 */ real A1m1f(real eps) { static const real coeff[] = { /* (1-eps)*A1-1, polynomial in eps2 of order 3 */ 1, 4, 64, 0, 256, }; int m = nA1/2; real t = polyval(m, coeff, sq(eps)) / coeff[m + 1]; return (t + eps) / (1 - eps); } /* The coefficients C1[l] in the Fourier expansion of B1 */ void C1f(real eps, real c[]) { static const real coeff[] = { /* C1[1]/eps^1, polynomial in eps2 of order 2 */ -1, 6, -16, 32, /* C1[2]/eps^2, polynomial in eps2 of order 2 */ -9, 64, -128, 2048, /* C1[3]/eps^3, polynomial in eps2 of order 1 */ 9, -16, 768, /* C1[4]/eps^4, polynomial in eps2 of order 1 */ 3, -5, 512, /* C1[5]/eps^5, polynomial in eps2 of order 0 */ -7, 1280, /* C1[6]/eps^6, polynomial in eps2 of order 0 */ -7, 2048, }; real eps2 = sq(eps), d = eps; int o = 0, l; for (l = 1; l <= nC1; ++l) { /* l is index of C1p[l] */ int m = (nC1 - l) / 2; /* order of polynomial in eps^2 */ c[l] = d * polyval(m, coeff + o, eps2) / coeff[o + m + 1]; o += m + 2; d *= eps; } } /* The coefficients C1p[l] in the Fourier expansion of B1p */ void C1pf(real eps, real c[]) { static const real coeff[] = { /* C1p[1]/eps^1, polynomial in eps2 of order 2 */ 205, -432, 768, 1536, /* C1p[2]/eps^2, polynomial in eps2 of order 2 */ 4005, -4736, 3840, 12288, /* C1p[3]/eps^3, polynomial in eps2 of order 1 */ -225, 116, 384, /* C1p[4]/eps^4, polynomial in eps2 of order 1 */ -7173, 2695, 7680, /* C1p[5]/eps^5, polynomial in eps2 of order 0 */ 3467, 7680, /* C1p[6]/eps^6, polynomial in eps2 of order 0 */ 38081, 61440, }; real eps2 = sq(eps), d = eps; int o = 0, l; for (l = 1; l <= nC1p; ++l) { /* l is index of C1p[l] */ int m = (nC1p - l) / 2; /* order of polynomial in eps^2 */ c[l] = d * polyval(m, coeff + o, eps2) / coeff[o + m + 1]; o += m + 2; d *= eps; } } /* The scale factor A2-1 = mean value of (d/dsigma)I2 - 1 */ real A2m1f(real eps) { static const real coeff[] = { /* (eps+1)*A2-1, polynomial in eps2 of order 3 */ -11, -28, -192, 0, 256, }; int m = nA2/2; real t = polyval(m, coeff, sq(eps)) / coeff[m + 1]; return (t - eps) / (1 + eps); } /* The coefficients C2[l] in the Fourier expansion of B2 */ void C2f(real eps, real c[]) { static const real coeff[] = { /* C2[1]/eps^1, polynomial in eps2 of order 2 */ 1, 2, 16, 32, /* C2[2]/eps^2, polynomial in eps2 of order 2 */ 35, 64, 384, 2048, /* C2[3]/eps^3, polynomial in eps2 of order 1 */ 15, 80, 768, /* C2[4]/eps^4, polynomial in eps2 of order 1 */ 7, 35, 512, /* C2[5]/eps^5, polynomial in eps2 of order 0 */ 63, 1280, /* C2[6]/eps^6, polynomial in eps2 of order 0 */ 77, 2048, }; real eps2 = sq(eps), d = eps; int o = 0, l; for (l = 1; l <= nC2; ++l) { /* l is index of C2[l] */ int m = (nC2 - l) / 2; /* order of polynomial in eps^2 */ c[l] = d * polyval(m, coeff + o, eps2) / coeff[o + m + 1]; o += m + 2; d *= eps; } } /* The scale factor A3 = mean value of (d/dsigma)I3 */ void A3coeff(struct geod_geodesic* g) { static const real coeff[] = { /* A3, coeff of eps^5, polynomial in n of order 0 */ -3, 128, /* A3, coeff of eps^4, polynomial in n of order 1 */ -2, -3, 64, /* A3, coeff of eps^3, polynomial in n of order 2 */ -1, -3, -1, 16, /* A3, coeff of eps^2, polynomial in n of order 2 */ 3, -1, -2, 8, /* A3, coeff of eps^1, polynomial in n of order 1 */ 1, -1, 2, /* A3, coeff of eps^0, polynomial in n of order 0 */ 1, 1, }; int o = 0, k = 0, j; for (j = nA3 - 1; j >= 0; --j) { /* coeff of eps^j */ int m = nA3 - j - 1 < j ? nA3 - j - 1 : j; /* order of polynomial in n */ g->A3x[k++] = polyval(m, coeff + o, g->n) / coeff[o + m + 1]; o += m + 2; } } /* The coefficients C3[l] in the Fourier expansion of B3 */ void C3coeff(struct geod_geodesic* g) { static const real coeff[] = { /* C3[1], coeff of eps^5, polynomial in n of order 0 */ 3, 128, /* C3[1], coeff of eps^4, polynomial in n of order 1 */ 2, 5, 128, /* C3[1], coeff of eps^3, polynomial in n of order 2 */ -1, 3, 3, 64, /* C3[1], coeff of eps^2, polynomial in n of order 2 */ -1, 0, 1, 8, /* C3[1], coeff of eps^1, polynomial in n of order 1 */ -1, 1, 4, /* C3[2], coeff of eps^5, polynomial in n of order 0 */ 5, 256, /* C3[2], coeff of eps^4, polynomial in n of order 1 */ 1, 3, 128, /* C3[2], coeff of eps^3, polynomial in n of order 2 */ -3, -2, 3, 64, /* C3[2], coeff of eps^2, polynomial in n of order 2 */ 1, -3, 2, 32, /* C3[3], coeff of eps^5, polynomial in n of order 0 */ 7, 512, /* C3[3], coeff of eps^4, polynomial in n of order 1 */ -10, 9, 384, /* C3[3], coeff of eps^3, polynomial in n of order 2 */ 5, -9, 5, 192, /* C3[4], coeff of eps^5, polynomial in n of order 0 */ 7, 512, /* C3[4], coeff of eps^4, polynomial in n of order 1 */ -14, 7, 512, /* C3[5], coeff of eps^5, polynomial in n of order 0 */ 21, 2560, }; int o = 0, k = 0, l, j; for (l = 1; l < nC3; ++l) { /* l is index of C3[l] */ for (j = nC3 - 1; j >= l; --j) { /* coeff of eps^j */ int m = nC3 - j - 1 < j ? nC3 - j - 1 : j; /* order of polynomial in n */ g->C3x[k++] = polyval(m, coeff + o, g->n) / coeff[o + m + 1]; o += m + 2; } } } /* The coefficients C4[l] in the Fourier expansion of I4 */ void C4coeff(struct geod_geodesic* g) { static const real coeff[] = { /* C4[0], coeff of eps^5, polynomial in n of order 0 */ 97, 15015, /* C4[0], coeff of eps^4, polynomial in n of order 1 */ 1088, 156, 45045, /* C4[0], coeff of eps^3, polynomial in n of order 2 */ -224, -4784, 1573, 45045, /* C4[0], coeff of eps^2, polynomial in n of order 3 */ -10656, 14144, -4576, -858, 45045, /* C4[0], coeff of eps^1, polynomial in n of order 4 */ 64, 624, -4576, 6864, -3003, 15015, /* C4[0], coeff of eps^0, polynomial in n of order 5 */ 100, 208, 572, 3432, -12012, 30030, 45045, /* C4[1], coeff of eps^5, polynomial in n of order 0 */ 1, 9009, /* C4[1], coeff of eps^4, polynomial in n of order 1 */ -2944, 468, 135135, /* C4[1], coeff of eps^3, polynomial in n of order 2 */ 5792, 1040, -1287, 135135, /* C4[1], coeff of eps^2, polynomial in n of order 3 */ 5952, -11648, 9152, -2574, 135135, /* C4[1], coeff of eps^1, polynomial in n of order 4 */ -64, -624, 4576, -6864, 3003, 135135, /* C4[2], coeff of eps^5, polynomial in n of order 0 */ 8, 10725, /* C4[2], coeff of eps^4, polynomial in n of order 1 */ 1856, -936, 225225, /* C4[2], coeff of eps^3, polynomial in n of order 2 */ -8448, 4992, -1144, 225225, /* C4[2], coeff of eps^2, polynomial in n of order 3 */ -1440, 4160, -4576, 1716, 225225, /* C4[3], coeff of eps^5, polynomial in n of order 0 */ -136, 63063, /* C4[3], coeff of eps^4, polynomial in n of order 1 */ 1024, -208, 105105, /* C4[3], coeff of eps^3, polynomial in n of order 2 */ 3584, -3328, 1144, 315315, /* C4[4], coeff of eps^5, polynomial in n of order 0 */ -128, 135135, /* C4[4], coeff of eps^4, polynomial in n of order 1 */ -2560, 832, 405405, /* C4[5], coeff of eps^5, polynomial in n of order 0 */ 128, 99099, }; int o = 0, k = 0, l, j; for (l = 0; l < nC4; ++l) { /* l is index of C4[l] */ for (j = nC4 - 1; j >= l; --j) { /* coeff of eps^j */ int m = nC4 - j - 1; /* order of polynomial in n */ g->C4x[k++] = polyval(m, coeff + o, g->n) / coeff[o + m + 1]; o += m + 2; } } } int transit(real lon1, real lon2) { real lon12; /* Return 1 or -1 if crossing prime meridian in east or west direction. * Otherwise return zero. */ /* Compute lon12 the same way as Geodesic::Inverse. */ lon1 = AngNormalize(lon1); lon2 = AngNormalize(lon2); lon12 = AngDiff(lon1, lon2, nullptr); return lon1 <= 0 && lon2 > 0 && lon12 > 0 ? 1 : (lon2 <= 0 && lon1 > 0 && lon12 < 0 ? -1 : 0); } int transitdirect(real lon1, real lon2) { /* Compute exactly the parity of int(ceil(lon2 / 360)) - int(ceil(lon1 / 360)) */ lon1 = remainder(lon1, (real)(720)); lon2 = remainder(lon2, (real)(720)); return ( (lon2 <= 0 && lon2 > -360 ? 1 : 0) - (lon1 <= 0 && lon1 > -360 ? 1 : 0) ); } void accini(real s[]) { /* Initialize an accumulator; this is an array with two elements. */ s[0] = s[1] = 0; } void acccopy(const real s[], real t[]) { /* Copy an accumulator; t = s. */ t[0] = s[0]; t[1] = s[1]; } void accadd(real s[], real y) { /* Add y to an accumulator. */ real u, z = sumx(y, s[1], &u); s[0] = sumx(z, s[0], &s[1]); if (s[0] == 0) s[0] = u; else s[1] = s[1] + u; } real accsum(const real s[], real y) { /* Return accumulator + y (but don't add to accumulator). */ real t[2]; acccopy(s, t); accadd(t, y); return t[0]; } void accneg(real s[]) { /* Negate an accumulator. */ s[0] = -s[0]; s[1] = -s[1]; } void accrem(real s[], real y) { /* Reduce to [-y/2, y/2]. */ s[0] = remainder(s[0], y); accadd(s, (real)(0)); } void geod_polygon_init(struct geod_polygon* p, boolx polylinep) { p->polyline = (polylinep != 0); geod_polygon_clear(p); } void geod_polygon_clear(struct geod_polygon* p) { p->lat0 = p->lon0 = p->lat = p->lon = NaN; accini(p->P); accini(p->A); p->num = p->crossings = 0; } void geod_polygon_addpoint(const struct geod_geodesic* g, struct geod_polygon* p, real lat, real lon) { lon = AngNormalize(lon); if (p->num == 0) { p->lat0 = p->lat = lat; p->lon0 = p->lon = lon; } else { real s12, S12 = 0; /* Initialize S12 to stop Visual Studio warning */ geod_geninverse(g, p->lat, p->lon, lat, lon, &s12, nullptr, nullptr, nullptr, nullptr, nullptr, p->polyline ? nullptr : &S12); accadd(p->P, s12); if (!p->polyline) { accadd(p->A, S12); p->crossings += transit(p->lon, lon); } p->lat = lat; p->lon = lon; } ++p->num; } void geod_polygon_addedge(const struct geod_geodesic* g, struct geod_polygon* p, real azi, real s) { if (p->num) { /* Do nothing is num is zero */ /* Initialize S12 to stop Visual Studio warning. Initialization of lat and * lon is to make CLang static analyzer happy. */ real lat = 0, lon = 0, S12 = 0; geod_gendirect(g, p->lat, p->lon, azi, GEOD_LONG_UNROLL, s, &lat, &lon, nullptr, nullptr, nullptr, nullptr, nullptr, p->polyline ? nullptr : &S12); accadd(p->P, s); if (!p->polyline) { accadd(p->A, S12); p->crossings += transitdirect(p->lon, lon); } p->lat = lat; p->lon = lon; ++p->num; } } unsigned geod_polygon_compute(const struct geod_geodesic* g, const struct geod_polygon* p, boolx reverse, boolx sign, real* pA, real* pP) { real s12, S12, t[2]; if (p->num < 2) { if (pP) *pP = 0; if (!p->polyline && pA) *pA = 0; return p->num; } if (p->polyline) { if (pP) *pP = p->P[0]; return p->num; } geod_geninverse(g, p->lat, p->lon, p->lat0, p->lon0, &s12, nullptr, nullptr, nullptr, nullptr, nullptr, &S12); if (pP) *pP = accsum(p->P, s12); acccopy(p->A, t); accadd(t, S12); if (pA) *pA = areareduceA(t, 4 * pi * g->c2, p->crossings + transit(p->lon, p->lon0), reverse, sign); return p->num; } unsigned geod_polygon_testpoint(const struct geod_geodesic* g, const struct geod_polygon* p, real lat, real lon, boolx reverse, boolx sign, real* pA, real* pP) { real perimeter, tempsum; int crossings, i; unsigned num = p->num + 1; if (num == 1) { if (pP) *pP = 0; if (!p->polyline && pA) *pA = 0; return num; } perimeter = p->P[0]; tempsum = p->polyline ? 0 : p->A[0]; crossings = p->crossings; for (i = 0; i < (p->polyline ? 1 : 2); ++i) { real s12, S12 = 0; /* Initialize S12 to stop Visual Studio warning */ geod_geninverse(g, i == 0 ? p->lat : lat, i == 0 ? p->lon : lon, i != 0 ? p->lat0 : lat, i != 0 ? p->lon0 : lon, &s12, nullptr, nullptr, nullptr, nullptr, nullptr, p->polyline ? nullptr : &S12); perimeter += s12; if (!p->polyline) { tempsum += S12; crossings += transit(i == 0 ? p->lon : lon, i != 0 ? p->lon0 : lon); } } if (pP) *pP = perimeter; if (p->polyline) return num; if (pA) *pA = areareduceB(tempsum, 4 * pi * g->c2, crossings, reverse, sign); return num; } unsigned geod_polygon_testedge(const struct geod_geodesic* g, const struct geod_polygon* p, real azi, real s, boolx reverse, boolx sign, real* pA, real* pP) { real perimeter, tempsum; int crossings; unsigned num = p->num + 1; if (num == 1) { /* we don't have a starting point! */ if (pP) *pP = NaN; if (!p->polyline && pA) *pA = NaN; return 0; } perimeter = p->P[0] + s; if (p->polyline) { if (pP) *pP = perimeter; return num; } tempsum = p->A[0]; crossings = p->crossings; { /* Initialization of lat, lon, and S12 is to make CLang static analyzer * happy. */ real lat = 0, lon = 0, s12, S12 = 0; geod_gendirect(g, p->lat, p->lon, azi, GEOD_LONG_UNROLL, s, &lat, &lon, nullptr, nullptr, nullptr, nullptr, nullptr, &S12); tempsum += S12; crossings += transitdirect(p->lon, lon); geod_geninverse(g, lat, lon, p->lat0, p->lon0, &s12, nullptr, nullptr, nullptr, nullptr, nullptr, &S12); perimeter += s12; tempsum += S12; crossings += transit(lon, p->lon0); } if (pP) *pP = perimeter; if (pA) *pA = areareduceB(tempsum, 4 * pi * g->c2, crossings, reverse, sign); return num; } void geod_polygonarea(const struct geod_geodesic* g, real lats[], real lons[], int n, real* pA, real* pP) { int i; struct geod_polygon p; geod_polygon_init(&p, FALSE); for (i = 0; i < n; ++i) geod_polygon_addpoint(g, &p, lats[i], lons[i]); geod_polygon_compute(g, &p, FALSE, TRUE, pA, pP); } real areareduceA(real area[], real area0, int crossings, boolx reverse, boolx sign) { accrem(area, area0); if (crossings & 1) accadd(area, (area[0] < 0 ? 1 : -1) * area0/2); /* area is with the clockwise sense. If !reverse convert to * counter-clockwise convention. */ if (!reverse) accneg(area); /* If sign put area in (-area0/2, area0/2], else put area in [0, area0) */ if (sign) { if (area[0] > area0/2) accadd(area, -area0); else if (area[0] <= -area0/2) accadd(area, +area0); } else { if (area[0] >= area0) accadd(area, -area0); else if (area[0] < 0) accadd(area, +area0); } return 0 + area[0]; } real areareduceB(real area, real area0, int crossings, boolx reverse, boolx sign) { area = remainder(area, area0); if (crossings & 1) area += (area < 0 ? 1 : -1) * area0/2; /* area is with the clockwise sense. If !reverse convert to * counter-clockwise convention. */ if (!reverse) area *= -1; /* If sign put area in (-area0/2, area0/2], else put area in [0, area0) */ if (sign) { if (area > area0/2) area -= area0; else if (area <= -area0/2) area += area0; } else { if (area >= area0) area -= area0; else if (area < 0) area += area0; } return 0 + area; } /** @endcond */ terra/src/write_ogr.cpp0000644000176200001440000003673714756763132014721 0ustar liggesusers// Copyright (c) 2018-2025 Robert J. Hijmans // // This file is part of the "spat" library. // // spat is free software: you can redistribute it and/or modify it // under the terms of the GNU General Public License as published by // the Free Software Foundation, either version 2 of the License, or // (at your option) any later version. // // spat is distributed in the hope that it will be useful, but // WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with spat. If not, see . #include "spatVector.h" #include #include "string_utils.h" #include #include "vecmath.h" #ifdef useGDAL #include "file_utils.h" #include "ogrsf_frmts.h" bool driverSupports(std::string driver, std::string option) { if (driver == "GPKG") { if (option == "ENCODING") { return false; } } return true; } GDALDataset* SpatVector::write_ogr(std::string filename, std::string lyrname, std::string driver, bool append, bool overwrite, std::vector options) { GDALDataset *poDS = NULL; if (!filename.empty()) { if (file_exists(filename)) { // || path_exists(filename)) { if ((!overwrite) && (!append)) { setError("file exists. Use 'overwrite=TRUE' to overwrite it"); return(poDS); } else { options.push_back("OVERWRITE=YES"); } } else { append = false; } // if (nrow() == 0) { // addWarning("no geometries to write"); //return(poDS); // } } if (append) { #if GDAL_VERSION_MAJOR < 3 setError("GDAL >= 3 required for inserting layers into an existing file"); return(poDS); #endif poDS = static_cast(GDALOpenEx(filename.c_str(), GDAL_OF_VECTOR | GDAL_OF_UPDATE, NULL, NULL, NULL )); std::vector lyrnms; size_t n = poDS->GetLayerCount(); for (size_t i=0; iGetLayer(i); if (poLayer != NULL) { lyrnms.push_back((std::string)poLayer->GetName()); } } if (is_in_vector(lyrname, lyrnms)) { if (!overwrite) { setError("layer exists. Use 'overwrite=TRUE' to overwrite it"); return(poDS); } else { options.push_back("OVERWRITE=YES"); } } } else { GDALDriver *poDriver = GetGDALDriverManager()->GetDriverByName( driver.c_str() ); if ( poDriver == NULL ) { setError( driver + " driver not available"); return poDS; } char **papszMetadata; papszMetadata = poDriver->GetMetadata(); if (!CSLFetchBoolean( papszMetadata, GDAL_DCAP_VECTOR, FALSE)) { setError(driver + " is not a vector format"); return poDS; } if (!CSLFetchBoolean( papszMetadata, GDAL_DCAP_CREATE, FALSE)) { setError("cannot create a "+ driver + " dataset"); return poDS; } poDS = poDriver->Create(filename.c_str(), 0, 0, 0, GDT_Unknown, NULL ); } if( poDS == NULL ) { setError("Creation of output dataset failed"); return poDS; } OGRwkbGeometryType wkb; if (nrow() > 0) { SpatGeomType geomtype = geoms[0].gtype; if (geomtype == points) { wkb = is_multipoint() ? wkbMultiPoint : wkbPoint; } else if (geomtype == lines) { wkb = wkbMultiLineString; } else if (geomtype == polygons) { wkb = wkbMultiPolygon; } else { setError("this geometry type is not supported: " + type()); return poDS; } } else { wkb = wkbUnknown; } std::string s = srs.wkt; OGRSpatialReference *SRS = NULL; if (!s.empty()) { SRS = new OGRSpatialReference; OGRErr err = SRS->SetFromUserInput(s.c_str()); #if GDAL_VERSION_NUM >= 2050000 SRS->SetAxisMappingStrategy(OAMS_TRADITIONAL_GIS_ORDER); #endif if (err != OGRERR_NONE) { setError("crs error"); delete SRS; return poDS; } } size_t nGroupTransactions = 0; OGRLayer *poLayer; char** papszOptions = NULL; if (!options.empty()) { for (size_t i=0; i gopt = strsplit(options[i], "="); if (gopt.size() == 2) { if (gopt[0] == "nGroupTransactions") { try { nGroupTransactions = std::stoi(gopt[1]); } catch (std::invalid_argument &e) { nGroupTransactions = 0; } } else { if (driverSupports(driver, gopt[0])) { papszOptions = CSLSetNameValue(papszOptions, gopt[0].c_str(), gopt[1].c_str() ); } } } } // papszOptions = CSLSetNameValue( papszOptions, "ENCODING", "UTF-8" ); } poLayer = poDS->CreateLayer(lyrname.c_str(), SRS, wkb, papszOptions); CSLDestroy(papszOptions); if( poLayer == NULL ) { setError( "Layer creation failed" ); return poDS; } // if (SRS != NULL) SRS->Release(); if (SRS != NULL) OSRDestroySpatialReference(SRS); std::vector nms = get_names(); std::vector tps = df.get_datatypes(); OGRFieldType otype; int nfields = nms.size(); size_t ngeoms = size(); for (int i=0; i rge = vrange(df.getI(i), true); if ((rge[0] >= -2147483648) && (rge[1] <= 2147483648)) { otype = OFTInteger; } else { otype = OFTInteger64; } } else if (tps[i] == "bool") { otype = OFTInteger; eSubType = OFSTBoolean; } else if (tps[i] == "time") { SpatTime_v tm = df.getT(i); if (tm.step == "days") { otype = OFTDate; } else { otype = OFTDateTime; } } else { otype = OFTString; } OGRFieldDefn oField(nms[i].c_str(), otype); oField.SetSubType(eSubType); if (otype == OFTString) { size_t w = 10; w = std::max(w, df.strwidth(i)); oField.SetWidth(w); } if( poLayer->CreateField( &oField ) != OGRERR_NONE ) { setError( "Field creation failed for: " + nms[i]); return poDS; } } if (ngeoms == 0) { return poDS; } // use a single transaction as in sf // makes a big difference for gpkg by avoiding many INSERTs bool can_do_transaction = poDS->TestCapability(ODsCTransactions); // == TRUE); bool transaction = false; if (can_do_transaction) { transaction = (poDS->StartTransaction() == OGRERR_NONE); if (! transaction) { setError("transaction failed"); return poDS; } } // chunks if (nGroupTransactions == 0) { nGroupTransactions = 50000; } size_t gcntr = 0; long longNA = NA::value; SpatTime_t timeNA = NA::value; for (size_t i=0; iGetLayerDefn() ); for (int j=0; jSetField(j, df.getDvalue(i, j)); } } else if (tps[j] == "long") { long ival = df.getIvalue(i, j); if (ival != longNA) { poFeature->SetField(j, (GIntBig)ival); } } else if (tps[j] == "bool") { int8_t b = df.getBvalue(i, j); if (b < 2) { poFeature->SetField(j, b); } else { poFeature->SetFieldNull(j); } } else if (tps[j] == "time") { SpatTime_t tval = df.getTvalue(i, j); if (tval != timeNA) { std::vector dt = get_date(tval); poFeature->SetField(j, dt[0], dt[1], dt[2], dt[3], dt[4], dt[5], 100); } else { poFeature->SetFieldNull(j); } } else if (tps[j] == "factor") { SpatFactor f = df.getFvalue(i, j); if (f.v[0] != 0) { std::string s = f.getLabel(0); poFeature->SetField(j, f.getLabel(0).c_str()); } } else { std::string s = df.getSvalue(i, j); if (s != df.NAS) { poFeature->SetField(j, df.getSvalue(i, j).c_str()); } } } //r++; // points -- also need to do multi-points OGRPoint pt; if (wkb == wkbPoint) { if (geoms[i].parts.size() > 0) { if (!std::isnan(geoms[i].parts[0].x[0])) { pt.setX( geoms[i].parts[0].x[0] ); pt.setY( geoms[i].parts[0].y[0] ); } } poFeature->SetGeometry( &pt ); } else if (wkb == wkbMultiPoint) { OGRMultiPoint poGeom; for (size_t j=0; jSetGeometry( &poGeom ) != OGRERR_NONE) { setError("cannot set geometry"); return poDS; } // lines } else if (wkb == wkbMultiLineString) { OGRMultiLineString poGeom; for (size_t j=0; jSetGeometry( &poGeom ) != OGRERR_NONE) { setError("cannot set geometry"); return poDS; } // polygons } else if (wkb == wkbMultiPolygon) { SpatGeom g = getGeom(i); OGRMultiPolygon poGeom; for (size_t j=0; jSetGeometry( &poGeom ) != OGRERR_NONE) { setError("cannot set geometry"); return poDS; } } else { setError("Only points, lines and polygons are currently supported"); return poDS; } if( poLayer->CreateFeature( poFeature ) != OGRERR_NONE ) { setError("Failed to create feature"); return poDS; } OGRFeature::DestroyFeature( poFeature ); gcntr++; if (transaction && (gcntr == nGroupTransactions)) { if (poDS->CommitTransaction() != OGRERR_NONE) { poDS->RollbackTransaction(); setError("transaction commit failed"); } gcntr = 0; transaction = (poDS->StartTransaction() == OGRERR_NONE); if (! transaction) { setError("transaction failed"); return poDS; } } } if (transaction && (gcntr>0) && (poDS->CommitTransaction() != OGRERR_NONE)) { poDS->RollbackTransaction(); setError("transaction commit failed"); } return poDS; } bool SpatVector::write(std::string filename, std::string lyrname, std::string driver, bool append, bool overwrite, std::vector options) { // if (nrow() == 0) { // setError("nothing to write"); // return false; // } GDALDataset *poDS = write_ogr(filename, lyrname, driver, append, overwrite, options); if (poDS != NULL) GDALClose( poDS ); if (hasError()) { return false; } return true; } GDALDataset* SpatVector::GDAL_ds() { return write_ogr("", "layer", "Memory", false, true, std::vector()); } bool SpatDataFrame::write_dbf(std::string filename, bool overwrite, SpatOptions &opt) { // filename is here "raster.tif" // to write "raster.tif.vat.dbf" if (!filename.empty()) { if (file_exists(filename) & (!overwrite)) { setError("file exists. Use 'overwrite=TRUE' to overwrite it"); return(false); } if (nrow() == 0) { setError("nothing to write"); return(false); } } std::string fbase = tempFile(opt.get_tempdir(), opt.tmpfile, ""); std::string f = fbase + ".shp"; GDALDriver *poDriver = GetGDALDriverManager()->GetDriverByName( "ESRI Shapefile" ); GDALDataset *poDS = NULL; poDS = poDriver->Create(f.c_str(), 0, 0, 0, GDT_Unknown, NULL ); if( poDS == NULL ) { setError("Creation of output dataset failed" ); return false; } OGRwkbGeometryType wkb = wkbPoint; OGRSpatialReference *SRS = NULL; OGRLayer *poLayer; poLayer = poDS->CreateLayer("dbf", SRS, wkb, NULL ); if( poLayer == NULL ) { setError( "Layer creation failed" ); return false; } std::vector nms = get_names(); std::vector tps = get_datatypes(); OGRFieldType otype; int nfields = nms.size(); for (int i=0; iCreateField( &oField ) != OGRERR_NONE ) { setError( "Field creation failed for: " + nms[i]); return false; } } for (size_t i=0; iGetLayerDefn() ); for (int j=0; jSetField(j, getDvalue(i, j)); } else if (tps[j] == "long") { poFeature->SetField(j, (GIntBig) getIvalue(i, j)); } else { poFeature->SetField(j, getSvalue(i, j).c_str()); } } OGRPoint pt; pt.setX( 0.0 ); pt.setY( 0.0 ); poFeature->SetGeometry( &pt ); if( poLayer->CreateFeature( poFeature ) != OGRERR_NONE ) { setError("Failed to create feature"); return false; } OGRFeature::DestroyFeature( poFeature ); } GDALClose( poDS ); f = fbase + ".dbf"; filename += ".vat.dbf"; // c++17 has file_copy std::ifstream src(f.c_str(), std::ios::binary); std::ofstream dst(filename.c_str(), std::ios::binary); dst << src.rdbuf(); filename.erase(filename.length()-3); filename += "cpg"; std::ofstream cpg; cpg.open (filename.c_str()); cpg << "UTF-8"; cpg.close(); return true; } bool SpatVector::delete_layers(std::string filename, std::vector layers, bool return_error) { if (filename.empty()) { setError("empty filename"); return false; } if (!file_exists(filename)) { setError("file does not exist"); return false; } if (layers.empty()) return(true); GDALDataset *poDS = static_cast(GDALOpenEx(filename.c_str(), GDAL_OF_VECTOR | GDAL_OF_UPDATE, NULL, NULL, NULL )); if( poDS == NULL ) { setError("Cannot open or update this dataset" ); return false; } std::string fails; size_t n = poDS->GetLayerCount(); for (int i =(n-1); i > 0; i--) { size_t m = layers.size(); if (m == 0) break; OGRLayer *poLayer = poDS->GetLayer(i); if (poLayer == NULL) continue; std::string lname = poLayer->GetName(); for (size_t j=0; jDeleteLayer(i); if (err == OGRERR_UNSUPPORTED_OPERATION) { setError("Deleting layer not supported for this file (format / driver)"); GDALClose(poDS); return(false); } if (err != OGRERR_NONE) { if (fails.empty()) { fails = layers[j]; } else { fails += ", " + layers[j]; } } layers.erase(layers.begin() + j); break; } } } GDALClose(poDS); if (!layers.empty()) { fails += concatenate(layers, ", "); } if (!fails.empty()) { if (return_error) { setError("deleting failed for: " + fails); } else { addWarning("deleting failed for: " + fails); } } return true; } #endif terra/src/common.h0000644000176200001440000000005714646556142013636 0ustar liggesusers#include extern std::mt19937 my_rgen; terra/src/watershed_internal.cpp0000644000176200001440000007756014646745037016603 0ustar liggesusers#include "spatRaster.h" #include "watershed_internal.h" // C/C++ code // Author: Ezio Crestaz,Emanuele Cordano // Date: February 2021 - April 2024 // Scope: compute watershed upstream of point i,j // p: pointer to an integer 1D array storing a 2D raster // nx,ny: number of cells in x (longitude) and in y (latitude) // x,y: indexes of cell upstream of which the watershed must be computed // NOTE: the function recursively call itself up to the watershed boundary or raster limit // // // Function: offset // Scope: return offset of a raster cell stored in a 1D integers array with respect to base address // nx,ny: number of cells in x (longitude) and in y (latitude) // x,y: indexes of cell upstream of which the watershed must be computed int offset(int nx, int ny, int x, int y) { return y * nx + x; //according to original Ezio's code BY ROWS //return x * ny + y; // according offset defintion in Rccp for IntergerMatrix // BY COLS } // // Functions: getRow, getCol // Scope: return offset of a raster cell stored in a 1D integers array with respect to base address // nx,ny: number of cells in x (longitude) and in y (latitude) // offset: // NOTE: it assumes the offset is a valid value // int getRow(int nx, int ny, int offset) { return offset/nx;// according to Ezio's original code // BY ROWS //return offset % ny; // according offset definition in Rccp for IntergerMatrix // BY COLS } int getCol(int nx, int ny, int offset) { // according to Ezio's original code return offset % nx;// according to Ezio's original code // BY ROWS //return offset/ny; // according offset definition in Rccp for IntergerMatrix // BY COLS } // Function: inRaster // Scope: check if a given cell is valid or not, that's within the raster // nx,ny: number of cells in x (longitude) and in y (latitude) // x,y: indexes of cell upstream of which the watershed must be computed // bool inRaster(int nx, int ny, int x, int y) { return !(x < 0 || x >= nx || y >= ny || y < 0); } // Function: watershed (version 0, recursive) void watershed(double* p, int nx, int ny, int x, int y, int* pOut) { // static int nCall = 0; // nCall++; ///printf("%d \n", nCall); ///printf("%d %d %d %d \n",nx,ny,x,y); // Set cell under analysis to 1, being part of the watershed // For the first cell it is not granted that it is a valid raster cell *(pOut + offset(nx, ny, x, y)) = 1; // Given the cell under analysis at x,y all 8 bounding cells are processed, checking the following: // 1. the bounding cell must be within the raster, which is not true when the cell under analysis is // on the boundary of the input raster); // 2. the bounding cell in the output raster, that will identify the watershed upstream of the pour point, // must be 0, otherwise it means that it has already been identified as belonging to the watershed and // hence it does not require any further processing; // 3. the bounding cell from the flow direction raster must report a flow direction towards the cell under // analysis. The value change consistently with expected flow direction and ESRI ArcGIS codification // If, and only if, all the above conditions hold true, then the function watershed is called recursively // on the bounding cell. The watershed function itself will return back to the calling function when all // the upstream tree will be investigated and the watershed fully identified. // Bounding raster cell located to the E if (inRaster(nx, ny, x + 1, y) && // !*(pOut + offset(nx, ny, x + 1, y)) && *(p + offset(nx, ny, x + 1, y)) == 16) watershed(p, nx, ny, x + 1, y,pOut); // Bounding raster cell located to the SE if (inRaster(nx, ny, x + 1, y + 1) && // !*(pOut + offset(nx, ny, x + 1, y + 1)) && *(p + offset(nx, ny, x + 1, y + 1)) == 32) watershed(p, nx, ny, x + 1, y + 1, pOut); // Bounding raster cell located to the S if (inRaster(nx, ny, x, y + 1) && // !*(pOut + offset(nx, ny, x, y + 1)) && *(p + offset(nx, ny, x, y + 1)) == 64) watershed(p, nx, ny, x, y + 1, pOut); // Bounding raster cell located to the SW if (inRaster(nx, ny, x - 1, y + 1) && // !*(pOut + offset(nx, ny, x - 1, y + 1)) && *(p + offset(nx, ny, x - 1, y + 1)) == 128) watershed(p, nx, ny, x - 1, y + 1, pOut); // Bounding raster cell located to the W if (inRaster(nx, ny, x - 1, y) && // !*(pOut + offset(nx, ny, x - 1, y)) && *(p + offset(nx, ny, x - 1, y)) == 1) watershed(p, nx, ny, x - 1, y, pOut); // Bounding raster cell located to the NW if (inRaster(nx, ny, x - 1, y - 1) && // !*(pOut + offset(nx, ny, x - 1, y - 1)) && *(p + offset(nx, ny, x - 1, y - 1)) == 2) watershed(p, nx, ny, x - 1, y - 1, pOut); // Bounding raster cell located to the N if (inRaster(nx, ny, x, y - 1) && // !*(pOut + offset(nx, ny, x, y - 1)) && *(p + offset(nx, ny, x, y - 1)) == 4) watershed(p, nx, ny, x, y - 1, pOut); // Bounding raster cell located to the NE if (inRaster(nx, ny, x + 1, y - 1) && // !*(pOut + offset(nx, ny, x + 1, y - 1)) && *(p + offset(nx, ny, x + 1, y - 1)) == 8) watershed(p, nx, ny, x + 1, y - 1, pOut); } // Function: watershed (version 1, see below) // // Scope: compute watershed upstream of point i,j // p: pointer to an integer array storing a 2D raster // nx,ny: number of cells in x (longitude) and in y (latitude) // x,y: indexes of cell upstream of which the watershed must be computed // NOTE: the function is an iterative version of the previous recursive version // Cells to be processed are dinamically managed in a queue, up to the basin boundaries // //void watershed_v1(int* p, int nx, int ny, int x, int y, int* pOut) // void watershed_v1(double* p, int nx, int ny, int pp_offset, int* pOut) void watershed_v1(double* p, int nx, int ny, int pp_offset, double* pOut) { int q[10000]; // Queue of raster cells (offset in memory) to be processed int delta; // Offset in memory from base queue address of a raster cell int n = 0; // Number of raster cells to be processed in queue // int nLoop = 0; // Counter for loops over cells int x,y; ///printf("DEBUG: col=%d,row=%d\n",x,y); // printf("TEST Row, cell 60: %d,%d\n", getRow(nx,ny,60), getCol(nx,ny,60)); // Set raster cell in the output file delta = pp_offset; //offset(nx, ny, x, y); *(pOut + delta) = 1; *(p + delta) = -10; // EC 20210316 // Store raster cell offset in the queue and update number of elements q[0] = delta; n++; ///printf("BEFORE n=%d and size(n)=%d\n", n, (int)sizeof(n)); // Process all pending (until any) raster cells in the queue //for (int i = 0; i < n; i++) { while (n > 0) { //printf("DEBUG: IN THE LOOP n=%d\n", n); // REMOVE PRINTF ?? // nLoop++; // if (nLoop % 10000 == 0) printf("%d ", nLoop); // Print number of internal loops // Pick up top raster cell x = getCol(nx, ny, q[0]); // ATTENTION: base 0 or 1? y = getRow(nx, ny, q[0]); //printf("col=%d row=%d\n", x, y); // Queue just full. This should be better managed incrementing its size dinamically if (n > 9990) { //THIS MUST BE MODIFIED printf("\nAborted! Internal buffer for cells to be processed just full! Size to be incremented!\n"); return; } // Investigate D8 raster cells all around the cell under investigation // Bounding raster cell located to the E if (inRaster(nx, ny, x + 1, y) && *(p + offset(nx, ny, x + 1, y)) == 16) { delta = offset(nx, ny, x + 1, y); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the SE if (inRaster(nx, ny, x + 1, y + 1) && *(p + offset(nx, ny, x + 1, y + 1)) == 32) { delta = offset(nx, ny, x + 1, y + 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the S if (inRaster(nx, ny, x, y + 1) && *(p + offset(nx, ny, x, y + 1)) == 64) { delta = offset(nx, ny, x, y + 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the SW if (inRaster(nx, ny, x - 1, y + 1) && *(p + offset(nx, ny, x - 1, y + 1)) == 128) { delta = offset(nx, ny, x - 1, y + 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the W if (inRaster(nx, ny, x - 1, y) && *(p + offset(nx, ny, x - 1, y)) == 1) { delta = offset(nx, ny, x - 1, y); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the NW if (inRaster(nx, ny, x - 1, y - 1) && *(p + offset(nx, ny, x - 1, y - 1)) == 2) { delta = offset(nx, ny, x - 1, y - 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the N if (inRaster(nx, ny, x, y - 1) && *(p + offset(nx, ny, x, y - 1)) == 4) { delta = offset(nx, ny, x, y - 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the NE if (inRaster(nx, ny, x + 1, y - 1) && *(p + offset(nx, ny, x + 1, y - 1)) == 8) { delta = offset(nx, ny, x + 1, y - 1); *(pOut + delta) = 1; q[n] = delta; n++; } //printf("DEBUG AT THE END - n=%d\n",n); // Just completed the analysis on current raster cell. // Raster cells in queue are shifted up of one position, current raster cell being // the facto removed from the queue, and the number of elements is updated for (int i = 0; i < n; i++) q[i] = q[i + 1]; n--; } } // // Function: resizeQueue // Scope: resize (doubling) an existing queue to store integer offsets of raster cells // Parameters: int* q pointer to existing queue // int n current number of elements // Return a pointer to the resized queue, while preserving previous values // int* resizeQueue(int* q, int n) { int* tmp = (int*)CPLMalloc(2*n*sizeof(int)); //printf("resizeQueue function: %d\n", n); //EC 20231129 // Copy input queue to the new one element by element. Not initialized elements // in the second half of the queue do not need any further action at this stage for (int i = 0; i < n; i++) *(tmp + i) = *(q + i); // Free up the memory allocated for the previous queue (not needed anymore!); CPLFree(q); return tmp; } // // Scope: compute watershed upstream of point i,j // p: pointer to an integer array storing a 2D raster // nx,ny: number of cells in x (longitude) and in y (latitude) // x,y: indexes of cell upstream of which the watershed must be computed // NOTE: the function is an iterative version of the previous recursive version // Current version implements a dinamic queue, up to the basin boundaries // // void watershed_v2(int* p, int nx, int ny, int x, int y, int* pOut) void watershed_v2(double* p, int nx, int ny, int pp_offset, double* pOut) { int* q; // A pointer to a queue of raster cells (offset in memory) to be processed int qSize = 50; // Starting queue size, that can be dinamically incremented if needed int delta; // Offset in memory from base queue address of a raster cell int n = 0; // Number of raster cells to be processed in queue // int nLoop = 0; // Counter for loops over cells int x,y; // printf("DEBUG: col=%d,row=%d\n", x, y); q = (int*)CPLMalloc(sizeof(int)*qSize); // printf("TEST Row, cell 60: %d,%d\n", getRow(nx,ny,60), getCol(nx,ny,60)); // Set raster cell in the output file delta = pp_offset; // delta=offset(nx, ny, x, y); *(pOut + delta) = 1; *(p + delta) = -10; // EC 20210316 // Store raster cell offset in the queue and update number of elements q[0] = delta; n++; // commented by EC 20231129 printf("BEFORE n=%d and size(n)=%ld\n", n, sizeof(n)); // Process all pending (until any) raster cells in the queue while (n > 0) { //printf("DEBUG: IN THE LOOP n=%d\n", n); // nLoop++; // EC 20231129 if (nLoop % 100000 == 0) printf("%d\n", nLoop); // Print number of internal loops //printf("%d\n", n); // Pick up top raster cell x = getCol(nx, ny, q[0]); // ATTENTION: base 0 or 1? y = getRow(nx, ny, q[0]); //printf("col=%d row=%d\n", x, y); // Queue is just full, only 10 raster cells to accomodate if (n > (qSize-10)) { q = resizeQueue(q, qSize); qSize *= 2; // puts("Press any key to continue ... "); // getchar(); } // Investigate D8 raster cells all around the cell under investigation // Bounding raster cell located to the E if (inRaster(nx, ny, x + 1, y) && *(p + offset(nx, ny, x + 1, y)) == 16) { delta = offset(nx, ny, x + 1, y); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the SE if (inRaster(nx, ny, x + 1, y + 1) && *(p + offset(nx, ny, x + 1, y + 1)) == 32) { delta = offset(nx, ny, x + 1, y + 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the S if (inRaster(nx, ny, x, y + 1) && *(p + offset(nx, ny, x, y + 1)) == 64) { delta = offset(nx, ny, x, y + 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the SW if (inRaster(nx, ny, x - 1, y + 1) && *(p + offset(nx, ny, x - 1, y + 1)) == 128) { delta = offset(nx, ny, x - 1, y + 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the W if (inRaster(nx, ny, x - 1, y) && *(p + offset(nx, ny, x - 1, y)) == 1) { delta = offset(nx, ny, x - 1, y); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the NW if (inRaster(nx, ny, x - 1, y - 1) && *(p + offset(nx, ny, x - 1, y - 1)) == 2) { delta = offset(nx, ny, x - 1, y - 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the N if (inRaster(nx, ny, x, y - 1) && *(p + offset(nx, ny, x, y - 1)) == 4) { delta = offset(nx, ny, x, y - 1); *(pOut + delta) = 1; q[n] = delta; n++; } // Bounding raster cell located to the NE if (inRaster(nx, ny, x + 1, y - 1) && *(p + offset(nx, ny, x + 1, y - 1)) == 8) { delta = offset(nx, ny, x + 1, y - 1); *(pOut + delta) = 1; q[n] = delta; n++; } //printf("DEBUG AT THE END - n=%d\n",n); // Just completed the analysis on current raster cell. // Raster cells in queue are shifted up of one position, current raster cell being // the facto removed from the queue, and the number of elements is updated for (int i = 0; i < n; i++) q[i] = q[i + 1]; n--; } CPLFree(q); // Frees memory allocated to the queue (whether is the original or a resized one) } // TO INSERT::: std::vector SpatRaster::readValues(size_t row, size_t nrows, size_t col, size_t ncols){ //Rcpp::IntegerVector SpatRaster::watershed2(int pp_offset,SpatOptions opt) { SpatRaster SpatRaster::watershed2(int pp_offset,SpatOptions &opt) { // DA TESTARE SpatRaster out=geometry(); //std::vector oname="watershed"; //out.setNames(oname); int nx=ncol(); int ny=nrow(); //printf("nx=%d ny=%d\n",nx,ny); //Rcpp::IntegerVector pOut(nx*ny); // https://www.codeguru.com/cpp/cpp/cpp_mfc/stl/article.php/c4027/C-Tutorial-A-Beginners-Guide-to-stdvector-Part-1.htm std::vector p=getValues(0,opt); //EC 20211203 //see https://www.delftstack.com/howto/cpp/how-to-convert-vector-to-array-in-cpp/ //SEE HERE https://stackoverflow.com/questions/26488480/how-can-i-trust-casting-from-double-to-integer //int *q=p.begin(); //int *qOut=pOut.begin(); // https://www.google.com/search?q=how+to+express+NumericVector+as+a+pointer&oq=how+to+express+NumericVector+as+a+pointer&aqs=chrome..69i57j33i160.13306j0j15&sourceid=chrome&ie=UTF-8 // https://dirk.eddelbuettel.com/code/rcpp/Rcpp-quickref.pdf // http://adv-r.had.co.nz/Rcpp.html std::vector pOutv(nx*ny,0); // EC 20210319 pOutv.reserve(nx*ny); // EC 20210319 std::fill(pOutv.begin(), pOutv.end(), trunc(0)); ///see //watershed_v1(&p[0],nx,ny,pp_offset,pOut.begin()); watershed_v2(&p[0],nx,ny,pp_offset,&pOutv[0]); if (!out.writeStart(opt,filenames())) { readStop(); return out; } // out.writeValues(pOutv,0,ny,0,nx); UNTIL 20220725 out.writeValues(pOutv,0,ny); //,0,nx); // LOOK AT writeValuesGDAL out.writeStop(); return out; //return(pOut); } /// 20220809 /// PITFINDER // TO INSERT::: std::vector SpatRaster::readValues(size_t row, size_t nrows, size_t col, size_t ncols){ //Rcpp::IntegerVector SpatRaster::watershed2(int pp_offset,SpatOptions opt) { SpatRaster SpatRaster::pitfinder2(SpatOptions &opt) { // DA TESTARE SpatRaster out=geometry(); //std::vector oname="watershed"; //out.setNames(oname); int nx=ncol(); int ny=nrow(); //printf("nx=%d ny=%d\n",nx,ny); //Rcpp::IntegerVector pOut(nx*ny); // https://www.codeguru.com/cpp/cpp/cpp_mfc/stl/article.php/c4027/C-Tutorial-A-Beginners-Guide-to-stdvector-Part-1.htm std::vector p=getValues(0,opt); //EC 20211203 //see https://www.delftstack.com/howto/cpp/how-to-convert-vector-to-array-in-cpp/ //SEE HERE https://stackoverflow.com/questions/26488480/how-can-i-trust-casting-from-double-to-integer //int *q=p.begin(); //int *qOut=pOut.begin(); // https://www.google.com/search?q=how+to+express+NumericVector+as+a+pointer&oq=how+to+express+NumericVector+as+a+pointer&aqs=chrome..69i57j33i160.13306j0j15&sourceid=chrome&ie=UTF-8 // https://dirk.eddelbuettel.com/code/rcpp/Rcpp-quickref.pdf // http://adv-r.had.co.nz/Rcpp.html std::vector pOutv(nx*ny,0); // EC 20210319 pOutv.reserve(nx*ny); // EC 20210319 std::fill(pOutv.begin(), pOutv.end(), trunc(0)); ///see pitfinder(&p[0],nx,ny,&pOutv[0]); if (!out.writeStart(opt,filenames())) { readStop(); return out; } // out.writeValues(pOutv,0,ny,0,nx); UNTIL 20220725 out.writeValues(pOutv,0,ny); //,0,nx); // LOOK AT writeValuesGDAL out.writeStop(); return out; //return(pOut); } // void watershed_v2(int* p, int nx, int ny, int x, int y, int* pOut) void pitfinder(double* p, int nx, int ny, double* pOut) { //int* q; // A pointer to a queue of raster cells (offset in memory) to be processed // int qSize = 50; // Starting queue size, that can be dinamically incremented if needed //int delta; // Offset in memory from base queue address of a raster cell //int n = 0; // Number of raster cells to be processed in queue // int nLoop = 0; // Counter for loops over cells int x,y; int cnt=1; // int pdown; //hu int // printf("DEBUG: col=%d,row=%d\n", x, y); // #### // // ## TROVARE HLOS / BUCHI !!! // #FROM THE CELL(x): (see help terrein) // ## ## // ## 32 64 128 // ## 16 x 1 // ## 8 4 2 // ##TO THE CELL (y): // ## 2 4 8 // ## 1 y 16 // ##128 64 32 // // #### // // q = (int*)CPLMalloc(sizeof(int)*qSize); // printf("TEST Row, cell 60: %d,%d\n", getRow(nx,ny,60), getCol(nx,ny,60)); // Set raster cell in the output file //delta = pp_offset; // delta=offset(nx, ny, x, y); //*(pOut + delta) = 1; //*(p + delta) = -10; // EC 20210316 // Store raster cell offset in the queue and update number of elements //q[0] = delta; //n++; // printf("BEFORE n=%d and size(n)=%d\n", n, sizeof(n)); for (int i = 0; i < nx*ny; i++) { *(pOut+i)=0; } for (int i = 0; i < nx*ny; i++) { // *(pOut+i)=0; // ## 32 64 128 // ## 16 x 1 // ## 8 4 2 // ## 2 4 8 // ## 1 y 16 // ##128 64 32 x = getCol(nx, ny,i); y = getRow(nx, ny,i); // printf("\n x=%d ",x); // printf("y=%d ",y); // printf("i=%d \n",i); // printf("p=%f ",*(p+i)); // printf("cnt=%d ",cnt); // printf("pout=%f ",*(pOut+i)); if (*(p+i) == 1) { // if (inRaster(nx, ny, x + 1, y)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x + 1, y))); // } if (inRaster(nx, ny, x + 1, y) && *(p+offset(nx, ny, x + 1, y)) == 16) { *(pOut+i)=*(pOut+offset(nx, ny, x + 1, y)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } // *(pOut+i)=1; // TO COMMENT } } else if (*(p+i) == 2) { // if (inRaster(nx, ny, x + 1, y+1)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x + 1, y+1))); // } if (inRaster(nx, ny, x + 1, y+1) && *(p+offset(nx, ny, x + 1, y+1)) == 32) { *(pOut+i)=*(pOut+offset(nx, ny, x + 1, y+1)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } // *(pOut+i)=1; // TO COMMENT } } else if (*(p+i) == 4) { // if (inRaster(nx, ny, x , y-1)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x , y+1))); // } if (inRaster(nx, ny, x, y+1) && *(p+offset(nx, ny, x, y+1)) == 64) { //printf("pit p=%f \n",*(p+i)); *(pOut+i)=*(pOut+offset(nx, ny, x, y+1)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } // *(pOut+i)=1; // TO COMMENT } } else if (*(p+i) == 8) { // if (inRaster(nx, ny, x - 1, y+1)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x - 1, y+1))); // } if (inRaster(nx, ny, x-1, y+1) && *(p+offset(nx, ny, x - 1, y+1)) == 128) { *(pOut+i)=*(pOut+offset(nx, ny, x-1, y+1)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } // *(pOut+i)=1; // TO COMMENT } } else if (*(p+i) == 16) { // if (inRaster(nx, ny, x - 1, y)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x - 1, y))); // } if (inRaster(nx, ny, x-1, y) && *(p+offset(nx, ny, x - 1, y)) == 1) { *(pOut+i)=*(pOut+offset(nx, ny, x-1,y)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } // *(pOut+i)=1; // TO COMMENT } } else if (*(p+i) == 32) { // if (inRaster(nx, ny, x - 1, y-1)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x - 1, y-1))); // } if (inRaster(nx, ny, x - 1, y-1) && *(p+offset(nx, ny, x-1, y-1)) == 2) { *(pOut+i)=*(pOut+offset(nx, ny, x-1,y-1)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } // *(pOut+i)=1; // TO COMMENT } } else if (*(p+i) == 64) { // if (inRaster(nx, ny, x , y-1)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x, y-1))); // } if (inRaster(nx, ny, x, y-1) && *(p+offset(nx, ny, x, y-1)) == 4) { *(pOut+i)=*(pOut+offset(nx, ny, x,y-1)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } } } else if (*(p+i) == 128) { // if (inRaster(nx, ny, x + 1, y-1)) { // printf("pit p=%f ,,",*(p+i)); // printf("pit p=%f ,,",*(p+offset(nx, ny, x + 1, y-1))); // } if (inRaster(nx, ny, x + 1, y-1) && *(p+offset(nx, ny, x + 1, y-1)) == 8) { *(pOut+i)=*(pOut+offset(nx, ny, x+1,y+1)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } } } else if (*(p+i)==0){ if (*(pOut+i)==0 && inRaster(nx, ny, x + 1, y+1)) *(pOut+i)=*(pOut+offset(nx, ny, x+1,y+1)); if (*(pOut+i)==0 && inRaster(nx, ny, x , y+1)) *(pOut+i)=*(pOut+offset(nx, ny, x,y+1)); if (*(pOut+i)==0 && inRaster(nx, ny, x - 1, y+1)) *(pOut+i)=*(pOut+offset(nx, ny, x-1,y+1)); if (*(pOut+i)==0 && inRaster(nx, ny, x + 1, y)) *(pOut+i)=*(pOut+offset(nx, ny, x+1,y)); if (*(pOut+i)==0 && inRaster(nx, ny, x , y)) *(pOut+i)=*(pOut+offset(nx, ny, x,y)); if (*(pOut+i)==0 && inRaster(nx, ny, x - 1, y)) *(pOut+i)=*(pOut+offset(nx, ny, x-1,y)); if (*(pOut+i)==0 && inRaster(nx, ny, x + 1, y-1)) *(pOut+i)=*(pOut+offset(nx, ny, x+1,y-1)); if (*(pOut+i)==0 && inRaster(nx, ny, x , y-1)) *(pOut+i)=*(pOut+offset(nx, ny, x,y-1)); if (*(pOut+i)==0 && inRaster(nx, ny, x - 1, y-1)) *(pOut+i)=*(pOut+offset(nx, ny, x-1,y-1)); if (*(pOut+i)==0) { *(pOut+i)=(double)cnt; cnt++; } } // printf("pout=%f",*(pOut+i)); // printf("cnt=%d \n",cnt); } } /////////////////////////////////////// //// flow accumulation functions ////// /////////////////////////////////////// void NextCell(double* p, int nx, int ny,int* pnext) { //int* q; // A pointer to a queue of raster cells (offset in memory) to be processed // int qSize = 50; // Starting queue size, that can be dinamically incremented if needed //int delta; // Offset in memory from base queue address of a raster cell //int n = 0; // Number of raster cells to be processed in queue // int nLoop = 0; // Counter for loops over cells int i; // ## 32 64 128 // ## 16 x 1 // ## 8 4 2 for (i=0;i SpatRaster::readValues(size_t row, size_t nrows, size_t col, size_t ncols){ //Rcpp::IntegerVector SpatRaster::watershed2(int pp_offset,SpatOptions opt) { SpatRaster SpatRaster::NIDP2(SpatOptions &opt) { // DA TESTARE SpatRaster out=geometry(); //std::vector oname="watershed"; //out.setNames(oname); int nx=ncol(); int ny=nrow(); //printf("nx=%d ny=%d\n",nx,ny); //Rcpp::IntegerVector pOut(nx*ny); // https://www.codeguru.com/cpp/cpp/cpp_mfc/stl/article.php/c4027/C-Tutorial-A-Beginners-Guide-to-stdvector-Part-1.htm std::vector p=getValues(0,opt); //EC 20211203 //see https://www.delftstack.com/howto/cpp/how-to-convert-vector-to-array-in-cpp/ std::vector pOutv(nx*ny,0); std::vector pnext(nx*ny,0); std::vector nidp_value(nx*ny,0); NextCell(&p[0],nx,ny,&pnext[0]); NIDP(&pnext[0],nx,ny,&nidp_value[0]); if (!out.writeStart(opt,filenames())) { readStop(); return out; } // out.writeValues(pOutv,0,ny,0,nx); UNTIL 20220725 out.writeValues(nidp_value,0,ny); //,0,nx); // LOOK AT writeValuesGDAL out.writeStop(); return out; //return(pOut); } // FlowAccu algorithm 5 // Reference: https://link.springer.com/article/10.1007/s11707-018-0725-9 void FlowAccu(int* pnext, int nx, int ny,double* nidp_value,double* flowaccu_value) { int n=0,flowpath_cond; // int x,y; double nAccu=0; for (int i=0;i=2) { *(nidp_value+n)-=1; flowpath_cond=0; } else { n=*(pnext+n); } //printf("n=%d \n",n); //printf("flowpath_cond=%d \n",flowpath_cond); } while (flowpath_cond==1); } } // It is added an array of weight to each cell (e.g. area, averaged precipitation) void FlowAccu_weight(int* pnext, int nx, int ny,double* nidp_value,double* flowaccu_value,double* weight) { int n=0, flowpath_cond; double nAccu=0; for (int i=0;i=2) { *(nidp_value+n)-=1; flowpath_cond=0; } else { n=*(pnext+n); } //printf("n=%d \n",n); //printf("flowpath_cond=%d \n",flowpath_cond); } while (flowpath_cond==1); } } SpatRaster SpatRaster::flowAccu2(SpatOptions &opt) { // DA TESTARE SpatRaster out=geometry(); //std::vector oname="watershed"; //out.setNames(oname); int nx=ncol(); int ny=nrow(); //printf("nx=%d ny=%d\n",nx,ny); //Rcpp::IntegerVector pOut(nx*ny); // https://www.codeguru.com/cpp/cpp/cpp_mfc/stl/article.php/c4027/C-Tutorial-A-Beginners-Guide-to-stdvector-Part-1.htm std::vector p=getValues(0,opt); //EC 20211203 //see https://www.delftstack.com/howto/cpp/how-to-convert-vector-to-array-in-cpp/ std::vector pOutv(nx*ny,0); std::vector pnext(nx*ny,0); std::vector nidp_value(nx*ny,0); std::vector flowaccu_value(nx*ny,1); NextCell(&p[0],nx,ny,&pnext[0]); NIDP(&pnext[0],nx,ny,&nidp_value[0]); FlowAccu(&pnext[0],nx,ny,&nidp_value[0],&flowaccu_value[0]); if (!out.writeStart(opt,filenames())) { readStop(); return out; } // out.writeValues(pOutv,0,ny,0,nx); UNTIL 20220725 out.writeValues(flowaccu_value,0,ny); //,0,nx); // LOOK AT writeValuesGDAL out.writeStop(); return out; //return(pOut); } SpatRaster SpatRaster::flowAccu2_weight(SpatRaster weight,SpatOptions &opt) { // DA TESTARE SpatRaster out=geometry(); //std::vector oname="watershed"; //out.setNames(oname); int nx=ncol(); int ny=nrow(); //printf("nx=%d ny=%d\n",nx,ny); //Rcpp::IntegerVector pOut(nx*ny); // https://www.codeguru.com/cpp/cpp/cpp_mfc/stl/article.php/c4027/C-Tutorial-A-Beginners-Guide-to-stdvector-Part-1.htm std::vector p=getValues(0,opt); //EC 20211203 //see https://www.delftstack.com/howto/cpp/how-to-convert-vector-to-array-in-cpp/ std::vector weigh=weight.getValues(0,opt); std::vector pOutv(nx*ny,0); std::vector pnext(nx*ny,0); std::vector nidp_value(nx*ny,0); std::vector flowaccu_value(nx*ny,1); NextCell(&p[0],nx,ny,&pnext[0]); NIDP(&pnext[0],nx,ny,&nidp_value[0]); FlowAccu_weight(&pnext[0],nx,ny,&nidp_value[0],&flowaccu_value[0],&weigh[0]); if (!out.writeStart(opt,filenames())) { readStop(); return out; } // out.writeValues(pOutv,0,ny,0,nx); UNTIL 20220725 out.writeValues(flowaccu_value,0,ny); //,0,nx); // LOOK AT writeValuesGDAL out.writeStop(); return out; } terra/NAMESPACE0000644000176200001440000001052114756471111012614 0ustar liggesusersuseDynLib(terra, .registration=TRUE) import(methods, Rcpp) exportClasses(SpatExtent, SpatRaster, SpatRasterDataset, SpatRasterCollection, SpatVector, SpatVectorProxy, SpatVectorCollection) exportMethods("[", "[[", "!", "%in%", activeCat, "activeCat<-", "add<-", addCats, adjacent, all.equal, aggregate, allNA, align, animate, anyNA, app, Arith, approximate, as.bool, as.int, as.contour, as.lines, as.points, as.polygons, as.raster, as.array, as.data.frame, as.factor, as.list, as.logical, as.matrix, as.numeric, atan2, atan_2, autocor, barplot, blocks, boundaries, boxplot, buffer, cartogram, categories, cats, catalyze, clamp, clamp_ts, classify, clearance, cellSize, cells, cellFromXY, cellFromRowCol, cellFromRowColCombine, centroids, click, bestMatch, colFromX, colFromCell, colorize, coltab, "coltab<-", combineGeoms, compare, concats, Compare, compareGeom, contour, convHull, countNA, costDist, crds, cover, crop, crosstab, crs, "crs<-", datatype, deepcopy, delaunay, densify, density, depth, "depth<-", describe, diff, disagg, direction, distance, divide, dots, draw, droplevels, elongate, emptyGeoms, erase, extend, ext, "ext<-", extract, extractRange, expanse, fillHoles, fillTime, flip, focal, focal3D, focalPairs, focalReg, focalCpp, focalValues, forceCCW, freq, gaps, geom, geomtype, getTileExtents, global, gridDistance, gridDist, has.colors, has.RGB, has.time, hull, hasMinMax, hasValues, hist, head, identical, ifel, impose, init, image, inext, interpIDW, interpNear, inMemory, inset, interpolate, intersect, is.bool, is.int, is.lonlat, is.rotated, isTRUE, isFALSE, is.empty, is.factor, is.flipped, is.lines, is.points, is.polygons, is.related, is.valid, k_means, lapp, layerCor, levels, "levels<-", linearUnits, lines, Logic, varnames, "varnames<-", logic, longnames, "longnames<-", makeValid, mask, match, math, Math, Math2, mean, median, meta, merge, mergeLines, mergeTime, minCircle, minmax, minRect, modal, mosaic, na.omit, not.na, NAflag, "NAflag<-", nearby, nearest, ncell, ncol, "ncol<-", nlyr, "nlyr<-", noNA, normalize.longitude, nrow, "nrow<-", nseg, nsrc, origin, "origin<-", pairs, panel, patches, perim, persp, plot, plotRGB, plet, prcomp, princomp, RGB, "RGB<-", polys, points, predict, project, quantile, query, rangeFill, rapp, rast, rasterize, rasterizeGeom, rasterizeWin, readStart, readStop, readValues, rectify, regress, relate, removeDupNodes, res, "res<-", resample, rescale, rev, rcl, roll, rotate, rowFromY, rowColCombine, rowColFromCell, rowFromCell, sapp, scale, scale_linear, scoff, "scoff<-", sds, sort, sprc, sel, selectRange, setMinMax, setValues, segregate, selectHighest, set.cats, set.crs, set.ext, set.names, set.RGB, set.values, set.window, size, sharedPaths, shift, sieve, simplifyGeom, snap, sources, spatSample, split, spin, stdev, stretch, subset, subst, summary, Summary, surfArea, svc, symdif, t, metags, "metags<-", tail, tapp, terrain, thresh, tighten, makeNodes, makeTiles, time, timeInfo, "time<-", text, toMemory, trans, trim, units, union, "units<-", unique, unwrap, update, vect, values, "values<-", viewshed, voronoi, vrt, weighted.mean, where.min, where.max, which.lyr, which.min, which.max, which.lyr, width, window, "window<-", writeCDF, writeRaster, wrap, wrapCache, writeStart, writeStop, writeVector, writeValues, xmin, xmax, "xmin<-", "xmax<-", xres, xFromCol, xyFromCell, xFromCell, ymin, ymax, "ymin<-", "ymax<-", yres, yFromCell, yFromRow, zonal, zoom, cbind2, readRDS, saveRDS, unserialize, serialize, xapp, area, colSums, rowSums, colMeans, rowMeans) exportMethods(watershed, pitfinder, NIDP, flowAccumulation) S3method(cbind, SpatVector) S3method(rbind, SpatVector) S3method(as.data.frame, SpatRaster) S3method(as.data.frame, SpatVector) S3method(as.matrix, SpatRaster) S3method(as.matrix, SpatExtent) S3method(as.list, SpatRaster) S3method(as.list, SpatRasterCollection) S3method(as.list, SpatRasterDataset) S3method(as.list, SpatVector) S3method(as.list, SpatVectorCollection) S3method(str, SpatVector) S3method(str, SpatRaster) S3method(str, SpatExtent) S3method(str, SpatGraticule) export(add_box, add_legend, add_grid, add_mtext, clearVSIcache, combineLevels, focalMat, extractAlong, gdal, getGDALconfig, graticule, halo, libVersion, setGDALconfig, map.pal, map_extent, north, sbar, terraOptions, tmpFiles, makeVRT, mem_info, free_RAM, same.crs, shade, gdalCache, fileBlocksize, vector_layers, vrt_tiles, names, round) terra/NEWS.md0000644000176200001440000023343514757467121012515 0ustar liggesusers# version 1.8-29 ## bug fixes - `cover` did not work well if multiple replacement values were supplied [#1741](https://github.com/rspatial/terra/issues/1741) by Tim Howard - `ext<-` made a shallow copy. Reported on [SO 79440691](https://stackoverflow.com/questions/79440691/extent-is-rewritten-for-separate-spatraster-when-modifying-extent-using-terra-in/79440823#79440823) by katefull06 and as [#1743](https://github.com/rspatial/terra/issues/1743) by Agustin Lobo - `extract` with cells only used the NA flag for the first data source. [GSE 490433] (https://gis.stackexchange.com/questions/490433/problem-extracting-values-from-raster-in-r-with-terra-package) by MartinL ## enhancements - `spatSample` and `spatSample` gain argument "exact=FALSE" to request the exact (but perhaps less regular) sample size for a regular sample. Currently pnly for planar crs. - `spatSample` gains argument "each=TRUE" to request, when using stratified sampling, a sample size for each stratum, or for all strata combined. - `focal` now maintains categories with "fun=modal", "min", "max", or "first" [SO 79449904](https://stackoverflow.com/questions/79449904/preserving-original-categories-when-using-terrafocal) by Sophie Père ## new - `clearVSIcache`. Suggested by Shannon Albeke # version 1.8-21 Released 2025-02-10 ## bug fixes - `sieve` failed with large rasters [#1729](https://github.com/rspatial/terra/issues/1729) by Reed Humphrey - `extractRange` only worked for SpatVector, not for matrix or vector [#1733](https://github.com/rspatial/terra/issues/1733) by Victor Van der Meersch - `extract` over https with a multilayer SpatRaster returned the values for the first layer for all layer [#1736](https://github.com/rspatial/terra/issues/1736) by Shannon Albeke ## enhancements - new argument xyz="" to the `rast` method - new arguments "type" and "breaks" to `plet` method [#1187](https://github.com/rspatial/terra/issues/1187) by Augustin Lobo - new argument "cores" in `lapp` [#1190](https://github.com/rspatial/terra/issues/1190) by kel44 - `aggregate` now handles `fun="table"` [#1662](https://github.com/rspatial/terra/issues/1662) by Fernando Aramburu. ## new - `is.flipped` method [#1627](https://github.com/rspatial/terra/issues/1627) by Timothée Giraud - `as.array` method - `distance` now has argument "values". If TRUE, the values of the nearest non-target cell is returned instead of the distance [#1243](https://github.com/rspatial/terra/issues/1243) by Simon Dedman - `thresh` [#1233](https://github.com/rspatial/terra/issues/1233) by Agustin Lobo # version 1.8-15 Released 2025-01-24 ## bug fixes - `readRDS` failed for rasters with timestep="seconds" [#1711](https://github.com/rspatial/terra/issues/1711) by Pascal Oettli - `divide` always returned NULL [#1724](https://github.com/rspatial/terra/issues/1724) by Márcia Barbosa - `erase` failed in some cases [#1710](https://github.com/rspatial/terra/issues/1710) by erkent-carb ## enhancements - `bestMatch` now has argument "fun" to allow the use of different distance measures, and a method - `wrap` (and `writeRDS`) now captures varnames/longnames [#1719](https://github.com/rspatial/terra/issues/1719) by Andrew Gene Brown - improved raster metadata writing [#1714](https://github.com/rspatial/terra/pull/1714) by Andrew Gene Brown - `vect` and `writeVector` now properly read and write date and datetime data. [#1718](https://github.com/rspatial/terra/issues/1718) by Andrew Gene Brown - improved estimate of available memory on linux systems [#1506](https://github.com/rspatial/terra/issues/1506) by Cedric Rossi # version 1.8-10 Released 2025-01-13 ## bug fixes - `expanse(transform=TRUE)` crashed R when the crs was "local". [#1671](https://github.com/rspatial/terra/issues/1671) by Michael Chirico - `patches(values=TRUE)` wrapped around the edges [#1675](https://github.com/rspatial/terra/issues/1675) by Michael Chirico - `spin` now correctly handles spherical coordinates [#1576](https://github.com/rspatial/terra/issues/1576) by jeanlobry - `mosaic` sometimes crashed R [#1524](https://github.com/rspatial/terra/issues/1524) by John Baums, Dave Klinges, and Hugh Graham. - `spatSample` ignored argument "exp" when taking a random sample with na.rm=TRUE on a large raster [#1437](https://github.com/rspatial/terra/issues/1437) by Babak Naimi - `split` did not work properly [#1619](https://github.com/rspatial/terra/issues/1619) by Michael Sumner - `autocor` improved handling of NA cells for global Moran computation [#1992](https://github.com/rspatial/terra/issues/1592) by Nicholas Berryman - `shade` is more memory-safe. [#1452](https://github.com/rspatial/terra/issues/1452) by Francis van Oordt and Chris English - fixed bug in `rasterize` revealed when using `crop(mask=TRUE)` [#1686](https://github.com/rspatial/terra/issues/1686) by edixon1 - fixed `to_id = NA` bug in `nearest` [#1471](https://github.com/rspatial/terra/issues/1471) by Mats Blomqvist - better handling of date/unit [#1684](https://github.com/rspatial/terra/issues/1684) and [#1688](https://github.com/rspatial/terra/issues/1688) by Andrew Gene Brown - `spatSample(method="regular")` on a raster with one column returned too many samples [#1362](https://github.com/rspatial/terra/issues/1362) by Daniel R Schlaepfer ## enhancements - `plot` now uses the same default viridis color palette as `plot` [#1670](https://github.com/rspatial/terra/issues/1670) by Márcia Barbosa - `relate` now accepts relation="equals" [#1672](https://github.com/rspatial/terra/issues/1672) by Krzysztof Dyba - `init` now accepts additional arguments for function "fun" - better handling of the 32 connections limitation set by the HDF4 library [#1481](https://github.com/rspatial/terra/issues/1481) by Dimitri Falk - When using RStudio a once per session warning is given when using draw, sel or click [#1063](https://github.com/rspatial/terra/issues/1063) by Sergei Kharchenko - `distance` from lon and lat lines/polygons computes distance to the edges instead of the nodes [#1462](https://github.com/rspatial/terra/issues/1462) by Derek Friend - `distance` now works for lon/lat data [#1615](https://github.com/rspatial/terra/issues/1615) by Wencheng Lau-Medrano - using overviews for faster plotting of COGs over http [#1353](https://github.com/rspatial/terra/issues/1353) by Michael Sumner and [#1412](https://github.com/rspatial/terra/issues/1412); and argument `plot(x, overview=)` to change the default behavior. - `extract` with points is now faster for rasters accessed over http [#1504](https://github.com/rspatial/terra/issues/1504) by Krzysztof Dyba - `extract` with many points on very large rasters was slower in compared to doing the same with "raster" (which uses terra for that!) [#1584](https://github.com/rspatial/terra/issues/1584) by Hassan Masoomi - `merge` now has three alternative algorithms [1366](https://github.com/rspatial/terra/issues/1366) by Hassan Masoomi and [#1650](https://github.com/rspatial/terra/issues/1650) by Agustin Lobo ## new - `$` can now be used to get a categorical SpatRaster with a different active category - `scale_linear` method for linear scaling of cell values between a minimum and maximum value such as 0 and 1 - `distance` and related methods get argument "method" to choose the distance algorithm for lon/lat data [#1677](https://github.com/rspatial/terra/issues/1677) by Márcia Barbosa - `divide` and `divide` methods - `nseg` counts the number of segments in a SpatVector [#1647](https://github.com/rspatial/terra/pull/1674) by Michael Chirico - `extract` argument "search_radius" to extract values from the nearest raster cell that is not `NA` [#873](https://github.com/rspatial/terra/issues/873) by matthewseanmarcus - `combineLevels` to combine the levels of all layers [link](https://stackoverflow.com/questions/79340152/how-to-set-factor-levels-in-a-rast-stack-using-terra-when-different-levels-exi) on SO by Sam # version 1.8-5 Released 2024-12-12 ## bug fixes - `spatSample(method='stratified', ext=e)` returned the wrong sampling coordinates [#1628](https://github.com/rspatial/terra/issues/1628) by Barnabas Harris - `spatSample(method='stratified')` could fail with small sample sizes [#1503](https://github.com/rspatial/terra/issues/1503) by karluf - transparency (alpha) did not work with RGB plotting. [#1642](https://github.com/rspatial/terra/issues/1642) by Timothée Giraud - rasterization failed on very large rasters [#1636](https://github.com/rspatial/terra/issues/1636) by Mary Fisher, [#1463](https://github.com/rspatial/terra/issues/1463) by Nic Spono and [#1281](https://github.com/rspatial/terra/issues/1281) by Sebastian Dunnett - `tmpFiles` only looked in the default temp files folder [#1630](https://github.com/rspatial/terra/issues/1630) by smckenzie1986 - `where.min` did not work well if there were negative values [#1634](https://github.com/rspatial/terra/issues/1634) by Michael Sumner - `plet` now works for RGB rasters and rasters with a color table [#1596](https://github.com/rspatial/terra/issues/1596) by Agustin Lobo - `vect` did not work properly [#1376](https://github.com/rspatial/terra/issues/1376) by silasprincipe - `compareGeom` did not work [#1654](https://github.com/rspatial/terra/issues/1654) by Jason Flower - `buffer` is now more accurate buffers for lonlat polygons [#1616](https://github.com/rspatial/terra/issues/1616) by Roberto Amaral-Santos - `terra:interpNear` used square windows, not circles, beyond 100 points [#1509](https://github.com/rspatial/terra/issues/1509) by Jean-Luc Dupouey - `vect` read INT64 fields as integers, sometimes leading to overflows. [#1666](https://github.com/rspatial/terra/issues/1666) by bengannon-fc - `plot` showed a legend title even if none was requested if title parameters were specified . [#1664](https://github.com/rspatial/terra/issues/1664) by Márcia Barbosa ## enhancements - improved documentation of `writeVector` overwrite when using layers. [#1573](https://github.com/rspatial/terra/issues/1573) by Todd West - improved treatment of (supposedly) flipped rasters by Timothée Giraud [#1627](https://github.com/rspatial/terra/issues/1627) and fchianucci [#1646](https://github.com/rspatial/terra/issues/1646) - added `map.pal("random")` [#1631](https://github.com/rspatial/terra/issues/1631) by Agustin Lobo - expressions can now be used in legend titles [#1626](https://github.com/rspatial/terra/issues/1626) by Noah Goodkind - `app` and `tapp` now emit a warning when factors are coerced to numeric [#1566](https://github.com/rspatial/terra/issues/1566) by shuysman - `plet` now has argument "stretch" for RGB rasters [#1596](https://github.com/rspatial/terra/issues/1596) by Agustin - `%%` and `%/%` now behave the same for SpatRaster as for (base R) numbers [#1661](https://github.com/rspatial/terra/issues/1661) by Klaus Huebert ## new - `patches` with option `valus=TRUE` can now distinguish regions based on their cell values (instead of only NA vs not-NA) [#495](https://github.com/rspatial/terra/issues/495) by Jakub Nowosad and [#1632](https://github.com/rspatial/terra/issues/1632) by Agustin Lobo - `rowSums`, `rowMeans`, `colSums` and `colMeans` for SpatRaster - `metags` for SpatRasterDataset [#1624](https://github.com/rspatial/terra/issues/1624) by Andrea Manica - `metags` for layers (bands) of SpatRaster are now saved to and read from GTiff files [#1071](https://github.com/rspatial/terra/issues/1071) by Mike Koontz - `global` has new effcient functions "anyNA" and "anynotNA" [#1540](https://github.com/rspatial/terra/issues/1540) by Kevin J Wolz - `wrap`, `saveRDS` and `serialize` for SpatExtent. [#1430](https://github.com/rspatial/terra/issues/1430) by BastienFR - `vect` method suggested in relation to [tidyterra #155](https://github.com/dieghernan/tidyterra/issues/155) by Diego Hernangómez - `toMemory` and `` methods [#1660](https://github.com/rspatial/terra/pull/1660) by Derek Friend # version 1.7-83 Released 2024-10-14 ## bug fixes - `flip(direction="vertical")` failed in some cases [#1518](https://github.com/rspatial/terra/issues/1518) by Ed Carnell - `zonal(as.raster=TRUE)` failed when the zonal raster was categorical [1514](https://github.com/rspatial/terra/issues/1514) by Jessi L Brown - `distance` and `` ignored the unit argument. [#1545](https://github.com/rspatial/terra/issues/1545) by Wencheng Lau-Medrano - NetCDF files with month time-step encode from 0-11 made R crash [#1544](https://github.com/rspatial/terra/issues/1544) by Martin Holdrege - `split` only worked well if the split field was of type character. [#1530](https://github.com/rspatial/terra/issues/1530) by Igor Graczykowski - `gridDist` (and probably some other methods) emitted a "cannot overwrite existing file" error when processing large datasets [#1522](https://github.com/rspatial/terra/issues/1522) by Clare Pearson - `terrain` did not accept multiple variables [#1561](https://github.com/rspatial/terra/issues/1561) by Michael Mahoney - `rotate` was vulnerable to an integer overflow [#1562](https://github.com/rspatial/terra/issues/1562) by Sacha Ruzzante - `getTileExtents` could return overlapping tiles or tiles with gaps due to floating point imprecision. [#1564](https://github.com/rspatial/terra/issues/1564) by Michael Sumner - `rasterize` with points failed when using `update=TRUE` [#1611](https://github.com/rspatial/terra/issues/1611) by Jordan Adamson - `buffer` on a lonlat multipoint SpatVector returned a buffer around a single point. [#1607](https://github.com/rspatial/terra/issues/1607) by Márcia Barbosa - `buffer` no longer crashes (for particular cases and unknown reasons) on windows [#1331](https://github.com/rspatial/terra/issues/1331) by Julian090601, [#1363](https://github.com/rspatial/terra/issues/1363) by Rupert Overall and [#1531](https://github.com/rspatial/terra/issues/1531) by Igor Graczykowski ## enhancements - `as.list` sets the names of the list [#1513](https://github.com/rspatial/terra/issues/1513) - a SpatVectorCollection can now be subset with its names; and if made from a list it takes the names from the list. [1515](https://github.com/rspatial/terra/issues/1515) by jedgroev - argument `fill_range` to plot and `plot` to use the color of the extreme values of the specified range [#1553](https://github.com/rspatial/terra/issues/1553) by Mike Koontz - `plet` can now handle rasters with a "local" (Cartesian) CRS. [#1570](https://github.com/rspatial/terra/issues/1570) by Augustin Lobo. - `geom` can now return "wkb" [#1609](https://github.com/rspatial/terra/issues/1609) - faster plotting when color names are used. In response to question by Olle on [gis.stackexchange.com](https://gis.stackexchange.com/questions/487112/plotting-discrete-categorical-rasters-with-custom-colors-slows-down-r-terra/488012#488012) ## new - `map_extent` returns the coordinates of the axes position of a map created with `plot` [#1517](https://github.com/rspatial/terra/issues/1517) by Daniel Schuch - `polys` method [#1543](https://github.com/rspatial/terra/issues/1543) by Márcia Barbosa - `plot` method [#1532](https://github.com/rspatial/terra/issues/1532) by jedgroev - `add_mtext` to add text around the margins of a map. [#1567](https://github.com/rspatial/terra/issues/1567) by Daniel Schuch # version 1.7-78 Released 2024-05-22 ## bug fixes - `writeVector` and `readVector` better handle empty geopackage layers [#1426](https://github.com/rspatial/terra/issues/1426) by Andrew Gene Brown. - `writeCDF` only wrote global variables if there was more than one [#1443](https://github.com/rspatial/terra/issues/1443) by Daniel Schlaepfer - `rasterize` with "by" returned odd layernames [#1435](https://github.com/rspatial/terra/issues/1435) by Philippe Massicotte - `convHull`, `minCircle` and `minRect` with a zero-row SpatVector crashed R [#1445](https://github.com/rspatial/terra/issues/1445) by Andrew Gene Brown - `rangeFill` with argument `circular=TRUE` did not work properly [#1460](https://github.com/rspatial/terra/issues/1460) by Alice - `crs(describe = TRUE)` returned an mis-ordered extent [#1485](https://github.com/rspatial/terra/issues/1485) by Dimitri Falk - `tapp` with a custom function and an index like "yearmonths" could shift time for not considering the time zone. [#1483](https://github.com/rspatial/terra/issues/1483) by Finn Roberts - `plot` could fail when there were multiple values with very small differences [#1491](https://github.com/rspatial/terra/issues/1491) by srfall - `as.data.frame` with "xy=TRUE" and "wide=FALSE" could fail if coordinates were very similar [#1476](https://github.com/rspatial/terra/issues/1476) by Pascal Oettli - `rasterizeGeom` now returns the correct layer name [#1472](https://github.com/rspatial/terra/issues/1472) by HRodenhizer - `cellSize` with "mask=TRUE" failed if the output was to be written to a temp file [#1496](https://github.com/rspatial/terra/issues/1496) by Pascal Sauer - `ext` did not return the full extent [#1501](https://github.com/rspatial/terra/issues/1501) by erkent-carb ## enhancements - `extract` has new argument "small=TRUE" to allow for strict use of "touches=FALSE" [#1419](https://github.com/rspatial/terra/issues/1419) by Floris Vanderhaeghe. - `as.list` has new argument "geom=NULL" - `rast` now recognizes (x, y, z) base R "image" structures [stackoverflow](https://stackoverflow.com/questions/77949551/rspatial-convert-a-grid-list-to-a-raster-using-terra) by Ignacio Marzan. - `inset` has new arguments "offset" and "add" [#1422](https://github.com/rspatial/terra/issues/1422) by Armand-CT - `expanse` has argument `usenames` [#1446](https://github.com/rspatial/terra/issues/1446) by Bappa Das - the default color palette is now `terra::map.pal("viridis")` instead of `terrain.colors`. The default can be changes with `options(terra.pal=...)` [#1474](https://github.com/rspatial/terra/issues/1474) by Derek Friend - `as.list` now returns a named list. [#1513](https://github.com/rspatial/terra/issues/1513) by Eric R. Scott ## new - `bestMatch` method - argument "pairs=TRUE" to `cells` [#1487](https://github.com/rspatial/terra/issues/1487) by Floris Vanderhaeghe - `add_grid` to add a grid to a map # version 1.7-71 Released 2024-01-31 ## bug fixes - k_means did not work if there were NAs [#1314](https://github.com/rspatial/terra/issues/1314) by Jakub Nowosad - `layerCor` with a custom function did not work anymore [#1387](https://github.com/rspatial/terra/issues/1387) by Jakub Nowosad - `plet` broke when using "panel=TRUE" [#1384](https://github.com/rspatial/terra/issues/1384) by Elise Hellwig - using /vis3/ to open a SpatRaster did not work [#1382](https://github.com/rspatial/terra/issues/1382) by Mike Koontz - `plot(add=TRUE)` sampled the raster data without considering the extent of the map. [#1394](https://github.com/rspatial/terra/issues/1394) by Márcia Barbosa - `plot(add=TRUE)` now only considers the first layer of a multi-layer SpatRaster [1395](https://github.com/rspatial/terra/issues/1395) by Márcia Barbosa - `set.cats` failed with a tibble was used instead of a data.frame [#1406](https://github.com/rspatial/terra/issues/1406) by Mike Koontz - `polys` argument "alpha" was ignored if a single color was used. [#1413](https://github.com/rspatial/terra/issues/1413) by Derek Friend - `query` ignore the "vars" argument if all rows were selected. [#1398](https://github.com/rspatial/terra/issues/1398) by erkent-carb. - `spatSample` ignored "replace=TRUE" with random sampling, na.rm=TRUE, and a sample size larger than the non NA cells. [#1411](https://github.com/rspatial/terra/issues/1411) by Babak Naimi - `spatSample` sometimes returned fewer values than requested and available for lonlat rasters. [#1396](https://github.com/rspatial/terra/issues/1396) by Márcia Barbosa. ## enhancements - `vect` now has argument "opts" for GDAL open options, e.g. to declare a file encoding. [#1389](https://github.com/rspatial/terra/issues/1389) by Mats Blomqvist - `plot(plg=list(tic=""))` now allows choosing alternative continuous legend tic-mark styles ("in", "out", "through" or "none") - `makeTiles` has new argument "buffer" [#1408](https://github.com/rspatial/terra/issues/1408) by Joy Flowers. ## new - `prcomp` method [#1361](https://github.com/rspatial/terra/issues/1361#issuecomment-1860311029) by Jakub Nowosad - `add_box` to add a box around the map. The box is drawn where the axes are, not around the plotting region. - `getTileExtents` provides the extents of tiles. These may be used in parallelization. See [#1391](https://github.com/rspatial/terra/issues/1391) by Alex Ilich. # version 1.7-65 Released 2023-12-15 ## bug fixes - `flip` with argument `direction="vertical"` filed in some cases with large rasters processed in chunks [0b714b0](https://github.com/rspatial/terra/commit/0b714b038b101011ce27391133a7a1f9a91821cc) by Dulci on [stackoveflow]( https://stackoverflow.com/questions/77304534/rspatial-terraflip-error-when-flipping-a-multi-layer-spatrast-object) - SpatRaster now correctly handles `NA & FALSE` and `NA | TRUE` [#1316](https://github.com/rspatial/terra/issues/1316) by John Baums - `set.names` wasn't working properly for SpatRasterDataset or SpatRasterCollection [#1333](https://github.com/rspatial/terra/pull/1333) by Derek Friend - `extract` with argument "layer" not NULL shifted the layers [#1332](https://github.com/rspatial/terra/issues/1332) by Ewan Wakefield - `terraOptions` did not capture "memmin" on [stackoverflow](https://stackoverflow.com/questions/77552234/controlling-chunk-size-in-terra) by dww - `rasterize` with points and a built-in function could crash if no field was used [#1369](https://github.com/rspatial/terra/issues/1369) by anjelinejeline ## enhancements - `mosaic` can now use `fun="modal"` - `rast and rast` now have option 'type="xylz" [#1318](https://github.com/rspatial/terra/issues/1318) by Agustin Lobo - `extract` can now use multiple summarizing functions [#1335](https://github.com/rspatial/terra/issues/1335) by Derek Friend - `disagg` and `focal` have more optimistic memory requirement estimation [#1334](https://github.com/rspatial/terra/issues/1334) by Mikko Kuronen ## new - `k_means` method [#1314](https://github.com/rspatial/terra/issues/1314) by Agustin Lobo - `princomp` method [#1361](https://github.com/rspatial/terra/issues/1361) by Alex Ilich - `has.time` method - new argument "raw=FALSE" to `rast`, `sds`, and `sprc` to allow ignoring scale and offset [1354](https://github.com/rspatial/terra/issues/1354) by Insang Song # version 1.7-55 Released 2023-10-14 ## bug fixes - `mosaic` ignored the filename argument if the SpatRasterCollection only had a single SpatRaster [#1267](https://github.com/rspatial/terra/issues/1267) by Michael Mahoney - Attempting to use `extract` with a raster file that had been deleted crashed R. [#1268](https://github.com/rspatial/terra/issues/1268) by Derek Friend - `split` did not work well in all cases. [#1256](https://github.com/rspatial/terra/issues/1256) by Derek Corcoran Barrios - `intersect` with two SpatVectors crashed R if there was a date/time variable [#1273]( https://github.com/rspatial/terra/issues/1273) by Dave Dixon - "values=FALSE" was ignored by `spatSample(method="weights")` [#1275](https://github.com/rspatial/terra/issues/1275) by François Rousseu - `coltab<-` again works with a list as value [#1280](https://github.com/rspatial/terra/issues/1280) by Diego Hernangómez - `stretch` with histogram equalization was not memory-safe [#1305](https://github.com/rspatial/terra/issues/1305) by Evan Hersh - `plot` now resets the "mar" parameter [#1297](https://github.com/rspatial/terra/issues/1297) by Márcia Barbosa - `plotRGB` ignored the "smooth" argument [#1307](https://github.com/rspatial/terra/issues/1307) by Timothée Giraud ## enhancements - argument "gdal" in `project` was renamed to "use_gdal" [#1269](https://github.com/rspatial/terra/issues/1269) by Stuart Brown. - SpatVector attributes can now be stored as an ordered factor [#1277](https://github.com/rspatial/terra/issues/1277) by Ben Notkin - `plot` now uses an "interval" legend when breaks are supplied [#1303](https://github.com/rspatial/terra/issues/1303) by Gonzalo Rizzo - `crop` now keeps more metadata, including variable names [#1302](https://github.com/rspatial/terra/issues/1302) by rhgof - `extract(fun="table")` now returns an easier to use data.frame [#1294](https://github.com/rspatial/terra/issues/1294) by Fernando Aramburu. ## new - `metags<-` and `metags` to set arbitrary SpatRaster/file level metadata [#1304](https://github.com/rspatial/terra/issues/1304) by Francesco Chianucci # version 1.7-46 Released 2023-09-06 ## bug fixes - `plot` used the wrong main label in some cases [#1210](https://github.com/rspatial/terra/issues/1210) by Márcia Barbosa - `plotRGB` failed with an "ext=" argument [#1228](https://github.com/rspatial/terra/issues/1228) by Dave Edge - `rast` failed badly when the array had less than three dimensions. [#1254](https://github.com/rspatial/terra/issues/1254) by andreimirt. - `all.equal` for a SpatRaster with multiple layers [#1236](https://github.com/rspatial/terra/issues/1236) by Sarah Endicott - `zonal(wide=FALSE)` could give wrong results if the zonal SpatRaster had "layer" as layername. [#1251](https://github.com/rspatial/terra/issues/1251) by Jeff Hanson - `panel` now support argument "range" [#141](https://github.com/rspatial/terra/issues/1241) by Jakub Nowosad - `rasterize` with `by=` returned wrong layernames if the by field was not sorted [#1266](https://github.com/rspatial/terra/issues/1266) by Sebastian Dunnett - `mosaic` with multiple layers was not correct [#1262](https://github.com/rspatial/terra/issues/1262) by Jean-Romain ## enhancements - `wrap` now stores color tables [#1215](https://github.com/rspatial/terra/issues/1215) by Patrick Brown - `global` now has a "maxcell" argument [#1213](https://github.com/rspatial/terra/issues/1213) by Alex Ilich - `layerCor` with fun='pearson' now returns output with the layer names [#1206](https://github.com/rspatial/terra/issues/1206) - `vrt` now has argument "set_names" [#1244](https://github.com/rspatial/terra/issues/1244) by sam-a-levy - `vrt` now has argument "return_filename" [#1258](https://github.com/rspatial/terra/issues/1258) by Krzysztof Dyba - `project` has new argument "by_util" exposing the GDAL warp utility [#1222](https://github.com/rspatial/terra/pull/1222) by Michael Sumner. ## new - `compareGeom` for list and SpatRasterCollection [#1207](https://github.com/rspatial/terra/issues/1207) by Sarah Endicott - `is.rotated` method [#1229](https://github.com/rspatial/terra/issues/1229) by Andy Lyons - `forceCCW` method to force counter-clockwise orientation of polygons [#1249](https://github.com/rspatial/terra/issues/1249) by srfall. - `vrt_tiles` returns the filenames of the tiles in a vrt file [#1261](https://github.com/rspatial/terra/issues/1261) by Derek Friend - `extractAlong` to extract raster cell values for a line that are ordered along the line. [#1257](https://github.com/rspatial/terra/issues/1257) by adamkc. # version 1.7-39 Released 2023-06-23 ## bug fixes - the tempdir option did not use path.expand. [#1195](https://github.com/rspatial/terra/issues/1195) by Alex Ilich - the layer names returned by predict where inconsistent when using argument "index". [#1194](https://github.com/rspatial/terra/issues/1194) by Michael Mahoney - compilation failed with older compilers because of use of std::filesystem [#1191](https://github.com/rspatial/terra/issues/1191) - Small changes to `RGB<-` and `coltab<-` so that terra can be installed with R-devel (after a bug fix https://bugs.r-project.org/show_bug.cgi?id=18538) # version 1.7-37 Released 2023-06-18 ## bug fixes - `rasterize` with points and a custom function did not work for large rasters. [#1127](https://github.com/rspatial/terra/issues/1127) by Skip Woolley - `crop` with "mask=TRUE" did not work well if the raster had a scale/offset [#1128](https://github.com/rspatial/terra/issues/1128) by Monika Anna Tomaszewska - `zonal` with a custom function always removed NAs. [#1133](https://github.com/rspatial/terra/issues/1133) by Matthias Weigand - `wrap` lost changed layer names if the source was from disk; and information on some time-step in some cases. [#1144](https://github.com/rspatial/terra/issues/1144) by Pascal Führlich - `global(fun="isNA")` was not correct when the SpatRaster had multiple layers [#1141](https://github.com/rspatial/terra/issues/1141) by Robin Freeman - `interpIDW` with `near=TRUE` did not work properly (near=TRUE is now the default). [#1186](https://github.com/rspatial/terra/issues/1186) by Hugh Graham - "YYYY-1-1" was sometimes encoded as "YYYY-13-1". [#1168](https://github.com/rspatial/terra/issues/1168) by Colin Brust ## enhancements - `panel` for categorical SpatRasters. [#1143](https://github.com/rspatial/terra/issues/1143) by Jason Flower - argument "ext" in `plot` can now also expand the plot. [#1136](https://github.com/rspatial/terra/issues/1136) by Jakub Nowosad. - argument `overwrite=FALSE` to `makeTiles`. [#1167](https://github.com/rspatial/terra/issues/1167) by Gray Martin. - legend options for `. [#1177](https://github.com/rspatial/terra/issues/1177) by Agustin Lobo. - better handling of mixed geometry type vector data by `vect` and `svc`. [#1160](https://github.com/rspatial/terra/issues/1160) by Mike Sumner. - new argument `sql` to `query`. [#1157](https://github.com/rspatial/terra/issues/1157) by Carl Boettiger - support for writing raster data to a vitual file system [#1209](https://github.com/rspatial/terra/issues/1209) by Carl Boettiger ## new - `wrap` and `wrap` methods. [#954](https://github.com/rspatial/terra/issues/954) by James Camac # version 1.7-29 Released 2023-04-22 ## new - `regress` to get regression model coefficients for each cell, with a fixed "X". - `regress` to get regression model coefficients for each cell. ## enhancements - `lapp` is now more flexible in that it can now also use functions that are vectorized by cell, not by chunk. See [#1029](https://github.com/rspatial/terra/issues/1029) - `project` has new argument "partial=FALSE" that can be used to keep geometries that can only be partially included in the output crs. - extracting a SpatVector column with a non-existing variable name now returns NULL (because that is what a data.frame does) instead of throwing an error. [#1118](https://github.com/rspatial/terra/issues/1118) by Derek Friend. ## bug fixes - a problem with reading empty categories in .img files created buggy SpatRasters - `global` with fun="notNA" was wrong [#111](https://github.com/rspatial/terra/issues/1111) by Jeffrey Hanson - `extract` with "bind=TRUE" did not work - `extract` with point geometries and a "fun" returned values in the wrong order - `plot` argument "colNA" did not work when "alpha" was also set [#1102](https://github.com/rspatial/terra/issues/1102) by Márcia Barbosa - `crop` with "extend=TRUE" did not extend the SpatRaster if the input had no cell values. [#1114](https://github.com/rspatial/terra/issues/1114) by Jasper van Doninck - setting a factor or date/time variable in a SpatVector did not work [#1117](https://github.com/rspatial/terra/issues/1117) by MK Schneider - `focalMat` did not work well when using terraOptions(todisk=T) [#1116](https://github.com/rspatial/terra/issues/1116) # version 1.7-23 Released 2023-04-08 ## new - The `halo` function for adding halo-ed text to plots is now exposed - `add_legend` to allow using a keyword such as "topleft" to position a custom legend. [#1053](https://github.com/rspatial/terra/issues/1053) by Márcia Barbosa - the `same.crs` function is now exported - `countNA` method - `split` to split polygons with lines ## enhancements - better support for other color spaces than RGB [#1060](https://github.com/rspatial/terra/issues/1060) by Dominic Royé - path expansion in writeVector [#1055](https://github.com/rspatial/terra/issues/1055) by Andrew Gene Brown. - `clamp` now also accepts SpatRasters to set the lower and upper boundaries. - `freq` has new arguments "zones=NULL" and "wide=FALSE", to allow tabulation of values by zone. - `expanse` has new arguments "zones=NULL" and "wide=FALSE", to allow tabulation of values by zone. - `unique` has new argument "digits=NA" - `rasterize` now accepts fun="table" to tabulate cells by cell value - `rast` has new argument "snap" to snap the window in or out. [#1094](https://github.com/rspatial/terra/issues/1094) by Derek Friend - `plot` has new argument "clip=TRUE" that can be set to FALSE to avoid clipping the axes to the mapped area [#1080](https://github.com/rspatial/terra/issues/1080) by Márcia Barbosa - better error message when coercing an sf object that is not fully formed [#1098](https://github.com/rspatial/terra/issues/1098) by Brandon McNellis - `writeCDF` had new argument "split" allowing to treat each layer as a subdataset [#1077](https://github.com/rspatial/terra/issues/1077) by Andrea Manica - `global` now accepts multiple summarizing functions ## bug fixes - A SpatRaster with RGB layers was forced to INT1U when writing [#1051](https://github.com/rspatial/terra/issues/1051) by Cesar Aybar - In files with multiple vector layers, the crs of the first layer was always used; ignoring that the crs could be different for other layers [#1052](https://github.com/rspatial/terra/issues/1052) by Andrew Gene Brown - `sieve` was not able to write to file [#1061](https://github.com/rspatial/terra/issues/1061) by leo - `rasterize` did not work with sf objects [#1054](https://github.com/rspatial/terra/issues/1054) by Jakub Nowosad - `query` did not work for hyphenated layer names [#1058](https://github.com/rspatial/terra/issues/1058) by Robbie Price - `focal3D` na.policy did not work [#1057](https://github.com/rspatial/terra/issues/1057) by Flávio Mota - `layerCor` with `na.rm=TRUE` failed for a SpatRaster with more than 2 layers [#1056](https://github.com/rspatial/terra/issues/1056) by Alex Ilich. - inset with keyword positioning did not work well [#1053](https://github.com/rspatial/terra/issues/1053) by Márcia Barbosa - yearmonths time stamps were not read from file for years <1970 and >2037 [#1062](https://github.com/rspatial/terra/issues/1062) by Colin Brust - `compareGeom` did not work for multiple SpatRasters [#1063](https://github.com/rspatial/terra/issues/1064) - `viewshed` could not handle a filename argument. [#1100](https://github.com/rspatial/terra/issues/1100) by kamistick # version 1.7-18 Released 2023-03-06 ## new - argument `order=FALSE` to `sort` - `sort` (and `` method - argument `by=NULL` to `rasterize>` [#986](https://github.com/rspatial/terra/issues/986) by Sam Weber - `meta` method to get metadata - `compare` and `logic` methods - `vect` method - `panel` for "panel" plots (multiple layers, single legend) ## enhancements - it is now possible to save terra options across sessions [#995](https://github.com/rspatial/terra/issues/995) by Guillaume Patoine. - better warnings for `is.lonlat` [#1006](https://github.com/rspatial/terra/issues/1006) by Andrew Gene Brown - argument `na.rm` to `merge` - the axes of maps created with `plot` are now snug around the mapped area, instead of at the limits of the graphics figure region. - C++ cleaning to avoid warnings by clang-tidy (e.g. now using `.empty()` instead of `.size()==0`). [#1013-1017] by Michael Chirico - `rasterize` with lines and polygons can now use the "fun" argument (for min, max, mean, and sum) [#1041](https://github.com/rspatial/terra/issues/1041) by Bart Huntley ## bug fixes - the legend created by `plet` was not always correct. [#983](https://github.com/rspatial/terra/issues/983) by Simon Rolph - `spatSample(regular=TRUE)` failed with providing two numbers (row, col) as sample size. [#991]( https://github.com/rspatial/terra/issues/991) by srfall - `merge` did not ignore NAs [#1002](https://github.com/rspatial/terra/issues/1002) by jmmonnet. - `writeCDF` failed when using argument force_v4 [#1009](https://github.com/rspatial/terra/issues/1009) by R. Kyle Bocinsky - `predict` better handling of rasters with many NAs [#988](https://github.com/rspatial/terra/issues/998) by Lucas Johnson - `layerCor` did not handle NAs well if they were in different cells across layers [#1034](https://github.com/rspatial/terra/issues/1034) by François Rousseu. # version 1.7-3 Released 2023-01-24 ## new - argument `w` to `zonal` to compute weighted means - `zonal` method - `clamp_ts` method ## bug fixes - in the previous version, a bug was introduced such that the order of operation in arithmetic operations with SpatRasters was ignored. [#978](https://github.com/rspatial/terra/issues/978) by Andrew Marx - Fixed `split`. [#979](https://github.com/rspatial/terra/issues/979) by srfall - `spatSample` with `as.df=FALSE` returned a data.frame instead of a matrix [#982](https://github.com/rspatial/terra/issues/982) by Alex Ilich # version 1.6-53 Released 2023-01-17 ## new - arithmetic and logical operations between a SpatRaster and a matrix, to allow for using cell-varying and cell/layer-varying scalars. layer-varying scalars were already supported via vectors. ## enhancements - `shade` is now vectorized for arguments `angle` and `direction` to facilitate generating multiple hillshades that can be combined for a better result [#948](https://github.com/rspatial/terra/issues/948) by Jürgen Niedballa - `sharedPaths` now uses spatial indices [#960](https://github.com/rspatial/terra/issues/960) by Jeff Hanson - `predict` has better support for models such as ranger that do not return anything for missing values [#968](https://github.com/rspatial/terra/issues/968) by Alex Ilich ## bug fixes - `writeCDF` now supports writing yearly time steps [#926](https://github.com/rspatial/terra/issues/926) by Andrea Manica - `as.contour` now works for a single level [#966](https://github.com/rspatial/terra/issues/966) by Johannes Signer - subsetting a SpatRaster with a window returned a SpatRaster with the dimensions of the non-windowed raster, thus changing the resolution. [#964](https://github.com/rspatial/terra/issues/964) by Derek Friend - removing a factor variable from a SpatVector crashed R. [#969](https://github.com/rspatial/terra/issues/969) by Andrew Gene Brown - median did not always return the correct number for a SpatRaster with 3 or more layers [#970](https://github.com/rspatial/terra/issues/970) by MatteaE # version 1.6-47 Released 2022-12-02 ## new - `roll` method for rolling (moving) average and other rolling functions - `noNA` method to identify cells that are not NA (across layers) - `rangeFill` method ## enhancements - argument `exhaustive` to `spatSample` for large sparse rasters. [#905] by PetiteTong. - `focalPairs` and `focalReg` can now use the values in custom windows as weights. [#907] by Fabian Fischer. - `focalReg` now has additional argument "intercept=TRUE". [#916] by Jordan Adamson - `crs(x, warn=TRUE)<-` now emits a warning about the difference between transforming and setting a crs when x already had a crs. [#897] by Márcia Barbosa. - it is now possible to write a scale and offset with `writeRaster` [#900] by Kyle David - `crosstab` now shows the labels names for a categorical SpatRaster. [895] by Derek Corcoran Barrios - `makeTiles` can now take a SpatVector to define the tiles. [920] by Tristan Goodbody ## bug fixes - `focalPairs` and `focalReg` now work for custom windows [#907] by Fabian Fischer - argument "alpha" in `plot` was not working properly. [#906] by Márcia Barbosa. - `time<-` with time-step "years" could not handle negative years. [#911] by Andrea Manica - `wrap`/`unwrap` (and by extension `saveRDS`/`readRDS`) did not handle categorical rasters well [#912] by Christine Anderson. - `interpIDW` failed with GDAL 3.6 [#910] by Roger Bivand - `spatSample` with strata bug fix "unable to find an inherited method for function 'trim'" [#919] by Alfredo Ascanio - it is possible to slice a SpatRaster with a SpatExtent [#914] by Jakub Nowosad. - `merge`/`mosaic` did not handle NAs when using two layers [#913] by Joao Carreiras. ## name changes - focalCor -> focalPairs to reflect its possible use beyond correlation # version 1.6-41 Released 2022-11-18 ## new - `[` and `[<-` for SpatRaster now have a third index `k` for subsetting or assigning values by layer - `anyNA` and `allNA` for SpatRaster - `unwrap` to restore a PackedSpatVector or PackedSpatRaster - `rasterizeWin` method for rasterization with a moving window (circle, ellipse, rectangle, buffer) - `interpIDW` method for inverse-distance-weighted interpolation of points with a moving window - `interpNear` method for nearest neighbor interpolation of points with a moving window - `viewshed` method for SpatRaster - `update` method for SpatRaster to write new names or a new extent or crs to an existing raster file. - `sieve` filter for SpatRaster - argument `segments=FALSE` to `disagg` - `sprc` method to create a SpatRasterCollection from a file with subdatasets - `graticule` function to create a SpatGraticule and related methods `plot` and `crop` - `elongate` method for SpatVector lines ## enhancements - faster `mosaic` and `merge` [#577] by Jean-Romain - `wrap` now uses file references if the data is deemed too large to all load into memory. [#801] by Jean-Romain - `readRDS` and `unserialize` now return a SpatRaster or SpatVector (instead of a PackedSpat*) - better support for a "local" arbitrary Euclidean crs [#797] by Agustin Lobo - `clamp` can now take low and high values for each layer - The `pax` argument in `plot` now provides more control over what to draw on each axis via parameters `side`, `tick` and `lab` - The `pax` argument in `plot` now has argument `retro` to use a sexagesimal notation of degrees - `extend` has a new argument `fill=NA` - A warning is now given when `c`ombining SpatRasters with different CRSs. [#818] by Andrew Marx - `plotRGB` now accounts for the value of zlim when stretching; allowing to use the same coloring scheme across SpatRasters [#810] by Agustin Lobo. - the center of rotation for `spin` is now vectorized ## bug fixes - The annoying garbage collection messages `Error in x$.self$finalize() : attempt to apply non-function` is now suppressed in most cases. [#218] by Charlie Joey Hadley. This problem should go away altogether when a new version of "Rcpp" is released (ETA Jan 2023) thanks to a fix by Kevin Ushey [#30] - `spatSample` with `na.rm` and SpatRasters with multiple layers did not work. [#800] by Andrea Manica - `adjacent` with `pairs=TRUE, include=TRUE` ignored `include=TRUE` [#808] by Joseph Lewis - `rasterize` did not accept "NA" as value for updating [#809] by Márcia Barbosa - `extract` with a perfectly vertical or horizontal line failed in some cases [#823] by Dimitri Falk - `wrap` failed if there was a single point geometry [#815] by Patrick Schaefer - `extract` with `weights=TRUE` did not return values [#814] by Jean-Luc Dupouey. - `x[["newname"]] <- r` for SpatRasters `x` and `r` did not work [#795] by Jim Shady - fixed support for some non-conventional netCDF files [#869] by Mike Sumner, [#864] by eleanorecc, and [#851] by Philippe Massicotte. ## name changes - `costDistance` -> `costDist` to avoid conflict with {gdistance} - `gridDistance` -> `gridDist` for consistency # version 1.6-17 Released 2022-09-10 ## new - `droplevels` for SpatRaster. [#757] by Rodolfo Jaffe. - `normalize.longitude` for SpatVector. - `scoff` to get and `scoff<-` to set the scale (gain) and offset of a SpatRaster. ## enhancements - new argument `raw=FALSE` to `extract` [#776] by Thomas Roh. - `as.data.frame` now takes `na.rm=NA` to only remove rows that are NA for all layers. The default value changed from `TRUE` to `NA`. [#792] by Ed Carnell - faster plotting of SpatVector data [#774] by Krzysztof Dyba - `distance` has new arguments "target" and "exclude". [#560] by Bernardo Brandão Niebuhr - new argument `sparse=FALSE` for `relate. - new argument `usenames=FALSE` for `lapp` [#793] by Colin Brust. - `vect` now reports that a file is non-existent [#784] by John Baums - faster `relate` [#716] by Krzysztof Dyba - `focal3D` now checks if all the window's dimensions are odd [#772] by Neander Marcel Heming ## bug fixes - `all.equal` bug [#756] fixed by John Baums - `extract<"SpatRaster","sf">` ignored the ID argument. [#755] by Dainius Masiliūnas. - There is now (in all cases) a check to avoid overwriting (one of) the input file(s) when writing a raster file [#760] by John Baums - `vrt` is no longer constrained by the maximum number of files that can be opened [#780] by 8Ginette8 - `weighted.mean` crashed with numeric weights and na.rm=TRUE [#777] by David Holstius - `project` did not consider an extent that was set by the user [#775] by Philippe Massicotte - `focalCor` failed for large rasters [#607] by John Clark - `focal` with `expand=TRUE` was prone to run out of memory [#610] by Nathan Elliott - `crop` did not work well when the second argument were points or lines [#782] by Márcia Barbosa - `adjacent` with `pairs=TRUE` now respects the `include=TRUE` argument [808] by Joseph Lewis # version 1.6-7 Released 2022-08-07 ## new - method `blocks` to guide reading raster data in chunks. [#748] by John Baums ## enhancements - A warning is given when writing raster values that are outside the limits of the requested datatype [#752] by Jim Shady - Arguments to `extract` were simplified. [#736] by François Rousseu ## bug fixes - values of `focal` where not correct if the input SpatRaster had multiple layers and a "custom" function. [#727] by Jean-Luc Dupouey. - `plot` did not honor argument `legend=FALSE`. [#738] by Grzegorz Sapijaszko - `expanse` failed when processing in chunks [#741] by Gareth Davies - `crop` with argument `snap="out"` could lead to a crash if the extent was beyond the SpatRaster. [#740] by Mauricio Zambrano-Bigiarini # version 1.6-3 Released 2022-07-25 ## bug fixes - `subst` no longer uses values that it changed earlier on. [#639] by Paul Smith - `as.points` could return wrong factor labels. [#640] by Attilio Benini - `mask` crashed when the results were written to disk. [#646] by Monika Anna Tomaszewska - `extract(xy=TRUE)` returned the locations of the points, not the xy-coordinates of the cells. [#650] by Ward Fonteyn - `wrap` did not return the correct labels for some categorical rasters. [#652] by Jakub Nowosad - better support for non-latin characters in the legend [#658] by Krzysztof Dyba - holes in small lon/lat polygons are now properly buffered [#689] by David Hofmann ## enhancements - `subst` can now substitute the values from multiple input layers with a single output value (layer) - `subset` now behaves like `subset` [#648] by Andrew Gene Brown - setting category labels with a vector of names is now deprecated. A data.frame with at least two columns should be used. The first column should have the cell values (IDs). - It is now possible to "drop" a layer from a SpatRaster by setting it to NULL [#664] by Daniel Valentins - `freq` now provides the labels of factors, even if `bylayer=FALSE`. It now always returns a `data.frame` (it used to return a `matrix` in some cases. [#687] by Rodolfo Jaffé - `disagg` and `aggregate` now return a warning instead of an error when using a (dis)aggregation factor of 1.[#684] by Justin Fain. - `project` crashed when erroneously projecting raster data from one celestial body to another [#688] by Mike Sumner - you can now set a color table with a two column (value, ID) data.frame - categorical rasters can now be updated more easily [#667] by Alex Ilich - more control over matching values with colors when using `plot`. [#673] by Jakub Nowosad. - SpatVector attributes can now also be a factor, date, or POSIXct. [#697] by Grant Williamson - improved handling of missing values in `extract(method="bilinear")`. [#693] by swooping-magpie ## new - argument `as.raster` to `unique` to create a categorical raster with the unique combinations in the layers of the input raster. The default for argument `na.rm` was changed to `FALSE` - `sort` to sort cell values across layers. - `has.colors` and `has.RGB` for SpatRaster - `cover` can now combine categorical rasters - `concats` to combine the levels of two SpatRaster into new categories [#663] by Alex Ilich - `zonal` method to aggregate SpatVector attributes by polygons # version 1.5-34 Released 2022-06-09 ## bug fixes - "flipped" rasters were not always handled well. [#546] by Dan Baston - better reading of GTiff with subdatsets. [#601] by Kyle Doherty - better handling of multi-layer categorical rasters and `extract`. [#580] by André M. Bellvé - `weighted.mean` did not adjust the weights if there were `NA`s in the values. [#574] by Lars Dalby - bug in masking. [#552] reported by Márcia Barbosa and [565] by Jakub Nowosad. - fixed `stretch` option in `plotRGB` [#550] by Agustin Lobo - unwrap of a SpatRaster failed with a crs including a "'". [#602] by Jean Romain. - `spatSample` with `cells=TRUE` failed for planar data [#544] by Benjamin Misiuk - `compareGeom(x, y, stopOnError=FALSE)` did not remove the error messages stored in `x` leading to unexpected warnings later on. [#568] by David Hofmann. ## enhancements - Using & or | with SpatRasters now returns a boolean SpatRaster. [#594] by Dan Baston - SpatVector now supports logical values. [#593] by Derek Friend - Attempt to create SpatRaster with an invalid number of rows now gives an error. [#544] by Dan Baston - `layerCor` does not create temp files anymore. [#551] by Christine Anderson - not using the same iterator symbols in nested loops to avoid warnings on the Intel compiler. [#573] by Gareth Davies. ## new - new arguments `res` and `origin` to `project` method. [#596] by Alex Ilich - new argument `inside=TRUE` to `centroids` to get a centroid-like point that is guaranteed to be on the geometry ("point on surface"). [#588] by Márcia Barbosa - new argument `keepgeom=FALSE` to `vect` that allows setting (keeping) the geometry as an attribute. [#586] by Márcia Barbosa - `saveRDS` and `serialize` methods for SpatRaster and SpatVector. [#549] by Andrei Mîrț - `xFromCol` and `yFromCol` now have a `` method. [#583] by Michael Sumner. - `svc` method to deal with GeometryCollection types. [#585] by Sarah Endicott - `as.points` and `as.polygons` have a new argument `na.all=FALSE` that affects the interpretation of `na.rm`. [#548] by Jean-Luc Dupouey. - `setGDALconfig` and `getGDALconfig` to set GDAL configuration options. [#608] by Erik Bolch. - new argument `circular` to `rapp` to allow the start to be after the end (for if layers represent days of the year) - new method `costDistance` - new methods `where.min` and `where.max` for `SpatRaster` to get the cell numbers for the extreme values in a SpatRaster. - new method `emptyGeoms` to get the indices of empty (null) geometries - new method `rasterizeGeom` to rasterize the geometry count or the area of (small) polygons or the length of lines. - new method `not.na` for `SpatRaster` which is a shortcut for `!is.na(x)`. - `as.list` implemented for ``. - `sources` implemented for ``, `` and `` [#638] by Andrew Gene Brown ## name changes - delauny -> delaunay [#627] by Derek Friend # version 1.5-21 Released 2022-02-17 - `writeVector` and `vect` now work with GPGK if the path has non-ascii characters [#518] - The results of `predict` with `cores > 1` and more than one output variable were garbled - `zonal` dropped category names when using an external (R) function [#527] by Jakub Nowosad - focal/focalCpp showed strange patterns when the window size was larger than the block size [#519] by Alex Ilich - using `xy=TRUE` in `as.data.frame` normalized the names [#538] by Kodi Arfer - new argument `options` to `vrt` [#629] by Monika Tomaszewska. ## enhancements - `makeTiles` has new arguments `extend` and `na.rm` [#520] by by L. Dalby - `project` now uses nearest neighbor as default method for RGB rasters - new argument `na.rm=TRUE` to `unique`. [#561] by Matthieu Stigler # version 1.5-17 Released 2022-01-30 ## bug fixes - `app` ignored the filename. [#498] by jszhao - `vect` failed silently if xy coordinates were integers [#496] by Márcia Barbosa - The output of `aggregate` was malformed when `nrow(x) %% fact != 0`. [#492] by Jean-François Bourdon - Integer `NA`s in SpatVector attributes where only recognized on Windows [#491] by Márcia Barbosa - `plot` failed when using a character variable with many unique values. [#489] by Márcia Barbosa - `rotate` failed on large files. Reported by Ujjawal Singh - writing raster files with a color table could lead to a crash [#501] by Kodi Arfer - `crds` replicated the coordinates [#504] by Murray Efford - `as.data.frame` returned integers if the file stored values as integers, even if there was a scale/offset that creates decimal numbers [#509] by Kodi Arfer - `project` opened the input raster file in read/write mode instead of read mode. That did not work with files that cannot be updated. ## enhancements - `distance`, `gridDistance`, `direction` and `patches` now process all layers of the input SpatRaster. [#503] by Chris Haak - consistent copy-on-modify behavior in `()<-` methods. in-place updating available with `set.` methods such as `set.names` and `set.values`. [#493] by Jean Romain and [#511] by Bryan Fuentes - much faster writing of GPGK vector data by using a single transaction (following sf) [#460] by Krzysztof Dyba - `aggregate` now accepts functions that return more than one value per aggregated cell - `writeVector` has new argument `insert` to add a layer to an existing file (e.g. GPKG). ## new - new option `method="weights"` for `spatSample` - new `mask` method to select intersecting geometries - new method `is.related` - `values` has new option `na.rm=TRUE`. [#490] by Henk Harmsen - new class `SpatVectorProxy` to provide access to large vector databases that cannot or should not be read into memory in its entirety. - new argument `proxy=FALSE` to `vect` to create a SpatVectorProxy object - new method `query` to extract parts of a SpatVectorProxy - new method `vector_layers` that returns, and can delete, vector format layers from a database/file such as GPKG ## name changes To avoid name clashes with tidyverse - arrow -> north - src -> sprc - simplify -> simplifyGeom For consistency - setCats -> set.cats # version 1.5-12 Released 2022-01-13 ## bug fixes - `setValues` and `init` failed (or even crashed R) when using a single value on a largish raster. [#414] - conversion from `sfc` to `SpatVector` lost the crs. [#415] by Jean-Luc Dupouey - `buffer` on a SpatRaster with no values caused a crash [#416] by Sebastian Brinkmann - `writeVector` now assumes "traditional GIS order" (long/lat) if the CRS specifies lat/long. [#333]( by Agustin Lobo - argument `main` was ignored in `density` when using a single layer SpatRaster [#424] by dvictori - Summary type math functions such as `min` and `mean`, when used with multiple SpatRasters and numbers, ignored additional SpatRasters [#426] by Zhuonan Wang - names are now conserved when creating a SpatRaster from a RasterStack that points to file(s) [#430] by Dan Baston - `classify` with `right=FALSE` ignored `include.lowest=TRUE` [#442] by Alex Ilich - `patches` now combines patches that connect across the data line [#366] by Hirscht - `patches(directions=8)` now connects in NE/SW direction [#451] by Jean-François Bourdon. - `centroids` now considers cases where SpatVector parts are nearest to each other when crossing the date line instead of the zero-meridian [#366] by Hirscht - `terrain` created empty (`NA`) rows between chunks used for processing large rasters. [#453] by Robert Ritson. - `inset` did not draw the "box" correctly. [#457] by Márcia Barbosa - `as.lines` now works with a points SpatVector [#464] by Márcia Barbosa ## enhancements - `values(x)<-` now accepts (hex coded) colors as values - `focal` now wraps around the dateline like raster::focal [#242] by Alexander Marbler - `aggregate` now does not show a progress bar in all cases [#249] by Lachlan - `as.data.frame or ` are now also implemented as S3 methods to assure correct dispatch by other S3 methods such as `data.table::as.data.table`. See [#284] by Patrick Schratz - `crs` now shows the correct authority if it is not EPSG. [#419] by Matthew Williamson - It now possible to add a SpatRaster to an empty SpatRaster (with no values), even if it has a different geometry, ignoring the empty SpatRaster [#421] by Alex Ilich. - `rast` has a new argument `lyrs` to subset the layers and open the file in one step. - `rast` now has a crs and extent argument. [#439] by RS-eco - `type="xyz"` is now default in `rast`. [#438] by RS-eco - `classify` has a new argument `brackets` to show if a side of an interval is open or closed. - further support for categorical data in `freq` and `as.data.frame`. [#441] ngould7 - speed up in processing of multi-layer in memory data. [#437] by Krzysztof Dyba - `vect` and `vect` are now much faster. [#413] by BastienFR - `extract` with points provided as a matrix or cell numbers is not much faster. [#341] - `focal` has a new argument `na.policy` that can be set to one of "all" (default), "only" or "omit". argument `na.only` has been removed, as you can now use `na.policy="only"` - `inset` argument `border` changed to `perimeter` to allow passing `border` on to `plot`. [#456] by Márcia Barbosa - The compile-time and run-time versions of GEOS are now compared and a warning is given if they are not the same. [#459] by Edzer Pebesma - it is now possible to add sub-datasets to GPKG and GTiff files. [#300] by gtitov - general option `memfrac` can now be set to zero (in stead of not lower than 0.1). [#476] by Matt Strimas-Mackey - new argument `allowGaps` in `patches` to disallow gaps between patch IDs. See [#478] by Dunbar Carpenter. ## new - timestamps and units are now saved to an auxiliary file (filename.aux.json) for all raster formats except NetCDF when using writeCDF (because in that case they are stored in the netcdf file) - new method `mergeTime` to combine multiple rasters, perhaps partly overlapping in time, into a single time series - new method `fillTime` that can add empty layers in between existing layers to assure that the time step between layers is constant - new method `approximate` to fill in missing values by cell across layers - new methods `is.bool` and `as.bool` for SpatRaster and explicit recognition of Boolean raster data in various places (e.g., extract, plot) - new methods `is.int` and `as.int` for SpatRaster. - when assigning integer values to a SpatRaster, or when reading an integer file, the corresponding layers are now classified as being of integer type [#446] by L. Dalby - new method `layerCor` (like `raster::layerStats`). [#420] by Alex Ilich - new method `focalCor` (like `raster::corLocal`). [#427] by Zhuonan Wang - new method `all.equal` for `SpatRaster`. See [#428] by Dongdong Kong - new method `math` for `SpatRaster` that implements the Math-generic methods *and* accepts a filename - new method `sds` - new method `rasterize`, see [#413] by BastienFR - new method `colorize` to transform color representations - new method `arrow` to draw a (North) arrow on a map. [#461] by Márcia Barbosa - new method `densify` to insert nodes between existing nodes of a line or polygon SpatVector - new method `direction` for SpatRaster. [#462] by Márcia Barbosa - new method `focal3D` to compute focal values for a three-dimensional (row, column, layer) window - new function `makeVRT` to create a vrt file for a file that needs a header to be read. - new option `method="stratified"` for `spatSample`. [#470] by Michael Mahoney - new general option `memmax` to cap the amount of RAM that terra can be used in raster processing [#476] by Matt Strimas-Mackey - new method `gridDistance` to compute distances traversing a raster, perhaps with obstacles. [#477] by Márcia Barbosa # version 1.4-22 Released 2021-11-24 ## changes - `focal` now has ellipses (`...`) to allow for providing additional arguments to `fun`. For this reason it does not have a `na.rm` argument anymore as that can be supplied via the ellipses. In practice this means that the default will be `na.rm=FALSE` for the standard functions such as `mean` and `sum`. ## bug fixes - `app` grossly overestimated RAM needed, slowing it down. Reported by Jerry Nelson - `terra` now installs, again, with older versions of GEOS [#406] by fparyani - `terra` did not install with Clang on CRAN/OSX due to using C++13 idiom. ## enhancements - `lapp` and `tapp` now have a `cores` argument (as do `app` and `predict`). Suggested by Dongdong Kong [#365] - `focal` now also works with a function that returns multiple values. See [#318] by Alex Ilich. - `focal` can now process multiple layers in one step. - expanded support for conversion from `stars` objects [#220] by Jakub Nowosad ## new - `focalCpp` takes a C++ function that iterates over cells to speed up computation by avoiding `apply` (see [#318] by Alex Ilich). - `focalReg` for focal OLS regression models between layers # version 1.4-20 Released 2021-11-16 ## bug fixes - `terra` did not install with versions of GDAL below 3 [#402] by Alex Ilich. - `distance` between two SpatVectors or matrices with `pairwise=FALSE` returned a matrix that was filled by column instead of by row [#403] by Paul Smith # version 1.4-19 Released 2021-11-15 ## bug fixes - `rast` with some NetCDF files failed because of bad parsing of dates. [#361] by Juan Carlos Zamora-Pereira - `distance` with lon/lat data was not correct. [#368] by Greg Schmidt - `as.polygons` failed with a SpatRaster and a categorical layer that is not the first layer. [#370] by Patrick Schratz - The filename argument in `rasterize` was not ignored, also causing errors when writing to temporary files. [#377] by Robbie Price - `rast` crashed if the sds was an empty character string. [#381] by Dan Baston - `plot` now responds to the `range` argument [#385] by Márcia Barbosa - `zonal` failed for user-defined functions. [#393] by mqueinnec ## new - new method `selectHighest` to select n cell values with the highest or lowest values. - new method `vect` to append SpatVectors (faster than `do.call(rbind, x)`) - new argument `align=FALSE` to `project` to align to the template SpatRaster but ignore the resolution - new method `gdalCache` to set the GDAL cache size, contributed by Dan Baston [#387] - new method `fileBlocksize` - new argument `options` to `writeVector` to pass layer creation options to GDAL - new SpatVector topology methods `mergeLines`, `snap`, `makeNodes`, `removeDupNodes`, `gaps`, `simplify` - new SpatVector characterization methods `width` and `clearance` ## enhancements - `terra` now installs with older versions of GEOS [#363] - `terra` now installs on CentOS 7 with GDAL 2.1.4 and a C++ compiler that does not support std::regexp. [#384] by Ariel Paulson # version 1.4-11 Released 2021-10-11 ## enhancements - the definition of `setValues` now has two arguments (`x` and `values`), just like `raster` had; to avoid reverse dependency problems with `raster` # version 1.4-9 Released 2021-10-07 ## name changes To avoid name conflicts with `sp` (via `raster`) `disaggregate` is now called `disagg` and `bbox,SpatRaster` and `bbox` have been removed (but could be resurrected in `raster` or under another name). ## enhancements - `project` and `resample` now choose the resampling method based on the first layer, using "near" for categorical data. Thanks to Matthew Lewis [#355] ## bug fixes - `hist` failed with small samples. Issue [#356] by Martin Queinnec # version 1.4-7 Released 2021-10-05 ## note `terra` no longer depends on `raster`. To avoid name clashes between these two packages, and to allow replacing methods from `rgeos` and `rgdal` in `raster`, `raster` now depends on `terra` instead. ## enhancements - `freq` has a new argument `usenames`. See issue [#309] by Bappa Das - `rast` has a new argument `opts` that can be used to pass GDAL open options. See issue [#314] - `rast` now takes arguments `names` and `vals`. See issue [#323] by Dongdong Kong - `crs<-` now warns if an unsupported datum is used. See issue [#317] - `spatSample` now returns factor values if a SpatRaster layer is.factor except when using `as.df=FALSE` - new method `origin<-` to set the origin of a SpatRaster. See issue [#326] by Jakub Nowosad - `crs` has a new argument `parse`. See [#344] - `plot` has a new argument `reset=FALSE` that allows resetting the par()$mar parameters after plotting. See issue [#340] by Derek Friend - `crds` has a new argument `na.rm`. See [#338] by Kodi Arfer - `show(Spat*)` now prints the name and EPSG code of a crs if available. See [#317] by Jakub Nowosad ## bug fixes - `plotRGB` failed if there were `NA`s. Issue [#308] by Jakub Nowosad - `writeVector` crashed R when used with a SpatVector with no geometries. Reported by Timothy White in issue [#319] - `summary` now returns counts for the classes (instead of a numerical summary of the indices) [#324] by Jakub Nowosad - `tapp` with a character index now returns a SpatRaster with the correct names [#345] by Stuart Brown - `rasterize` with a character variable now adds the ID column to the categories [#337] by Tate Brasel - `cellSize` now masks values in all cases (when requested with `mask=TRUE`). Issue [#339] by Jean-Luc Dupouey - `buffer` no longer treats lines like polygons [#332] by Márcia Barbosa - `plot` now passes the layer index to `fun` [#310] by Ben Tupper - the `to_id` in `nearest` was sometimes wrong. See [#328] by Shawn Ligocki - better support for ESRI value attribute tables (VAT). See this [SO question]( https://stackoverflow.com/q/69385928/635245) - `focal` did not reset initial values for NA cells when processing chunks. [#312] by Jeffrey Evans - `focal` could run out of memory when using a large window and user-defined function, and was inexact at the chunk boundary [#347] - `zonal` with `as.raster=TRUE` failed for categorical SpatRasters [#348] by Jakub Nowosad # version 1.3-22 Released 2021-08-20 ## enhancements - if `time(x) <- d` is set with a `Date` class object, `time(x)` now returns a `Date` object instead of a `POSIXct` object. Issue [#256] by Mauricio Zambrano-Bigiarini - The UTF-8 encoding of character attributes of a SpatVector is now declared such that they display correctly in R. See issue [#258] by AGeographer. Also implemented for names in both SpatVector and SpatRaster - `rast` method to avoid confusion with the `matrix` and `list` methods in response to a [SO question](https://stackoverflow.com/q/68133958/635245) by Stackbeans - the extreme values used to represent NA where not as intended (one or two lower) for INT2U and INT4U. Reported by Jean-Luc Dupouey on [stackoverflow](https://stackoverflow.com/q/68216362/635245) - `writeCDF` now also writes the time dimensions if there is only one time-step. See this [SO question](https://stackoverflow.com/a/68227180/635245) - `vect` (filename) now has argument `layer` to select a layer from a multi-layer file / database, and arguments `query`, `extent` and `filter` for reading a subset - `subst` can now create multiple output layers See [issue 276] by Agustin Lobo - `classify` can now create different multiple output layers See [issue 276] by Agustin Lobo - Argument `alpha` of `plot` can now be a `SpatRaster`. See this [SO question](https://stackoverflow.com/q/68736432/635245) by James McCarthy ## bug fixes - The `filename` and `overwrite` arguments were ignored in `rasterize` - gdal options are now also honored for create-copy drivers [#260] - buffer for lonlat now works better at the world's "edges" [#261] - scale/offset were ignored by `project`. Reported by Fabian Fischer - `rasterize` with `inverse=TRUE` crashed the R session. Issue [#264] by Jean-Luc Dupouey - The output of `merge` and `mosaic` was not correct for large rasters (only the first rows were used). Reported by Zavud Baghirov in [#271] - `as.points,SpatRaster` did not remove `NA`'s correctly and shifted values. Issues [#269] and [#273] by Julian Hagenauer - `rast` rotated values when using an equal-sided matrix [#274] by Jakub Nowosad - the number of rows and columns were reversed when using `project` with a crs argument. [#283] by Timothée Giraud - In `classify`, argument `right` had TRUE and FALSE reversed. - `terrain` had edge effects [#303] by Andrew Gene Brown. - `terrain` can now compute multiple variables at once [#286] by Žan Kuralt - `wrap` changed factors into numeric [#302] by Patrick Schratz - `writeVector` failed with "FlatGeobuf" (and probably other formats as well) for not using a proper MultiPolygon [#299] by L Dalby - regular sampling of polygons with `spatSample` is now much more regular [#289] by Jakub Nowosad # version 1.3-4 Released 2021-06-20 ## new - `na.omit` to remove empty geometries and/or attribute records that have an `NA` - new method `src` to create a `SpatRasterCollection` (a loose collection of tiles). - `merge` and `mosaic` now have methods for a `SpatRasterCollection`. To avoid the (inefficient) use of `do.call`. #210 by Matthew Talluto. - `activeCat` and `activeCat<-` to get or set the "active" category if there are multiple categories (raster attributes) - `as.numeric` and `catalyze` to transfer categories to numeric cell values - summarize methods such as `range` and `mean` for (the attributes of) a `SpatVector` - new method `shade`, to compute hill shading ## enhancements - additional arguments (such as `na.rm`) are now used by `rasterize` with point geometries. #209 by Jakub Nowosad - improved handling (and documentation) of `gstat` models by `interpolate`. #208 by Jakub Nowosad - new argument `cpkgs` to `predict` to list the packages that need to be exported to the cores if argument `cores` is larger than one. `?predict` now shows different approaches to parallelize `predict` (based on examples in issue. #178 by by Matthew Coghill. - `freq` now returns labels for categorical layers - `adjacent` now has a `pairs` argument. #239 by Kenneth Blake Vernon - `adjacent` now also takes a matrix to specify adjacent cells - `mean` and other summarize methods now take a `filename` argument and disallow non-recognized named arguments. #238 by Jessica Nephin - The raster attribute table of ESRI-GRID integer data, or from an ESRI `vat.dbf` file is now ignored if it only has the counts of the values. #234 by Jullee - time attributes are no longer lost when doing raster operations. #246 by Mauricio Zambrano-Bigiarini - resample (and project) no longer ignore `gdal=""` write options and use BIGTIFF if necessary (suggested by Ani Ghosh) - new argument `layer` in the `extract-SpatRaster,SpatVector` method to extract values for a single layers specified for each geometry (see this [question](https://gis.stackexchange.com/a/401591/8993)). ## bug fixes - better handling of paths with non-ASCII characters (e.g., Chinese) for GeoTiff but still fails for NetCDF. [#233] by Dongdong Kong - `extract` with points and `cells=TRUE` or `xy=TRUE` gave garbled output - `as.character` (called by `wrap`) did not capture the layer names. [#213] by Pascal Title - `focal` mirrored the weight matrix, thus affecting the results when using an asymmetrical weight matrix. Reported by Sebastiano Trevisani - `terra::terraOptions` now works without attaching the package. [#229] by Karl Dunkle Werner - `app` with `ncores > 0` and a function that returns multiple layers now works. [#240] by BastienFR. - `autocor` (local) can now handle `NA` values. [#245] by Jakub Nowosad . - `mask` with a SpatVector and a large (out of memory) multi-layer SpatRaster only worked for the first layer. Reported by Monika Tomaszewska. # version 1.2-10 Released 2021-05-13 ## new - `as.lines` method for SpatRaster - `as.polygons` method for SpatVector lines - `autocor` has new methods `mean`, to compute the local mean, and `locmor`, for the local Moran's *I* - `sharedPaths` method for SpatVector (lines and polygons) - `RGB2col` method to reduce a three-layer RGB SpatRaster to a single layer SpatRaster with a color-table (with <= 256 colors) - `split` methods for SpatVector and SpatRaster ## enhancements - `rast` now takes the crs from the Raster object, not from the file it may point to. [#200] by Floris Vanderhaeghe - `convhull` has a new argument `by=""` to make convex hulls for sub-sets of a SpatVector. - faster processing of large in memory rasters. See issue [#206] by Krzysztof Dyba. ## bug fixes - `extract` with multiple layers could return a data.frame where the values were not in the correct order (by row instead of by column) - `crop` works again with `sf` objects. [#201] by Sebastian Brinkmann - `vect` now also works for lines, and should be faster - `vect` crashed R if a file had empty geometries. [#202] by consumere - `extract(points, bilinear=TRUE, cells=TRUE)` now works. [#203] by fab4app - `zonal` now works for `min` and `max`. [#207] Reported by Jakub Nowosad ## name changes To avoid name conflicts with the `spatstat` package - `area,SpatRaster-method(x, sum=FALSE)` -> `cellSize(x)` - `area,SpatRaster/SpatVector-method(x, sum=TRUE)` -> `expanse(x)` - `convexhull` -> `convHull` - `perimeter` -> `perim` - `tiles` -> `makeTiles` - `coords` -> `crds` # version 1.2-5 Released 2021-04-30 ## new - `trim` has a new argument `value` that allows trimming rows and columns with other values than the default `NA` - `rapp` has a new argument `clamp` that allows clamping start and end values to `1:nlyr(x)`, avoiding that all values are considered `NA` - `spatSample` has new arguments `as.points` and `values`. Getting values, cells and coordinates is no longer mutually exclusive. In response to [#191] by Agustin Lobo - `area` has a new argument `mask=FALSE` - `classify` can now take a single number to request that many cuts - `mosaic` and `merge` now warn and resample if rasters are not aligned - `extract` has a new argument `exact` to get the fraction covered for each cell ## bug fixes - `flip(x, direction="vertical")` no longer reverses the order of the layers - `extract` did not work for horizontal or vertical lines as their extent was considered invalid. Reported by Monika Tomaszewska - `autocor` did not handle NA values [#192] by Laurence Hawker - `nearest` now works for angular coordinates - The unit of `slope` in `terrain` was not correct (the tangent was returned instead of the slope), [#196] by Sven Alder - `quantile` now works for rasters that have cells that are all `NA`. Reported by Jerry Nelson ## name changes To avoid name conflicts with tidyverse with deprecation warning: - separate -> segregate - expand -> extend - near -> nearby - pack -> wrap without deprecation warning: - transpose -> trans - collapse -> tighten - fill -> fillHoles - select -> sel # version 1.1-17 Released 2021-04-14 ## major changes - `c` now returns a list. `rbind` is used to append SpatVector objects - overhaul of handling of factors. `rats` has been removed, and `levels` and `cats` have changed # version 1.1-4 - No news recorded for this and earlier versions terra/configure.ac0000644000176200001440000005043014741300126013655 0ustar liggesusersdnl Process this file with autoconf to produce a configure script. dnl GDAL stuff largely copied from rgdal, (c) Roger Bivand AC_INIT AC_CONFIG_SRCDIR([src/read_ogr.cpp]) : ${R_HOME=`R RHOME`} if test -z "${R_HOME}"; then echo "could not determine R_HOME" exit 1 fi RBIN="${R_HOME}/bin/R" # https://github.com/r-spatial/sf/issues/1054: # RVER=`"${RBIN}" --version | head -1 | cut -f3 -d" "` RSCRIPT="${R_HOME}/bin/Rscript" RVER=`"${RSCRIPT}" -e 'writeLines(paste(sep=".", base::version$major, base::version$minor))'` RVER_MAJOR=`echo ${RVER} | cut -f1 -d"."` RVER_MINOR=`echo ${RVER} | cut -f2 -d"."` RVER_PATCH=`echo ${RVER} | cut -f3 -d"."` #if test [$RVER_MAJOR = "development"]; then CXX=`"${RBIN}" CMD config CXX` #else # if test [$RVER_MAJOR -lt 3] -o [$RVER_MAJOR -eq 3 -a $RVER_MINOR -lt 3]; then # AC_MSG_ERROR([terra is not compatible with R versions before 3.3.0]) # else # CXX=`"${RBIN}" CMD config CXX` # fi #fi # pick all flags for testing from R : ${CC=`"${RBIN}" CMD config CC`} : ${CFLAGS=`"${RBIN}" CMD config CFLAGS`} : ${CPPFLAGS=`"${RBIN}" CMD config CPPFLAGS`} : ${CXXFLAGS=`"${RBIN}" CMD config CXXFLAGS`} : ${LDFLAGS=`"${RBIN}" CMD config LDFLAGS`} # AC_SUBST([CC],["clang"]) # AC_SUBST([CXX],["clang++"]) AC_MSG_NOTICE([CC: ${CC}]) AC_MSG_NOTICE([CXX: ${CXX}]) # AC_MSG_NOTICE([${PACKAGE_NAME}: ${PACKAGE_VERSION}]) GENERIC_INSTALL_MESSAGE=" *** Installing this package from source requires the prior *** installation of external software, see for details *** https://rspatial.github.io/terra/" #GDAL GDAL_CONFIG="gdal-config" GDAL_CONFIG_SET="no" AC_ARG_WITH([gdal-config], AS_HELP_STRING([--with-gdal-config=GDAL_CONFIG],[the location of gdal-config]), [gdal_config=$withval]) if test [ -n "$gdal_config" ] ; then GDAL_CONFIG_SET="yes" AC_SUBST([GDAL_CONFIG],["${gdal_config}"]) AC_MSG_NOTICE(gdal-config set to $GDAL_CONFIG) fi if test ["$GDAL_CONFIG_SET" = "no"] ; then AC_PATH_PROG([GDAL_CONFIG], ["$GDAL_CONFIG"],["no"]) if test ["$GDAL_CONFIG" = "no"] ; then AC_MSG_ERROR([gdal-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}]) fi else AC_MSG_CHECKING(gdal-config exists) if test -r "${GDAL_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_ERROR([gdal-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}]) fi AC_MSG_CHECKING(gdal-config executable) if test -x "${GDAL_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_ERROR([gdal-config not executable. ${GENERIC_INSTALL_MESSAGE}]) fi fi AC_MSG_CHECKING(gdal-config usability) if test `${GDAL_CONFIG} --version`; then GDAL_CPPFLAGS=`${GDAL_CONFIG} --cflags` GDAL_VERSION=`${GDAL_CONFIG} --version` GDAL_LIBS=`${GDAL_CONFIG} --libs` GDAL_DEP_LIBS=`${GDAL_CONFIG} --dep-libs` GDAL_DATADIR=`${GDAL_CONFIG} --datadir` AC_MSG_RESULT(yes) else AC_MSG_ERROR([gdal-config not found. ${GENERIC_INSTALL_MESSAGE}]) fi AC_MSG_NOTICE([GDAL: ${GDAL_VERSION}]) AC_MSG_CHECKING([GDAL version >= 2.0.1]) GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MIN_VER=`echo $GDAL_VERSION | cut -d "." -f2` GDAL_PATCH_VER=`echo $GDAL_VERSION | cut -d "." -f3` if test ${GDAL_MAJ_VER} -lt 2 ; then AC_MSG_RESULT(no) AC_MSG_ERROR([terra is not compatible with GDAL versions below 2.0.1]) else AC_MSG_RESULT(yes) fi #if test [${GDAL_MAJ_VER} -eq 3] -a [${GDAL_MIN_VER} -eq 6] -a [${GDAL_PATCH_VER} -eq 0] ; then if test "${GDAL_VERSION}" = "3.6.0" ; then AC_MSG_ERROR([GDAL version 3.6.0 has been withdrawn, please update GDAL]) fi INLIBS="${LIBS}" INCPPFLAGS="${CPPFLAGS}" INPKG_CPPFLAGS="${PKG_CPPFLAGS}" INPKG_LIBS="${PKG_LIBS}" AC_SUBST([PKG_CPPFLAGS], ["${INPKG_CPPFLAGS} ${GDAL_CPPFLAGS}"]) AC_SUBST([PKG_LIBS], ["${INPKG_LIBS} ${GDAL_LIBS}"]) # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS}" gdalok=yes AC_CHECK_HEADERS(gdal.h,,gdalok=no) if test "${gdalok}" = no; then AC_MSG_ERROR([gdal.h not found in given locations.. ${GENERIC_INSTALL_MESSAGE}]) fi NEED_DEPS=no LIBS="${INLIBS} ${PKG_LIBS}" [cat > gdal_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif int main(void) { GDALAllRegister(); } #ifdef __cplusplus } #endif _EOCONF] AC_MSG_CHECKING(GDAL: linking with --libs only) ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdalok=no AC_MSG_RESULT(no) else AC_MSG_RESULT(yes) fi if test "${gdalok}" = no; then AC_MSG_CHECKING(GDAL: linking with --libs and --dep-libs) LIBS="${LIBS} ${GDAL_DEP_LIBS}" gdalok=yes ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2>> errors.txt if test `echo $?` -ne 0 ; then gdalok=no fi if test "${gdalok}" = yes; then NEED_DEPS=yes AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) fi fi if test "${gdalok}" = no; then cat errors.txt AC_MSG_NOTICE([Install failure: compilation and/or linkage problems.]) AC_MSG_ERROR([GDALAllRegister not found in libgdal. ${GENERIC_INSTALL_MESSAGE}]) fi rm -f gdal_test errors.txt gdal_test.cpp GDAL_GE_250="no" GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MOD_VER=`echo $GDAL_VERSION | cut -d "." -f2` if test "${GDAL_MAJ_VER}" = 2 ; then if test "${GDAL_MOD_VER}" -ge 5 ; then GDAL_GE_250="yes" fi else if test "${GDAL_MAJ_VER}" -ge 3 ; then GDAL_GE_250="yes" fi fi GDAL_DATA_TEST_FILE="${GDAL_DATADIR}/pcs.csv" AC_MSG_CHECKING(GDAL: ${GDAL_DATADIR}/pcs.csv readable) if test -r "${GDAL_DATA_TEST_FILE}" ; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) if test "${GDAL_GE_250}" = "no" ; then AC_MSG_ERROR([pcs.csv not found in GDAL data directory. ${GENERIC_INSTALL_MESSAGE}]) fi fi # Optional local copy of GDAL datadir and PROJ_LIB data_copy=no if test "${PROJ_GDAL_DATA_COPY}" ; then data_copy=yes AC_MSG_NOTICE([PROJ_GDAL_DATA_COPY used.]) else AC_ARG_WITH([data-copy], AS_HELP_STRING([--with-data-copy=yes/no],[local copy of data directories in package, default no]), [data_copy=$withval]) fi if test "${data_copy}" = "yes" ; then AC_MSG_NOTICE([Copy data for:]) proj_lib0="${PROJ_LIB}" AC_ARG_WITH([proj-data], AS_HELP_STRING([--with-proj-data=DIR],[location of PROJ data directory]), [proj_lib1=$withval]) if test -n "${proj_lib0}" ; then proj_lib="${proj_lib0}" else proj_lib="${proj_lib1}" fi if test -n "${proj_lib}" ; then if test -d "${proj_lib}" ; then cp -r "${proj_lib}" "${R_PACKAGE_DIR}" AC_MSG_NOTICE([ PROJ: ${proj_lib}]) else AC_MSG_ERROR([PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR.]) fi else AC_MSG_ERROR([PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR.]) fi if test -d "${GDAL_DATADIR}" ; then cp -r "${GDAL_DATADIR}" "${R_PACKAGE_DIR}" AC_MSG_NOTICE([ GDAL: ${GDAL_DATADIR}]) else AC_MSG_ERROR([GDAL data files not found.]) fi fi # # test whether PROJ is available to gdal: # gdal_has_proj=no [cat > gdal_proj.cpp <<_EOCONF #include #include #include int main(int argc, char *argv[]) { OGRSpatialReference *dest = new OGRSpatialReference; OGRSpatialReference *src = new OGRSpatialReference; src->importFromEPSG(4326); dest->importFromEPSG(3857); OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(src, dest); return(ct == NULL); // signals PROJ is not available through gdal } _EOCONF] AC_MSG_CHECKING(GDAL: checking whether PROJ is available for linking:) ${CXX} ${CPPFLAGS} -o gdal_proj gdal_proj.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdal_has_proj=no AC_MSG_RESULT(no) else gdal_has_proj=yes AC_MSG_RESULT(yes) fi if test "${gdal_has_proj}" = no; then cat errors.txt AC_MSG_NOTICE([Install failure: compilation and/or linkage problems.]) AC_MSG_ERROR([cannot link projection code. ${GENERIC_INSTALL_MESSAGE}]) fi AC_MSG_CHECKING(GDAL: checking whether PROJ is available for running:) if test "x$cross_compiling" = "xyes"; then AC_MSG_RESULT(cross compiling, assuming yes) else ./gdal_proj if test `echo $?` -ne 0 ; then gdal_has_proj=no AC_MSG_RESULT(no) else gdal_has_proj=yes AC_MSG_RESULT(yes) fi if test "${gdal_has_proj}" = no; then AC_MSG_ERROR([OGRCoordinateTransformation() does not return a coord.trans: PROJ not available? ${GENERIC_INSTALL_MESSAGE}]) fi fi rm -fr errors.txt gdal_proj.cpp gdal_proj AC_MSG_NOTICE([GDAL: ${GDAL_VERSION}]) # sqlite3 AC_ARG_WITH([sqlite3-lib], AS_HELP_STRING([--with-sqlite3-lib=LIB_PATH],[the location of sqlite3 libraries]), [sqlite3_lib_path=$withval]) if test [ -n "$sqlite3_lib_path" ] ; then AC_SUBST([SQLITE3_LIBS], ["-L${sqlite3_lib_path}"]) fi # # PROJ # PROJ_CONFIG="pkg-config proj" if `$PROJ_CONFIG --exists` ; then AC_MSG_NOTICE([pkg-config proj exists, will use it]) proj_config_ok=yes else proj_config_ok=no fi AC_ARG_WITH([proj-include], AS_HELP_STRING([--with-proj-include=DIR],[location of proj header files]), [proj_include_path=$withval]) if test [ -n "$proj_include_path" ] ; then AC_SUBST([PROJ_CPPFLAGS],["-I${proj_include_path}"]) else if test "${proj_config_ok}" = yes; then PROJ_INCLUDE_PATH=`${PROJ_CONFIG} --cflags` AC_SUBST([PROJ_CPPFLAGS],["${PROJ_INCLUDE_PATH}"]) fi fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt AC_ARG_WITH([proj-api], AS_HELP_STRING([--with-proj-api=yes/no],[use the deprecated proj_api.h even when PROJ 6 is available; default no]), [proj_api=$withval]) PROJ6="no" PROJH="no" if test "${proj_config_ok}" = yes; then PROJ_VERSION=`${PROJ_CONFIG} --modversion` PROJV1=`echo "${PROJ_VERSION}" | cut -c 1` if test "${PROJV1}" -ge 6; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" if test "${proj_api}" = yes; then AC_MSG_NOTICE([using proj_api.h even with PROJ 5/6]) PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DACCEPT_USE_OF_DEPRECATED_PROJ_API_H" else AC_MSG_NOTICE([using proj.h.]) PROJH="yes" fi fi else if test "${PROJH}" = no ; then PROJH=yes AC_CHECK_HEADERS(proj.h,,PROJH=no) if test "${PROJH}" = yes; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" fi fi fi CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS} ${PROJ_CPPFLAGS}" if test "${PROJH}" = no then proj4ok=yes AC_CHECK_HEADERS(proj_api.h,,proj4ok=no) if test "${proj4ok}" = no; then AC_MSG_ERROR([proj_api.h not found in standard or given locations.]) fi fi # dnl ditto for a library path AC_ARG_WITH([proj-lib], AS_HELP_STRING([--with-proj-lib=LIB_PATH],[the location of proj libraries]), [proj_lib_path=$withval]) if test [ -n "$proj_lib_path" ] ; then AC_SUBST([PROJ_LIBS], ["-L${proj_lib_path} ${INPKG_LIBS} -lproj"]) else if test "${proj_config_ok}" = yes; then if test `uname` = "Darwin"; then PROJ_LIB_PATH=`${PROJ_CONFIG} --libs --static` else PROJ_LIB_PATH=`${PROJ_CONFIG} --libs` fi AC_SUBST([PROJ_LIBS], ["${PROJ_LIB_PATH} ${INPKG_LIBS}"]) proj_version=`${PROJ_CONFIG} --modversion` AC_MSG_NOTICE([PROJ: ${proj_version}]) else PROJ_LIBS="${PKG_LIBS} -lproj" fi fi LIBS="${PROJ_LIBS} ${INLIBS} ${PKG_LIBS}" if test "${PROJH}" = no; then proj4ok=yes AC_CHECK_LIB(proj,pj_init_plus,,proj4ok=no) if test "${proj4ok}" = no; then AC_MSG_ERROR([libproj not found in standard or given locations.]) fi [cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d\n", PJ_VERSION); exit(0); } _EOCONF] else [cat > proj_conf_test.cpp <<_EOCONF #include #include #include int main(void) { proj_context_create(); exit(0); } _EOCONF] #AC_CHECK_LIB(proj,proj_context_create,,proj6ok=no) AC_MSG_CHECKING(PROJ: checking whether PROJ and sqlite3 are available for linking:) ${CXX} ${CPPFLAGS} -o proj_conf_test proj_conf_test.cpp ${LIBS} $SQLITE3_LIBS -lsqlite3 2> errors.txt if test `echo $?` -ne 0 ; then proj6ok=no AC_MSG_RESULT(no) else proj6ok=yes AC_MSG_RESULT(yes) fi if test "${proj6ok}" = no; then AC_MSG_ERROR([libproj or sqlite3 not found in standard or given locations.]) fi [cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d.%d.%d\n", PROJ_VERSION_MAJOR, PROJ_VERSION_MINOR, PROJ_VERSION_PATCH); exit(0); } _EOCONF] fi #AC_MSG_NOTICE([PKG_LIBS: ${PKG_LIBS}]) ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} proj_version=`./proj_conf_test` AC_ARG_WITH([proj-share], AS_HELP_STRING([--with-proj-share=SHARE_PATH],[the location of proj metadata files]), [proj_share_path=$withval]) if test [ -n "$proj_share_path" ] ; then AC_MSG_NOTICE([PROJ_LIB: ${proj_share_path}]) fi if test ${PROJ6} = "no"; then [cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "epsg", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF] ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test [ -n "$proj_share_path" ] ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi AC_MSG_CHECKING(PROJ: epsg found and readable) if test ${proj_share} -eq 1 ; then AC_MSG_RESULT(no) STOP="stop" else AC_MSG_RESULT(yes) fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/epsg not found" echo "Either install missing proj support files, for example" echo "the proj-nad and proj-epsg RPMs on systems using RPMs," echo "or if installed but not autodetected, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi else # proj >= 6 if test "${PROJH}" = no; then [cat > proj_conf_test.c <<_EOCONF #include #include int main(void) { PAFile fp; projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "proj.db", "rb"); if (fp == NULL) exit(1); pj_ctx_fclose(ctx, fp); exit(0); } _EOCONF] ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test [ -n "$proj_share_path" ] ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi AC_MSG_CHECKING(PROJ: proj.db found and readable) if test ${proj_share} -eq 1 ; then AC_MSG_RESULT(no) STOP="stop" else AC_MSG_RESULT(yes) fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/proj.db not found" echo "Either install missing proj support files, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi [cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "conus", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF] ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test [ -n "$proj_share_path" ] ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi AC_MSG_CHECKING(PROJ: conus found and readable) if test ${proj_share} -eq 1 ; then WARN="warn" AC_MSG_RESULT(no) else AC_MSG_RESULT(yes) fi rm -f proj_conf_test.c proj_conf_test if test "$WARN" = "warn" ; then echo "Note: proj/conus not found" echo "No support available in PROJ4 for NAD grid datum transformations" echo "If required, consider re-installing from source with the contents" echo "of proj-datumgrid-1..zip from http://download.osgeo.org/proj/ in nad/." fi fi # PROJH = no fi # proj >= 6 # # GEOS: # GEOS_CONFIG="geos-config" GEOS_CONFIG_SET="no" AC_ARG_WITH([geos-config], AS_HELP_STRING([--with-geos-config=GEOS_CONFIG],[the location of geos-config]), [geos_config=$withval]) if test [ -n "$geos_config" ] ; then GEOS_CONFIG_SET="yes" AC_SUBST([GEOS_CONFIG],["${geos_config}"]) AC_MSG_NOTICE(geos-config set to $GEOS_CONFIG) fi if test ["$GEOS_CONFIG_SET" = "no"] ; then AC_PATH_PROG([GEOS_CONFIG], ["$GEOS_CONFIG"],["no"]) if test ["$GEOS_CONFIG" = "no"] ; then AC_MSG_RESULT(no) AC_MSG_ERROR([geos-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}]) fi else AC_MSG_CHECKING(geos-config exists) if test -r "${GEOS_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([geos-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}]) fi AC_MSG_CHECKING(geos-config executable) if test -x "${GEOS_CONFIG}"; then AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([geos-config not executable. ${GENERIC_INSTALL_MESSAGE}]) fi fi AC_MSG_CHECKING(geos-config usability) if test `${GEOS_CONFIG} --version` then GEOS_CLIBS="`${GEOS_CONFIG} --clibs`" #GEOS_DEP_CLIBS=`geos-config --static-clibs` -- this gives -m instead of -lm, which breaks clang # fixed in 3.7.0 at https://github.com/libgeos/libgeos/pull/73#issuecomment-262208677 GEOS_DEP_CLIBS=`${GEOS_CONFIG} --static-clibs | sed 's/-m/-lm/g'` GEOS_CPPFLAGS=`${GEOS_CONFIG} --cflags` AC_MSG_RESULT(yes) else AC_MSG_RESULT(no) AC_MSG_ERROR([${GEOS_CONFIG} not usable]) fi GEOS_VERSION=`${GEOS_CONFIG} --version` AC_MSG_NOTICE([GEOS: ${GEOS_VERSION}]) AC_MSG_CHECKING([GEOS version >= 3.4.0]) # GDAL 2.0.1 requires GEOS 3.1.0 GEOS_VER_DOT=`echo $GEOS_VERSION | tr -d ".[[:alpha:]]"` if test ${GEOS_VER_DOT} -lt 340 ; then AC_MSG_RESULT(no) AC_MSG_ERROR([upgrade GEOS to 3.4.0 or later]) else AC_MSG_RESULT(yes) fi AC_SUBST([PKG_CPPFLAGS], ["${INPKG_CPPFLAGS} ${PROJ_CPPFLAGS} ${GDAL_CPPFLAGS} ${GEOS_CPPFLAGS}"]) AC_SUBST([PKG_LIBS], ["${INPKG_LIBS} ${GDAL_LIBS}"]) if test "${NEED_DEPS}" = yes; then AC_SUBST([PKG_LIBS], ["${PKG_LIBS} ${GDAL_DEP_LIBS}"]) fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${CPPFLAGS} ${PKG_CPPFLAGS}" LIBS="${LIBS} ${PKG_LIBS}" geosok=yes AC_CHECK_HEADERS(geos_c.h,,geosok=no) if test "${geosok}" = no; then AC_MSG_ERROR([geos_c.h not found in given locations.]) fi [cat > geos_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif static void __errorHandler(const char *fmt, ...) { return; } static void __warningHandler(const char *fmt, ...) { return; } int main(void) { GEOSContextHandle_t r = initGEOS_r((GEOSMessageHandler) __warningHandler, (GEOSMessageHandler) __errorHandler); finishGEOS_r(r); } #ifdef __cplusplus } #endif _EOCONF] #echo "${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${LIBS}" AC_MSG_CHECKING(geos: linking with ${GEOS_CLIBS}) ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no AC_MSG_RESULT(no) else AC_SUBST([PKG_LIBS], ["${PKG_LIBS} ${GEOS_CLIBS}"]) AC_MSG_RESULT(yes) fi if test "${geosok}" = no; then AC_MSG_CHECKING(geos: linking with ${GEOS_DEP_CLIBS}) ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_DEP_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no AC_MSG_RESULT(no) cat errors.txt AC_MSG_NOTICE([Install failure: compilation and/or linkage problems.]) AC_MSG_ERROR([initGEOS_r not found in libgeos_c.]) else AC_SUBST([PKG_LIBS], ["${PKG_LIBS} ${GEOS_DEP_CLIBS}"]) AC_MSG_RESULT(yes) fi fi rm -f geos_test errors.txt geos_test.cpp # # add PROJ_LIBS # AC_SUBST([PKG_LIBS], ["${PROJ_LIBS} ${PKG_LIBS}"]) # # concluding substitution # AC_MSG_NOTICE([Package CPP flags: ${PKG_CPPFLAGS}]) AC_MSG_NOTICE([Package LIBS: ${PKG_LIBS}]) AC_CONFIG_FILES(src/Makevars) AC_OUTPUT terra/inst/0000755000176200001440000000000014757467215012366 5ustar liggesusersterra/inst/tinytest/0000755000176200001440000000000014743504671014242 5ustar liggesusersterra/inst/tinytest/test_zonal.R0000644000176200001440000000132014536376240016542 0ustar liggesusers v <- rast(matrix(c(1, 2, 3, NA), ncol = 2)) z <- rast(matrix(c(1, 1, 2, 2), ncol = 2)) a <- zonal(v, z, \(x) sum(is.na(x))) expect_equal(unlist(a, use.names=FALSE), c(1,2,0,1)) a <- zonal(v, z, "isNA") expect_equal(unlist(a, use.names=FALSE), c(1,2,0,1)) a <- zonal(v, z, \(x) mean(x)) expect_equal(unlist(a, use.names=FALSE), c(1,2,1.5,NA)) a <- zonal(v, z, "mean") expect_equal(unlist(a, use.names=FALSE), c(1,2,1.5,NA)) a <- zonal(v, z, \(x) mean(x, na.rm=T)) expect_equal(unlist(a, use.names=FALSE), c(1,2,1.5,3)) a <- zonal(v, z, \(x, ...) mean(x, ...), na.rm=T) expect_equal(unlist(a, use.names=FALSE), c(1,2,1.5,3)) a <- zonal(v, z, "mean", na.rm=T) expect_equal(unlist(a, use.names=FALSE), c(1,2,1.5,3)) terra/inst/tinytest/test_plot.R0000644000176200001440000000015714736314264016404 0ustar liggesusers # multiple sources s <- rast(system.file("ex/logo.tif", package="terra")) plotRGB(c(s[[1]], s[[2]], s[[3]])) terra/inst/tinytest/test_equal.R0000644000176200001440000000047614536376240016541 0ustar liggesusers x <- sqrt(1:100) mat <- matrix(x, 10, 10) r1 <- rast(nrows=10, ncols=10, xmin=0, vals = x) r2 <- rast(nrows=10, ncols=10, xmin=0, vals = mat) expect_inherits(all.equal(r1, r2), "character") expect_true(all.equal(r1, r1)) # works for multiple layers r3 <- c(r1, r2) r4 <- c(r1, r2) expect_true(all.equal(r3, r4)) terra/inst/tinytest/test_aggregate.R0000644000176200001440000000113514536376240017351 0ustar liggesusers r <- rast(ncol = 4, nrow = 4, xmin=0, xmax=1, ymin=0, ymax=1) values(r) <- c(NA, 2:16) expect_equal(as.vector(values(aggregate(r, 2, mean))), c(NaN, 5.5, 11.5, 13.5)) expect_equal(as.vector(values(aggregate(r, 2, mean, na.rm=TRUE))), c(4 + 1/3, 5.5, 11.5, 13.5)) rr = c(r,r*2) expect_equal(as.vector(values(aggregate(rr, 2, mean))), c(NaN, 5.5, 11.5, 13.5, NaN, 11.0, 23.0, 27.0)) expect_equal(as.vector(values(aggregate(rr, 2, mean, na.rm=TRUE))), c(4 + 1/3, 5.5, 11.5, 13.5, 8+2/3, 11.0, 23.0, 27.0)) expect_equal(as.vector(values(aggregate(rr, 2, min, na.rm=TRUE))), c(2, 3, 9, 11, 4, 6, 18, 22)) terra/inst/tinytest/test_weighted-mean.R0000644000176200001440000000075314536376240020146 0ustar liggesusers x <- rast(nrows=10, ncols=10, xmin=0, xmax=10, vals = 1) y <- rast(nrows=10, ncols=10, xmin=0, xmax=10, vals = 2) z <- rast(nrows=10, ncols=10, xmin=0, xmax=10, vals = 3) wt <- c(x,y,z) z[1,1] <- NA xt <- c(x,y,z) wm <- terra::weighted.mean(xt, wt, na.rm = TRUE) terra_wm <- as.numeric(global(wm, fun = "min")) # |> not available on older R # global(fun = "min") |> # as.numeric() stats_wm <- stats::weighted.mean(x = c(1,2,NA), w = 1:3, na.rm = TRUE) expect_equal(terra_wm, stats_wm) terra/inst/tinytest/test_geom.R0000644000176200001440000000237614536376240016362 0ustar liggesusers r <- rast(ncol = 20, nrow = 10, xmin=-10, xmax=10, ymin=-5, ymax=6) values(r) <- ncell(r):1 r <- c(r, r/2, r*2) # compare geometries expect_equal(res(r), c(1.0, 1.1)) expect_equal(dim(r), c(10, 20, 3)) expect_equivalent(as.vector(ext(r)), c(-10, 10, -5, 6)) expect_equal(xyFromCell(r, 10), cbind(x=-0.5, y=5.45)) expect_equal(xyFromCell(r, 1), cbind(x=-9.5, y=5.45)) expect_equal(xyFromCell(r, ncell(r)), cbind(x=9.5, y=-4.45)) expect_equal(as.vector(is.na(xyFromCell(r, 0))), c(TRUE, TRUE)) expect_equal(as.vector(is.na(xyFromCell(r, ncell(r)+1))), c(TRUE, TRUE)) expect_equivalent(r[10], data.frame(cbind(191, 95.5, 382))) expect_equivalent(r[2,], data.frame(matrix(c(180,179,178,177,176,175,174,173,172,171,170,169,168,167,166,165,164,163,162,161,90,89.5,89,88.5,88,87.5,87,86.5,86,85.5,85,84.5,84,83.5,83,82.5,82,81.5,81,80.5,360,358,356,354,352,350,348,346,344,342,340,338,336,334,332,330,328,326,324,322), ncol=3))) expect_equivalent(r[,2], data.frame(matrix(c(199,179,159,139,119,99,79,59,39,19,99.5,89.5,79.5,69.5,59.5,49.5,39.5,29.5,19.5,9.5,398,358,318,278,238,198,158,118,78,38), ncol=3))) expect_equivalent(r[3:4, 2:3], data.frame(matrix(c(159,158,139,138,79.5,79,69.5,69,318,316,278,276),ncol=3))) expect_equivalent(r[[1]][5,6][1], data.frame(lyr.1=115)) terra/inst/tinytest/test_extent.R0000644000176200001440000000027314536376240016734 0ustar liggesusers# intersection of disjoint envelopes is NULL a <- ext(c(xmin = 0, xmax = 10, ymin = 0, ymax = 10)) b <- ext(c(xmin = 100, xmax = 101, ymin = 100, ymax = 101)) expect_null(intersect(a, b))terra/inst/tinytest/test_vect-geom.R0000644000176200001440000000047714677042604017321 0ustar liggesusers f <- system.file("ex/lux.shp", package="terra") lux <- vect(f) listofraw <- geom(lux[1:2, ], wkb = TRUE) wkb <- listofraw[[1]] hex <- geom(lux[1, ], hex = TRUE) expect_equal(typeof(listofraw), "list") expect_equal(typeof(wkb), "raw") expect_equal(tolower(paste0(as.character(wkb), collapse = "")), tolower(hex)) terra/inst/tinytest/tinytest.R0000644000176200001440000000012714536376240016247 0ustar liggesusers if ( requireNamespace("tinytest", quietly=TRUE) ){ tinytest::test_package("terra") } terra/inst/tinytest/test_replace.R0000644000176200001440000000076014536376240017041 0ustar liggesusers r <- rast(nrow=2, ncol=2, vals=1:4) x <- c(r, r) x[1] <- cbind(5, 6) x[2] <- c(7, 8) expect_equal(as.vector(values(x)), c(5,7,3,4,6,8,3,4)) r <- rast(nrow=20, ncol=20) x <- setValues(r, 1:400) y <- setValues(r, rep(1:5, 80)) set.seed(1) x[sample(ncell(r), 100)] <- NA y <- mask(y, x) z1 <- rast(x) z1[y==1] <- x[y==1] y <- y == 1 z1[y] <- x[y] z2 <- mask(x, y, maskvalue=FALSE) z3 <- ifel(y, x, NA) z <- as.data.frame(c(z1, z2, z3)) expect_true(all(z[,1] == z[,2]) && all(z[,1] == z[,3])) terra/inst/tinytest/test_window.R0000644000176200001440000000131314536376240016730 0ustar liggesusers # #library(terra) # x <- rast(system.file("ex/logo.tif", package="terra")) # y <- rast(system.file("ex/logo.tif", package="terra")) * 1 # e <- ext(c(35,55,35,55)) # z <- crop(x, e) # window(x) <- e # window(y) <- e # a <- c(z, y, x) # s <- spatSample(x, 4, cell=TRUE) # expect_equal(s, spatSample(y, 3, cell=TRUE)) # expect_equal(s, spatSample(z, 3, cell=TRUE)) # expect_equal(s, spatSample(a, 3, cell=TRUE)) # expect_equal(values(x), values(y)) # expect_equal(values(x), values(z)) # xy <- 10 * cbind(-1:6, -1:6) # e1 <- extract(x, xy) # e2 <- extract(y, xy) # e3 <- extract(z, xy) # e4 <- extract(a, xy) # e <- cbind(e1, e2, e3) # expect_equal(e1, e2) # expect_equal(e1, e3) # expect_equivalent(e, e4) terra/inst/tinytest/test_multivariate.R0000644000176200001440000000047114543061432020123 0ustar liggesusers f <- system.file("ex/logo.tif", package = "terra") r <- rast(f) km <- k_means(r, centers=5) r[1] <- NA km <- k_means(r, centers=5) km <- k_means(r, centers=5, maxcell=10) x <- rast(system.file("ex/logo.tif", package="terra")) a <- layerCor(x, "cor") b <- layerCor(x, cor) expect_equivalent(a$correlation, b) terra/inst/tinytest/test_extract.R0000644000176200001440000003053214736314125017074 0ustar liggesusers set.seed(500) r <- rast(ext=c(0, 3, 0, 3), ncol = 3, nrow = 3, nlyr=2, vals=runif(18)) pts <- cbind(c(0.5, 1.5), c(0.5, 1.5)) vct <- terra::vect(pts) e <- terra::extract(r, vct, ID = FALSE) expect_equal(e[,1], c(0.5121819, 0.81227813)) e <- terra::extract(r, vct, ID = FALSE, fun=sum) expect_equal(e[,1], c(0.5121819, 0.81227813)) # multiple sources and band subset/order s <- rast(system.file("ex/logo.tif", package="terra")) e <- extract(c(s[[2:3]], s/10, s[[3:1]]), cbind(41.5, 52.5)) expect_equal(as.vector(unlist(e)), c(146, 185, 13.7, 14.6, 18.5, 185, 146, 137)) f <- system.file("ex/lux.shp", package="terra") y <- vect(f)[1:2,] elev <- rast(system.file("ex/elev.tif", package = "terra")) e <- extract(elev, y, fun=mean, na.rm=TRUE, ID=TRUE) expect_equal(e[,2], c(467.10517, 333.86294)) e <- extract(elev, y, fun=mean, exact=TRUE, na.rm=TRUE, ID=FALSE) expect_equal(e[,1], c(467.379239, 334.685564)) e <- extract(elev, y, fun=mean, weights=TRUE, na.rm=TRUE, ID=TRUE) expect_equal(e[,2], c(467.3933629, 334.65513085)) e <- extract(elev, 1, raw=TRUE) expect_true(inherits(e, "array")) x <- rast(y, res=.2) values(x) <- 1:ncell(x) expect_equal(cells(x, y), cbind(ID=c(1,2), cell=c(1,4))) expect_equal(as.vector(cells(x, y, weights=TRUE)), c(1, 1, 1, 2, 2, 2, 1, 2, 4, 2, 3, 4, 0.521988, 0.414648, 0.043812, 0.000240, 0.072960, 0.491532)) expect_equivalent(unlist(extract(x, y, ID=TRUE)), c(1,2,1,4)) expect_equivalent(unlist(extract(x, y, cells=TRUE, weights=TRUE, ID=TRUE)), c(1, 1, 1, 2, 2, 2, 1, 2, 4, 2, 3, 4, 1, 2, 4, 2, 3, 4, 0.521988, 0.414648, 0.043812, 0.000240, 0.072960, 0.491532)) r <- rast(nrows=5, ncols=5, xmin=0, xmax=1, ymin=0, ymax=1, names="test") r[c(2,7)] <- c(15, 20) rr <- c(r, r/2) names(rr)[2] <- "half" xy <- cbind(x=0.3, y=c(0.9, 0.7)) v <- vect(xy) e <- extract(r, v, ID=TRUE) expect_equal(e, data.frame(ID=1:2, test=c(15,20))) ee <- extract(rr, v, ID=TRUE) expect_equal(ee, data.frame(ID=1:2, test=c(15,20), half=c(7.5, 10))) e <- extract(r, v, cell=TRUE, ID=TRUE) expect_equal(e, data.frame(ID=1:2, test=c(15,20), cell=c(2,7))) ee <- extract(rr, v, cell=TRUE, ID=FALSE) expect_equal(ee, data.frame(test=c(15,20), half=c(7.5, 10), cell=c(2,7))) ee <- extract(rr, v, cell=TRUE, xy=TRUE, ID=TRUE) expect_equal(ee, data.frame(ID=1:2, test=c(15,20), half=c(7.5, 10), cell=c(2,7), xy)) ee <- extract(rr, v, xy=TRUE, ID=TRUE) expect_equal(ee, data.frame(ID=1:2, test=c(15,20), half=c(7.5, 10), xy)) f <- system.file("ex/meuse.tif", package="terra") r <- rast(f) xy <- cbind(179000, 330000) xy <- rbind(xy-100, xy, xy+1000) e <- extract(r, xy) expect_equal(e[,1] , c(378, 251, 208)) vxy <- vect(xy) e <- extract(r, vxy, ID=FALSE, method="bilinear") expect_equal(e[,1] , c(378.00, 270.75, 197.25)) e <- extract(r, vxy, method="bilinear", cells=TRUE, ID=FALSE) expect_equal(unlist(e, use.names=FALSE), c(378.00, 270.75, 197.25,8173.00,8016.00,6041.00)) r <- rast(nrows = 10, ncols = 10, nlyrs = 1, vals = 1:100, names = "temp") x1 <- rbind(c(-145,-10), c(-145,-5), c(-140, -5), c(-140,-10)) x2 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55)) z <- rbind(cbind(object=1, part=1, x1, hole=0), cbind(object=3, part=1, x2, hole=0)) colnames(z)[3:4] <- c('x', 'y') p <- vect(z, "polygons", crs=crs(r)) rr <- c(r, r*2) test <- terra::extract(r, p, ID=TRUE, fun = mean) expect_equal(as.vector(as.matrix(test)), c(1,2,51.5,53)) test <- terra::extract(rr, p, fun = mean, ID=TRUE) expect_equal(as.vector(as.matrix(test)), c(1,2,51.5,53,103,106)) test <- terra::extract(r, p, fun = mean, exact=TRUE, ID=TRUE) expect_equal(round(as.vector(as.matrix(test)),5), c(1,2, 51.80006, 52.21312)) test <- terra::extract(rr, p, fun = mean, exact=TRUE, ID=TRUE) expect_equal(round(as.vector(as.matrix(test)),5), c(1,2, 51.80006, 52.21312, 103.60012, 104.42623)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(100, 100, NaN, 100) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(100, NaN, 100, 100) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(100, 100, 100, NaN) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(NaN, 100, 100, 100) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(NaN, NaN, 100, 100) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(NaN, 100, NaN, 100) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(NaN, 100, 100, NaN) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(100, NaN, NaN, 100) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(100, NaN, 100, NaN) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) r <- terra::rast(nrow = 2, ncol = 2, nlyrs = 1, xmin = -100, xmax = 100, ymin = -100, ymax = 100) terra::values(r) <- c(100, 100, NaN, NaN) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 0.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = 45.0, Y = -45.0), method = "bilinear")$lyr.1), c(100.0)) expect_equal(round(terra::extract(r, data.frame(X = -45.0, Y = 45.0), method = "bilinear")$lyr.1), c(100.0)) # v <- vect(system.file("ex/lux.shp", package="terra"))[1:2,] # z <- rast(v, resolution=.1, names="test") # values(z) <- 1:ncell(z) # ee <- extract(z, v, as.list=TRUE) # expect_equal(rapply(ee, mean), c(5.20,16.75)) # x <- c(z, z*2, z/3) # names(x) <- letters[1:3] # ee <- extract(x, v, as.list=TRUE) # m <- matrix(rapply(ee, mean), ncol=nlyr(x), byrow=TRUE) # expect_equal(round(as.vector(t(m)),6), c(5.200000, 10.400000, 1.733333, 16.750000, 33.500000, 5.583333)) m = rast(nrow = 2, ncol = 2, vals=1:4) expect_equal(cells(m), 1:4) v <- vect(system.file("ex/lux.shp", package="terra")) r <- rast(system.file("ex/elev.tif", package="terra")) fun <- function(x, ...) c(min(x, ...), mean(x, ...), max(x, ...)) e <- extract(r, v, fun, na.rm=TRUE)[6,] expect_equivalent(round(e, 4), c(6, 164, 314.9969, 403)) e <- extract(r, v, quantile, na.rm=TRUE)[12,] expect_equivalent(round(e), c(12, 213, 274, 317, 352, 413)) fun <- c("min", "max") e <- extract(r, v[1:2, ], fun, na.rm=TRUE) expect_equivalent(unlist(e), c(1, 2, 339, 195, 547, 514)) x <- rast(ncol=4, nrow=4, nlyr=3, extent=ext(-2, 2, -2, 2)) values(x) <- rbind(11:13) xy <- data.frame(x=-1:1,y=-1:1) e <- extract(x, xy, ID=TRUE, layer=1:3) expect_equal(e$value, 11:13) terra/inst/tinytest/test_cats.R0000644000176200001440000000333614536376240016362 0ustar liggesusers set.seed(0) r <- rast(nrows=10, ncols=10) values(r) <- sample(3, ncell(r), replace=TRUE) r0 <- r * 1 # categories in a single layer lv <- data.frame(id=1:4, cover=c("forest", "water", "urban", "other"), stringsAsFactors=FALSE) levels(r) <- lv names(r) <- "land cover" v <- cats(r)[[1]] #coltab(r) <- rainbow(4) expect_equal(v$id, lv[,1]) expect_equal(v$cover, lv[,2]) r <- droplevels(r) expect_equal(levels(r)[[1]][,2], c("forest", "water", "urban")) lv <- lv[-4,] # reading/writing categories ftmp <- tempfile(fileext = ".tif") z <- writeRaster(r, ftmp, overwrite=TRUE) v <- cats(z)[[1]] expect_equal(v$value, 1:3) expect_equal(v$`land cover`, lv[,2]) # reading/writing subset of categories levels(r) = cats(r)[[1]][2:3,] zz = writeRaster(r, ftmp, overwrite=TRUE) v <- cats(zz)[[1]] expect_equal(v$value, 2:3) expect_equal(v$cover, lv[-1,2]) # categories in multiple layers r2 <- rast(list(a=r0, b=r0)) # values are numeric initially expect_equal(values(r2)[1,], c(a = 2, b = 2)) # set layer a categories levels(r2) <- lv expect_equal(levels(r2), list(lv, "")) # verify samples for layer a have categories expect_equal( r2[c(15,3)], data.frame(cover = factor(c("forest", "urban"), levels = lv[,2]), b = c(1, 3), stringsAsFactors=FALSE )) # set all layer categories levels(r2) <- rep(list(lv), 2) expect_equal(levels(r2), list(lv, lv)) # verify samples for layer a and layer b have categories expect_equal(r2[c(15,3)], data.frame(cover = factor(c("forest", "urban"), levels = lv[,2]), cover = factor(c("forest", "urban"), levels = lv[,2]), stringsAsFactors=FALSE, check.names = FALSE)) # make sure no errors when show()ing factors expect_silent(show(r2)) terra/inst/tinytest/test_matrix-input.R0000644000176200001440000000340714536376240020070 0ustar liggesusers expect_equal(class(rast(volcano))[1], "SpatRaster") ## degeneracies dm1 <- rast(matrix(1:10)) dm2 <- rast(matrix(1:10, nrow = 1)) expect_equal(class(dm1)[1], "SpatRaster") expect_equal(class(dm2)[1], "SpatRaster") expect_equal(dim(dm1), c(10L, 1L, 1L)) expect_equal(dim(dm2), c(1L, 10L, 1L)) r <- rast(matrix(1)) expect_equal(class(r)[1], "SpatRaster") expect_error(rast(matrix(1:4)[0, , drop = FALSE])) # test_that matrix input type xyz works r <- rast(cbind(as.matrix(expand.grid(1:3, 1:4)), 1:12), type = "xyz") expect_equal(class(r)[1], "SpatRaster") m <- cbind(x=c(1,1,2,2), y=c(1,2,1,2), z1=1:4, z2=5:8) r <- rast(m, type="xyz") expect_equal(as.vector(values(r)), c(2,4,1,3,6,8,5,7)) #---------------------------------------------------------------- ## ensure matrix and array input result in extent 0,nrow,0,ncol ## no input r <- rast(ncol = 4, nrow = 4, xmin=0, xmax=1, ymin=0, ymax=1) expect_equal(c(xmin(r), xmax(r), ymin(r), ymax(r)), c(0, 1, 0, 1)) ## matrix r <- rast(matrix(1:12, 3)) expect_equal(c(xmin(r), xmax(r), ymin(r), ymax(r)), c(0, 4, 0, 3)) ## array (degenerate) r <- rast(array(1:12, c(3, 4))) expect_equal(c(xmin(r), xmax(r), ymin(r), ymax(r)), c(0, 4, 0, 3)) ## array r <- rast(array(1:24, c(3, 4, 2))) expect_equal(c(xmin(r), xmax(r), ymin(r), ymax(r)), c(0, 4, 0, 3)) ## unless we provide on creation r <- rast(matrix(1:12, 3), extent = c(-2, 10, -1, 20)) expect_equal(c(xmin(r), xmax(r), ymin(r), ymax(r)), c(-2, 10, -1, 20)) r <- rast(array(1:12, c(3, 4)), extent = c(-2, 10, -1, 20)) expect_equal(c(xmin(r), xmax(r), ymin(r), ymax(r)), c(-2, 10, -1, 20)) r <- rast(array(1:24, c(3, 4, 2)), extent = c(-2, 10, -1, 20)) expect_equal(c(xmin(r), xmax(r), ymin(r), ymax(r)), c(-2, 10, -1, 20)) #---------------------------------------------------------------- terra/inst/tinytest/test_crop.R0000644000176200001440000000177614536376240016401 0ustar liggesusers r <- rast(nrow=10, ncol=10, extent=ext(0, 10, 0, 10)) e <- ext(-10, 15, -10, 15) expect_equivalent(as.vector(ext(crop(r, e))), c(0,10,0,10)) expect_equivalent(as.vector(ext(crop(r, e, extend=TRUE))), c(-10,15,-10,15)) e <- ext(-10, 5, -10, 5) expect_equivalent(as.vector(ext(crop(r, e))), c(0,5,0,5)) expect_equivalent(as.vector(ext(crop(r, e, extend=TRUE))), c(-10,5,-10,5)) e <- ext(0, 5, 0, 5) expect_equivalent(as.vector(ext(crop(r, e))), c(0,5,0,5)) expect_equivalent(as.vector(ext(crop(r, e, extend=TRUE))), c(0,5,0,5)) values(r) <- 1 e <- ext(-10, 15, -10, 15) expect_equivalent(as.vector(ext(crop(r, e))), c(0,10,0,10)) expect_equivalent(as.vector(ext(crop(r, e, extend=TRUE))), c(-10,15,-10,15)) e <- ext(-10, 5, -10, 5) expect_equivalent(as.vector(ext(crop(r, e))), c(0,5,0,5)) expect_equivalent(as.vector(ext(crop(r, e, extend=TRUE))), c(-10,5,-10,5)) e <- ext(0, 5, 0, 5) expect_equivalent(as.vector(ext(crop(r, e))), c(0,5,0,5)) expect_equivalent(as.vector(ext(crop(r, e, extend=TRUE))), c(0,5,0,5)) terra/inst/tinytest/test_focal.R0000644000176200001440000000406314536376240016512 0ustar liggesusers m <- matrix(0,3,3) m[c(4,6)] <- c(1,-1) r <- rast(nrows=3, ncols=3, vals=1:9, crs="+proj=merc") f <- focal(r, m, na.rm=TRUE) e <- c(-4, -5, -6, -6, -6, -6, 4, 5, 6) expect_equal(e, as.vector(values(f))) f <- focal(r, t(m), na.rm=TRUE) e <- c(-2, -2, 2, -5, -2, 5, -8, -2, 8) expect_equal(e, as.vector(values(f))) #expect_error(focal(r, m, fun=mean, na.rm=TRUE), pattern="[focal]") #e <- c(-4, -5, -6, -3, -3, -3, 4, 5, 6) #expect_equal(e, as.vector(values(f))) m <- matrix(1,3,3) f <- focal(r, m, na.rm=TRUE) e <- c(12,21,16,27,45,33,24,39,28) expect_equal(e, as.vector(values(f))) f <- focal(r, 3, na.rm=TRUE) expect_equal(e, as.vector(values(f))) f <- focal(r, m, na.rm=FALSE, fillvalue=0) expect_equal(e, as.vector(values(f))) f <- focal(r, m, na.rm=FALSE) e <- c(NA, NA, NA, NA, 45, NA, NA, NA, NA) expect_equal(e, as.vector(values(f))) f <- focal(r, 3, na.rm=FALSE) expect_equal(e, as.vector(values(f))) r <- rast(nrow=3, ncol=3) values(r) <- 1:ncell(r) rr <- rast(nrow=3, ncol=3, xmin=0) values(rr) <- 1:ncell(rr) f <- focalValues(r)[1,] e <- c(NA, NA, NA, 3, 1, 2, 6, 4, 5) expect_equal(e, f) f <- focalValues(rr)[1,] e <- c(NA, NA, NA, NA, 1, 2, NA, 4, 5) expect_equal(e, f) f <- as.vector(values(focal(rr, 3, max, na.rm=TRUE))) e <- c(5, 6, 6, 8, 9, 9, 8, 9, 9) expect_equal(e, f) f <- as.vector(values(focal(r, 3, max, na.rm=TRUE))) e <- c(6, 6, 6, 9, 9, 9, 9, 9, 9) expect_equal(e, f) f <- as.vector(values(focal(rr, 3, sum, na.rm=TRUE))) e <- c(12, 21, 16, 27, 45, 33, 24, 39, 28) expect_equal(e, f) f <- as.vector(values(focal(r, 3, sum, na.rm=TRUE))) e <- c(21, 21, 21, 45, 45, 45, 39, 39, 39) expect_equal(e, f) f <- as.vector(values(focal(rr, 3, mean, na.rm=FALSE))) e <- c(NA, NA, NA, NA, 5, NA, NA, NA, NA) expect_equal(e, f) f <- as.vector(values(focal(r, 3, mean, na.rm=FALSE))) e <- c(NA, NA, NA, 5, 5, 5, NA, NA, NA) expect_equal(e, f) r <- rast(ncols=100, nrows=100, ext(0, 10, 0, 10)) values(r) = 1:ncell(r) r[5,]=NA f= focal(r, w=5, fun=mean, na.policy="only", na.rm=TRUE, wopt=list(steps=4)) x = (f - r) expect_equal(sum(values(x), na.rm=TRUE), 0) terra/inst/tinytest/test_global.R0000644000176200001440000000062014536376240016661 0ustar liggesusers f <- system.file("ex/elev.tif", package="terra") r <- rast(f) r[1:50,] <- NA v <- c(717627, 304.33715, 141, 432, 308.22562, 48.40079, 141, 432) f <- c("sum", "mean", "min", "max", "rms", "sd", "range") x <- unlist(sapply(f, function(s) global(r, s, na.rm=TRUE))) #terraOptions(steps=4, todisk=T) y <- unlist(sapply(f, function(s) global(r, s, na.rm=TRUE))) expect_equivalent(x,v) expect_equal(x, y) terra/inst/tinytest/test_patches.R0000644000176200001440000000167014536376240017056 0ustar liggesusers r <- rast(matrix(c(0,1,1,0), ncol=2)) p <- patches(r, directions = 8, zeroAsNA=TRUE) expect_equal(as.vector(values(p)), c(NaN, 1, 1, NaN)) p <- patches(r, directions = 4, zeroAsNA=TRUE) expect_equal(as.vector(values(p)), c(NaN, 1, 2, NaN)) r <- rast(matrix(c(1,0,0,1), ncol=2)) p <- patches(r, directions = 8, zeroAsNA=TRUE) expect_equal(as.vector(values(p)), c(1, NaN, NaN, 1)) p <- patches(r, directions = 4, zeroAsNA=TRUE) expect_equal(as.vector(values(p)), c(1, NaN, NaN, 2)) p <- patches(r, directions = 4, zeroAsNA=FALSE) expect_equal(as.vector(values(p)), c(1, 1, 1, 1)) r <- rast(nrows=18, ncols=36) r[1:2, 5:8] <- 11 r[7:8, 1:6] <- 12 r[5:6, 22:36] <- 13 r[15:16, 18:29] <- 14 p <- patches(r) expect_equal(as.vector(unique(values(p))), c(NaN, 1:4)) p <- patches(r, directions=8) expect_equal(as.vector(unique(values(p))), c(NaN, 1:3)) xmin(r) <- 0 p <- patches(r, directions=8) expect_equal(as.vector(unique(values(p))), c(NaN, 1:4)) terra/inst/tinytest/test_raster-vector.R0000644000176200001440000000317314536376240020227 0ustar liggesusers#context("test-raster-vector") # #p1 <- rbind(c(-180, -20), c(-140, 55), c(10, 0), c(-140, -60), c(-180, -20)) #hole <- rbind(c(-150, -20), c(-100, -10), c(-110, 20), c(-150, -20)) #p2 <- rbind(c(-10, 0), c(140, 60), c(160, 0), c(140, -55), c(-10, 0)) #p3 <- rbind(c(-125, 0), c(0, 60), c(40, 5), c(15, -45), c(-125, 0)) #z <- rbind(cbind(object=1, part=1, p1, hole=0), # cbind(object=1, part=1, hole, hole=1), # cbind(object=2, part=1, p2, hole=0), # cbind(object=3, part=1, p3, hole=0)) #colnames(z)[3:4] <- c('x', 'y') #z <- data.frame(z) #v <- vect(z, "polygons") #vx <- as(z, "SpatialPolygons") #crs(vx) <- "+proj=longlat +datum=WGS84" # #r <- rast(ncol = 20, nrow = 10) #rx <- raster(ncol = 20, nrow = 10) #rv <- rasterize(v, r) #rvx <- rasterize(vx, rx) # #test_that("rasterize", { # expect_equivalent(values(rv), values(rvx)) #}) # #test_that("crop", { # #ex <- extent(-90,90,-60,60) # #e <- ext(-90,90,-60,60) # rc <- crop(rv, v) # rcx <- crop(rvx, vx) # expect_equivalent(values(rc), values(rcx)) #}) # # #test_that("mask", { # values(r) <- values(rx) <- 1:ncell(r) # m <- mask(r, v) # mx <- mask(rx, vx) # expect_equivalent(values(m), values(mx)) #}) # # #set.seed(0) #values(r) <- values(rx) <- runif(ncell(r)) # # #test_that("classify", { # rcl <- cbind(from=seq(0,0.9,.1), to=seq(0.1,1,.1), becomes=1:10) # rc <- classify(r, rcl) # rcx <- reclassify(rx, rcl) # expect_equivalent(values(rc), values(rcx)) #}) # # #test_that("app", { # s <- c(r, log(r), sqrt(r)) # sx <- stack(rx, log(rx), sqrt(rx)) # rd <- app(s, mean) # rdx <- calc(sx, mean) # expect_equivalent(values(rd), values(rdx), tolerance=0.00001) #}) # #terra/inst/tinytest/test_wkt_grd.R0000644000176200001440000000103214536376240017060 0ustar liggesusers# failed on CRAN #if (terra::gdal() >= "2.3.0") { # fl <- system.file("ex/test.grd", package="terra") # tst <- terra::rast(fl) # terra::crs(tst) <- "EPSG:28992" # tf <- tempfile(fileext=".grd") # terra::writeRaster(tst, tf) # tst1 <- terra::rast(tf) # if (terra::gdal() > "3.4.2") { # expect_identical(terra::crs(tst, describe=TRUE)[1:3], # terra::crs(tst1, describe=TRUE)[1:3]) # } else { # expect_false(isTRUE(all.equal(terra::crs(tst, describe=TRUE)[1:3], # terra::crs(tst1, describe=TRUE)[1:3]))) # } #} terra/inst/tinytest/test_arith.R0000644000176200001440000000035714536376240016537 0ustar liggesusers r <- rast(matrix(0.5, 2, 2)) expect_equal(as.vector(values(2 - r)), rep(1.5, 4)) expect_equal(as.vector(values(r - 2)), rep(-1.5, 4)) expect_equal(as.vector(values(2 / r)), rep(4, 4)) expect_equal(as.vector(values(r / 2)), rep(0.25, 4)) terra/inst/tinytest/test_flowAccumulation.R0000644000176200001440000000175514633631501020737 0ustar liggesusers### library(terra) #> terra 1.7.29 elev <- c(78, 72, 69, 71, 58, 49, 74, 67, 56, 49, 46, 50, 69, 53, 44, 37, 38, 48, 64, 58, 55, 22, 31, 24, 68, 61, 47, 21, 16, 19, 74, 53, 34, 12, 11, 12) |> matrix(ncol = 6, byrow = TRUE) |> rast() flowdir0 <- c(002,002,002,004,004,008, 002,002,002,004,004,008, 001,001,002,004,008,004, 128,128,001,002,004,008, 002,002,001,004,004,004, 001,001,001,001,000,016) |> matrix(ncol = 6, byrow = TRUE) |> rast() flowacc0 <- c(001,001,001,001,001,001, 001,002,002,003,003,001, 001,004,008,006,005,001, 001,001,001,021,001,002, 001,001,001,002,025,001, 001,003,005,008,036,002) |> matrix(ncol = 6, byrow = TRUE) |> rast() flowdir1 <- terrain(elev,"flowdir") flowacc1 <- flowAccumulation(flowdir1) result <- (flowacc1==flowacc0) & (flowdir1==flowdir0) expect_equal(all(result[]),TRUE) terra/inst/tinytest/test_time.R0000644000176200001440000000026414743505334016361 0ustar liggesusers x <- rast(nrows=2, ncols=2, vals=1:4, names="random") time(x) <- as.POSIXct("2000-01-02 12:12:12", tz="America/Los_Angeles") expect_equal(timeInfo(x)$zone, "America/Los_Angeles") terra/inst/tinytest/test_merge.R0000644000176200001440000000125414536376240016524 0ustar liggesusers r1 <- terra::rast(xmin = 0, xmax = 1); r1$x = 1; r1$y = 2 r2 <- terra::rast(xmin = 1, xmax = 2); r2$x = 3; r2$y = 4 expect_equal(names(terra::merge(r1, r2)), c("x", "y")) x <- rast(xmin=-110, xmax=-50, ymin=40, ymax=70, ncols=30, nrows=15) y <- rast(xmin=-80, xmax=-20, ymax=60, ymin=30) res(y) <- res(x) set.seed(1) vx <- 1:ncell(x) vx[floor(runif(50, min = 300, max = 450))] <- NA vy <- 1:ncell(y) vy[floor(runif(50, min = 0, max = 150))] <- NA values(x) <- vx values(y) <- vy m <- terra::merge(x, y) a <- m[11,1:20][[1]] w <- which(is.na(a)) expect_equal(w, c(2,3,9)) expect_equal(a[-w], c(301, 304, 305, 306, 307, 308, 310, 311, 312, 313, 314, 315, 151, 317, 153, 319, 320)) terra/inst/tinytest/test_rasterize.R0000644000176200001440000000043014720757472017435 0ustar liggesusers v <- vect(system.file("ex/lux.shp", package = "terra")) r <- rast(v, ncols = 75, nrows = 100) z <- rasterize(v, r, cover = TRUE, by = "ID_2") v <- unlist(z[30*75+28]) e <- c(0.01538462, NA, NA, NA, 0.9846154, NA, NA, NA, NA, NA, NA, NA) expect_equivalent(v, e, tolerance=2e-07) terra/inst/tinytest/test_pitfinder.R0000644000176200001440000000153314633631501017401 0ustar liggesusers ## Creation of a Digital Elevation Model elev <- array(NA,c(9,9)) dx <- 1 dy <- 1 for (r in 1:nrow(elev)) { x <- (r-5)*dx for (c in 1:ncol(elev)) { y <- (c-5)*dy elev[r,c] <- 10+5*(x^2+y^2) } } elev <- cbind(elev,elev) elev <- rbind(elev,elev) elev <- rast(elev) ## Flow Directions flowdir<- terrain(elev,v="flowdir") #t(array(flowdir[],rev(dim(flowdir)[1:2]))) ## Pit Detect pits1 <- pitfinder(flowdir) xypit <- as.data.frame(pits1,xy=TRUE) names(xypit) <- c("x","y","pit") xypit$icell <- 1:nrow(xypit) xypit[which(xypit$pit!=0),] xypit2 <- xypit[which(xypit$pit!=0),] # > xypit2 # x y pit icell # 77 4.5 13.5 1 77 # 86 13.5 13.5 2 86 # 239 4.5 4.5 3 239 # 248 13.5 4.5 4 248 pits0 <- elev*0 pits0[c(77,86,239,248)] <- c(1,2,3,4) result <- (pits1==pits0) expect_equal(all(result[]),TRUE)terra/inst/tinytest/test_vector-subset.R0000644000176200001440000000071414536376240020232 0ustar liggesusers f <- system.file("ex/lux.shp", package="terra") lux <- vect(f) expect_equal(dim(lux), c(12,6)) expect_equivalent(unlist(lux[,"ID_2",drop=TRUE]), c(1:7, 12, 8:11)) x <- lux[lux$NAME_1 == "Luxembourg", 2:3] expect_equal(length(x), 4) expect_equal(nrow(x), 4) expect_equal(ncol(x), 2) expect_equal(unique(x$NAME_1), "Luxembourg") expect_equivalent(unlist(x[,2,drop=TRUE]), 8:11) lux$ID_1 <- factor(LETTERS[1:12]) expect_equal(class(lux$ID_1), "factor") terra/inst/tinytest/test_rds.R0000644000176200001440000000032014752267471016213 0ustar liggesusers f <- system.file("ex/rds_tst.rds", package="terra") x <- rast(f) y <- rast(nrows=2, ncols=2, vals=1:4, names="random") time(y) <- as.POSIXct("2025-01-25 21:28:51", tz="UTC") expect_true(all.equal(x, y)) terra/inst/tinytest/test_classify.R0000644000176200001440000000142614536376240017243 0ustar liggesusers r <- rast(ncols=3, nrows=3) set.seed(68) values(r) <- runif(ncell(r)) # from example # all values > 0 and <= 0.25 become 1, etc. m <- c(0, 0.25, 1, 0.25, 0.5, 2, 0.5, 1, 3) # from example rclmat <- matrix(m, ncol=3, byrow=TRUE) rc <- classify(r, rclmat, include.lowest=TRUE) expect_equal(as.vector(values(rc)), c(3, 3, 2, 3, 2, 3, 3, 1, 2)) values(r) <- (1:ncell(r))-1 m <- c(0, 2, 1, 2, 3, 2, 3, 8, 3) rclmat <- matrix(m, ncol=3, byrow=TRUE) rc <- classify(r, rclmat, right=FALSE) expect_equal(as.vector(values(rc)), c(1, 1, 2, 3, 3, 3, 3, 3, 8)) rc <- classify(r, rclmat, right=TRUE) expect_equal(as.vector(values(rc)), c(0, 1, 1, 2, 3, 3, 3, 3, 3)) rc <- classify(r, rclmat, right=TRUE, include.lowest=TRUE) expect_equal(as.vector(values(rc)), c(1, 1, 1, 2, 3, 3, 3, 3, 3)) terra/inst/tinytest/test_crds.R0000644000176200001440000000020114536376240016347 0ustar liggesusers m <- matrix(c(0,1,0,0,0,1), ncol=2) v <- vect(m, type="polygons") x <- as.vector(crds(v)) expect_equal(x, c(0,1,0,0,0,0,1,0)) terra/inst/colors/0000755000176200001440000000000014536376240013657 5ustar liggesusersterra/inst/colors/legends.rds0000644000176200001440000002007014536376240016011 0ustar liggesusers|XW7b7XP ;fl{ffg)RņY {!vL D$*`5,c.Y7y죇{Ͻzf&MO>ywԜאge&\ ~+h@coUЄɦ,V'}%2Y%>2*54pft0PfBpT| DpUDLL7;s<*p1Nk2ӧ<)+ʪS\@ RNh{6ك; 8aٮڟ[w<Q{X˵m׍)H^ߺhf0C[wnofʦ`C3ӎX}l%fk~()vtbeb[O{}SNڷkh1D^} wuЖ\4NܾJqL퇼N'hλ_3 8t-,Ykgă>e5OP;Ńj V 3( 7,=5=!]㖙P["j4iKޘKwQ_ b޹!hkѫUʺ>G2 O7ʪh44 h htGYL@qeχƥqydΘ дCOtg߯ |.ɁNE'QiZ@s)=g->w&mבgO-❛ -nth~ Zf֡ެ%sV͚ m'm847]}&>p/p* A{9 ʢ"{d OoK֖..ǡGwԆBQ9dٶR{p_2I-pzpsp֙zTy uʖ zs(e#-lksخf opP.Л|с@ty3kO Xi-w6qEݲ}ib`wgB{P$䛭@5.tPM}u`[[PK,@xb {?L^c(?L/L+UoMդ8A7dE};P[hyw ujJ;> @Ӵqkڗ8|hvw 4wr8x׌Q!|ϪY4ij ţk@y>|[ l{zϺVC-^%5/Aoz:Q{ngs\O'{,>1u=+Lb7CN'wgCs<-?6O/?I^zL-i f϶v,ي{$Te-_}:]bs,}Au&7<`]omlipou-Ӹ܇@:΅@z;5[ Ӽ< 7ּ&'K6vl `òCr{nն<זFcP'0_y[-?Y1Ԡ3g:ǥ2_]+bA7ghCl|[S}L۾LӇu-0˂ʳ)W^&w6D9^N/+G >|z2WB%#IhIU`8{+0PrD+jMUe YpARqP&t(@Y*)I im$!'(T*$*RNjP& $@JNQPV!h#i6(/:"J?R:^C5`P0j!T|bP~Ոi~DE  ߱N@_ Y$* E qC$\_ZhҸ4E Ed/1DO (&ȢҐ dYKYR4IC?) YAr•VP%6VIQZïcEh:$q)KKֱ4cFw"@8t,?ë_<47@ ckf`Y,P!}>b@+h #|BH!} ܪQn/Ph!V&Y T(''G ƝPo\q//)Pi 'Tfel`qRdJcVҒTF-/#D/-CRIR'99֤Zupd\@ܸi@\rkFRIu()k™F7xsyIEFi%c+ȾOŪs^NU&1(+u"X+eݪ( LjD^$I**CunARy?3·rzLrUq\+ίB tKl)ԴS'R܁nyR3 s ,B_@>PVu+Z>w@r/G|:k bV4,in@rߞ*@t[69y67Jlh{Q~)zxs'@}Vuu[e}D6U:+o˝ ul : c2[Ѕ͘gf^]t[ƞiAwdPC~z50bq+=ưݩϠ,vR ̾F`n{ͣ' zWlz *&c?\S,Ҥ$oA#WJ@_ܤR kɵ2py9(Jgl8O8yۍTp nfw-3sMϔ?N>u7<(\ =zϣ(cwb4]xF0( ~8}x>zwi<gW.xިhO/׸2R=w8c8x y*bJ6r/,cs;1:ot=nx[’Vw7vtqn;=G'ՍmkàvCaP2z`.aPr̎L ZkcMK70vEP|.)&#?/|t9їc'\Y?|f=8nٶگ~Ws[j;yu߯>lb׷Ӹ$&^<]yw6#Qgv `sx/y>{uWd9~{='$_\E-߾sk=2)1vׯ / vqwU75f# G|~8XwW޲f6=AnwA@tn MZ^M2{U'nPκ|M= sk~f ]ڿ-S=z} o *1(Vv|sj]3WIb;APF hrnãlN *܆n!`x)K JXܬn::upSMnV7+aupapp0nǁ"Ё\AgK+_$ 4q,o]=TLR/:cJBq6?+HNP٫ZAgJ$ƆQj*=%r ʯcT3g̲ Z5<.DNE]OC^D0D]IFb Y EﾠNs.D%%WoyeZ0+XFVKn+@ lȌ8kُٸ&W۶8Mf6~ Ojmԩ߯zQ/K`[>7M[mݑc{{hC{4fѽI-;glEaϻy}]3*" +5ޘla>J-_RWv=|=R5c7wo}u3kq[32[zO5H|}?Oଚ4(:7 Asg}pI,pMSJ"˹qku!hv<N`yu;r8e;8,́Se[9׫ݻfnYj?p7r1mmm ˹-s?LG0p^;yR_g|\5a,^ \ \xMROuyoۀNyhYWVv.h2v\P/Wc[\Xb 7i nK?, Ͱpq/8gu5gDQKx=vtգq'۹7xs ^^YYWjs.pVߊ[ qjg؝).}v]DShm?s{tzܓÝ{AڎmI޻<}VM0Xbov.=9>&~M`hsT>>_K6iUays0`o_ Ԏ`3DW/G0P =yef`ː^ C,< Z̷GF`j~-ϗMNH{= OKC reFv>/̀~bSFp G'>e%vkfl0|袴6n 7 N^Ce90dVs+P=5`8nuN glKf O9}l3-P0h#$4.o̪a0"`uaqpT X&au:L #a0 T?nك蔂'ny Y6$H5n42d#y.]E! %Ch$ \<ґL)}Z&u Kjˊ￠7kin;tvi&,Ƶg>P{I]ү [B>펐M5 4čN028+,T=GXQ^4Ư FɐHLiаFB^THN^(oTa+W~r]$>>VI5LWʇHNJ`a w/d _s*BFU4|HW0HF(XE_|W>}W@A Lߓf =HYG!;{ZF:66iv|W{}]l%#򞌜ZW~Fz9zlM a!q|a!aQxBbhSKbbcLʲK0 ͅE qCbL-FŅ;PUF8ƄE%DD 2:"D1Qq1R_wEj˅DFġyHn /$HDǍLi5)!&"jlL!.3ݳ4pqcUZqa̋Faterra/inst/colors/palettes.rds0000644000176200001440000001203514536376240016213 0ustar liggesusersI%7r|/G|j H-[uUl%̨~̗I$Ӈ>~|?c{zx_ SWg˯Ztaۏ6>C<އiٟN'S>M9k>B8/Mu?Dd%-]~{j2*둉؏*ydQј#+T2H*:*z"])XpҗmՑhtB@G&l;2Ǒ:}dB#9D+GZb;)9j^TLGVb<S)/IG:<2hD{d%# nNtJÇxӉ|dT5#ȢeMdW=#Dj' T~SSI;9Ȣ.rj{f"v5"#5$" l: "vf".H F2L"ȮbhHhQ$}PEd3 F.rwfVCiDZ""Pp&$8@XHc*T֜49=QL̀3ǑL*ߏvbT_"q렣3Z!"g&# |r^;nfbl95QimPƑv׏v@3 ]u)h\pV]>9ᬋGN\8+硹I&p@CӹhqFW!69yuε#~[B;rx][hJ3 GRgGhsR1aAg#f NjBg'U?Yn#[ЁCl8)3VTaux i((nGmg:NNGXogt*nʝ:9S;3trTUؠkwPȒt4* tkY3"Ⱦ–Ă];-Oƀ_ ˝/Mk/`ΪH4oXZ.2 P})(w:Dv8sPBUΙZ aJM{vZ YHNOWX!`tCsBai))=48h݉ص˩vQ SHU}>PUdӧ 0rogf9+Ɲ0g^>Қ Љ & L"IaʙYԦ oNg 2.0f@!D3,J$ŦPlrZj؏kT }j2egb=*9h#TId BfNGN[μq[!t Dwd=# ,)NW}iD>:靃n-)#p͉TH ~N+ݑAiIdVDgو!1(T2BUiE:Ad$#""ĨE:g:^dD^ά"ĤH\ T t" pysF&䬪 AA9U?3k54j ZMN5ȜA[IR>Ԣtʋ"B TZjDFw8~p tFCÙlrV l&&B9LJ )6^Nc*̜49sz3!zVC3YZhpV6AmaÜ>9mN+ɗV4pZpNg193gt8ԉ39 j9, .@];1MݒenI2NZWv0ʩ&S9d*Zl)-ҕ%]2 Q#&DOe,.ea~i8~4.8g'P aʓ)ύ6$Lj2^IqZ;5À vNLIq-,M#.I%:TLpgpPX`+,\9c9`8Tq(Τ`: 8-$9m"#,zINۘaN* ٖIj+CΉ+A2ƬDj:N:>Xa){9G83 ;+N$܈0e#gѰN\l]@*73͍&pkX&r4ҍl*nt"=,Ie.NݘLXD⤩'n2ތHS7R(0L" N|X֍8$v% LEF'E`oTrrS ݘEVhÝ܈+s^lWGBlqwG ?>{?~c~u.JAY>dA zҲXB#?n9>li9~`QFwU)3G||a WMP˶ௌf;a]7PF DؕWhֶkTuK51;F4Рs^a衙IH6)1A-e"vQJk$ hGQ  N8#.4 tw-::8IG p}-F8*Hh &s9FSpg4me $Έ2hVZn%:uT4b\vf1&z p@O3v.t z$:$]лN @;]\W 2r+cVW$V:bJdO+3n't?X9WP#m0+-)G^%¸F*n]bjɌW٣ZӬħJ<|*ʸ*SVV.X~LᇤW>ٕnr.S2m%^톎g\J Qو8qfýO +ʴ2ș r亲Xʑ;rrYJX\_ـœ萺xuʑ0Ablȸ3Ć g›2ݚRU:kzٰfTjfVWjMřUL,Z_q A0hKԡsWLI\]=7M#DP%j8"*Fw40ϛ!b>4\?mCZm!6:$B#އFĉṂ >ku{ ՐWӽqv Y y--똉Hײu|& :.e-#QЇ:3tzN:.cf<5qLǧr!㭪q I)JU08҃^Ϋf0D|uI <>|]!am5f'B91<,qRa`9KQSuauu^IMMGE0MC9~# ͵ȚR>՗,)*u^{>j>~^/x|7?}gϯ_~w?[ǧ~{}'_}_Ӈ_|훿o^wO7o~x?wOOo珁=y/߼Oxk?=}_wo޾z/??}~7OQ>ջ^?>?s~yͷo?=_yx>y Gxterra/inst/ex/0000755000176200001440000000000014752267456013002 5ustar liggesusersterra/inst/ex/elev_vinschgau.tif0000644000176200001440000034473114625602163016507 0ustar liggesusersII* J=S   8JK_W 90c(c;]NkatQ 0BURhzu 3863 -9999 388 -9999 @o@@o@A"AJSA# x )#unknown|unknown|-3.39999999999999996e+38''"K' @'$"<DD@$9$\0E`L7 !/$dO ` & #@a;8G(hB, "ϹsH@uI !+nLZ|̵2YZP(-r쒵(+ rV&- SZQ .:bȵ_*BWc,[N߻;l+fǬj{]` PQ`|4) (O8HKQH)|W7PQ#8:hs@R2n,`xʊi P?4<HD (҄:G< ( nkď0 *A! AP ȘKlPjo52+C&Jbh-"bj2#*!o6! " 4S2p;aـ<$9/Z8,~h* F0RbHxNLPMcΒH9(D(GfO`6b0jN,v8Dԅ20RҢ@A ZB0;_# ~ǂ\s&+JBuHw`A:h'Jqrbc>eP˵1!xx,z(^9j3Δ ;<iF/+$۲PKi " ۱DD`nl͜P6JVc.(,2Xc3&;θr8K37(ޣA<'!R6An"';#v<'U :9^C)0#q"n^ 0NpB~{G<҂NxQ%@tJpI`@y^;Ih1 Á 2 A),IO/g!!OHMBeVXPI  ,bMI)2Gaph'>j3A@H& kƂ3iwC0Ux`\q@#a@Uz4@@Ma50O<, :@%P J8#Y$TXy@xPGUB !`@< N X`+(FOؠD 膴FV 0w ]j;@pX(H ƒX$ 1pw݀w+%GvI'=r<85Ԍj!IBhAbBTR0lV^8(IA3aa2k @ǗaTJ+/3 2@ =$l@:c4j (Ij@qZ[LasG|[ .gK``fVp(YߐAqCOIH NQɚ3h0,P%BCBGDDНU x)M`A`, Ja4{@*ȀHAGH"i Ȱ< q4AzCOh DECC!d ؒQ`łUBޠ'XA GB[6(F aE( `H%P@ 0`u:h^@ <,АA~<۳#ʑ@;+da`LW Af0d&,(@IHJ$`\nܘc0]B2 #@ p`A  piB$.=Bp\cwjwͰ8ąN8,H8a]9xJ(w0 g$VbBU xY薩L(|.7vZ&Po0Ƞu B%uԠ)h.,"r7@' -N88f{ S7(b8+@5]@V6;P;p-@*zuQCB@/30^lqӠ``e@)RAI80RG((n?`* U))TX#lց ) %Ю T   ^-  fbP7!,U @ ;C  ;ɐ!U!f%  Ղa c8BԮ @1C8 A0| Ql-Q\68(m!@ъ%n,@P $#J3.jauC8UA mv\i)xGl|9BP=^iJb6 ȣ @#a`F VSล, /&">`J".oS&։E >}BД{KX!nnX @@O $WniAA i2#`@==B*,!^(Je\-L#` F($Q`` ⢈=e0F``($2U- " ! )AJRDOAB@{@=0v"#% 7n~&%Rrց -t,` d ‘)@#、P  f AU**Jj2€j#G*JeZ h=dJ&"i 8s;I~j#((C?a C7bvSxAkkPb2G``^ `M~@7md:SB!O"jc=fQ8͚*'P, Ecl |je=rvRiF3H2@`;F r0ln!25@@sc2KIc8c3Hn>%D(#@tbut`vM&*r %t@*R'  o2vwb@`ڤvEB7IC E"/Җ)1 ^E,V%%kBK&pX+r*0X+F&dgdC,a U"X5&K7KuV0ƂbF:(f ^d‏$B-](~*(v+bY`%X!BiSؚ RR3, ZJ 6T<-'&XH2Hb&<6$Fmob٠`]#(ӄ$f ;WvWBX#(  2~6F "(S€f (}OeJk"^dl,hIhTD:.!fdc fJf b z ~ =n]pT ,ȯJɀVdLIۃ|@D:&ȱ8&+qD |:%|%x3:R $B,9j X t &7Fh @ɁArT,69Nc8٠Amx瀤8hs &;D#$@_8E&.Dz؎n,R*(jBA B@Flb&jܸ3&‚# ײcښ9TlP%ed"B.ӔRV%)po~xJ5Q,]% ‡. _b> ̻#%!Z#{@@|ɃhYJRY>#%{/sb< 񜳚HA b@w '| 86Gh&vTO_xa=SόR@ M`(f2Y``J>x3/@az%|ncUFDkׂ؉W0aO>Ņz *DD ΉEEB9''@"HI0a/4%`#m@d@$7:HmI Y#$HFKB RؘBLHIEMBz *Đ5LCRHgX_/RLuaD ;yU Zט3&L5lBj:$ (GIf5&DoXlBlfP\Z BFl*!(+ ?M4!}]HDް 0㍻~73cOHX:@j2`)@îڞ@X n bF`qR #! RB-" 3ɁPI <*()B•2<:!!+sTt!2$L X>hG%PM|.$?0CP6+o(ۀ+ &$*+R#pDᒷ7ӄ0Ay!+x:I2&("{C2$@ǃ(fX$ ⩨ې(Są!%p(}+ۉ $1@с`  5 apS֢;ҥ&) n0*-hnb8cT" \~m"8bV *  (pC`ChCCF:0(`Q,CR{G3 (,  Q! ( %p࿒j (,@ EԐ}IIA(ExH`$i Ą'ЦSVM aJ;fep  8P1ZVbAr4Di唔 b 2( D!oʤ hEq/l4nM YVO"zIlpHY"J+n*F2\`LIF;a@8P81,aVB<`C @ @# ǀ R Q-aD0 1K<,dF4R-X'rA(0$7 < &aFD6$ qLJ#VE3B +`=[I<@_u{K>(0`O(J)X-`7Y$5'ҤPx0@9O}0\@C |xO5+P`g`w0HS dxIlvqp"Ig5Jye FdC_XK`)=CBZ\ M0Gy#g`N1 PP5 q T@O2H  vp(4#*% q`; 0.׬-0748fP%7˿v>BXQfͨuRp {xaLW ~{W AЈSZHk7` S6* *BP" ^BX0GrD/nJ +$^C ,IaibQ nQg 8 yW@qJ#2 +sOh!AJn$зg}c`T2 Q@o[C(㡠aDb\(rDzI^^a Ч;u8_A*#aKq61|n@3nL"v&b^3i T&|rƎl,*T80.  X%0*380*BC(5!7`@ M[dBДRF$P P^"Pi4psbH )E k(ޜقBa`S mO#CB`HAI ȂG.8!… , ?^Ommbb WMKB'|![_@@@ø! Da@@`ZN:Hr rPF"fG]š](5=;|(I&([Ds8bB:`ͦ1# Pr|F8E֞b!A?뚎v&!„oכ" DaLmg>@|6  mbj5dk O ''@""KI P !%L4G ha(LВ8t\ŗ2e\iI [h7-8'P@ UsI+dA-PFiD4OV<ƍ?x(JBGBoq0|$E d$1#!V9#6T[M'U;4z˟R@ 8r` sPT> qY(B\8pݧ# CpBB&! $҇ʚتVھ p> :18hl9ǀNIr 0o 0xHhTVԎI*PG`nJ&pH.S~,\΃ McJc (op#o>b;B:p)jW2I < U[`L¶pz!XmE1ڶ hS  0*Hz&*Bg*h[\*  d%jڦW A*zPc%kA b_%kZN$RJ)c z~w@8!RIAk4 eA2H m!w9*rbPy)"WZ\|&`7ga<RՉڮ#Ap QAgAQa=P>x3{nu Tjԗ4^f7})gAa^C 8pAp  x,dxH#)~Q^ `&D^{Q 66CA J_aȀHAL OX Mr(Va1 HB eAw(?T)B*DFƂx+t؀H1x$3Ba̋0`ă d@10@q H+EX54L(lt882@bi (eEvGA@08@ S";O<a$V#&ʂ IC;2=è(1pˑŁy$M(.b݁> (@рi[)cdųhLMIS&Xa0 ~.K0*d̔4 Ѕ2 #In*Ž+kJ` l !9lHP?+2 b,LM@ p98Ɉ%` SaIH0)$TZɊ@KŎ@p9AX ȫ@<J m( P@<he> ,(@oـ IB2vAA.$ܕj xe&e'@T`85  *PW"&:{!χ2v$!P"$6G4,JBN`Jb080d'q@s V"]n(]"k'@q d8=?@+ń14_{`'pr*89A`P@sDA4²DyH NnHt i 4c:K/.uI! 8h*0`߫ 0`F0&($;K* /0I*= §g -;Qj%p^LH*1zDݵ\PDAjL%" (MPRHh4.e[u A1d T f%b8"CPiZoK**`A 8p]v2;UJ֗ i8@`nSk@l@ QVaҚ}Zz@M6P9 ԅ,@ʃ2 "zD8_Ɓ0PJT6s[FXb bDP>^|>Yo p宑UBuG$+2:'"6 0``v8!J"I&5!!'Ѻ !BcSDB: <Z=;$?,XL8ƧwwA\:c Xa@xLdH(=`Bm3F&Ϯer 6@F" ӅX=m*1 Pp x&#gW6a <\`_@p$(Ă&"r Η` r "{ ~  Z X \ `M BamPb\B\~bnaFmb"V @k@„@@Pa;@TpY_)v )+&&\hA@.ံaN"=.#c ~82c p`=0 =`@= Ta@Bg1wE0Hǣ`0d0I4I Kdྡ``$#o/"H@MW``w%x1 9;@`yIv ho B.3FT B6H! 8`B``0:Cd&DH2Kr`X+Ҝ# 2gF-MtC x ĥr n*㌑p``_# ޏ,6S0IȜNƎ4-&Cr @rEΰb A&1+&.i@hl :." P¡@¬n~M%Zn ANmbj&& `Zoc)! #p& =p$)j|`#|)bi,p\lAJ #ZA]ʪ"'.cB&Xė`<[h>#ZA$@@AaA )nr  , Z7"&op @r<&.z~qf&.p ]`#$3R9O @U鐛+wP2%n1EI0:"6J᠇ @ @! `(800väIr!^A@CPCxV@e,0#Hnj2[a@[13E[i!$tw!vrlK.U1/ A`|a0F%pZ~ @'S'-"CVD"# aÁa .F= %=a| rnA !)K G,QB2N0X [ Z"$5$Gr# r < 2:Cm#pd H10M Ŷ Q` >[c("\oa"gARb*G6&&Fix@5al٢'"c77b:W"qW@ (h s"N !o Z# W%݅QTr&#/3ǃsD!$ + ŸN\/nNg4A|EF\&0$@2L0<`8kh?X,qzH2RI4>&!S8CS~ 8$Jj1! $,HqĈ0t܈ G`/p @+QAh:!6&A 3S+2I!*#j,d!S /+~,Ș!3 I9RN"ԄF`GOs %Ma(B$BC?aa-B Di33 XPC"JYr2ML2[ СY[t[^M0@Va$m@f&آ#``6fXZÄTBDM,R8(U0 A&I ;i5`"`];>d1Q oۤHaIJ@)AAGjL] A38@z=BxEZNtAơpP&=Ğz~HQpf`!`CNdE`#㔺ڄD8`pal, hN"P,@T6 -b, (1ƺZi YFr@ -`& V!`)/0b8P2B(8, @<$>,F95D p@4ĝÂ:0@F 11 ah !* W8谄NV(/D01 `ı1DA` h/>aAZ XCB' ؐHS< FbȂT.sIN˙3pbItÁj:u|FM2BԌL(IH$b4jQ)+&HRabKn|aJZ| |'oP}Z1=`sp (@M k!s\)FNtoJE`@5$qWl57`~DŽ8y® t" ]#cH@ъE`g`|ZY1+8@00D6^fV/D@B`_AC8OdC'E.OWbIPbcaCgAQ08Áo r  &?S P,`]k@ci PE2։QBeL4 (E+X @x4@ą+AH8"C&h,,EpYÂSfР\"21*YGmHcT1wTLc Lh+`A& i AL(HM!  0@?]E:'^hE'h>!zb6&w~  hZtLwA8и%ДS$*#$%M.$bDrڌmwRNȀ%b 6( gc> *B>"1r$ [A~  BV`[@@ ][@X J05 "Wc dC08!1h-lҩd/p &V S^@Y};ddJL2ɓYȝ+"XP 2 \@p"DWX W@WeD a4 9+/m32h΁8 26e,shch'"@2'X[QWCL0%tp& /* ,i8+E;d" A#zB%l!srtu| >eDb-vAD-E!b2`xLlރE!@m B@4ah$d: d@AAfn1q%`}Ry>V J@47g@x#ÄS"3n|RuZ 5:3 |UUa၅GBhRtOr=Tx"*>gVy3vh!c̜( ULޛЬAl[&̲2HD] ;2W5FlȈ7h=d)K!YB&6rd6 aaX.Ͳ^@AfC*Qc HJX :1h2s~# WOеԊ lI$rAcLMLWO"t'( /I3@j?vP҅ " %v`'3%`q `1 wItC `8SUʣCW# U- A =B,1P" zarp0F@a jhBA #*ȘǫЎH`Ұ,HP'(BBYrP k(vh"Lƈ*KDBQKDL.ڝeZ!_0 BƄ AJ DpB)fPT0:?)8SPAŘ`E5h!S=hBHU kIPM'sDT(E@BbhPc8S`^'xM8PfF5p HOVĦZ@,0>l&t'& Z ("!EJ[H;4Y#JVjNlĘs 4cf/th#inxjt#)ۚ@0 =(N56pp/$o}RX1,z(p7qUjND˃NJ&~/]ADJ\q$ 4݈͐${HFMddi"{J!F\"/O L @aOz<2(/"0>1@q8(`\Aj JX/tfV @N%%` dxHB3H, PY+ ,, UAAEB@HRP'PK, kP8/p@R @X,4ڹ.( "KXLy qP娯( z X,J )`_ (p(U(aĸQ`_ )XoEyǂ(hP  U=*$# okI^Z `"2h&hr#r R&ڭw3N:##42!CL2P@8ș3N VABl2XG2gVH 4 Lj&b40B ,RpЄU/D#600Hh'0рAP@4!CbvzRM,nZ pTL3S9L$ZFp8xdxK@}#BK[{$aI^9$쌎"lY4ĺ{ "8rǤaBD8>AtX3܎U(pTh0}#_s*P\d`A, ”PmG %`@A)$y  P%`F $ X_T2;Ds XI ,:E  Оņ ObxLQ1н/q  `'f`q]ҘpJaADĄ*h O.UG , VU0&vVAND6P)/V>CpmM*8XN +PV$hBgIXp+Id d{3\Pp>ڇ؋j#P8BֆKqt"l_뽈N HTR3Ops_ 9|bT+H?%P0h/g gP/+kxPKSu,( MclAX4#A8$G bb-adS 8Q}Q`@0PbqtXPAAЇYGڵp8D#F+~/|f+q ح.N/qT+m|ADBndP`#H I`_`H0ZH,` $Ą>@ɮ+,܊IX,ttPb h Vc Tp!@3 v4z@c@!@uRu@2- " h hN/F $8!BiA&ލ# FBhx8"#F!PB>#( l$FF'gp <}!~CM J g**q@˥֑b/`g궢ֶCD#( c1`=p = sA`{A.B&9#!d6R6@>@8`@yBD{*vpU?O.!| ER˂ra=@n"*B r-eRVW OeC^AEŀ O^`B Z ­ C@X"X1PP`@Jh+ҭI)FT&b^`P`Ml3QetЀr=T^1H@M`@nNh7LZ]` r@U 2?Db Q3J@6K Mh?KQ^hvh@@'@afF#<#F!Rr#  l4!!`;v@`3J" H$,|=I M`LDU]j:``q /AFvbЪm@wPA`}q@@s =  'c"eTCd5F'kB@) (vR:agp~@a/.+J pH24n /@ @qO45"J`@_!@2.(OZ Q5G2-$ 1LX:(Ջ+Ũ  =LQ!Qc9 KO4ԃc0 #:H(Å lH,BX,5CKD!SqG%tAd܍ +e V:D`\Ra2,c3H]Ma@`-2-;O`J``MiV+Jh'dʓ,ΊKn.& p( 8bvJSaB⃸+cVs@@pڀ"v'h@h@J%a%bv@DkA&7{HB'AV:as;" }ap!@{ uU`$ !@`@٧@n1JVRO~D5t-Z#ǩdsuJ!@{m@} `1@sR^1I"u+g|b{@)#cdUZ L#BvsAAP7XqZ ˀq(,hZpaYB~@,.0.&/҄!IK@0i6bѥ敏B"A(삖+J ,b @4l M`P% Pa@P.%"w3e4w1LQ- cb( EW@\O@DK-ָ`=¶sP&=D r[ #ODFEBH: $-0 6=BК\F WZd W@ rb@4A{"$W1U&d:xj2A! ~qڂx$h %`16!Zntn/TH * &f"c z4 4"  ms@|!O   37-g6/![PT\OwN8]aZVHV>}` uOlp...v V(5:+ {BR*vZCd6[J6AݴJ7AIBv3!r15ZK`J`-:6B38!R%J$/( -q(ETDʉX *4~PԒ؈@K쪲K-tňTp@CL&h a 0r'3 2) -pA3583+ IA,ub'-UJXGBTxEDKdXId~QhHp Ё/tn'c] L \PF@=3h -mas2@q9*+盚}9(z&I 4 @$o LZ+.K(MbLXX%(^9hb#0$xsc ~%F-l,;.Pk 6tp @v9j,!Ȅed 'i$lΨy P^A|EI&4Ia$(@ `2 T(@ ;tdLцg r^LH35!6u AP(@JO\ѹ1?FʼnR0p@={ 8Y pO"F5F6&;%)_XJ > xԁӉK6 s#82ުbB7]OqsܵW<8`T@T$ޅR8E`D LhFA&QJH8 pAP8pR@Q„Pi)# L!U%%$<tS,IP7 y p gp9uɬX&nL Caa$BeDAƄE pb QRJd)u8B=YD="5zv*fc p`I`BTzʲ5 B; FI8ZU/)4pZN@A0&~7@*Y&o QkBvM`zUl0pcB @@9@  zH *xW9NhAg6Fa1cFd H@@yxAl"@ K:03 qX;c4Ƥ(+AnAş"VZ.x:@ȁ aey d_ <@>yA3Ν@Hސ`H7AC1:1 WQ6g8+YD-hHpeƒ KB @,3ċRN=0p*! 0!ਃUI,%qA(H!DǗMHx\o%(- !;Jg ^YB, Gz HX'a͆(IR 1bI\f0POBA5Y X(X,0t8%- R^ \;i"QD܇ X,-dz~QcKa`]EAD#Ji0 Ke)h"XGA`T &/.f6*p6JHqɮ[K2,Gc( 6RBHf<$nj @@@@@. !( $  :B/NTA`4`,c9+ 6.;jB+$a)$gj 6 `"|"<@d;`;@,; 5@:+z` oό3#;#_pרRA`8 xXQZ@ઑK@[ TȄԈ(G@)HI4.VP@ @`': " &! ;BCW(ZE.JðX,n/IR ($ RI9hX .&&&.;L/C 3n`:;(k墄$b✡m#b!A@ڣh`+ `2 k@1'd%> Ɛ :  B~ j tR!I  63 _AC pB{J` "TAoLoo@RJun>z@Ai>$#@l!@"MGmǚ'(:, ;;C.jtp~'H;4bo>:@C@RAEPv'l^Ċ`}'P NLd چPR-gRC:q o`)]Ddz$R@p@ E< /̾)dTcƆ )(KeN)l\ -h|-ħ:$ t\`E@e V@V@ Jfʂb5^Tt/UI]XT d` Z3G-Le]†eV[P;3~G!$G;k' b\!&@u!k6) Tp.DညI 3 x3 064ra!AAB @6mX/G B;3`s!}@=c>` pRzv)iAAFL!Bchn)c VpaRtU6/Ja@1kd@!\ToA@X q m@7F7A AxÐ ObAp!7A@v $V!n0;y"↉T ||E-L~†*/h.lI!8"@oAA*Gw)%H*/0c)"؜@k @ q jL eG 67b63(*B Bc ! zAJ\p|RA!`?n; =r :(_`|D(tTbFM1$ &3 1cbiG@ӡMFo$.|L nVCfI'/L$3 )€l/`?a d@`҂)V]zETpCޮb\~z~L%3vxP@`%Fʬ,K=; L.B{[L9)2Ka!2Kb TT; \IaQD~.b 69"A[3WB]UM`@@\\c\TE0R[T,i^$z"PP +IsD{ddF.{(Kr<0z+8 6s!?aoUb42¾2GxROD& ''"H* vuE$X0.8G8 0>h@9 cq6 ; $@ 9m.J% > RAj\8jզGh@Cp G~]PB oTIJ2LGb-l 4F [[b6Q"@`H AHg`2B|X M㈉dTf@ )@D o n)AK>I @=;hbzBop )fʇO> )!0a`ljGf| S˅hCH!1) N 1!!h0&((b+."l'B{F `)BsO("PhCT( ; h=a3[ҏbo"67J[LBi ̀̈NJ.): z*  /W|00h0%mb홢ٵ*.jkNH)aą^ۀ693 ;)rQ®빠)*<-9zBPr"H@`%i`в4or1K A9i! IM8!.:/r)B `d/ -&٪_`omOA] tn̐h^BhZ@^Dt='nH:c'jި.兵21 #w3C F (JhH/  8#Pre(8 HA2 $F@ # 0a€ӂI p`&դ$pY.np'@Pj Y38 0zx-#G0pTquԑ ~40Q#J8#N+hTx_Ąq \u PFp`i6~30=B *ˉ"&6Ci p@]} Rm#ؿ(0.Kbt dӴ10 ̠Lغ%h(9@J aBCHB!I9 IAs4x%31XLA@;Bu T 149lqNg %I4V l T(\8W`9|ͪ '^C\,F"Q9:cXL̠@ v 85JxKf 9;7̀dE@awN+ 0U -'(WR" ;0AF * ɜD9DЖ@AAn0fk#805xz)ࡠ \ӂqE! +[|@5thZv,x@z]Q$*8MeDD\ ph ே]Z^}29ђrE'Mn-ָx(⚨M+~Pu@`b5 f%%Vo>.w}CZ!3iNnɱ /zV8"L+/|uRcK 930`km"( :*|ڱ )A* NJ *>f2$  vEBZz3`D+np4,( %jy̞BN ` DN 3a=z%?:m,,Fc /t<.4=-)K6aR+mšd@aBP l /v** 2-z$r@"4Bf:ZӂreD<# '1UCK2yD`Ξb:&4͉ "!6 SmbDK= x='%dM%jNJF`rPD:hX $@F`FDv8"4p4& rfa`jA@w$Bzfa)HXok@_jm,-&(`EnRZL1Z <HN  Fj@F+"J_ NJֱM b e& NLΞBx~`[ZE<.V%|eN2+c6 },2C]fj@i 讜|lp. DB3"'0X.)򧰚fai%6 * ?gN  !N ()`I K 6A (`Һ/3'$F* @1s >:*$X( JbTTˎ(vFD"JA4BUCZQ/B2yJ;P+f0 k2)Ff.9aa0]blcD=0 'E|l3apĘKLƨX`PEN `P~.&0D7t&fmtBcfM_A" @jA)-'z s 0!esUxbJWR,,MVg`Z"2xBo`V9Em!ZVPtB~@B8 32<'D"484-) %̇LV["ZC!LXI/A8z—Ett"ҜB:!fiQ@ DqH.azcJ#jo( LOԌ(.m  `Eaaa.,!k j%v8ZA@[&%>h/$%DtA9h@T%$D.a^% 4&J|ؖ0Od82#D[Of܂rӊxa J(/ /6q7 q`?v)An#sA⛘5 jM+k¶23aMD.#=e)C pNśH`N@K&=% Z aKN< -)H%w%$8JDp|#x&tFkk_j&Ogr_`p{y b ΓIcvB/"7N.$6KDN&DzzgW _ I/BabZ1Ҁ)zf ˼4/G2PBcɔբatDb!}cJՐ+m(kƸ1,bDyF?=cF ''" ˆ0`}BK5 !( %" -$@7pB@J@iY0b1 a$\rx bP,|#&LK I1l*.WMV,)X%Wi* B2 j^rsvQvAa[PpD2V@`k+^4Mָ`WwQ|߱p9BuhI(uĂBkL! ` 7t '$ 4λH1 ɀ kz %򖧜  Pp(HhH #Gu@ˌ @FhE:/z"^okD޲ > IEGD,|o0/W?` a Pˆ ɠ@:@ nTA0 O" Ne܈T5L ~޽&?%PP?HP=%c9A(0+# h2\.p# uP1XLTPO 0`%pL |(#)r#<)X?$x1Dl&jԄhwz @(X*頪z{2ƾ8 e8V`D,PcH2(p0 X/r:LP\Lx>gH`='fJpWBҋѾPP-{x@8nZ8Q9)艴 v%ջzv9{z>`XgPK؁2hL`&(EB)3hq`hirT~PB A`SUQ 3OɈ _Zk0o `PCA&! 6d$XPC@00YhPa@ yw>C41$0 X|-*j~ H0qL.|}ҡ JHb6 /LW##J8`|F((H4 W~qsV]M<#3L@HV`c|!_>+x32X# @Y#U9WMj@,xr(pCd 0@Ś4 x !,2 ǜP%P!  F A 0~RZ aP9P]DK1@\ $ (F48X1@ ``#%OcA{}ʼnxXHp@>tT$|!@988P׋Ј1# :@Hp8, b(ʈqFWC`n9ZteiNL.O"4E^! D! `pHƄN{E,1R@vgvn) .,,JO!Aʰa OLv\ڈ70 jOW`HT"2tח|UY.2h 谝C ȀA *{EY FK <PeX8p(+JyCw|?h+qL000!T $G(" CHc ڊI{:\@$kj&3Ɉ0)~k'PPHx`?6mkjL8b 2T,!Dd_7&u !CG1pqb0Iv +`hPdI2S* D(.sA`A %**$ sp@|,*5@ 6huxA ɽ9!|!1ՠ`;AW\__FVِBZxn5#Bg hLӊτBPPd# ei1T@y . FCq *Ruf$< : uhDz8T;(AJY脻dV ֹXP&;E.0PHX YH`ƀNu} PWÎ<;_ys,*4.0 CA\I1z %zuq%`& _11rLu1lTZ.aADSL3VVDSDJ9$ ?dN$c"@D:f"L`E, aDA?0Z+fmbJ!Bc*VТ:.^9!xȮ"bva# 8xutv@#t "ȽTC>$NffT:"fШ+K>.2~ G-<+vkiX2lǃڑ>@K b:1 D$ghABB bV | ";Bha}z)+ |$p @+J{ŀ*T !"8/+A7J 2:J :@ Լ$ĘIh2>#> ?a O= 4@"74 '1$$p*h̄+,2)f0FSb 7&FodBӄ' ̸"X'GFq:Bh= $f\YJE{C(A#")"%>`E^dl DGhbkz P-"&LdB1>``.5O)%rJ L`%Hҙd|{WF&HƁުBb$F, FZ7cCCvgp9/A3dzAAPVa ӔX``l QT%M$8h'ںzf=& A ޘΟ,~a iJ "h!,! z2%i3IC> `@!"hP("0m@PႵ($`F.*_7ˤ|Ӳǻ'Oo>5?""*%cz#bR$žj2|.ur\a`G @gࠠA@rXb"9v _ R=  v&br$4X4 1C&B A@.'Enߐ@`2za($_˻:(}=FN&+^2@S &%fH. IVHk%] kE1MDd}tr1A=uHs=?B.uS"!AAo@ct7?o@vb6"RcN&)X\>Va`|Yz%{;HĴN`Ydh$|3 Je'qovG44#? +Rv8wzb:, 1@gC  Bza.D(q:鍒=!J%dT?A㎯2(lr (5 ` a,i`Q"< .@!W/`oF&"fڞ :U. iP<"^sBc;c.C赌d* P~A`Fo#L:B}Ag* R2&5wD/4PМ-Na#0,, :`PÄ4&YM>0 B7= e4rϾFsk@GxfLBV2⢣n>b?nGX?!M@b'>,(EkMB&#(  HZt<ဉhOش~0P!ì.,)nBnC7l@v9{nnÉ@tA@`@Xj+C'TPƀ5Wn$͒2S::w @L^+[rTL``"A'M>'mQƞ\aAJ"t i{xnagT@@E^mWepƐ. BBnҋr>*53a80B)P9PK Aa Բ"@11 jVqu608_"Nu^t`9U; F \(1z&e:"LT@~\&6@\a 2#J b1pI)a h`XiQq%ݯU2$Lx=f Dr砠 ''@ "R$ 6ȋ3J`kThhBVKI BPH@e 8K$&P# h)Bl<%)* da H "l_%ͬ RkhfP NhVK?0(@xIN@e3;BАLİ& na l k%dx.a]aoѦW mF<7<_idASi hW!O8ky{_PՆx]u6ȯ A`4P.k"ӰKҠС (ͼ` 8a .`2 Ar"jJ#!((q DBJx;n!JPK F0;+Oi9@诓hۀw"(C<@=Bl6@!Rȡ ܧq6v@2x;K&ҊXgzp-pX!me 1!驛85Hd2 .b3ce 9`nJ殺!Z*0.ePJt:z.eX"4[eӆ^m`ۄJ @ <(<`L@L5G/ )oɶz@ª , zg hqϪ&<>:h .2,`z &"!LI0M$J,q1/ , `C@ZB P+:M3ڠ>h LO3iAdi wA 0 C Xt(xXJ a #4:z 0d /較JG I! GF2Y$  @IL lxmdvx,bA}f8-W<@& n7I 9u@ c !@a"$$`:P`Md)琨`K#ũPI8H(9 rD` TU8&8@AJ ɍ{ @7`f&*\0pM \왮y_Kc !䨓0d1Iޑwtɸ" jop8bڋ: xVZFnx&mvHD!8gP=ATF!uyJ/ERJoe[%("P ăH@FT<8h`V* j ,`A- FJ 0 Ã[t ALCh](PP !+;Z6ذSa@=-(r lhwBB4?E#)t/ N@.t䋻 3,/H@Rv$X3'~t;!q Oa`B5ƪ@2 P) $]``J'7X`,`IhD`SDiq*Lbc%d#,IlAs4 -Z2N( pQ>u4"@ tWЈ [*d`9\cfة($".+ѾȂ0h3СiB*/ [W  Z)$X0#V` /btyYBMsR%QIS3B›"7rK 2.vCV*^]A ' [Z^k`0耍``էRh#Qƅ4JyȶuMX0e8-@b|80J!!OP svL{UE(.q`b`,)JJBj (% kc3(r A B0/+YѯY U\GF,`OYcP6\P{,{z jRL e9 D +@ek KLnKWd,/PC, :  `{b0!`o#BlK*ξxi_eFz"Z$ĦB.j|)&ӠKhv+nVQ>@ PA6hK`;GnffDZWM,&0 ulz E^DIA م½C Z=As0rޛ*b%*6cXjSaT&fn`@0xC: b uB8`V@@T  zb.ڲAϦ7 z?AѨ %"J" ݧ>Ft  ~ $j:࠶*`jD@ >+"%A/H<+e: 8[$L]] *'24?`?ghk6fJF"%$(4 6D~ck.n> >dM̀j C68r@Dq+@ՎFȂLF"> h;%MF+dm ` ")&K&Ƀ0>hjI(^K,$+4DL?@]] ±3D- qZx@K @4`@  4:n8qz VA8#jQ"f@Eq9P`Bs;2Nhօ2$"$*'3J,E3br2!L.*r  /^/q.BD.Da4, *s%#G`a6!x N!CC|/ D |#rCbN#akX3@Aa@]A`Sp@DL#a@A@AAM7S8q L |6z`Rp$* (  ʉH 8+D [` @)+[a6/#"`(ogbJfXJ0h0%F'$X2"-\h!Cz"!C!NN"5EAE>#T/#x=C#LX&Ұf@Q+":~@qgm[JX ZA + $ $ b Ad)4" AcV%X,`#:4``Tz">c )Ra0 <> Z" ?.| b 5)%#k[Ai؇ d.UcoT"/((JB?Fzb'FR @ʦ"!3j-rgB:)r~j0)9Z3A&nID$'"fLk /\aF A,X 5t7C@b4D !!AA@Xa@`@E4z"l"DT/Rl%CX mj%U:Ixn f6LB>L&US%$` -P Q^$# @ʂdWrIU/<+J2gb2uN"’o*4Lt8hpAu@1LXt s> qE@e@Me$ !AX`Z.X;:b   8 $ $ Aamk +rN? bB6j€CL7pn7.:@V7x @Q:G$*c6=AAg%W:)&060H}0'Mmga`#fȩrZ!U8wt8XC EH a4<=BX/"m'4w  %ÆXz/$<!dTP,`TYrDH 8 #Qs!24g) <\# ]ڧrOA*$q&&jhd $hz8m\NA(A\ d ''"XL*@sB\XJE>*t5 kě03jPxjHpkt^, /4l*0(,QnjڪEpK*dD=V[{(а`2! י֪:Z œUE6N-KO!]Q@kJԦKeE/>f<0r#ȃ] 4;zѾWفSymR,N.@nZX4b2 ?5-2 0CBAp C4:OPPiTŃL$YjMژp(Kt[bi<851@*ϣ CLv(m X3|+` ?#A7Ȱ_5!̓_{< , :@8,jx@;!-xx+SR'XU'8@x9IAT1f&ɂC ?a @GJxWyD, T:a8qȄVGH@J4 W@%BhU7EUbeP Y%R_%؊PЙt L%  Ä9iDSxŅ,r"Fj 0EI>NŜ&Pb*|0‚YvYbx ${B`WAaK#v@Nq@_E]1)eA]F8`]@ (x GAt[TE)H Z@BLHVrȓ A{S!Wp($`VTd8`2 Lp n3AfHYp@*b+C+jXHEHhPP$ 4q  #-6H^0Æs , `D,,e (ࠛo #0f, %dhbkS䱺cI Ȉ(K!2cӯ1]d= (@~2`fAF|8>A =Q 'F술C ` 5 |9e"}[zަ]^'F>xnCYwÅ0 iiXTh"ȴ! pa.R`F$qE3 g!*4$.B Li| ̈˲t4g΀Y0fEY,i0qxp1(P)A(a˗9!yO?``-j XIT EEA`ajk&t?1.H 6aU@"v HH 0UN *#p*!wb7AC =^3+q6@ ' & a+2 T4`3`{Ȏ'H$(4 x$~m !!YA Zq&\ i=o ̾&Ra`@gaa;Ag @]hceLcw$a"cGd ",iL VÃrCFL8ccdH 6  8 Ifꊈ) i' 3DAK!`mࠖ@An`bBzetZgBt<`z`nx  Ti+&i@i 'K\``t,Bz'? qAL" g6Ngb 6GbBbx@ciTpan "'H&K/4ZdIaীA@ ZCH&I)b#€zD>nP@Axxv"MF1# :SCS9`@!UB 0l7`$B !A1¼6A 1#aզD襔ocL`| ,2_`@@ذ5+Y. <CEgs$ N!B`o DA*hFZrj`F````aaAa6q*'Dtjh+@N"=3¶$g@1d!2ACL@h 4l$6A&50Z!PRǂ! c`~**1Tߧ< 9$DL_!@nBI +AitFa!6AA5B-)D[((DVEbtu=A4$ڐ?4!a{8"2;HB}lrVb`c`p׬!'Z{ݨ-"o{$PNqZ 1/*$3&nMc#e#v4!!!!!!6@x"6@" ''" K I a" NH BXhIPuazǐ Edr)`Bpz*#*" / Hb$7Z *֚*Q &wp^K(1Ty(2ƭp1h*+b4Lp <@Y$ F3GhS}mE`dYUlƌ1k GJ5]fEb܎<.t<P)g*bO*o(p+*XZ$ jj> +b`)`zC2 { ˨ Y!J . "d{^Ö 3I H%I  p$!iP*0lId<Y5G\hI.Sh'iyb1:>S3eCC$۳T%0_H[HĠ-)I#{B 6H@*1Hi.8HȲY_z_R%rM5B5#/1ó^<$%14!k51 @È $p%PI| I-f@0!0Iz${;4p稓0 + -be?{A!0A=0"YS_N?0p&{^˥k i"L>`ŃCZI{"DJE13HۥaP%["Z_4[1{/j_0`Nv.{%J_"\wq`ńPk*oB!TE t[|OA- mH `؃.!bY XD .&E$y6i`<ܗQ`<p@Cg6EL2P pq/.B H `AF$"HX%೚%ippCpwoD  0r7J4.޻#H (B\ȻC ,p;/pS; 4BцJDe ]DVh6!Z)E! p"A@/(hsz!D\QJPu2 k¹`B$ Pk9u0bƐ k1,hRÂR 8$a v@D pAc_&u HH36HE"EAA*$! $!3 `rKLZh!؅d%̂JBeR?FIz4d %iD`JIdf 0wF"M8B6& DZL WFh]Pu@C0&Lp(#&70rae4$!(4SH0 9rcDp@܋PfC@ ["&" I{dp)#!7x&AyAY Bm$5?42F9#j833D'H A29jdm-KRetB*-`]/@K@3!a\pqH8"H\ϯ –A "\rCfK䰠g, 84j!84p:@$ ^e YNA&dFQ3J܀ ½1$b,rs &|$x X BA$QH]E<8?E$"CC @Xa#   b(x`lQP! (LXL@(!*2V#vi sࡇpC@zH @L!Yf@+B;ycT# X_!}Lj  =Bx4^08sI{޲6s07H`@">b$swJ$F"S' f@ÄRD).v0`0*A  {s@av5 (@4&7\(@N5N,4 (c^Ձ##Bmf a l b GRP`/Ĥ  T@N@.`K@F.@#zŔ0*Ah@r!YF-F)` YAg!`enPD@-0E! HRb0$ DIAf"XXIrdo@!$!r X :1 DTp"EhD6^@`(Q0.t B^ңc0vHC2($ X T^yT"y@^| "#ẉzy@pM$SH\@A` [4 l- &H @fGva ,dAF-@lFON)@":("HmDBx6fPEGAF ޫ̽4@R2' AVcaq@{$(C4n;S9nNXF26(@)_c2-"HR\Fa/@ F@GU~<Bdc:04.D -I*0.O`Fc0 @4 (lYմ%Vk 5.9VLY@-e\~0YWb.>#s4" @h@#23P O^_HcQ.N~KX"yN5'^N*%HfRH %^c2,2a@p h@74-27p4&(%"YIBp4 w7 Y5V47"P"Ar A. fDg oJ G ObjvH-DADA%Y<~2r<ʠGl.%%b٨^N T H D91*AѢ?{ l}Þx@9b65C=_@AB^_%A t ]ANCI"45A#!R7c_M'BiaSA :mĴDp&B ɐ+(!F@E8"XHLkHMME Ix@g.`:{u=^`pt\t  LK܃[%(  n Aaeh~đC&MJK0@@Oƴf@@HdR 4 qR8"^ C1 $0v^#z$JmR ^9/'5# 5V7x61Au cBc cI:(S cC X_B%Ђ`5^5|(F"S"Z7 ''5" IM x!)4/ `K  @!!@%PHH":b" 0r|4+1%xaSD2BT@ #A3!%x㢘;0&Bsy B\ R0 "A"r9.<2 EA(l9kdH 8&&.\?X vo$b@L/8!EH// &"0`-'*`)Zf2H'anm+J T@#:7pRzX-2,BF@o  z,M$ 6+R &*r(bF/L Dnr$1he1X&D"& $@T@@⦎R@#P &  :$696 5.  T&bv2rC! #e!<&4p1\3<3 aj &`a@Ӏ >  pNbN3t31Ò#(`8q9R7eز,DDD"0S*$RNL@%a`hGP as`qe$  ~0HPbXEa`M&EьPdUr%rK% v$¸oEqN"t%܂z1@rkn9&Z$b bM!bLGp4k @anrQs=9! !@RxZ@KK@RP%U"@K /ZSU"/'/!E cSZS;![L2 `qorfTOH"kF@@0!0hN@F@M@e!`/+SfQZ̈!e("d(нqEj!'V2 (TUIf43( a a Fp dTA.@8/ 3 |-|Ϡnb]TTH/H@& 8 Ei0/`nnN)%  Oex|(lMfDB$3J+nA@ (@%)#04nd$z ( P  $v o "   F#:/WX\6XZ`&8e! 2#/p)4 N1V *'al+U4(~ E B:I"w]Rg1vv¾K) TA/kh#MhZAZn[A74PBt&>o֤o"d܁+%D+d*NDedA[ך"lv-qHR~Mv`  LAPΠ@@]Xp4v Ϊl54j8TP7g. /q 8b8d& a `a w@@ J fuAMbC/v GTM k^4 -mE@h*vb)$( j"xPRl$s`@z+n`zDD 4 L"1"4Dds@@@@ѓ`1{0IanhQ(C8Ǩ T55 t :n2炆xho*jx)#xMe.@J1{6¯u)6`-SGi@rq|f ,;F$3<JI6kr>Qp/zpL0odM# k6k`:S6缾C#[>1J:LS,|23,|2иRBPkPUe ^<9!\@q(0TCD3j衍363`1ԡFHѡHAf$ U[O>#W(PA/v B#$"K $p# *# tp!Q@ă@?Ԏc4hRE ? Gف2!uĬ9vC ۂ? :U*|@ھHj_3\1&Xf We =ǔXGz8PB2 @DŽ|l6:ŃsRA6$Ha)#"kPBHqx@'GPH(+,,)# *yCqnSBP(hn}KlM@ SI]1@% R!QZg"*Q܁F)rB*(k%"E P0* `g +QdFX(<8HXC @`e`s!bA@te(k  AσdX#6Q1H  ,JH@A>:#rD P!KxW# b:a<>!@3ib!E!@v2B:b:: ^Ih^CuuI#PuB 2ɤ6 @eV T-^b?"r[Z. -2JxA@A@%s.}R#r'' "pj BVHB"X#%bAxH1 hH%Lt%aܩ`'.Q%`0#vpS(`&l?H굘ֵ]Zzc^%?;07kHZDT ((X5f6[2/Y (ɜ2*uKl_"C=$P[ .#f.$qBbRӕDV^uń?+8J!`P+`@gln.'rlvJ5qCRPXl^0B E Cl_!)@/4RD1ī,(z  f/P@kp IB s@@3|1 ynӃ s-v1"bpƢA0;lB#3 W4"'- - 4h1b @؏M$ĂH4Z]tЄKufx p(Ă,H X T+pfkpĉH_mXčl0: Y9',M d͍2@Ks՜K$d*{F  %" # @ 4*@ % 6rgڂ1 "hH%P6+2(+9f %BpHH{t ܷ˾.@Am7"0lL0F>E0 (m:?mGJ`ddķZD jǃjPfHobda/P>@1̄F#"#@;3dO E kloX/6O +PA{#s ե`@4&5 ?@aPJ'1@3LsM0 6ˡ/01q@ 9r@18hSrf+)+Kr4&B1 CXp`F$D( rV:1v5f #@((DA_`NˊCJhA∛n p1B4%"pE6B(Yxc my]rЈD!Y"mr5kՁ p$-Ђ1$.1LH!ܾJ P-\7`a n}>i4(nȸðAu& eC xB!GlQ@e 2+Mp, `*dȠCƃp׀j{ HX` p`, .8 mQRFyn#f, ]D4 m1Lh0U@ 28UB#@20> XB—,ݡh h50Yda?(SհPDfNhmyO S}!X"@Is\gI`憻Aw `%anPȌX UhacÀx^@fŠ0HC sVBs L i!l !@c03 .S b*kZ/sc&j)%A20@aBA&` 0 \c`N`e쪂 .1LЇ" 0b13h 442\i\Q K<`- ubK9S A)f&klhAwRaP@1!ą# uWBpkK8/.0DGW'҈0:0ha$/qe8paNpSFP ocš MA+ QQc2p3 ZuCo`}5AAp a(؛"n*jY( j ~x8ws18"500< $A"}c X V;#mHp3 U"(*L[`9G DZ !``fCQ 'D"=xX`"\3/7!y3J x-ӄڱ  ;K (pv%PvA\qqL"8'9ш(8\dƵ-~KFb 6qDtpfA qz&:o0Y-(aaw\c7аPJ{ :  ˣV`#BG12ĠV B$1J4 *\,1)\\Z- LXX0Ţѩ|66-: B P4 n1r1D4 1В(`C Cl .  )Ad0m 4 j-  бm$j)Z+V -`ߡ(&#p  [<J*`!i%A6` gwBj1/ N@ 2P(0ζ5q$1"(*@(b$;N` ..6 ԑǘ6:W AcC#:z$c$_lVc1 J \ \ \  .: >:2 @Ni!(S + >"A(4ܵ`#V_ 0h60(1 1.b̀@!2MX) 1&.B_L}saҨ.*^\@`aV0#BB#BZbLL Z,K@H|5i 8 ^ /1,(1/68 )#l˖#AġA kL@AeT0 C MJDV0 CTP)J"܀&!.  l774115AHA@5@ @u!T#R*^&6b`). P#&``Bm +BjnfFe-EĦ.^ vv#da@4ߠ J4BnOhnI<޳!E.톂ZCHsaA114.#n9T1՚ %VE1Ъ6Ǯ=lVϺ61/46t.a'6bܯhv@l3h.: > Kbr,0*05t4\01ɰ<6К >5se0-5p5 #CzcC/8#̀ # \5]31-a f.jL W7rf-F4%4-.\E0t \ ms1 bXXXifs-2-.Kl[$67435s6 BaϐMlF0P,1( !BC/P(LX " ..>(FBl4!d  u )P>-V)xH뱰^ `%&) bx*D#tCT).26Tfx1.ڐ-ĨQCHXyIm]P|@76g)`'oTiwEA;F55vK'6)1_@znH=kb;VAC$WY_|Ъ`hp010a??\551<\SDb݌#C20710's2(3Y4=w64085mH(6f@^"ҠAe /̀>CW?cW!C >@"ݗ=‰0и5(Ւ6-C\#4h9w!,E8 <׍\ ӛ9\jXTE^m( F5vdrB\Ϯ07l,1/ݟ7#4Ar ï,0LT1μ&Ŀ/WO@W4$X   c C Dw@c @H@"$ f@ f@GxE`wPxwS LZ,d߆CMN7*f @A. J#+\ j"bmRB.  .N!<@.2:b(`@g i@i[(+,!y$d<C xE "='sxN-A VknuVmc? icWh9050- ;0j76 ]mA# j21^&A`10` :5yz6-ه"B^1Z1:BC=ʍ(-* C!cC0fVmA)[[[]5e[.=mZcll-: = o.'2L46o@@hH  h$PUE0͞Zdd 6گEMy''"HI# (+T%<6sGqz6`m x*kF $ v>鏼fOP BBP BPb0zQ$[!< xJ_~I`/(~H">)"nNKY"U4湨5{̨+ h.Z=PAn0Sx5BϽei< zJjpida^./z_z ޢpAȌʛ# S_+eO [80ڙAA, QnP kÂPpɨ֖ &C:&Cd6%Bj2%$:Z!d&j0dArZRP"@3\ 5Ӂ0:#3>NVifB!(b >'ҢJ"M*_ԩ!ҪhJONNS2)&j % &@d i<(l JZ SH%V-jPV>REHIڛTG:h,)m`0y^hf: h9L:b!ؓiQڕ7䡰 #>|K|%18HVJP8Zh ެ'J@*xi&8P0%IZ?*8u$ZјB!tHgppmBX4pPgEй+ 6ap2r # yl`ʦrmRj`stkl 6.;cQY`'[3!O#Ȁf$U~z:UƔu| zHA%AaF`@}0Qr9 Z` &$$|@C@E/ 7`g0" CM3`\}c1TqQd;nG Ж-#8* MRG2$qb`IPhMj<N`Lg ѩUh/2j6UhBAmJpFURH)P| TX*ebX*LyM!.EL#Țӊh9&A uy)P " 0%ϯ0 2N"{ȐBq|e""T@ԐoI`b =nIDL;9^!I 1̸6D۩MX3@`[!S⛣>Ƃ hpNPόJ8<[2~wxgM44 9:-,>WꈐwCF(*8wf(Py~aQDKD2|hPK@Aĭ LrThJk0T K` (@@YY\g@‘ $u XB'qnJ3NC>.%R` rd" 7 ze&Ԓ` 2=gry% D\" ֊Pb  pz7rh`S07h`# ʁhA%e,/ `ABXxl 򴚄 >=' 4GœrUX|$Yd`EMc8ѕ9'DBSEWFJFJPD\R<,P Ԩ: T7@)r!.:*XKDpYTSe@@"c3m)($㋄i2 fC#3+'B`tumȃi@A JHKD-ĜJ[0#`/r߫ Kj X P2@hÀN0xAJHobg +mD(P`t/i4Lj +@ plq&^r0)gS@AOF$ʆ[@bߖfB"Lk58AA P6AbxVMt:06KA5AĨ( 𠳶'TDn ho2D0o Y!TA@V>)O #  s x01D%T4AA0pIk~g{΀D/1w9 O>BH{=Z+?cs90Hb 6 E Kb#% GJMnBG4/<Ǟt KB 2IJ )!`+1i'a'%Z&ERNN!>V V%$ @R E*Đ@RSZ@ : 0J0 jD)f Ř$82%E8~  \ %K\bj>sAB8"ޭ`{A"d0 $8& kucl!Ch"" (:~!N(H)8(|0 P"tA MT+^"qZ-⣇t.b A! ф3'FB h J0>( ͦ #  J  Bt&&h"H [AZ[ g$kL  2pf@"8 58wo)Lwt , lpy!@k@y$48"Ty{A@_b& O&)=R C( B0CD0C>$CNC Ce)~G҅r>`& L 8I&R JcaD D&PTM`N!TNPTj %*h@@  * pJ0Nl0#&O&D))f%0 !I 889A(BOf 7 BT| ) kGHcy2X#:4a6)2J..87q h -R%P 0)`"V,f<.{FCJ 2 F H  :7$< %:T'Njt% A :b@`h  LpTD JZ{ Ҍ P[S&da4paRDh>"urgm-#J,"<¤< JFقclBZ<ߢZ7$ B#3bšР]AF#&x_dҠAAX8I* r8=$0+BMaDZ%+cDm>.~ϪlG0rv |σ0&P@D! 7NO%NNSZ%P&K8 `[4B<[2`2S ZA> H4"&R 0^dQ \0"d8$!TP&&b>ynb% x@Ao A@. -r(wFwK " cW$ l!C  #HaJt#@`a*-!o@)@!YIxIاNra@|տ(tQ$h`@c@@%6bu4 $ b[\!@A r3N[@Ӑ!GD |& lwp < 6-3F. 60nfdp njD,@)Ѥ%it+U"8Ta@= #rj#l)  y)`òl0zzb ]nB]]8W1}x& 1o;1oA1hd }a\\d[a]@A]$l-h&V"&X厂j 2&Oa;}:Ĥ XM,iHO($0 b[hA98Egî0)H  |?_ (TFd3Oajl%TMtB dӀ@NNNA,X0;RB -bK20-#AA 2*@3A|3@ t@8<`! &Wa@v`f@a wg@wQ.7?f@U@/@O`Om cWT$bIrkHՑ:0   T* >@6A6Tjd -) 2 ` fF" &T& Jc "NZ@0 \ \#`ag|&'IáB   >@\8ԣaAU6)j+| ܟO#c[|J%Ihy%[aZA@@g]N?I!9IJ .)Zh)Ȋa t&כ[L &"| 4 P Y\1<&W2 - CU/D"e[Q`a< d6(4.2 "Bf6ttq!~Q[thj#8d# <''$"HU X%%@"v'0J, p"22 zMɳ6 8gMI2lë́`e Dҫ6hz;Z^8 Gu͔T@nf,+JzR|uunUlBZ23((26@B\rY $tжIHj4%gMwݫ@&» Ҁ&Hzzw!:?jn("*t8+z>IkJt$*I@>I&:K @IB@{ *L0 > 4AܦF̐)à 0=0i Ea0B PS  PA,Q/ySe?HSNe(P" %`PR(&0b= 72zg \@A[9Xq(pE5BB1*bEXGJrJ , (Q8V%XE$!qC@ R034ąZۍgN(.rD-RjYBo^qZRy!Ԡ$uA'T $ "1  dg\h $N?F1$,7 a.GIq&Si8A!ijVIB1 n)m\ @rܓTJt{8_JVCB`@9JT?04 L J29!0K{- XOjX/ \pXL/M uj * %'Nܷ҆XfoJ,PB! U<#%ϙG|*@ @$`  ehSlH{PS*XRʦuCV00AI 28 `7bC@pK| t Y3p@' *]ZwFą* x tBtʲ-ӈz<H[@t)b0z@$x໡ۂ 00,JҚ jHCG l 48P`Ҕn4߀ 2Sd Á؟^<*"fX9 A2j)$w2SA%(@e@RJj 6 k$ =0RBGÞRAA,}P3 6% }l23)hl@ (P3 sS2'NSr~  S M j^`ޡ=o 0C mVU@4Gݯ:@u.DlR'٠sfԁ (%")3*5@@4J@*CpSDxpA' / P8PjQ%n@P/Y eJ.XpO?[s0 jF6Qr@V@}Pjdw"zb.'-y- opχ2pop߂> @S!m!N È .o&Ԓn޴'=:1!#Hq "%7 ݐQH! r#?=A}!G=H`;hWK B&A[%_uΠ@&`\!`ۮ`%vFB7p_PA@h@_v0 42#cj2I@p &g^p ~┐aK^}@H @DfIa 'LJ 0?bfP'@Ab$ ف@! A 4A $lp  L'E D j  ~ EL#0-Kx!\w,*~p@@7` @Fx6r ـa@e2$x7` ۠ _d!)' nf3+Ȃzn@ )H:: >I@0nA+h 'Kh  e``j@@,V 4U܁jPx80Ѱ.j -j{"M6( @.'h  22(F ? )¬뎨()JVj\Ґbv &I@z@y b "t+&X)M@?-N (-L~|*Ea@E`kn5#u-J0,32 R۬.ƌ )ªbhfcpv  @nR zjۂX,@ b, xoG=zBM"BDu<,€@!a 4Cl$B,!@`فa5e e ـa$%l@0BY 4`"-@̒A)`@waV@@ˌ)c2 sFr pMg Y! ] v7*bS"u ѳ)@@`A怀`j~*˚xny†I~)QC|Ž 'h ŽDb-  YcW'R@*'\8u(޼Q,"A$ub$*D&uM  +-KwN.Bz@)@88պ(u"(.8JVw`bMQ '!P2'F"AW'kv} 7V* 8 ;6j .΂lZ\!Y d,77t4 .4%@ 3r@5aA `t`]t)(ͩ> $`A'jo:.Ҳ3.+JբBÉ-BcBBRbBNBtbS)7*0xf$`#a3!J HI@ `$Ap@u7@Y3tAt-Mk|aAFh n.Ȭv!6i@@bR6] P   R 5DqA6j7ˆ 3* \UNI(z@=-HB73+ [T.Ob܊uBt@`@AIW:-EcE9<̘*h@Y &U(TjU2VAvb ):#ܢ`֤bR"tu,C6- KW@Bp>-EdNR P @ j8n@nN' 2T6$V7a-25*jhT#*0 n6nR ?J\^N1fwDi!n@0G"ǠLaƠ(('m@t(rQt 6[H `pt&$#V@ Z `f@t$ha59cF);"l@@r)AFKF n4&'$fyJ'8cPLfm &g?%Hh4e)LxtD-A(-\|C@ @b5ڶ(p N-X`:^X@@i2"muaX6>\ N⏓0jΠIX*)T"‐Av \#3얠 jZu_MEZaSbB)X@!tAUmM ;c3UfdQ`;Z)@]꙳Uv dxKb-RF sE\ t7aЮpnϢ&z"fz?J Ѯ/C~21ܛ{)[@a' V"yǯ,$㈝"(h'@R'V ''@"K@ BJH(paK=HhH@QBNxJXhK8Xd(I'kH5,zJbL ;jzcL@7 Zf [S>Ь[ ]I`bY%]ySb'f[Ψ8J)"L]GD o+Еj0 @ ;R+%>Oו]@D}QuQRYژ5۽jiYgV ~Uκf?TF#DJC*c;*!ʬ0K)aÐ- .CkT`*@*԰:pEp/#ȢFԭ(ɁS! Ȁs,Dhk8 +JeUU5P 1@ÁPQS, (2ʴ Hh7"@؆7gDdBLɩ X]L$ f/5f0 N @p"  aS/ndi e~B^ (Hc 5 !BdՂ8v`X-0S]Eg`0T x0?+2Ap =ÁL0Pb$cpMrI\9:1ܒ$gT$9#BL ukDYtAa (Rn<e"x/<p0>X b޲JP?Á_K `;ؠs^h `B|F" ^%&yuўD ƒIQx ÅWv5`^7aLAÏL;@5BAIwYAe<8ߠpA%YgX-+DÅnC:ڈ8GဥBw0N0 CH-AX* eZ,j t,+ VC)Rӧ$J2M\G!^$n@?$6lp`d3"`.mp.`f#: .fpi Aa4 zE<zidn*b Dj ^"pn?L\\ |\:\ |`  2 ""@@\@@@zJ ^AaԮ0ΆVF!DB:W`o(d&&^ z~` X 2 <$N|F  >"%E:pᠨL *$LA J=Fb. 2Jo!X@c*{I2>oo!5@T8#F6*r OˊF  *OZ  *"+0MlA@&)5". %K>$#z  Ȁ DBAaahhBF UD(3#I. &$!઀ %>iX o 52s+B"A`A(4"kQ*B@ϡB9  ")"" pL+x+^.`0Id ]@! p@Y@-Z:F$(`W@UL%E$c*!! d/$Y.c x\Ƭ 7l.*CnR!(b(pFiRH$ƞ c\ &X% @";Df X o UG$F$L>vla@ q`k@fBXWU@2U0U:ES"iLEp'z?`TpȌߠ 1TЌGBÂ&-F! dR! ޴59EZ3 pa.0,*K>", CJ d ,N B"b 6981o5Xc{D,i;tbDI2""`e`U35#$aU@RLʲ$UFdf2LFcX`g\{"*D^#50:A!@AB(a +,,, @:pt%+ $>q?r"!%cd(: `dB&HjɌo%z5^n2*4]& fE&kF3"ong~t,\pV )ss% ߡq/ @d2V(& 6@̤ȋ.lI + :8f Cb$0a;b*o!pJ>q^\Wb: q;EUq W܂ tQ@j ,KOj<٤f E`CS J%FL쐶"gO*xT6L,tPƵ&gNjB Zr, ,(*Sl.hV\.jj'BΌQdBnN|)1<#kG$<^6V8(p UA/ŀȣ+_*:*'nC~oJd]aj!`b$lpAot 0楂Vt*L .`fN Wb7 gžBB B `" AX|-LEA%Ar$G BpFpzr&"**'  &2@v^ܢ1Y@kNcCX#Rr+ TgL iA*5!0+DH#n^B)01EZB*NCº׈*NR1dZ !GgC: Y|gzU9>X!9pa_+eCYv!:  W|Zh@̋]k)Ϡ UT$f>jcY!zJ$XXs& R+N fFN `W,^ f6)): tnD-IJcGgEh ШoaBj(+zIb+NU`U@# ~Yi/u"{LA*$Eś@{Ub%EaBZYY&+Guo@u)c 7-$ [)  i" ⻖"`WnZR ''*"Jc H a  $0JPBDh XqL9 f0O#Bb X@|H +: "PBvPEqEpO #3jX*oR(!- H`x>cCNdDPI1h~~ذѹK?Q%> wԘ ʑV[UGCR)ʤauYq^(k ׆<MW`̽Ƞs%!<;@xHzHk$(;RP$u&ڲo6cj h Rx8"oɠР̡px@!#{\ YAo(J,4C@6DB 2 `FG 0T8@ @1yLi 8p(Q}x(dr^/| O /88 `` r:etSd;} XPQ0Y" ^(a@LՂT #*PCĔ0HTD`$0Yp 9pE7L3*cup' 5ͬR!N0W]x5^}0_Ci7 /pچ!ȏ*XSj$;/%hTs `xx-@b48:G6aB. i1 I- X6L@4O8XCZql^DxpmpNd4@@t׉` F.,"b]ÁIt ذY"AdD(*jj,`Edd'\yWqS88%S36P8pC]A80 - `< 3 ?@@ ܩSgph2r\E'#Z˘71'2\Iwsį B1 l1Q##}il[i %MC (uK+I6D4T80,1\Ĝf+O* `R$pԢbwY3EE YpIMY*@ǂdziP@G ^u 0x6 bYY#a@ӎE䆤VG8T%b \0% 1/`;"%2IEm8)}c$F 2*ӘOpぁjyG-0B䂁 04 <If"e`de 2 .@"@Q-q8(bd.HX?Dx6g0dP˸V稑]g@Uőg@z>EkZAn:03IxND, %@͂ vv(A[ykx*L0T|)XxB)` v(-0ꯈOѠȘN$L$ІESD+~P~Bނ2HkP\q@ 0RzN3=hi\!`p,!V]fsr `_ 0g/k*cZaqB2C"2A@ĔpD/@j@k['Ƥ0: jaJ: jtCE%$єNck Hp* p§@@"y5 h ¦e Ӂ6`  &*`6I ~"~*Жՠ{.  t 84.(C$Ĥe@Rj@`,-,r0lJY ?I#>`` x@`X!P@ BD!~`- _,A`+Mm~.*bb?3!v ~ރ>p< erY !, j;)/@@cTKE0` Yi#,JU ? mO2rA p<`<2@@RPjPBo3@4B!@kd8lgBP,A@\ @ Ȱ t*rYt6b Bxc bAA6!D!C d P@/  /[;s b c 8b#$84AErp>1;t"rV&`V(58G2(VJ#!H<5" >~!TU Ş%.bGCGB)fڅ$VT"8ʉ^8R 4q*)9 @!!C[E(/s4 @+2i0/KHĕ}l)T`V0o6rpXfcP4 T#G8~Hn့,V d`edl /@wA@w@A)aA\e',$ fWt"@;$0b`| G2UE 12.:#@@@J6NF ( +PB6 Jx@ag8h*Bbb" 6dHK\*< ph Nz~ Ne!H ''$"Jg @ KK ha#%"SCDPrP^d+ Jq"6` tBh(Sc = pUfX2#|jd%+`a! yJ`IS񄮛n q P,( yXM  >ȀF n De:V ;)`.,TH,[Fo 멣j@ gaB x'{ЫI }"   Dz;%7.8+"RF$*˔ #`F#;@RpҚ 1̊ Р;o۶ɧ(>$@)0DL8+;gTw+c;TQ4KpYFKk va 1@šbG \x(+ m,&Ā>"eO  T|C~OW;gTk4f &,]LhZ;Ntֲe SNt6 q2>UA04ek.;vMmjE53A9qu;dG5ZJSTZ7 ,4{Z>EOmiLM!yӻ4%dY ؙ)#A >Fh& B(-`/X2n8P@~@($2hEĪ 1a~#aHlψ?>SHI;+C0(&H bn a`Z@$[YQpdME[V60MǀD + LcI0UcA2eQ!=.h,/0b1@˘"uH^|v@ xn0(Â8Sg8v@H4H(A S;$``?84 ;ft`;!xÃuRXڪ5T45% VQ4&2 !q ӟ# 8F/,#`}:(8@~#PpEK>% @ 0~<8sIhLBx( ցL944 068Z9MO>M@ 8;N5I WsO42Th C@< Fb Z?,/k6  (PN4"qth &f!1/@0F'.i@b6'A@3Ġd``4Hltz#ǘt&bb2 n6 T>I VJ!e nA"и1h V 20@0dg4T0 r-+d D bzdέYΔ'%  F  ;pJ`N@!7N0  l>P2!L029l \ (Lc`W8ѳL 7`'`s@sA@̌4a`4䏠<`S*V iva->3-#kP@ BF F@<8$c3!`[c2X >BƬ%bl-'c:q4xr1p>2*F%~Ga/'tv@@!@e77q<#T%7)b04vDG4d7.b1H8&-#d-,b(y1"| '-D)63+Ot%8 r"Z%I@DATA< 08vဝ7p_ @H4 c 5 6!` ͠@^4CAYάaw MGx;~9уqX;pok 1h|4` `vkT@I`Uڻb "K)AN͌pƸpƵq#Ⱦ6DS`8 =2$dTb( !C!&2*!c* -$Ÿ$" 0N|v , D"ED~LdD#OML8c[8 JvA`NC  OG +D@Yӎ1!@ vC̮0A DqFb!FZ>%!"FA` `o>G Z~ `AbY~ ) |S` v JM1cat ;  A@TS"NB+ZMjBlEb*b @r4\(11d-PcXV?ObT+" uw%:f8ADj%n bQ`}aQ"d@" UZZZ "+ d'M'&>ۢ"aGX;O:x5[Ex L:L*CF _Y:4@./b^B#o÷A B<0@!'@`U#SrZ#xD@ D@A'-0N ÜR( i*D)K"TN GE1M,רq7%  I ЎLF8hfnIAҺy¤!@pg KPx%[T dHRlC )}"XCc@}AB<)oDhD!HaJ 8 `D ogC Hy:S10 и%17@5 \B# yRJ PFIQ 2'HV Ⱦ'/AK t ك#!\lÁ:Nw# zcbxD xH// ,!GA唑iM d*(:L"R5`RP+΀`U(!u#tia;Fv$td u^8y쬄tJL jJH\e *, f`Hsrg#0eDe$PK=D_ 03P{-=h|)Kb@T&R "(0( , 8P2Ah)kf HH)!`Ci Xx@@]dOBE H*dJCL#PHEmpxS& PcD}kQ3 ^M]@C(ED  ,"(LȠawRdGVY9D[ĩYbS%A)&`rws6(Z@Qy \~,+-~H6ayzֲp2C:#?t<]ϴvCd 4 &c$"N"(d84x1.XU8<#֓ J+ ) Aa/2$0H!;]^Ȁ4pl"#XpT( ,)kWp`{0`xh7?[z$ɞP7AX`5l rG~0rˋ| ^s$`%DA 5x :vBO[a!b`(1" DӹToC⃼3mæj*'e| 8>*l<`!p\a 8'l'j(3M6B笮hEL@T`@^;A$>(pR&xVvOSEռm[< :k%-L5`W @ ~aP#^^d^ck5|5N B@)8d^TTf#PPϰ05n@]d$zpS#@G@-@8~Gf )'J@;@#`D;@`;B+鮈`$ ,`'xR Bք(ª8020l$N*ʢ""' 3bD'F,^*EbF"l R<1Fx  = jIcJx;ƖbG@U!ul!`1 8` RAN~g>> 4< `sXe " (/jD N$CbhB~ @~! ABš3D,  l N"@O"x+R ( `! ^:  HC^g>vC´uN 2i Ebct N¾28a1 , 2fCb>{ 77"2vj.#-`7AA&P L ;#Ja!P"Z%"4$F;h:- v0i 4|PzaT db(< z``f@SjG#ǎr S%^ӏ;Bf 4q8 ;Px;HBK΢4& F;A @L;APmG5#/`R/&' tp-+0C$&@mB "$f!/`-Aff&-g)¦%d" ZE+c4Bt$Lg7;5 ʳ*UL-Ð" ( lAJ2v-Ѫ$7Tr3O05f!7z2fЍl q BAA! λa`a@@"RF"$ (b*Aʌ8֣4s@a 2 1; H&ttLzBJ&xȱgJbD- )XbX 8qBL w# fTփ@8'$F=֨8 @ 4 R  D\ <),H$ H0ebC`0S:l { !@A&cqcI t/FU+X%GN4Vd!!0AAVB@BlK;B 8^BH`A J;A}=`s#Tsဵ@c}xzI&.`>n'p,X0fQr6$Mܰ(4-D/N7D*LR8LRQ"(EB b?,RTgȊbx| (b>'~(8iv"N%@"x U7"f4 #XK@J )* qB<5-}tw,  B'"&5$A LB* l tfE sJ[BBChV4;;;4X7$+x'B^S)E,@3B(⾱|"+#4QtjGrg`/a`++ӣ3d(P <ՠn!#.!l 0*&&x'"{||ƢD;t @\7"rb%8w",> ,c(%1 8a1c 49-1$9̯3A8v cC rB#B$ ltzƸw[#08aa)pi'j.*U S9Њ^y4=f?fKJѸP:x:0l"!25,6P T;!BL ))yP8FGV%r<`IeU8ER > _-8:@@VK; 8pu\``\ ''@"HI@ P>ȐgL@D@ G""&X@ 'VNVvs$`)`E&),P,(`]:nhR+h~!,"YNY[В$Rr6A\cWcSd I6o_ A ǁ3@J!x a+Tga8&L &ibΐ.OL&O؛JvF^q8v -'Ĺ(4^3`0c8#)t0l hI.  p`޴Lɀ    IDr&pHs!O X7@! 1r( dŬԥ'/2)2! iҁ` x+P&05ݵƄhpH )ѱ1Sޅ6rxI , m`0SbI)w)@.Mjlɢy2kDQ  `,*k4"p>k=ƅTg!4IƗI (֔a%`g=-+<,a t' H6^֓_,# )AX|<$jȀNȲV &=*`33*J y ,(e`]sx +ꊺ@?H9\ !6h"S+ª+"Ê iLl ^ux!XHA{ ANu0]cKI0'X0|&Xn0@ D`0&8 `n 8q Рi $P.`% RJ\ݙWE3!`>r   @H"C- >P@ dH'rȘM3@΋*XP&",X0[΀$@@Hd0E(.G: 3J- @ `%| R&,4B ^*"iX8)X&^#JGA$L8-< 3*P෠y2kH\$ !iPB $@0tMBLGsh0RM*M- ep``U$<`Vcx.P-"0·WH& A]"HKX/P*ae & adDKDAHcr;$aA>fu  r-72\Fni AJ"  <#` iLܐa@B5(fFdX``A)`z N8$pe8&cCMBQ@ 4 0rώaZj+\ةF '#@Z;if84M 8q{:́dXƒ [@ICµ(ޱdoiL JJ  S= Ch JT$/C0%S u sBý#@@}D4 *0`2`0^{x.v_BxTY%<@M@4|$с<+%xGc(;1Q +(0MU Т4GB!C\ RA]a5/xzFZ6  b@`aР" cBY@@" 2 :< 88!O ^`K5A@4 34ࣥ QV ` G)6l!P`f d g@cD)@" š%!c"\ Rxpnʐp`Hl  Xv߄bV&H`,d>/…bB8'&@0F0 *.R!D  @29r&¼-n|"em)/p^4!IA⺇pK^'2v`R"*bn!5@`r04!7 0i#j0R]'D0"BiR : >F ά㈭H.v/7gpK?  `  O, -e(֌>zF h FV a@@AǠ,ACW`#IL@ G>ba@Ʀ|G`ׄw%- P@ ,*BB h'g$"^@@#D /{7A1:00T pt.v^"Y; " "m 5A:$fV@RA @@@PxcA0 p $@aJ(&FĦr<]2`+ƒ,r&> p `vGv@h!b  52wvDI@`` d," EbX v,u@@&'fd0I6,*\`Z!>01/Ī7fp$bp(4tB D)*C>-4.l8]lT)Ź+ fh lk2j Gi6 fEN夬 *0Bo,5"` ,pJ0:mIv¢y:\<%"A d@Qf%*`H*5 F& nW,XW`@^W`ɢ Jg>P,F3 M "@T`&kBd]k" -Z˴b_9 TG 8Gm/6h%%,^bRR-LbIDg7e"{p-ofv&UM,`|Lz@a@@ 〠w`/Fs p1 bv0`K 1N7t,0'd!@,5 1@ $ReC,樜vn8"p@ʜ!Qd2a CCBPœ`O$`R["LHS:gA#eƠ@fdYf!R!,rKJ& R @ {AZ `@R 8.A[kiP&B1쟯x^eLb Gg@AzLj A1L#!JGaBG!S$ּ%J03 4%`u&B sgXb`@`S+.뇗6-\j(H> 1 %4i4W: I \ 4Gp\u?_@A M R'o^-Oʻ@E5 Z]@ɡ F9n  B2$6],%\KhX7|(i~mr61 2a ub)+nT0 dMJ`s``@v,`uK !@ A!R P' R11 m  n!Z R!}tA`!*Bdn$F!TpDĩz`a#+B5@6u"-@x^",IfNk,CIlޟ)~[H]U;d@P. gFPaȍ1A_`` ''"J# xK 0*{DŽ4 C%!$Ln(njh"c y@đ3Ӣ<4 "@P %3 DuAm^_DU{' ! S @_\^FQ$B"d` 'F$`ATW+`1r_R`ca[&v7 ,(߀j*g@רmpo3< Chn`f@hP.<` ^%Aؕ pB!ҏj#p L(SVϲopH ls2 #0s 09/) (pps&3Aˊ ,%ܬɞL" /2b0 YĶ8[A#&XfCQ>s9! \0Ld 5*1{rA AZ7/ x8p 6 .O-<*P`-VX!IZȰkip608^˨J#ހV 8WO2nx?,BAÃLHс Xh,  R_,Q (cq#]@ ED`<h%$d#J:r?"' D7*x+@̠] 8(` x,8,)IJL7 f&fJ׈ ]+.2U$)_Rbj[zOc⁀A#U8QR lSSQƈ0$MP-) `[IJP 'x@dl ЗK>`4[ 6A%@N(&9i8!Bx uY00nA _AP<аB`@Տ^ tΏ26@BixD)ɉ p90` ɆE]aw>(+vȄhJ 85bA"0*Vn€ $(t y#w0p>˨JX"՗U{v hTzO-BL2LA2) `/Gp$ތ9J&{Lx,6׃`p\C6,/ua(ބaPE{|Pd|6$4SFV` @, `'Z# Vtd@)j#"Zk!f$# ibT jO $]!@[Ť T  j`Ti|D8F  ÄeG@`@`͉   xDvۣ`V&N, RW`@~TmWAͬ'HJ ZL&r @r A p$QRWQ0[bzgp@@Bl!p* KLxVf¤ a@#$0 ^6 i`# ``Z]!॥ DN  jGbPK !޹=D ?"@y<* o`oAnB).*DD *$(Ű 6(޾F[@h%F֐$(4@ 0 ϐ Gmq6Sc\`e%bzPښ Y2f:\"++N`N΢DpG, jb>@֍G `%   a@a2F@@X6, @&>$d h  VbD`B=A 4 T$qAE-BD0$.RTl ƠLقzEҤ  o4,oǢ#kZK}*^ #<}J6"*N!p@yǘ&xq r*K*6Rh!6@7`r`@0C` 3Os2/-`.1b*<) ($&"f@9@t? 6p# ljm !)!<|B*+b^ `n *ZAD`O@C`O&hA$c-!t@Ab>Dt Dv` >:B)"ȈE[noTU"Qt@߰$ i@{`<9m"X# T,a@Ik|8CtD&Ga omkh!H'&L#dLKK İ N>L+L1ls !p 4@A`&IY b* '~]cXؼ*HQAE @W@ٹtTvP*[*<̒$F0 ~ *C+xJB`\&"OB :w! n\@݃C<"nB\uvaBG>vGoĤ$De| ] 17pǁRN(̌ "J`'Os@3OoAןCs>rʷ6JIUx ? oQxxA A?!Gpr՜N T'+$ྲྀ+@ 0`jnm6.0A-&(3:: +|N&d W"J `N K-G J}!?9*`l Β9b6J Nkf-.!B :1?%uL#V¾pN-ࠋ.,@i O$["6+{z,Id1{#&<`@J*=Xw-lm^~L@N:6@1 XR~$`6&6 x[j/k*=2E ș   `A3`ҥ)r@v7,| ="l!@m `D0tD0cԧyΆebJ7ia7ReVptUdç1܄p1 (iBtƞ 7A  \ ''" hIe PB jSΥ)鎈:Xr`ѐ,@+! \5Qu % @|5wd\ x "( 5`{TxVKCw1]]j aKr)%uadB0@]Haia@v!u$r}@, q B䋈%_ B|)WF!&կr<&{b|o4O6n[A.ALi,@HLJ趮t:@/ +ƮN4TH5] > F`@& J4 .Ni@ԪɄ ChTH>@ *B #|'B.2B2/+- 0A 3ghy1"[,KXp$AF ~ *9 x&l $p, CqHB,P`H", !k< ! P@lx @#T %# }@2A0x(@E <9Ez 0Q 4,F ,`- Q6j4@.Bk +@b $MA 0)aU s< 21AH HYrѡ Xza( ܁oD4p0IF5t̮FR[(QFlL0a-$bL[h"14  41Ё?&PA4TA@BPM@9jxtW-% MgR#Jd K%x NbB 0N @& fQq 7*Jॷq\D)d2ȲB2 T"p2/] K D O-S^YHvp#ЁƒH#1Ƃ5 4zsKBq z) _Y{IkZ 014P@00P s`4DHXhBI@H;`)1E _b=x,2Zb $`H!  0&@( DۮB`@0;Avb JIl;(! 0[Վ_"J@C&PG $X!C$̩ $GŹ/j+h]ƅB$<[V:O!(m%" ڐ@ , NL>sA@̌"<(E`@YĈ-P, V(0Y+q pT[V]/`FA ܥҥIC J+A8 -e("0PAGBH6 p6 KjT"dPL|3)jpQCW,pM}Bֹe(`NbD5r>Yʄ)`ÀT0(`dKk`A:B`3z>t 0U4xM0%e 4Y!\jZ x`7{+s%`qC[n@CIB(bjń ɋ [ lH$ P@^d O|RY lp I~( P"<r g@x<F[pEpx,@$HAd:$/ P.وAAb<BK`E, !fԾ&`@ -xzϿK Dd1(sF_|/hFk `j U".)*EfV F 5AYa Y2` B2SuA1@ F`Cp[`Np&VBoVY֢j rԂA D! faMF! J&m r_;(-@%)l V@^"  :"dՁ BNB^ n x-l_b@b`琬^!o n@n . Χ4"(- T@hŸ @B@nQaE X @G 6hxnJ:%<4Yapp>@B˔1ID@㢶d}#` V NzA`KjB~Bε`a$ "A`Ⱦrbx/+

@9A K /#ayH$2xGTPv[lŃ[G >ADF 2!],fP,X@;FN"q:% <̮ X!A$"4RQu:/!Q^i&m"@AW& n PФ:**M`@EsAJ ߉ |@!?F*ZAJ"  t%Eb 39/. 3!0 B.Ba lW)ͤB/} & (t@@?A@@d@"%"M Ai& eNc4k>ြD`&d[Ȑ@ ArZ*DbG @x  W_P~y,ķ"lJy`@/2B``zAl/䠸C2 g[$$D4![d|Ⱦ }A9@BO`~z@%''l6Ā`Fh!U1*} rX6$>x GB3BbT [.M:G 1#*Qatgi04*08G 5&Ԙ `ψ[}?k1" Ԇc\ZRt,Z,_;$t4740܀bŞ ޙ1䚢x1}JX78mn! Z6 fI1'+ќ*zLd€_*򾟪RY%R ʾN&B S)jZ&O&JbA$"E$jI$RLF%7P"jw2 |*助} bG)HXc/]rPXgX("M\hf!Z GW iv^Z:a ]`))wQMD긭 eJQ&BrVGr*j_"jc*zpFm+2eKIԈ # A=r =a ݔz86DǀDO@Oą6 A7-… ̉os@1 >PJ1&!=b{11o`%P{d|KA"@{`"^z80#4h$>@"](9 Z~ %*`oF+J4 HMAכ>G0!Kb#`85#@z n8A2*㨓) R/@DǠ`Bx&l dS T$|' #X,ΫA ] HG bq|QS\A4dg  `q zdԧH{ *D2B%-@4 8J&SjA 62Fr L2_2Db x02AAQt@ +J74S@B,τ( k-M)4 XJ hW |$.ǀ$mP1`&`pG ccņ..̽-AI5"*ܚEBV(4c!(! G!>F`$a@Y `%Сb"(pPY7V3"B Bk̑|࠯ȑ3## q8Ar7',`h=֏@ vě8"` 1 12om>U\%}  DX!`̡ xiP8Ed@z( j"i(`bDNB#fqɻ ]#( JF8C@`#}(%AS‚JPz<ѻѓN8 gIV8pX`= N w̞R$#U` x&T4U&(@54 ) @B \7Hpr4J1l@VM 0i l&Ab K Pj%* D v( l0DAC ۙv8Ii@ 8 03Q@F$rg (07݁ P53w9_ kؠcWi/Sh22b + @hJwpl+pCA@Cm-xDB%gl~ ,'# dD8  DI_H.8$D@A1 /xp L+`lF#+ 0RCQpLju<PZps){Тk`FٿA`uҭX?@/BӠdCRB`"HpXΩ*,$7AՂ .HX(amDJ6Ձat0 ogx !Қ 9b7*D5J 8 7B2T># v "/G X4:hc\w5Ȋ rj **h1h1g7$z+e*^A@(kA)*(+ b %&^F()() ),$ij*b+ցaM7j p¢ A T@I45wBjbR0B/@@iAcI)ɦ+ކ@Ӏa@\F+T[[A[@p@@ -l1iov*0/B& E9C\Pt@ 'oOv JH ^$b&D@Kn*| =@< D(*`> {A`<`Lb# !@9F!RBh \~ <#H b``l~@a|@}}^@?<``~t"h7`+er 2 5'88BH HǸ|JXK38?h  9&GDAAR`B28 â 9,Lk3d~$ @ B'XC bXa$+z"m)@ '#O@ak"gľØ~@:gуfK LC1[C+B8$^Ba`cvrc\T W! Aa4 _)1VB3Qd HKq1ĀP/#$Vz -%, d!e!aII1JD plM6c8JS7nf#'V @r )@ ]BF,(| %$s&Fd|  ( +%-`+ x &F%&P%1 R*º%%j-`ao>*8 s^9#Jw dT`ַC$ >V@%.N1a*  I h ԍv \"N c}:@: @ 0:f%QbkoiA!aVV! DwHVAP\D=d{N6r4j3 La@EUG21UB2 `!NԺB3sc\D&@fHA2KF !X  9X| }`~ >KWb \]Z#*` } c4"G">@a@=R "cZc][Xh$](C]WO4st"ak4 gd NhH,3TBF{@ H H@3OMj:T"vT0BSw81 BG7Jc0Jjc7@eNޔ"K4;whdW T1acNB> g(mbK;d\a BRbS b_st6( s< &W.$>@`A ,]L;Jx e2!p.Y (X( +/bkBqb‚*GYYaA@@ܔl&v+J&j7N$ƌ \ ސp60D&S5@ *.3R|A`HH6k|@[)Œ3 ظF7ˬn3'/.Kax=%h "+"1ب**\(_8  ߷K*\ H~^뢼zۗ$-0~"`L[/g&s`vM9Į75TwxC`iȆwH/ވcpa6W!`5,5Ugj uaTm6 1AAA1 SI# %͖ $$~SL*¯A BՂ @Ў/W)ݡa Bd dj7+ _@@n$ b@p''`"J' (a&4# !.%a80l6J8bo ݖf @Zl$)jl3 2֖MA~L_s-P;f*#蘶-YZ]T`+Chž҄ G@^'(00%1|% 8I#D RT$ CژPܜ7&d xq@ Hh t@0D|C-(;ؙCɃhir#/s"&!7Nx 02:s2\7 l46rHC8(4I (ND> H!x% h7L\<c7Gbr(+"~;25{ C!!!ɡ# @3% ȫ !,j ;: #!;#< $$pIҁ3>Sh]SuJq 2HTeP@hk W,Ba@XXvX!Aִ&ir Z!0䘍 ژ ɰؘiJ ʐD.*JItHQD ^hP{ D9&GNQfO~ef9gfqoh:&hNf~j:jα毮ŭl;&ǯlNѵf϶terra/inst/ex/lux.shp0000644000176200001440000017626414536376240014336 0ustar liggesusers' ~Z@ QH@Kŭ@ڿ_?I@ pp<N@@H@g=!൤@ڿ_?I@K'@@l I@bw @@3I@_$@M@I@k)+@;_I@ɹ,@ I@ Hf1@x}I@]Iٿ><@2I@`=`=@`'I@1ܱH@@I@xfO@;I@<@R@mI@}g@G' I@$Bm@[I@Q{@bOI@P6@U I@LA ^@(TI@8> @BI@b;@}@"`I@Q{@Ju {I@Hw@I@ؿ%w@\_I@06}@gieI@ D @j/I@}\ @I@?4@V4I@@?I@C`8y@0I@f$!z@y MI@XZ㿂@OI@?mz@( I@؟z@0 \ I@_ @p^ I@_l@ I@'t@D I@<t@S@h I@L8{@`? I@n@o I@Zp@* I@ ߤi@ I@źi@ I@1p@I I@=Zp@2_ I@&tv@j I@}w@3 I@_p@nI@o&q@d_SI@Aq@t}(I@_j@&I@@j@j5HI@%? f@;^I@sZd@`CI@R d@I@ؘpk@5I@) #k@<I@#q@|`I@/%?;r@ߞI@ sr@1GI@\ (y@wI@5 ty@ XI@m7)@J2I@Wy@ HI@%_[z@{I@?_@I@B_Ň@`I@n_@N|I@QI@ I@ 1@KI@)@{@ 0 I@@ _!I@?d@#I@@`I@D @U 0I@;@OdH@)wu@?H@U ă@H@?n@Ym_H@%@l@H@?h@o H@~ܟf@@AH@Rï?&a@,dH@N_@6H@3^@H@?[@ H@zZ@7H@|NQ`X@ yH@,W@~fH@o?T@OH@T"S@Y:H@YNQ@TH@q˿P@;H@<@N@+H@ * `5L@G~RH@VMJ J@`H@-#`G@f H@,_AF@h?UH@ wC@zH@r@@QH@ǻ*9@P KH@P@E7@DH@5@\3H@1Y4@z`H@rER3@Y H@LY3@HH@JV3@3H@p?3@?H@)3@H@D3@X @H@2@IqH@L_T2@ecH@@0@> @LH@Z/@g9H@˲P+@@H@5=*@H@?)@H@ 2)@=jH@O_(@U `H@\*s(@?H@<:'@_H@_%@H@M $@_H@/ן!@M#H@j@HH@vs@qhH@@3H@>C@S?H@ @X@H@J@eZH@a@z`EH@#@fqH@;}@tH@r@H@A7 @&`H@k-#@KqH@7`O'@PH@5)@/`jH@= *@x}H@,@_H@|`1@,H@3@H@G,6@H@-7@H@g_*9@_H@_D?^:@7,H@,?:@&@@H@ 2;@~ UH@J;@$H@;@H@#;@b`H@;`&;@\I@w?8@ ~I@wP`l7@?I@J 5@ޚ I@3@@I@0#@v0@ I@f.@|ߥI@&@u)@I@܋&@ @iI@3#@F II@&H*@I@Y@I@YNj@# I@|v@NI@S @'I@S @9C?I@*Ʒ~@?]I@?@]I@?@$ I@o$߄ @PI@K @5I@ؿ @6"I@GR@cv3I@п@;R <I@@JI@@@AxI@з?@KqI@@I@{&@;?I@U@ I@(@&`AI@҂d@*hI@vI N@0I@?@2I@| f@ TI@?@I@@4_I@@@mI@:@o 1I@ì@V `NI@M0@1eI@?M@.nI@쿭?@I@ɿ@@I@M@ɠ`vI@__@G' ]I@CH@2I@z ,@k_I@l@I@җ+@7I@ V@@?jI@0@/e HI@_@k_;I@@8I@0@0 9I@+3@@BI@Z@O۹@oKI@Ű?`@?bI@:Q@I@1@WI@?a@ I@F*ԯ@KI@@@I@_@WI@dޫ@J`I@؟@nI@|X@ I@O`@mI@ٟ8@bLI@)֪@,)I@R@pI@A͟@/"I@! z@|cI@@^_kI@@ZI@%@0 9I@_i@I@yo5@tI@ Ү@I@g'ſ@,nI@٬@ ~I@M:4@9+lI@ߩ@= ZI@"4@q@`4I@jqި@.I@K@fB_I@ `@2pI@J@^I@)@S.I@W@o$I@@W`H@Y߿@H@G@H@Ia @FH@}@v@H@a_@H{H@@&@@H@1@cv3H@x1 @%0H@MK݃@V4H@@ŭCH@~f|@3 H@{@B?H@9Wޟz@oc?H@k[9 y@dH@Ax@ngH@:]w@tH@&4eu@wPH@IQ`Ct@x1 9H@>\0Wo@+H@C@Sm@H@]?)k@$t`H@Yh@lH@7@^@pH@MT%Q\@H@/[@H@Β:>W@lKH@K O@ H@}˿N@>dI@p<N@aS`I@"bO@;_I@U@2I@& b@ـI@k@,I@{PUr@I@=p@4TI@bo@ө I@XE, o@ I@`kt@@)I@,@5u I@J_*@u I@8ߡ@s I@:? +@\! I@# @@(@ I@<"@.}  I@\M?@ I@Q@ L I@"Nx@ I@j @ I@*s@ I@0@U>I@[?@->xI@5@_)I@Nz@fB_I@ ` @U>I@}7@@kI@ @oI@<`@q?wI@͓@6uI@y.K@F?I@.@,nI@?@ڿ_?I@'@@l I@ C@ tH@1 ZC@,dH@uv@ ;H@. @_mH@ٟ@H@^>@@H@yD@=?H@I6@YH@W_@^;H@__/@ bH@۽?R@H@_@_H@ V9@r@?H@ߖ@WJ H@Զ@JJ5H@|5@?@H@@*hH@6  @N%@H@" @LYH@ jӿ@H@o?@N=_H@@_H@c+`@IH@' X@ڧ@H@u@H@s@H@L@N@:H@|M@;R @CwH@@MH@ ?1@`H@B v@\9H@/,@d^`H@_ @cH@?o@{H@(E@0H@@sH@t@ H@@2$@H@C@)%@H@<+*@H@?0@$H@(f9%6@.H@JG_<@@l H@/ =@~G`DH@6@:H@)8S7@sH@D_`p=@oH@?=@0aQH@1 ZC@L`H@}C@,H@I A@nH@״@@@KH@U@-@@ ;H@I>@ H@HF=@wI? H@vu;<@_H@K:@@H@(6@AH@=)@Z_ H@/"/%@H@pI "@# H@^ɟ @Y $H@!@QH@C@u& 3H@P@?H@8E4@F H@&S`\@\!H@~@ bH@<@>H@B@'H@84`@Ǽ H@i@NH@Զ @FH@  @(H@ @k\ H@ @(H@@ @Ym_H@-$`t @OH@?@H@ O@_H@EDֿ@_lH@5`@CH@RGr@0H@=@_H@ ` @P H@. @AQH@ @/"/H@ٮT@o@H@aN@hH@^9 @`YH@k@T~`9H@X?{@H@K H@$t`H@Lv@:H@& @ɠ`vH@@V `NH@ZT8@8@@H@K @ H@@BH@W=@ tH@9@@cwH@t@ H@hbb@n @H@º_@ jH@zŸ@l?H@*&@ߢH@k=@&@H@@DsH@M`@h@H@*@_H@5@6 @H@% @VH@do0@H@y_@@ZH@#%6@:H@j,@_@H@m w@H@n{_z@_H@-$`t@)c_H@'_n@ H@mo@\H@߃@:H@D1@H@@H@>;@7H@_v@_H@% @tH@ܟ@7H@z?@kH@ս_@ZH@n{_z@ H@ @V4H@U@=uߔH@K@e@=?H@mJ`@ eH@_)@(H@$ÿB@r/H@C N@+H@`@j H@ O@0sH@ޛ׿@ 1H@ɿ@kH@۟@?H@'D@G`H@>;@6"H@XC@>H@#N@v@w@_H@+෥@ oH@@ H@˷_@H@I7?Ý@(@H@ +&@0 H@@@ `H@,@n(`{H@! @Ym_uH@? @b`nH@(?@҂dH@ם՟P@YH@ZR y@* QH@V'@@:H@ @H@˄@^H@1 @. H@@@) @7 H@O @mgH@}@J`@H@1Y|@11 @+H@?z@WJ H@a u@`, H@ s@H@S?r@>EH@ 3o@?H@#Ol@*H@DE j@H@lf@"MH@'c@`(H@H"c@?2H@3@.`H@ؿ<@?bH@ ;@@@`H@Xߟ9@UH@X8@DsLH@;n7@s_7H@'?53@ H@(U2@@@H@R0@2pH@/@eH@S?.@y-H@G@,@¢@H@ )@WH@PK9&@. H@_."@2H@2G@2_H@H@Y߿H@@_H@2.ɿ@OH@qߗ@@H@ @H@~ @vH@l@H@&@:vH@1O@o ?H@D@!H@h͟@@?H@F+S@lH@nAL@H@82n@,H@`)ß~@H@wؿ@ `H@@5H@ I @7H@ןH @wH@C@_H@_@aH@[@H@l@4_H@҂d@ H@@X@H@*@qr`H@_@k\ H@@+?ZH@/"@H@߈@`H@ٟ8@H@Ag@y-BH@٬@h@WH@/ @jt?kH@5M@ 0H@A@@H@@@ө H@@4_H@,@@bH@L@?9H@$@ueUH@aR:`p@H@#;@-VH@  @Ǒ?H@4@cH@}@.H@]a@_BH@:P@WH@xE@/ H@C@lXH@G' @s@H@&@cH@Kڿx@!H@K$@n@._H@` @PH@?@qH@z @?H@cv@~H@b@ H@@>@%`H@G@_H@G?@?,H@>@2-4H@r/@r?H@'͟>@> @LH@b0@AQH@@ecH@zk&{@~H@$`@CwH@A_ @`?H@lݟ @H@_Q @`5H@f @ @HH@ @?oH@ @_H@韷@WH@r@g*@CH@z^@AiH@{9?2@?H@ff@aH@D@=H@_?@aTH@_@q yH@~_@% H@@\#H@Y$@ ?MH@?~@W`aH@N.l@@H@V@Y H@$s4`@&`H@O\,@_WH@M,@YH@R,@H@+@v H@N@)@> @LH@mo)@H@WJ )@H@դ%)@V `H@FW_*@2H@˲P+@@H@Z/@g9H@@0@> @LH@L_T2@ecH@2@IqH@D3@X @H@)3@H@p?3@?H@JV3@3H@LY3@HH@rER3@Y H@1Y4@z`H@5@\3H@P@E7@DH@ǻ*9@P KH@r@@QH@ wC@zH@,_AF@h?UH@-#`G@f H@VMJ J@`H@ * `5L@G~RH@<@N@+H@q˿P@;H@YNQ@TH@T"S@Y:H@o?T@OH@,W@~fH@|NQ`X@ yH@zZ@7H@?[@ H@3^@H@N_@6H@Rï?&a@,dH@~ܟf@@AH@?h@o H@Oi@)2H@&_h@H@mh@tH@p֟Hh@v %H@Z}g@H@gߞe@bH@`d@LA ^H@>Ad@fB_H@rc@6_H@z)Lc@sOH@P@b@1 H@;`@bH@`@?H@O_@?oH@Od7_@ H@ka@k?H@E Eb@v@H@ub@E|H@0I`~c@͓(H@4_c@$H@߽g@ @HH@h@]`'H@<%R`"j@wI? H@+ j@_H@8l@>EH@+ Vo@va_H@?p@߱H@Dr*cq@;H@q@7H@2){q@sH@n&p@G:H@p@y*H@5p@`H@ @'q@u H@<_q@@H@4 r@OH@! zt@;_H@u@H@DHv@lH@w@H@;`Gy@tH@I }@baH@A@?UH@;@?AH@ ۪k@K'H@OM΃@N| H@%@H@I@І@BH@$@Y H@u@4<0H@쟆@ @H@"@6_H@_ @5H@ ` @S@H@3@H@p?ܗ@~ H@&4e@{<H@7T @?_H@T;`@.:?H@g*@Ü@lKH@ @_)H@@`, H@'j@bH@:~@6 @H@9@͡@H@ߣ@#H@"d(@w@H@)NAR@-@H@v @H@8Z @(H@ҫ-@*hH@Y@ 8H@3@nH@vu;@11 @H@@]H@uv@ ;H@ &k`@H@J?@@H@5;@ԑ aH@ËՆ@7H@)!@6H@@;H@  @>]AH@PvL@@2TH@/ @q@b`nH@! @H@)^@4 H@@H@Ӂ0@ H@V@;H@9Qח@&@@H@;B@:@s@H@G?Ҙ@J'H@R0@Ro?=H@i@ H`H@ o@H@ÿ@0 \H@0r@+7H@ @\#H@ @_H@ @->xH@Gؿ@INH@q_S@58_:H@W@@&H@H:Ϣ@H@A@u@+rH@-Jb@QHmH@q @~G`DH@5@'@y@H@$qP@Y H@@Ǽ @H@6٨@g+H@?D8@qH@L?@fH@J_*@H@BӲ@\!H@B@zTH@ε@y'H@/y$@_BH@&@jH@ʋL@JH@VN@?H@U @[H@!c@"kH@B1@HH@"P?@ H@t@H@ "@]@H@'@6H@=@+rH@PS{@H@@l =@@H@ԟ@_mH@J @G~RH@w @v@%H@O@ZU@H@N@LH@,@@bH@@4_H@@@ө H@A@@H@5M@ 0H@/ @jt?kH@٬@h@WH@Ag@y-BH@ٟ8@H@߈@`H@/"@H@@+?ZH@_@k\ H@*@qr`H@@X@H@҂d@ H@l@4_H@[@H@_@aH@C@_H@ןH @wH@ I @7H@@5H@wؿ@ `H@`)ß~@H@82n@,H@nAL@H@F+S@lH@h͟@@?H@D@!H@1O@o ?H@&@:vH@l@H@~ @vH@ @H@qߗ@@H@2.ɿ@OH@@_H@H@Y߿H@2G@2_H@3>@@MEH@dl@H@>@SW H@e;@@(H@ `@_H@W@~H@ ğ@_XH@@z 7H@`@>EH@:g@zH@_@J`H@J?@ОH@|߱@WJ H@A ]@H@=/ @2~H@@ZfH@3N)@ueUH@O% @x1 9H@ BP@% #H@p ?@Ju H@-VK@rZ @H@g;_@ZU@H@״ @ H@П @`^H@u @KH@ S @ _!H@_$ @@@H@/ @tH@v @ H@E `@?H@LB@H@H @_H@Kŭ@<H@ @\H@@3H@_@@@`H@H?@ =H@>$@M@)H@q?@v H@eߋ@UH@#ٟ@VH@E#@ QH@@d)H@ @WH@%@. H@-1v@H@t@H@b@b}H@by>@iH@)k@h@WH@?_@7G6H@(?@ H@ކ @N=_H@>@ H@@4H@?+@H@3@@H@I@$t`]H@@j5HH@S@&@H@:?x@L`H@@ H@, @rrH@SI@ =H@@lH@(O@,H@+@"kH@꿵@KH@C@P?)H@P&O@RH@/d;^@|ߥH@/y$@:H@/J F@FH@˙_@Y H@@#@H@s+@58_H@S q@H@dB@ JH@bw@''H@i_@H@H`9@Ê H@B v@YH@g_@H@@Tj@Y $H@'+Lz@d)H@%@f@C4*H@_d@oc?'H@3u@&@H@@}_H@~@2H@@ H@_@pKH@ٗ* @ZH@*\@Q@H@\@[H@E"@?H@@OdH@5_#@fB_H@|@/ H@ @9+lH@* Q@GH@aC`z@l?H@%?z@H@ g@W`H@Oر@_H@@d)H@by@5uH@P-@j H@g?@4 -H@"_}@)@H@8ߡ@@H@Ia @/H@?<@b@H@oU@S߮H@@҂H@_χ@_H@ѿ@zoH@y@H@?_q@/H@ٮT@oh@{H@ц `d@@H@ S@9H@׿S@tH@m?S@-@7H@8E4O@cH@!Q N@;߀H@0aQ-@'_H@K+@IN`,H@+r!@VH@EH@R`@v"@@H@ٟ@H@. @_mH@uv@ ;H@@]H@vu;@11 @H@3@nH@Y@ 8H@ҫ-@*hH@8Z @(H@v @H@)NAR@-@H@"d(@w@H@ߣ@#H@9@͡@H@:~@6 @H@'j@bH@@`, H@ @_)H@g*@Ü@lKH@T;`@.:?H@7T @?_H@&4e@{<H@p?ܗ@~ H@3@H@ ` @S@H@_ @5H@"@6_H@쟆@ @H@u@4<0H@$@Y H@I@І@BH@%@H@OM΃@N| H@ ۪k@K'H@;@?AH@A@?UH@I }@baH@;`Gy@tH@w@H@DHv@lH@u@H@! zt@;_H@4 r@OH@<_q@@H@ @'q@u H@5p@`H@p@y*H@n&p@G:H@2){q@sH@q@7H@Dr*cq@;H@?p@߱H@+ Vo@va_H@8l@>EH@+ j@_H@<%R`"j@wI? H@h@]`'H@߽g@ @HH@4_c@$H@0I`~c@͓(H@ub@E|H@E Eb@v@H@ka@k?H@Od7_@ H@O_@?oH@`@?H@;`@bH@P@b@1 H@z)Lc@sOH@rc@6_H@>Ad@fB_H@`d@LA ^H@gߞe@bH@Z}g@H@p֟Hh@v %H@mh@tH@&_h@H@Oi@)2H@?h@o H@%@l@H@?n@Ym_H@ o@->H@ r@ H@֡t@_H@u@H@ߪv@ H@nRM Wx@UzH@(y@;?H@q.{@_H@Bc|@k?IH@g~@_H@xĶD@H@I"g@GH@@H@b:B@@+rH@1_|@9nH@Ku@=}H@ x@bH@;@@I@l| f@ TI@?@2I@vI N@0I@҂d@*hI@(@&`AI@U@ I@{&@;?I@@I@з?@KqI@@@AxI@@JI@п@;R <I@GR@cv3I@ؿ @6"I@K @5I@o$߄ @PI@?@$ I@?@]I@*Ʒ~@?]I@S @9C?I@S @'I@|v@NI@YNj@# I@Y@I@&H*@I@3#@F II@܋&@ @iI@&@u)@I@f.@|ߥI@0#@v0@ I@3@@I@J 5@ޚ I@wP`l7@?I@w?8@ ~I@;`&;@\I@#;@b`H@;@H@J;@$H@ 2;@~ UH@,?:@&@@H@_D?^:@7,H@g_*9@_H@-7@H@G,6@H@3@H@|`1@,H@,@_H@= *@x}H@5)@/`jH@7`O'@PH@k-#@KqH@A7 @&`H@r@H@;}@tH@#@fqH@a@z`EH@J@eZH@ @X@H@>C@S?H@@3H@vs@qhH@j@HH@/ן!@M#H@M $@_H@_%@H@<:'@_H@\*s(@?H@O_(@U `H@ 2)@=jH@?)@H@5=*@H@˲P+@@H@FW_*@2H@դ%)@V `H@WJ )@H@mo)@H@N@)@> @LH@+@v H@R,@H@M,@YH@<>\,@_WH@?+@.H@jx+@iMH@+/)@H@T'@Ju {H@b/$@c7H@Z'#@߱H@3@#@Z_H@2"@S vH@aP!@cUH@N-!@~@GH@1@@S.H@RŸ#@!H@69@_H@O@> @LH@r/@r?H@>@2-4H@G?@?,H@G@_H@@>@%`H@b@ H@cv@~H@z @?H@?@qH@` @PH@K$@n@._H@Kڿx@!H@&@cH@G' @s@H@C@lXH@xE@/ H@:P@WH@]a@_BH@}@.H@4@cH@  @Ǒ?H@#;@-VH@aR:`p@H@$@ueUH@L@?9H@,@@bH@N@LH@O@ZU@H@w @v@%H@J @G~RH@ԟ@_mH@@l =@@H@PS{@H@=@+rH@'@6H@ "@]@H@t@H@"P?@ H@B1@HH@!c@"kH@U @[H@VN@?H@ʋL@JH@>&@jH@fB_@/"H@q$@@UH@X?@% H@K @ `H@_P@ oH@}@ PH@n@ H@Y7ƹ@H@xH@ @_H@ @\#H@0r@+7H@ÿ@0 \H@ o@H@i@ H`H@R0@Ro?=H@G?Ҙ@J'H@;B@:@s@H@9Qח@&@@H@V@;H@Ӂ0@ H@@H@)^@4 H@! @H@/ @q@b`nH@PvL@@2TH@  @>]AH@@;H@)!@6H@ËՆ@7H@;@ԑ aH@& @H@5?R@H@ܟ@Ym_H@*ǿ*@CH@`@vH@ş}@H@'|@DH@%, 8{@NH@z@@XH@# y@^{H@8TJw@߭H@ t@_H@?*m@@H@_li@7H@b@ԑ aH@E `\@SH@5W@H@/7U@ޚ H@8Z S@2~H@RN@LA ^H@EX_@@x1 9H@kT=@)@H@!S ;@@XH@?_W9@O_|H@)8@g_H@)6@|@ H@o`4@2H@3џ2@ MH@@0@?YH@/@*@GH@72@&@j5HH@&@8XH@I"$$@)H@;#j@GH@J@YH@oL>@cwH@+@H@ r@F IH@tz@@AxH@@[H@`&9@H@d@iH@D @H?H@@ H@R@ؘH@aF@OYH@{ݿ@?VH@@7H@9n@hH@i 1@MߩH@k @VbH@yK @5H@*@ H@ٕc.@kH@Q1@_H@'T?4@QH@E4@N PH@;Q3 R>@|`H@WI;2C@~H@e;@C@b?H@ X?FD@_}H@cN@7H@X7 :O@UH@{gY@pH@| _@nH@l_@G' H@@}_@`YH@/[@H@MT%Q\@H@7@^@pH@Yh@lH@]?)k@$t`H@C@Sm@H@>\0Wo@+H@IQ`Ct@x1 9H@&4eu@wPH@:]w@tH@Ax@ngH@k[9 y@dH@9Wޟz@oc?H@{@B?H@~f|@3 H@@ŭCH@MK݃@V4H@x1 @%0H@1@cv3H@@&@@H@a_@H{H@}@v@H@Ia @FH@G@H@Y߿@H@@W`H@W@o$I@)@S.I@J@^I@ `@2pI@K@fB_I@jqި@.I@"4@q@`4I@ߩ@= ZI@M:4@9+lI@٬@ ~I@g'ſ@,nI@ Ү@I@yo5@tI@_i@I@%@0 9I@@ZI@@^_kI@! z@|cI@A͟@/"I@R@pI@)֪@,)I@ٟ8@bLI@O`@mI@|X@ I@؟@nI@dޫ@J`I@_@WI@@@I@F*ԯ@KI@?a@ I@1@WI@:Q@I@Ű?`@?bI@Z@O۹@oKI@+3@@BI@0@0 9I@@8I@_@k_;I@0@/e HI@ V@@?jI@җ+@7I@l@I@z ,@k_I@CH@2I@__@G' ]I@M@ɠ`vI@ɿ@@I@쿭?@I@?M@.nI@M0@1eI@ì@V `NI@:@o 1I@@@mI@@4_I@?@I@| f@ TI@W=@qH@Kŭ@PH@LBȊ@#H@@&H@YK`@x}H@EL`@לH@U)@kH@B!@H@ӕW@H@,@YH@;}@_XH@?@D_PH@忴@;H@Ƭ0@H@y(f@h?UH@ `@ _!H@?k@B8H@F?@-VH@8`@U;H@ٟ@G~RH@@&@1H@@H@6@PH@?X@xH@6@@)@6"H@s@P?H@H @Ǒ?H@.%` @zH@ASD@"H@*\@dH@EX_@m?H@ @H@Kŭ@l?H@c2@״H@_9@<6H@'_n @wH@3@!H@s @H@:2(@0I`~H@/:@H@ @>EH@ _.@Ê kH@!Q @YH@}6`F@J`H@ 7 |@]`'H@޿ @^ H@I@L@H@`@?H@]@4TH@z@\H@ @ @7 H@R0@f_ H@3@f_ H@@f_ H@ ?@xH@P߶o@;_H@[@6@͓H@) @/"H@(_0@H@o Ͽ@ W@\H@+@jH@D@@?fH@8~@XH@?@DH@N@;H@@X@, H@@WH@`&@@d`H@;Q3 R@`?H@s. @*H@e<@X@H@v@sVYH@`P@Y:H@9:@y@H@Ls@_H@t( @<H@_@`kH@1ܱ@(gH@-#`׿@ H@UR@=@ nH@IxJ @_dH@6ź@baH@A=@ eH@L`!@_hH@a?m@5uH@Ꟗ@$H@δ@bH@3\@iH@T@H@״@!@H@RS@@|H@%ϛ@H@" @H@7_@'_H@{@.:?H@(@@->H@m@΋@ _H@;?<@N H@n&ˈ@&H@~@LH@ -c@tyH@@gH@"@`UH@9@Q@?,H@W]$@@@H@1_@TH@i_@@AxH@KI o@`OH@@@?>H@OO@,@8H@ @(@H@ ?}@H@" z@H@$wv@) H@FCOr@_H@ _Co@H@wRm@4H@}!`k@H@$ÿBi@\9H@B_g@HH@V'@f@H@=_f@H@t7@zd@H@@_@H@/]@`zH@$\@>EnH@aW@=ZH@z_U@"JH@mR@y'H@wFJ@qH@!@bF@.:?H@C_5B@ _gH@ 7?@H@Aߓ=@Ro?H@21<@vH@JN`:@OH@bM 7@H@ 25@:H@zߐ3@xH@`j0@r?1H@;,@(TH@ (@PH@kT /'@fB_H@k:$@% H@zT@H@~r @H@b@sH@\@L`H@ :f@-`VH@ۦ6@@zH@hQ @H@%[@ H@[@ 1H@@qEH@G0@ ZH@̀?@Y H@t_K@g*@H@?@_H@̮A@''H@]: @$H@i9`?@H@@WH@ @ـH@@$1DH@5< }@ XH@r@2H@/@ H@@&6H@ 7@S@hH@߅R X@H@m w @@H@8̟ @H@l-@ @H@Q@XH@.K{@њH@DE @rH@&Aџ@2pH@?"@PLH@9@P H@6g@$H@C@ 8H@W=@ tH@@BH@K @ H@ZT8@8@@H@@V `NH@& @ɠ`vH@Lv@:H@K H@$t`H@X?{@H@k@T~`9H@^9 @`YH@aN@hH@ٮT@o@H@ @/"/H@. @AQH@ ` @P H@=@_H@RGr@0H@5`@CH@EDֿ@_lH@ O@_H@?@H@-$`t @OH@@ @Ym_H@ @(H@ @k\ H@  @(H@Զ @FH@i@NH@84`@Ǽ H@B@'H@<@>H@~@ bH@&S`\@\!H@8E4@F H@P@?H@C@u& 3H@!@QH@^ɟ @Y $H@pI "@# H@/"/%@H@=)@Z_ H@(6@AH@K:@@H@vu;<@_H@HF=@wI? H@I>@ H@U@-@@ ;H@״@@@KH@I A@nH@}C@,H@1 ZC@L`H@>TD@H@V{D@BH@D@gH@/ >@1H@?@fH@R@3H@?Q@ H@'S@;R H@U@?H@.ϿvW@?H@M@%b[@H@#@^@IH@_g@#H@2s@PH@{@@)$H@ǿK̀@u& H@@H@LBȊ@#H@8ٟ@H@qӟ܆@5H@0ICD@9H@E@`H@0G@ŭH@RH@1H@:OK@H@ ^L@H@'M@H@N8`M@H@7O@H@P@H@ )S@ H@)#.V@3H@=Y@?H@[@H@C\@xH@]@y MH@9[^@+H@w_@mH@9,`@H@t8a@Ǒ?H@}֟ib@DH@D=(c@=H@cf@>H@QEh@kH@k@;?#H@R q@v@%H@12?t@@*H@L;@w@ H@e,`#y@H@ޝJ@+|@# H@wF~@5VH@jG@ө 4H@_@^H@1@CH@|@#5H@@+zH@N_a@0aQH@@ *H@o$߄@y@H@^@Z_ H@. Q@+/H@I@~@=H@#Q`z@~H@'Qw@,ߦH@_5{@?oH@] ~@~ UH@2@EH@ @%,H@'@?_"H@qӟ܆@ОH@9@ͅ@RIH@u@ H@>p@wH@t_z@>EnH@W33z@ H@h:_w@ H@(;& `t@`zH@>@{w@H@wP`l{@`YH@f4|@o ?H@.@H@@жH@@ H@A@3 H@A <@? $H@Ag-`]@@)$H@":U|@v@%H@tQj|@GH@uSl|@߭H@׮z@2_H@2D%u@ ` H@Fq@~H@l,qp@=uH@nT`p@?H@q@FH@aA+x@ĆtH@ "z}@-H@ u@3H@0ICx@ _H@_ `Fx@ H@dH`w@H@ִu@H@0?u@G`H@Iw@ H@~Q@p@H@ Xp@r/H@3S@Vk@H@~^+g@ǻH@pc@ECH@j_@0H@M`iV@)K@ƻH@'U@1ûH@>pT@J2H@U@-L@H@L@4_H@w:L@" H@l_K@ H@rERG@H@@ߎ3@H@D=(c@=H@}֟ib@DH@t8a@Ǒ?H@9,`@H@w_@mH@9[^@+H@]@y MH@C\@xH@[@H@=Y@?H@)#.V@3H@ )S@ H@P@H@7O@H@N8`M@H@'M@H@ ^L@H@:OK@H@RH@1H@0G@ŭH@E@`H@0ICD@9H@}K?@5H@D@>@`+H@PLd=@ tH@"@<@z`H@ @@J:@3H@&?6@.H@`L3@0H@1@:H@24$0@ LH@14K.@gieH@,-@@H@EƟ,@KH@'+@%_H@J(@)K@FH@9 [&@ H@U%@7H@6%@_H@$@tH@$_K$@H@()=$@zH@ #@\!H@E?#@?-H@?d@pߘH@_@H@2@`H@`s@ H@@wH@@ AH@,EU@DyH@(?@ H@Q޿`@Ê H@C`Y@b H@P@''H@q_S @\3H@߰ @GH@^m@ L VH@+@ W@\H@ӬC@6uH@M`|@IqH@ҟ`@*hH@_$@?@H@@@ߙH@G +@}߶H@5)^@m@H@-U`m@5H@:?x@"e?H@v@O`H@ r@VH@N!s@`H@ٿ_@_H@+q@H@1@H@@@)c_H@|@H@t矅@=`H@H@wH@E"@H@wI? @_H@Fַ2@H@7@)H@傯W@* QH@@@qH@e@]`H@-B@|H@D@ H@۟@TH@*@1CH@}_@_lH@c̟g@U H@1*@H@ `@LY2H@@LvH@؄@AH@ZR y@OH@_.@ H@=a @8@H@D@2@@_H@(@@>H@V_@ H@f+?-@;H@*@i_>H@x?@ؘpH@ȿ@X@H@i8@o`H@&(@6"H@%@g*@CH@s @eQH@`$@/`jH@2!@@}H@IN`,@@H@@?H@¿c@H@P@J`H@K@H@1Z@F(H@j " @INH@#ȵ_F@H@L'@E|H@j@mpH@ʳ? @1eH@? @QH@\@L`H@b@sH@~r @H@zT@H@k:$@% H@kT /'@fB_H@ (@PH@;,@(TH@`j0@r?1H@zߐ3@xH@ 25@:H@bM 7@H@JN`:@OH@21<@vH@Aߓ=@Ro?H@ 7?@H@C_5B@ _gH@!@bF@.:?H@wFJ@qH@mR@y'H@z_U@"JH@aW@=ZH@$\@>EnH@/]@`zH@@_@H@t7@zd@H@=_f@H@V'@f@H@B_g@HH@$ÿBi@\9H@}!`k@H@wRm@4H@ _Co@H@FCOr@_H@$wv@) H@" z@H@ ?}@H@ @(@H@OO@,@8H@@@?>H@KI o@`OH@i_@@AxH@1_@TH@W]$@@@H@9@Q@?,H@"@`UH@@gH@ -c@tyH@~@LH@n&ˈ@&H@;?<@N H@m@΋@ _H@(@@->H@{@.:?H@7_@'_H@" @H@%ϛ@H@RS@@|H@״@!@H@T@H@3\@iH@ hIxJ h@^;H@ 8e@C4*H@*BH@@TSH@1@H@O@giH@Y @H@+ @mH@U#`M@xH@_@3 H@IQ`C@XF&H@V 5@`'H@;@(@i&H@v @,nH@EM@ H@0-@WH@f_@tH@|ο< @WH@0 @,@H@T"@H@cQ%@P?H@sj_6'@?H@ ? (@PH@r)@xH@t'+@ؘpH@nxm.@ՍjH@_O0@ՍjH@%+2@>EnH@_3@ yH@9,4@i_H@a?m6@xH@a淿7@U H@uv:@*H@ϣ<@H@O=@v 5H@G@>@]H@@kE@a H@R_H@PH@jK@H H@|?rN@b H@`?hP@jH@{T`3R@QH@; #V@DH@:W@MH@[ Z@/ @H@/N^]@?H@@&`@ yH@Qc@Ro?=H@$a@?_"H@`@H@o]@H@o\@vH@?b[@?H@i_X@SW jH@_ Y@48H@IY@_H@_Y@}H@9_tZ@AzH@"@\@x? H@>\@ H@(k]@dH@i_^@̫|H@wO_@ TH@kLH`@#0H@o:Ub@HfH@.d@_H@ 8e@ ZH@Hd@mH@<`d@#RH@(`}d@H@N`@\xH@Y_@=H@ s%_@HfH@B4^@d`H@3m^@(@ H@,H^@ H@Hc]@ H@g`]@H@(\@-H@~X@H@:W@k\ H@9WޟV@IH@g9V@E?H@_U@a H@TU@%H@F_U@''H@9T@9 (H@ExT@'H@U@-T@v %H@MCT@6DH@ֿ-T@@pH@oH@S@uH@34S@e @H@kR@#H@_LRQ@mH@KP@xH@#N@H@ݿL@WJ H@vJ?vJ@f H@&)G@7H@O`D@H@_C@~ H@,H>@0aH@ # <@1H@@%0:@aTH@9@+H@^?I6@H@އ,3@PLdH@fN1@H@Ǽ /@Q H@.@BH@ff.@+H@U `.@\H@C`8-@tmH@*@5{@SH@ڪE(@>H@\F&@y@H@L $@H@|S#@H@c5"@|`H@?L!@ߌH@=@ @(TH@@Li@ H@S`@zH@;7/@H@H@>H@o$߄@lH@0@WH@N>@8H@{g @ H@ T @(H@l @H@2߉@_H@wܮ@va_H@M:4@2H@4@}6H@p@wI? H@ĴN@! H@@S?H@@@H@(@`=H@} @@\_H@ _%@@Ju H@ڿ @v H@r?9 @h@H@,@?H@}!`@ bH@u@H@?@aTH@(@tH@9K@ H@j@H@;@?H@4@H@O@1H@0LC@H@L@RH@&@H@2L@{{ H@R@q H@R?@*NH@v>@6 @gH@S)ߗ@QxH@F6 @)H@e:@WH@}@b}H@H@PIW@f_H@i_f@H@St@l?H@-@tyH@@/ @qH@@ \H@@;H@v@̫H@?n@eZH@Ah_Dz@H@^9 @H@ؙڭ@ H@,'@cH@H@ H@?@c7H@ia@H@6-B@ɠ`vH@+ğ@d^`H@7@@?8H@՟@@H@9@->H@@O`H@,Q @ H@g@H?H@>@@yH@E@H@@hH@V߀@SH@E @t_KH@c–@J`@H@??ʔ@^;H@}`ő@ =H@o@AH@He/@*NH@} F.@`H@QH@6"H@;@sOH@_@J2bH@C#TZ@)H@F,ޟ@H@@[H@mJ`@H@λb@yH@[@6}@aH@*.x@3H@EZ2{@ `sH@r՟q@H@W7U@ɠ`vH@ݵ5@''H@0t Dy@* H@cy@H@!S s@ ?MH@IxJ h@H@A`ai@/ H@>zj@||H@*uEr@ H@-.w@dEH@_ |@_H@I8{@H@>\0W{@PH@OB{@ !ߐH@,@HbH@r?φ@o 1H@@ SeH@Ϳ؅@ _H@>]@u@H@w 5@o H@d[Ӗ@H@@Tj@eH@ц `۠@H@?@2pH@@j5H@HM @Z ^H@i_f@ZDH@d@zH@eC_@ H@@B2H@@CwH@1}@}_H@ |@_pH@>7@7H@@0 9H@]Iٿ>@H@oU@S߮H@?<@b@H@Ia @/H@8ߡ@@H@"_}@)@H@g?@4 -H@P-@j H@by@5uH@@d)H@Oر@_H@ g@W`H@%?z@H@aC`z@l?H@* Q@GH@ @9+lH@|@/ H@5_#@fB_H@@OdH@E"@?H@\@[H@*\@Q@H@ٗ* @ZH@_@pKH@@ H@~@2H@@}_H@3u@&@H@_d@oc?'H@%@f@C4*H@'+Lz@d)H@@Tj@Y $H@g_@H@34@} uH@S@cH@/v@*3 H@lSf@MH@@H@7@H@B?@2H@ߖ@_ؿH@;_@5H@ Jڟ@9nH@ٗ* @2pͿH@_ג@H@<t@t}(H@߽k@AH@] _X@|cH@ NW@eH@1]@KH@p`@ H@'`\@~H@ե=X@oXH@NܿO@H@ TƿD@`H@hNB@m?H@aS=@;H@1A@hH@D B@H@٬B@/e H@ƿB@4H@ C@H@N@B?H@+N@H@O@H@(9U@:j?H@X0_@06H@f@H@U@m@hcH@j_kx@`(H@z( x@%0H@*.x@3H@[@6}@aH@λb@yH@mJ`@H@@[H@F,ޟ@H@C#TZ@)H@_@J2bH@;@sOH@QH@6"H@} F.@`H@He/@*NH@o@AH@}`ő@ =H@??ʔ@^;H@c–@J`@H@E @t_KH@V߀@SH@@hH@E@H@>@@yH@g@H?H@,Q @ H@@O`H@9@->H@՟@@H@7@@?8H@+ğ@d^`H@6-B@ɠ`vH@ia@H@?@c7H@H@ H@,'@cH@ؙڭ@ H@^9 @H@Ah_Dz@H@?n@eZH@v@̫H@@;H@@ \H@@/ @qH@-@tyH@St@l?H@i_f@H@PIW@f_H@NH@>H@%, 8@F H@pެ@?H@@fH@*!@LY2H@_@5dH@@6 @gH@R?@*NH@R@q H@2L@{{ H@&@H@L@RH@0LC@H@O@1H@4@H@;@?H@j@H@9K@ H@(@tH@?@aTH@ @s@dH@_5@+ `oH@@2~H@^?.@H@_ @H@O @2H@:>@r/ H@,!@H@wؿ$@:j?H@X(@tH@~ڰO-@ H@pH.@<-H@40@baH@1+3@ߌH@s5@nH@H6@l H@n;#8@H@_ @@UH@C@|`H@S E@s_H@m&ZF@H@6F@o H@DF@Ǽ H@5F@H@բ1G@ H@R`}G@XH@PG@_H@䶿H@H@iI@KH@J@nH@3N)J@`H@EJ@?H@K@3H@cxK@@@H@M`K@*H@%K@?H@ `K@H@RC L@RH@Z/L@(H@ ~ +L@H@7*L@H@pL@H@º_L@U H@lo" L@H@iL@3 H@ `&L@_H@Y.SL@X @H@{_L@H@N@9fH@6~N@G' ]H@t$N@-`VH@P = N@%OH@0`,N@Ah_GH@RN@ ?H@DN@\3H@N@?(H@B{N@ H@66N@^H@N@BH@aSM@xH@M@v H@< 翬M@c H@f~?M@:H@(߿M@XFH@48@M@?H@RŸ#N@(gH@2-4N@_H@_9N@H@ S1N@@?jH@8N@@cH@HRN@ \H@*`mN@YH@EDֿN@DWH@0N@ueUH@bO@SH@XP@PH@x? Q@vNH@#5;Q@2pMH@Q@9JH@; #R@ _CH@QCR@j@G?RH@t֟j@t_KH@I;j@v@H@" j@58_:H@ jӿj@z?4H@ ?j@1H@?j@e @/H@-k@`k-H@'l@y'H@u_l@H@Xm@cH@*yn@H@ @o@N%@H@_Zo@2_H@"P?p@ H@6up@qH@'p@H@)^q@KqH@yH@q@ H@ r@H@65-r@(@ H@y.Kr@ H@=``r@X @H@:r@x? H@1_s@`=H@<ןs@ _CH@# t@HH@u@[H@_bu@@@`H@-6 u@?fH@au@N=_hH@>w@lYH@<_y@w`QH@@@H@ƕp@}6H@ `>@'H@=@H@ O@H@ƘG@}@ـH@ n@ܣuH@*@'jH@b0@״9H@3֔@/"/H@U `@H@$_K@rZ @H@@UH@9_٢@H@@ H@3D n@{nH@&l_p@\H@N@lYH@v@HfH@o@hH@ !@ @H@+@8?H@?'@H@*@͓H@G ^@xH@i@}_H@\L@K@_H@C_5@~@GH@,B@@va_H@/@ _H@?b@H@(@\H@;,@?YH@9@Q@TH@ `?3@`H@W?x@ŭþH@TM @ nH@:@j@?H@F@ݾH@R@sH@- }@H@"n@T[H@G}'hf@ڿ_H@"g@О.H@9@0g@c7H@2;g@u@H@_e@q3H@ ,d@_ H@F^@0H@ğUX@?VH@1?J@"kH@_I@H@.)N 9@2_H@S5@NH@@,@wH@OY+@?YH@z)+@ QH@N.l(@`H@ M:4@$t`]H@}K?@ @H@ߴ@H@Y"@@e @H@KT@(@H@8~@kH@R4 @P H@l@,H@Fַ2@H@wI? @_H@E"@H@H@wH@t矅@=`H@|@H@@@)c_H@1@H@+q@H@ٿ_@_H@N!s@`H@ r@VH@v@O`H@:?x@"e?H@-U`m@5H@5)^@m@H@G +@}߶H@@@ߙH@_$@?@H@ҟ`@*hH@M`|@IqH@ӬC@6uH@+@ W@\H@^m@ L VH@߰ @GH@q_S @\3H@P@''H@C`Y@b H@Q޿`@Ê H@(?@ H@,EU@DyH@@ AH@@wH@`s@ H@2@`H@_@H@?d@pߘH@E?#@?-H@ #@\!H@()=$@zH@$_K$@H@$@tH@6%@_H@U%@7H@9 [&@ H@J(@)K@FH@'+@%_H@EƟ,@KH@,-@@H@14K.@gieH@24$0@ LH@1@:H@`L3@0H@&?6@.H@ @@J:@3H@"@<@z`H@PLd=@ tH@D@>@`+H@}K?@5H@& =@H@ÍJw9@$\ @H@&6@7@! wH@sZ4@@XH@IM7`2@ DH@A1@g+H@J ,)/@P H@@RM-@L_H@eG,@H@l*@kH@ G*@ W@\H@C(@9C?H@ g'@(H@uv&@H@E $$@ H@$F"@S H@e,`#!@Z H@ @ H@y@/"H@_l@ `H@Y@(H@J)@\H@3u@G??0H@뿔@4TH@M@sH@# ?u@H@n+ a"@H@fm \$@@H@F&@^H@)?'@}H@5+@ L VH@ -@G:H@L_=/@`$H@(E1@ H@.3@&H@yA?1@ZlH@'.@.H@u)d,@H@u*@S H@P5_)@KH@y1(@"H@;&@ `H@ǀO $@m?H@n"@kH@@߼ @/"/H@)@?8H@jq@;H@%O@?8H@:?@4 -H@A@@@H@!;@HH@ow@DsH@d@cvH@0? @fB_H@( @f[H@" @}9H@K_" @H@z @H@I7?@^_kH@pM@RIH@LB@r?H@X@8H@ @?-H@M@tH@@ H@Iy @C4H@d@QHH@#ȵ_F@J`H@6L@_H@ng@d`H@ @ `H@;'G@ H@ٟ@H@4!1@58_H@ M@wH@ҟ@LH@l.@@H@2`^@;^H@?'@H@+@8?H@ !@ @H@o@hH@v@HfH@a>N@lYH@ӿN@+H@ @j H@i @'H@_2@ W@H@E@H@ޯ_@N H@ɼ@H@ÞǺ@0aH@`ϸ@H@*" @H@^G@ECH@d R@2~H@W@VH@)_@H@8@_H@Jq@$t`]H@/?`@4_H@w@/ H@`@b`nH@ȧS`@H@<@_H@Ŀ@ĆH@C@j5HH@+@H@j5ȩ@H@`@_H@o#+@ _!H@:M@-VKH@@'H@ƕp@}6H@@@H@<_y@w`QH@>w@lYH@au@N=_hH@-6 u@?fH@_bu@@@`H@u@[H@# t@HH@<ןs@ _CH@1_s@`=H@:r@x? H@=``r@X @H@y.Kr@ H@65-r@(@ H@ r@H@yH@q@ H@)^q@KqH@'p@H@6up@qH@"P?p@ H@_Zo@2_H@ @o@N%@H@*yn@H@Xm@cH@u_l@H@'l@y'H@-k@`k-H@?j@e @/H@ ?j@1H@ jӿj@z?4H@" j@58_:H@I;j@v@H@t֟j@t_KH@by>j@G?RH@9j@8XH@T"k@aH@Uݟbk@AiH@ k@etH@(Tk@~H@ k@7_H@k@.} H@#u_k@v@H@I8k@H@'4 k@Ώ_H@1 k@v H@&@ok@ H@0 9k@&`H@߳j@H@kj@@H@_rj@H@ۻHj@H@޿i@H@Fi@AH@ixai@rZ @H@~+i@y H@=h@ H@0g@.H@o.f@D H@(f@H@g_e@`H@7e@MH@Ye@1H@5/e@H@%m_d@,nH@c4?d@a H@)?/d@x?H@d@!@H@jc@6H@@,@c@? H@&@r/ H@O @2H@_ @H@^?.@H@@2~H@_5@+ `oH@ @s@dH@?@aTH@u@H@}!`@ bH@,@?H@r?9 @h@H@ڿ @v H@ _%@@Ju H@} @@\_H@(@`=H@@@H@@S?H@ĴN@! H@p@wI? H@4@}6H@M:4@2H@wܮ@va_H@2߉@_H@l @H@ T @(H@{g @ H@N>@8H@0@WH@o$߄@lH@H@>H@;7/@H@S`@zH@@Li@ H@=@ @(TH@?L!@ߌH@c5"@|`H@|S#@H@L $@H@\F&@y@H@ڪE(@>H@*@5{@SH@C`8-@tmH@U `.@\H@ff.@+H@.@BH@Ǽ /@Q H@fN1@H@އ,3@PLdH@^?I6@H@9@+H@@%0:@aTH@ # <@1H@,H>@0aH@_C@~ H@O`D@H@&)G@7H@vJ?vJ@f H@ݿL@WJ H@#N@H@KP@xH@_LRQ@mH@kR@#H@34S@e @H@oH@S@uH@ֿ-T@@pH@MCT@6DH@U@-T@v %H@ExT@'H@9T@9 (H@F_U@''H@TU@%H@_U@a H@g9V@E?H@9WޟV@IH@:W@k\ H@~X@H@(\@-H@g`]@H@Hc]@ H@,H^@ H@3m^@(@ H@B4^@d`H@ s%_@HfH@Y_@=H@N`@\xH@(`}d@H@<`d@#RH@Hd@mH@ 8e@ ZH@.d@_H@o:Ub@HfH@kLH`@#0H@wO_@ TH@i_^@̫|H@(k]@dH@>\@ H@"@\@x? H@9_tZ@AzH@_Y@}H@IY@_H@_ Y@48H@i_X@SW jH@?b[@?H@o\@vH@o]@H@`@H@$a@?_"H@Qc@Ro?=H@x e@`OH@9nj@Ju {H@k@H@bM o@jH@ ut@ @H@$@y@r/H@,@{@`H@I~@wH@)@.nH@ҙ(΀@WVH@ 6`@H@1$@,@ _H@T@H@:E`@?H@Y@@H@e@H@ߴ@H@ X:?x@e @H@]: @?bH@h-6 E@`, H@NI@P?H@NJ@SH@\*sL@ uH@EM@^mH@/N@@?jH@A O@kH@O@%_qH@忓P@q yH@?Q@?H@a_S@?H@?T@<H@[U@BH@2X@`H@+:Z@;?H@º_\@etH@ ~_]@G~RH@!h7]@8/H@N49^@F H@"? _@`H@?_@SH@~`@AiH@3EH@ s@H@a u@`, H@?z@WJ H@1Y|@11 @+H@}@J`@H@O @mgH@@@) @7 H@1 @. H@˄@^H@ @H@V'@@:H@ZR y@* QH@ם՟P@YH@(?@҂dH@? @b`nH@! @Ym_uH@,@n(`{H@@@ `H@ +&@0 H@I7?Ý@(@H@˷_@H@@ H@+෥@ oH@#N@v@w@_H@XC@>H@>;@6"H@'D@G`H@۟@?H@ɿ@kH@ޛ׿@ 1H@ O@0sH@`@j H@C N@+H@$ÿB@r/H@_)@(H@mJ`@ eH@K@e@=?H@U@=uߔH@ @V4H@n{_z@ H@ս_@ZH@z?@kH@ܟ@7H@% @tH@_v@_H@>;@7H@@H@D1@H@߃@:H@mo@\H@'_n@ H@-$`t@)c_H@n{_z@_H@m w@H@j,@_@H@#%6@:H@y_@@ZH@do0@H@% @VH@5@6 @H@*@_H@M`@h@H@@DsH@k=@&@H@*&@ߢH@zŸ@l?H@º_@ jH@hbb@n @H@t@ H@9@@cwH@W=@ tH@C@ 8H@6g@$H@9@P H@?"@PLH@&Aџ@2pH@DE @rH@.K{@њH@Q@XH@l-@ @H@8̟ @H@m w @@H@߅R X@H@ 7@S@hH@@&6H@/@ H@r@2H@5< }@ XH@@$1DH@ @ـH@@WH@i9`?@H@]: @$H@̮A@''H@?@_H@t_K@g*@H@̀?@Y H@G0@ ZH@@qEH@[@ 1H@%[@ H@hQ @H@ۦ6@@zH@ :f@-`VH@\@L`H@? @QH@ʳ? @1eH@j@mpH@L'@E|H@#ȵ_F@H@j " @INH@1Z@F(H@K@H@P@J`H@¿c@H@@?H@IN`,@@H@2!@@}H@`$@/`jH@s @eQH@%@g*@CH@&(@6"H@i8@o`H@ȿ@X@H@x?@ؘpH@*@i_>H@f+?-@;H@V_@ H@(@@>H@D@2@@_H@=a @8@H@_.@ H@ZR y@OH@؄@AH@@LvH@ `@LY2H@1*@H@c̟g@U H@}_@_lH@*@1CH@۟@TH@D@ H@-B@|H@e@]`H@@@qH@傯W@* QH@7@)H@Fַ2@H@l@,H@R4 @P H@8~@kH@KT@(@H@Y"@@e @H@ߴ@H@e@H@Y@@H@:E`@?H@T@H@1$@,@ _H@ 6`@H@ҙ(΀@WVH@)@.nH@I~@wH@,@{@`H@$@y@r/H@ ut@ @H@bM o@jH@k@H@9nj@Ju {H@x e@`OH@Qc@Ro?=H@@&`@ yH@/N^]@?H@[ Z@/ @H@:W@MH@; #V@DH@{T`3R@QH@`?hP@jH@|?rN@b H@jK@H H@R_H@PH@@kE@a H@G@>@]H@O=@v 5H@ϣ<@H@uv:@*H@a淿7@U H@a?m6@xH@9,4@i_H@_3@ yH@%+2@>EnH@_O0@ՍjH@nxm.@ՍjH@t'+@ؘpH@r)@xH@ ? (@PH@sj_6'@?H@cQ%@P?H@T"@H@0 @,@H@|ο< @WH@f_@tH@0-@WH@EM@ H@v @,nH@;@(@i&H@V 5@`'H@IQ`C@XF&H@_@3 H@U#`M@xH@+ @mH@Y @H@O@giH@1@H@@TSH@h͟@t>H@ G w@ _!H@:Y@BH@_@(TH@L@/`jH@B@ H@ކ @N=_H@(?@ H@?_@7G6H@)k@h@WH@by>@iH@b@b}H@t@H@-1v@H@%@. H@ @WH@@d)H@E#@ QH@#ٟ@VH@eߋ@UH@q?@v H@>$@M@)H@H?@ =H@_@@@`H@@3H@ @\H@Kŭ@<H@H @_H@LB@H@E `@?H@v @ H@/ @tH@_$ @@@H@ S @ _!H@u @KH@П @`^H@״ @ H@g;_@ZU@H@-VK@rZ @H@p ?@Ju H@ BP@% #H@O% @x1 9H@3N)@ueUH@@ZfH@=/ @2~H@A ]@H@|߱@WJ H@J?@ОH@_@J`H@:g@zH@`@>EH@@z 7H@ ğ@_XH@W@~H@ `@_H@e;@@(H@>@SW H@dl@H@3>@@MEH@2G@2_H@_."@2H@PK9&@. H@ )@WH@G@,@¢@H@S?.@y-H@/@eH@R0@2pH@(U2@@@H@'?53@ H@;n7@s_7H@X8@DsLH@Xߟ9@UH@ ;@@@`H@ؿ<@?bH@IM7`>@.`H@A-@@@ iWH@aA@]OH@8A@cC@ 8H@-6 E@`, H@terra/inst/ex/meuse.rds0000644000176200001440000001263414536376240014630 0ustar liggesusers[ tTU #D@ T%yHjJ2 !̨@@L*6Ђנ6ߦF4(*( HdP *3{ߗz~*s9R7 mX-A}R_^+h\KZcHt,ش p=vcK.a/KW%1묑@baoX171%8"[$#h#OlO")zDܡ$ւڈ&bP̃Q  ioIz8 ?B[ȿZ~-~)󰞄IY71YoQZ/6Cu~>~ۇxw|-C>2bߛ  ~˱Zo+K1O ò "PgaW=DH B/!i U q_xQSV<B}9 Kg`c^GXD?ngoc?!q}|@>C]*KsO8qZ|_ywI$DO?8d}-qJ>z9nBb{o5v¼;#4Y>M%.K۫AyA@[Ov6{ n" ԫsN=m:JȳNQ!J(52|聽}H¾'acl%Jl9ꔈkui / >I{ktأ?Za[!6"Rbsԫ-Ꝉa~ DEؿ4^No2x;_v\C߶yGK~ /M\`[%< #-'c?ݘ}[ek`Sĝ/Cbe:P8`sY ʍux?rQ~"j`ae#2YH`ID>_|'>g.i[%NGE@<ِ>|A9g`7}`>>~˴yy?q]곿E`||_ycL.8䟼7 s_Wy0ø>zfqN܇LHʐ y~`{k|-%;%ΡV<;A|%z>֗ Y/|1^  $έ>C>y|9X#N؍|,/BߗX. C^OD[%N慸̐o$BoF }C+i/F~|>Y|}z]My~=WscEWsm-b[^$HF5OQub#gczgфqE!(!=oDgC|Iy,7װ[Wc +mAR%~ц3/}jU/k"vvN ]Ѻao 6[k?p{%o\쓸D}~EvW|=2-yZa~NzKݕ_qw<Ǔ7mucGNoU"yơ~bOAS_o򊳏o kM6?V{%|Y?m~9$+mwZdY=lF{oՄiIyڎ-dBjW\^?T{_+nU,nij@G{9X+V[㳯}Au!\i{M-YrV9'ӟ}roUh-ځ.WVz}gnrm[VNO}tX{Ul~F^T=Y< :Zźq}[[+V>yĩ:Q&ګ [r\{Іke ^= )І N~B;rǓMvْ-[п⛬hewnjQG#}^~em[_]_=ckGWrԻvx'^H.Կ\{A}+Wʴw^đmC|?J!T?issvn~k/,}qmK#5>#hiVOֶڳEkш^㪏M]aڞ}Ds'au'u~ΤU;>گ}SΎXYvdGiK/Nv3S;yrL-muvҳ>v8oQ\vxŜ9kg[G&]<;4q:sυ;jzzֽ<}"tvEh/W;ꫭQdwZ*,]wx[BuOx{kpGgbHiGyPx4=)9֎g~Ľ7;z^S[]ާmP뻆aIjX]އ>]\w,+ yIX7:`u~w:tƲ>{BjqR|>}zfeT+5tޫ8y9｢~vA/=bko ?M;=~o龭 g{b>Iޔ?og|(pnE$2zׇyOfK,E}XOӽ%?w^o=o[YVvo^8/r޳70߇y{ccw^C cY+%?:?=2)=)?o䍀6#س^\-ynޓ7Gb: y)zߴoDG"/4kOぬYsY,!7_A]__!WhF0k䍜<2o>JiPN\&Ckv^$)o2 ѕk9Oj-}{ {]f/Uc#vO`^m\>Íj|=_Ww4dE h`kɿoCn2!k:>!SnWc+Ĥ\M5"TV+j1^euMWizVׯ_«3jc2i3r~\E탮k~9Wa=o+dQV1j4 ޕS0 ޣ/=EO.FpPLCo/%8y78$o$ aǿ@:o/!79߇2EX`[% 3 fs 5ż E@wBΛ{A|s@k!_<'ry=@"ȿR!'@{'zvo"d&cxȃ}s>9`ǿ@ީeه -s̓ua~w?utyp?njq_8`;|)@?̇qrx_ y17!sHWbP3;3g|n15 Fb723i9jqN">:jTȉT\I 9œ8n))z1psA2)2D5JR#ȭF5Qp*p*p*p*p*p)p)p)p).٥D-D:DCYC, CBCCCCƆC޽C}C]FCCC#CiCD%DDD$CC0C~C?CZC{(CR\CLbCْCėCTѝC٥CC CWCg`CDDPCCCo`C C0C|'CwCoC!_CqC; CC CâC9CdCѰCȅD;9D*rDCVCCsCCCd2C CpCbnCzC0cC;CNCQC?CWIC_CnD1.Di DPDC)CCRC \CCC5CȍCCICCpCuwCCǠCC3 DDDC֪CbpCNChCC堏CCƕC2CCC Cc)C~CCJCқCD(DDDuCC *CCͬC}CC֔C#C*MCހCgCKC]C/]CsC1CDFDL DDԓCބCCC*C\CCzC uCofsCxCMC:C>RCoSCF~CO?CT"DDnD+vC C*C2'CICNCQCSVC;C%CJvCtCCkCCBzCRn{C>CI0DI DD@0ChCCRCCՂC4COGC}CCLmkClC(CCbCDN|DrCzCFCzCǷC CC}CCbCK@C5{CPCؐC'5CuCfZD>AUDGD92D\DL DCCbCfCaCCϝCrC¥CҨCC`CyCeuC+C|D|jVD֝JD2HD2DD DcC7C CCCwBCMC=CCyԔCC?}{CC`CC) D]Dg[D?Dʉ5DY$D D:Q DC !CCKC xClCOCCɖCaCڔCJCϕCCHtDDCbD8lCCCC'rjD]PD,HDSCD`>Dn8DG1(D D XCCCVC'8CyCC9C׫C1CCCΉjC{fCtCCƟCcC넨CLD}DKDnDrQDG6KDBD:9D80DYDxCCxOCC\~CCRDC%Cy#CŲCϥC3CuCnC]CCS^CCBD QDDCD˟DgDǿDf{D5TD*LDnADa7Dz.DDGC϶CCCCCaC@CCQCܫCI*C䥁C{C~%CNC䒦CC#cDDD[?D_čD~֪D DR Dn8D ѩDtDtwDxQDMBD7Dt8,D@De DCC5Cq.CѬCC-4CC/CCEC|CC#CC CC/C^x[DaDWDgޥDD[DfDg5DD|tD`ׯD0DlD6FD7D/D9!Dr DC\C lC C zCCmECCC$Cz7C"CCf!CsBC|C}?CFCZD0`DSDZDxdDٶsD56_DMDWD\jD]qnDXuD8DAkDl+JD {5D$/D0D+DD[CIVoCɽCCPqClϚC CCbC CyCfClCC9PCfiC9C}^DtYDXDDID AD 9D0D!D+D(=D&ADt1D DmDLDJ!D@#D(DDBCk C'CYCCN4C]CKCp2CCCC.CIC6C CUC瓼CLGwD_xDZDlAD U/D D, D!DED6DԢ'D%Dy DCyxCD¹ D| D DGCn`C҉C۱C{CC CnCCܽCkCrFCCCvC7CDCҿCsDD5SD-DDYD:DD&D%DQLD\DD CC_/CCQ`CMCEZC\ CsC ӢCCv.CCUCzC)CCUCSCCCbCCCgCDDQKD^=DDDBDCѰC`D DD9D( DRD;aC CCCl~CCCC#CCu0C/CRCICžC*C ,CCoCCgCCGCCoJD;-DVCڠC C4C)CC-CJC(DWDwDԲC,C C'C2OCCHCmCCܑCu_C_QtC*C>WC^C!CC'C$ C'CbC C"2CHC.OD,+DCCg׷C>0C!CCD?CC~CEC~CCkCLCCjCpCmںCܟCCC Cu>CtYCM-CFVC۫CcC4rC;C7CaCŚCuCLC7Dc8DCt DDu7CACtC/CiCCTCCRC4RC*C}CCr0CCCǶC槲CiCZCwnCklC1CYICҥC͕CCB̻CCYCv]CFCGC%D DhD DC!C ;CCBCC1CBCؠCCC;CSCWCCwCrCCCCPnQCCCqCsSCw4C)C C۸C5C>zCCBCUZ,D/D D,MC8CCCR%CyCLCC2C#C')C2C"CJC꼄C˃CCCHCߔCheC[3C1$C`C"CiCCC/CCCC2DvR!D" DVC3C̹CCCICCCCBCYC)C ֞C&C7CC5C;CCCC oxCUCdOCoC{ÊCC>CjCCCCnC'MDd#DDCCeCJMCKCpCICȋCC(CC sCp}CCCCC CCdC\NaCbCDC9KCKipCYCsCI:CيC C4CəCDDg}D&VCѧCJCVCC/CGCCϿC7Ci֜CCC}CĠC}CeCC3CBC"IC]SC=$CY2CviC%܉C|C9Cg;CLCŵCCDDD8CCǠCPCCCCEC6CCE_CCduC7C*ןCwC_CyCCYuCMmC\^gCʌMC>TCxCRCzCۡCaCCдCDS DwFCCWC4CߴC,CtBC߾CUECCoCClCICAC̖CJCUCCCdCCHC2vCyCMCÏCwC̡C6ӨCCC{D(C CVjCl.C"CbC`{CCC*Dۘ-DD`CSCܜC`CC2 CCcyC΅CC"2|C-iC7C0C}^C{CCtCC]CoVCgCQAzCSЂC1CCaCˉCCCaCX&C(-DD5D +D9D` D5uCC|CCCCvCOK~CZC=8_C0YC=XCwECxDC][bCjtCuC{qClCjCynCtCaDzCwCk܂C^/C;C CsCeCɏCZ+)D2DKtC?fDI/DD?0D@$D~DrDDgDBD' DGDDhCCC֬C Cr CCMCYއCiC-Cu%0CXCJoCD*rC)"kC`CbyVC SCC\CgmCCCCeD:}D ?wDX,KD0h1DfH#D~}Dx^D/ D,UDDEDՏD CLC~C;C|CtFCC0CCWCCʬiCԯeCuCֈC5CtC_C~ACZ=CJ+VCsC.C CrDFDxlD+3jDЮ[DP>*D o D(DKD:CbCUoCvC\ZCCsCCOCCcCI|CACC~Cp0C*CCCC,CCqC~CblC~jC}C/xC!bCOC.D9DFD~HD;DDI4DZ.DMY%DPlD[DCC^CECCGCŋC]CCCYҝC;CC2CAACC lCC͔CCCyCFuCIłCJC>RCECwCCw˝C6*Du>D ^DDQD~4D'D;%DͱDD^u DCCLӄC˜CCCXC<_CCapC CvCدCC?C9o D8+(D0DTeCqCXCC%݂C*]C@ZCCtCCCCˣCdCD%DݢCCצC}CìCRCqCfCbCԫC. CuCJC#CfC&1CC6CifCCC,C(CZC}CsfC(CDF D DGDDZD\DDD=tD*DD>CC^CLCC߮CPC6CC7C8CCzCܥCjC=CPC6ŖC'CC|CuCx_C4C4CCCCCmCfCCCCDsf D7T DP DTD9C.fCPTCbCfCoC mC6CCCgFC,CźCyzC|CnWCFC}CCS͟CCCC\=C+>XCnCCʭC|CrrC:kCCC}CUC2gCCCDCCCjC?Dh^DӖDE DMvDCqCC_CCCC2CXCCCЌCɾCD%C]'C CBvCˈCC#qC3C*vCBC,CzqC9C UCC!+CCC3CyC`DD(DrD=DO D!DD]SDC^CDpDjLD wDDCCR\Cm0C2C]CECCaECSCKC׿C+^CZCUаC˧CšCC9cCCDC݄C7oC ~CnC$CqCCC+CCCȃDΩD٤!D.D2D,DA$D>DܸDWDs DD(CD~aDDDECbCeCC̤C-gC)C_C2CkCCcClCCUC̨C,CFYCnCCVC8C/CZCaCd0C^CxCCAC!CMCC-C>JCvCIDDyyGDaj}DRaD]XD{DCMD=6D//Ds&DCDjDDCC Cg=DDDCdMC C㠾CCUC4C6CC9CC}CCC}CȏC7C&CC*}C@CNMCxvCVCCӏC3ҘCb!C-oCGCsCCЁCM Dg,D&y^D0DDiD6DF6YDk:D3Du+Ds2DDDY.CCC4C:C;ECUC CdC)CCC C3ԷCU;CIC CO1CeC6CC* CҟCICCCCbmCejCuCCCQCC6CCC#C@}CC(C+<Dr/D{aDD;D#D]Dw\D;D}y2D)D)DD5D4{CCFCCvCCC{CC8CC@CCCDjCJCC$CJC8$CQCCTCvC?CAChCyCZCysC.Y[CcCCRCΘC+AC5ҳC'CC=CC\D)D~PDDDDDcXD&;D,".D$DexD} DwDdC@C,CƒC!CCH*Cj>CCC0mCCBCDCGCUC CC(YC}$CeCC7C%>CCufCߐC5CCnCN'iC6C/fBCS0vCsCCBCڒC ?CCdCȆCk D!D?DY_D1Di)DYDDDPCI$CqCCCrC(CJC CiCC+CCC`CMCJC##CCvCQ,CCfCoCÊuC9Cл~CECdCCCCqC-LCZUCCmfC^]CͫCC C`CC*CzDDC$pCCCdCqYC]CCC;$CCC7CCCbC]xCwCM"CCC&C)C|CYgCJC%]CxCOtlC&{CC(CCV~CwCeCC"CCC<CCwcCC`SCC4CSC,CCFCXCvClQC*gCCC!CC CoCfC{gCCC)CPC˕C C|CRyCuCC}C,C#}CؔjChqCcCBCӸC(C\rCέCCՑCdψCcxC\ vC"CCC!cC'"D,D(DDw DBbDWD DӣDCWCCppCCfC4CPCjCCCCDmC D}D\DDGDmDD}D3 DeDY DtDKChC> D,bD-DAC(CCFCC CbC D D DDCD<DUD- D2 DbDC'D D)DDC;CCS C)D}DuDDѬCfD;DDCCCռDD%DCYCV~CMCfCقCC:C~C|CgCterra/inst/ex/rds_tst.rds0000644000176200001440000000062414745253645015175 0ustar liggesusersRO0.B! "`H4 H֭#kQ] h:?"kx4}ZB/j)!FCO*JT8f$kaLs]8G#v- )3RT䭗9%~OVy8 29 92dfY{ם& v)6$$[O"oN[nJXn!;z '6L_IQwDjXzbAm9O$g ۧIޱGr>VQQE隈 Fɋy]PDg.terra/inst/ex/lux.dbf0000644000176200001440000000404614536376240014263 0ustar liggesusersy WID_1NNAME_1C ID_2NNAME_2C AREANPOPN 1.000000000000000Diekirch 1.000000000000000Clervaux 312.000000000000000 18081 1.000000000000000Diekirch 2.000000000000000Diekirch 218.000000000000000 32543 1.000000000000000Diekirch 3.000000000000000Redange 259.000000000000000 18664 1.000000000000000Diekirch 4.000000000000000Vianden 76.000000000000000 5163 1.000000000000000Diekirch 5.000000000000000Wiltz 263.000000000000000 16735 2.000000000000000Grevenmacher 6.000000000000000Echternach 188.000000000000000 18899 2.000000000000000Grevenmacher 7.000000000000000Remich 129.000000000000000 22366 2.000000000000000Grevenmacher 12.000000000000000Grevenmacher 210.000000000000000 29828 3.000000000000000Luxembourg 8.000000000000000Capellen 185.000000000000000 48187 3.000000000000000Luxembourg 9.000000000000000Esch-sur-Alzette 251.000000000000000 176820 3.000000000000000Luxembourg 10.000000000000000Luxembourg 237.000000000000000 182607 3.000000000000000Luxembourg 11.000000000000000Mersch 233.000000000000000 32112terra/inst/ex/lux.prj0000644000176200001440000000022114536376240014312 0ustar liggesusersGEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]]terra/inst/ex/test.grd0000644000176200001440000000077114536376240014454 0ustar liggesusers[general] creator=R package 'raster' created=2020-05-02 16:05:26 [georeference] nrows=115 ncols=80 xmin=178400 ymin=329400 xmax=181600 ymax=334000 projection=+proj=sterea +lat_0=52.1561605555556 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +datum=WGS84 +units=m +no_defs [data] datatype=FLT4S byteorder=little nbands=1 bandorder=BIL categorical=FALSE minvalue=138.707073391626 maxvalue=1736.05793034568 nodatavalue=-3.4e+38 [legend] legendtype= values= color= [description] layername=test terra/inst/ex/lux.shx0000644000176200001440000000030414536376240014323 0ustar liggesusers' b@ QH@Kŭ@ڿ_?I@2 p  "VH' x3; 8AF `J hT b r Xterra/inst/ex/logo.tif0000644000176200001440000005367214536376240014453 0ustar liggesusersII*ReM=S  H x-1> 255 -9999 0 -9999 red 255 -9999 0 -9999 green 255 -9999 0 -9999 blue ??@S@#      )#     ?mtr@@TXAunnamed|WGS 84|?P8$ ?Pc?"P F_w(~n4>1 ,K"3?fw}O_oN|t,MW?mvV׬V;%g%1zc!ŢԪvwjrl\T̓UlmCL|z;+n5f%eXLR^j]t^%lUIfZYTYL! B%dU%QI QVR1\WE\ZŁn\f)`ftnz*zNJ4 !N@IS9JҵH)J6{/tG#lg>I^n`e;eZ^u@EmVYDpVUHe\A] RV=@SqQRnXiPRdBQbUfa؜˙z R;eb[?x_%vWe8Ax^^\eu\%ifY0UPIRP1Yurܦ9_n[x9~d& e&qbm&1h9™ye~c\/1yΗ]ॶ(XŴNZgSV>QDXJD%ۓ2QD>Pd4J([JJkJ{@i":"| Gtfj쉒˘zۍc0f 2@pe5p5#plH(5c\j 3H c 1|1"\1. " 1! a a!a \.%8c)%GZZeH#j$bMi|~"&zQ9G,Xi dΌ4 :1\-3c z'E2#Ȑbn 'Dy"@O&ĠbVW'\}bLIq $0 F"PEeDTC Q*"DV P*DŽXOmE(2!=CcHI!EDP2#D89 Az/¿T_,l4L%8iHNq-$eH`l F cƌ1߸~sQ18xIXkd!$-ldG T'X؞bO `(f, M+(& E!xa70CX] -@Cd 1`^ L-BR )fC8Z A/|"B $(O <(EdSQ>&yA!0?q pgb\aBa<c&jZm#u xöG 1F&퐧@­Hi1qxZ PQ,!!<X <+C$ <`hP/PX ,㠸`^ .pu6BF%@pc t7v0D 6&-U\RP5DX\D w@*f\$>1* MIu4d8蒱mCn *O#dhA6Pðv#h:£GnCHzA? v! &R(`BҺv4&DF @ p ,l `D & T /@`\ 0FFD`NL`N V flxp !a.LA>ALa.l@ (` tjG|J`$Y!OZcԃ 6GV! ` @dB~nvR@ Z``H`:*"@(""`.@.2`,756@5(`F`8 8o@F$1$E hdfp` 2 (! 06!.lMnzYBX*Fi:a:=A!0!-Jm` @عAd!<!!1!pd%@ z`K) ;$ ,     BQB1:`# +,7-rF@NM-@THLVNR`@R2D2.HR./P`B 2Xnbv '"!8,!@ @ J>aǨ;#*ȽB!L5(sO(!B ๡VaF$!L!:@` ` @}/F+, `@@ B `&.4 $, (``f Pd|vra|~|ԋHHԒejA4: ` prV\YL LZb@ULR ^Nxx $ *A 7 @`P(+mb9B:G;>s#B$~Dm LɲO<@al&DhU!J `pb  C  h3@zaa NDkFզ%z#b*|v `a[/ ]jrU@XL`L`p @  6"$ ` a^#"BR/k,"{{N% "|~&4/f l ` `p!gU! G:xa @ ~F2\ q   b@G!sjct"i#Bn/IԆ#avZ|f-[aa}jZ7bÅv'#a. @@ p h5`v/ ` @u  ut @ !At<%6$pT":Ś#"k&aC ^f5=`l` 6 GnEL'wA!4 /DR\ B@8xV a"F&t"<@|Z+"8;عBj"|*!a*c|C ~syt @ @زM@9<zf @ vЫ&a * @ ` a 2/Ӡ-a `f@a(  rP$A.%B;ZQ"ӝ"|- /bkR c|*A*B'%'B.+BP|/ၢ` @`tך砬 `$`ugy @ 5a b)m>' 1! Kt^*|Y|@`/`C2qW|jamiN7bpT}AaaG 7c"nJP* *q[9:}v!.;N%B~AL&B.4$M\~ ` t !DǨxD#$R46a0 yi% @=Fʄdhs>Y[ r!A .h!Dp"RjbG"~ahƅAƁr|ha@At`AEɼ|A~d!P!!rfaO\Talta!"*$Wi;&_A| [O<g dB#xHSYF-01&&F xYb bS"@c$X @zqr@t#qx=Ѡdv"½F.%FrAѢARa~XtE_hrr^#e Raf&Fyx<$$$f$P!La<ᐛI&!z8%:cVF~ڤ :^ VP` ೺ ` SS3-\aͨfF`4  ڶAGk7JAcn\%q *O#"J!2!apvAA|aɁtΆaarAAaramA_Aߛ†aДDj`!v AL !" 1([/Zo7MQ_1˨ |:N9`0e~"7g ϗh,FEn4+%Ab(J˄̜N?wbO!  _2Sc(K4m|T3 k97}[t]{Wtۮv=ïoV9^~K\빼h>ByXJH1d,d5aX먇z9C3 x5 hDD=KEnX}@pGl{Ihf1fdgYp H)8v#=qA)rv(y'jaF"~` L70n'{II#X #VIF5>chP#N8% ;cL7OP)R>PARuE# VDT<%ETV=<E578RHDq6cEIVG9xee ^pјBE>BDDbo~"Q}gF8 >CK 08i"IYѸh&Y}汬fGQ\%x5"x"`+YGy^Q{Q~Z!S- 8 +kI ڢvC;;3)0PO|Kfba' 7#NY22JM)H@%AFI"ZtE 1[nEeJAwEV8>T>.D3^Q$/ ,UYxNF0R_Z8d7$4VN1ꞓD*;7V ƀeBwCh !1@) (."DH Ah)M 1Q*"Qn4q= . @C#\bQODx%[ a$'3Q8؜ N(h{ W -İb\a20i2F@z QK` @r`HBl v0JyƜJ{+<]Dġ>j#XSX>n6dY['BXNX$ (@`8p6` 82 p(` l EalܚdHhANDI.dIzA)K)"bf)⸘'+(\}ǹXEa.LD2H89q(J/ f4b^ |0]`R !0"bQvp#\m Fv@^(@Q!BWKIiҎJSjBp"bxk :4C r!A Vn0CW sSÁPNp @P@ ! h@D `&AH@ Z lA)@`1"/ph64b-gA83D6G At*p7I<~> N6&DA1@aSRm]Z+@bTBaCi A14PB[ [ybR$ .>sjQMp\I X "0 A@(ڒ2ZKIHBLDB@^ő&(sf:У &B A)@<ic{1<*<,j=GWAl*Ȼb q<' T*CaUF4CHdjwlhT ,PޏzIIhR]L "<^ QF5 cRՆ8D  x8Ȁ5+Q4{ OPg B@E qGA0I0V OPi _ R읗6~M[E&@sݾ'(F 0 A?`#Ҧcx>Scz>+ @? K'@tdS,Hf J8o 1V6p3@LyGa>=s}zpA@!6ЩĜA!^!VDLBlHHT RF 0X!| @:&4aT//AjaȠHA !J` @bL p πM*o!JPr*a!̠ `v z,L!J!b!bPd`o+I\!vl!D a mZF5#dAjZ @J^  t=D*zqa6?!I VH>D.`N?ʛAaa|!` @8`.LnlaL p 펈i &ᦉ"*dA"& p@ ZB` tp F@ZAƭ$aAy8a=q~!B0H2!Fzba @ @ JZGnh4 oHA sXKf@`)=pi-)? Sqt!7~A>VA.!*aX!AZہ^ N`R`/ªĚ;=CLx PšAd.L I!LTAaTa `f@@T`zjh$FA8+E >`=gR-(A0a<%IB.q LBH<z$A @ h`^GӤT^LtjiSe5:=7!7rN 4AV.BX!PGTv ZV~ Np1j A=MƤffRpƣA~b!b!BIW@ g|HAaP!T  D@( LjbƖjQvB Aa^(^`uEdR$<@)`` 4:&"hApd8b[cBІcTRKTv[NV_7}8lRO4!DXa!0 RL b*ov"ߢIsbɃ"xA!b @ !Vlpadd `0,R@Ti+^v1!jYt@ ]|/A/vaA.)VEsuw~  Ad~nl6N@EL `q5* ayAFeQi}r7Wa$~!!F!T8A, x` OC/#A!!a Av 9a< \`  `6@ P<` VIUTƨ!&aiFa&A!+\DA0f& taxamrZAbbxcVC.1u JAN9S}c}V͓~@,2Il`L 6>Z`zArAAAxanӳa!'ZA6!4  :(J!aP~`6@<0.ն76a!z!R!~|ݭڵMEa_w++x !x*jh,." qx`nOv=4dO ffn8a"x.P rM 4kAXVajV]!~avap!!# Z x8(@arCj `*@`."@n~AևM4A~4  ӦXơYbCڒ ,<AHa=2  @\G&J̓/*MeqN[O:A*myh6va6a_ytA!!ɺ[vw:av@`a <ļsY&  At!vOD!! U4C PIF~EqwݱuoVuzC!/w{_wzMf]Dw9&z9QDza.T)UdlY,kءFPAU& dY(G"~8I {N(_JHDjb4ud9'h%YCX5gRrYE,G!6UfVPZuA5zPiHV0AEqgg:u'g9Mb0 ("0}' &2(P @4=TcV5Mc\6CZ6!(P Tpairtx_tbEٌy=ٌzYMƱLay?f9Fy4ij)BB@HX `xX@0*{E v6ExdAF$vj= 5t(8Gb6(k AQ#9_Mj#m p:FѪ:@"0^ p L A2!,piMQt(Epn!%lr;EPbb10)pB `bP `d@Bl1NC,bَ#{[[n<$  p0RB@M 6!v AE@%h&>BWc9WVJ(hBp/XG@EWxKMxO Zsv}HwP^\`G2t2(/rጉ.X ?P8$ }>'1eq<%28[*MFDGIPTJU:qHM)dMBHC)@CS-PL&n>oHks`J104d*\#W9T iF‘yN+C ~2;زZEcbAr_"Ȕ g#Ӭ}PɶB)*E%]#RS*Goi u2KsA:L<ގd z<@4gmf,KB* $ ""0*ˆ, c6)1E@LE!2TDTV%JMG,nAA IYAID$YM+0 0t B0(2~z, ͜'18& "? 9I*Pd ^$BEAc ZA,QDFhD1\7$4cHAi6,0% i n|'DZ\=Pw3vg!7pjy@3v)b#j"&1 b9 9X2M4IVP*INT\M 1$pDMa%~힍ej3 r!@ Ñ7H3Z) PbAA>!=Pc! $h*YCA:P({"H! AD"};`CXbueOGpAw{)>d|׀ 8&~^K в a9!aL) 6'HL 2r(^QY " J sB){NN E9  @ '!W-Ir& Ah8 px< 2&b8]1/ȼbZA,fC BpIÁA$\jA6iQ9+u)*`uq#l}Pldj/@p8?{ 7Àh$K!1fQ@(E(pU qBDXdNrFPi=k9SdMv'HV <@" т1B` j."] p3"[[+E M Kq p$ىQ#p?JE7eQ0(Bb!T.@л#4{c*P]!F m[A)EkB4B{ !KQn$%@`1pƀC4 FZ1DЦ9 Cӛa %~0{5T@Ʃ[ݯU LH(A@b nPX AG`N`1`~ Jbt\ +İlEd0p>l$bn4D+" BoT Z*(BYN $#Đ:0g a=``tX.~xd|8df:FV !r  ` *kj ^;j>ʨ0L VF!4A0|@tnfJ`LIW B`D`,`NvLi8#h$fRAd.5`h`Jʼ`| @ T( R vƮF`D @ @ $ PAx"8!!. oJ Z~08@-x'y0S[װJv'da*&QqLQڀ]d&! !l"Kȡ!: A3 !f^/fP! B@ ^Xx@ `?@`@b@8/M`DJ. ,`NZj b@a  AA*Ap~a,+!.A a4@ "  2P!?MPv0Ꞩ 1K2 2`T~e_t+Fs 0^L!#@hz`6FP0D`<З%ZN=(a,:+AaA(sa (2Qpp2A?!"AA~8ҁ ` >\l\6 CC0B"x+C!xAL!s4Aa,,8a(aANf6s@  t @ `!TAPva6y3!~   Sa:p4aa?A0jr!za, ` . ޑ,x1,6\=U> lj0r!3w3aǎ4~2+cni8aa`T^t` `VN@ [Gh+ /P63@"PawsB`  `<R8(@@R zLnj3PIBefvifmtUEe\'0 h*va4ЮA0Lh(aJa!jҰ F`|X 5DiT@A|` `rPr!*aA`baAAZXiR@ i^ ў%0T3vYWwswwfwmt?P4Pu<(kFAP ]aABZJ`r 62fvxF#fekOs]AF   eaz!/!!!A~A<! @ AARn6gUWnU]MohftLAH*bjax XR` P`H@l d dI#gewpH+f$@ m"h0rA!~l "d `Re @\y8TYY e wWB!4 `a0 ` ` 1@ 2`tPs* (fl8 snyok@ !  ( š sn` R : 2!Xa헅Zq0:f(A`;X `v@<@ f@34 &``8 (`]`[@`J@F j`)Hb1v~f!an 7J> U8@y`j4@& b@0&Y,\NP65 tI*姳xQs)S9&z > 2j` 81`-{&""8 H-VBeQ2 Bj6`G+۠  ``BR2.:gaك\E" `@ @`B<& 4 * $62*@:r* xpZOl@ G vN@00`2  `97|30\@>.@v` Py+d|G)İTZZ!tDk1aH!^FX F^dVj=*~ܲ2 v|=TP'Q48F>D!DaNHdL76FA:&H\A4@mgӶk]E V,, fxP%ՃhF}/R0UN?[Iڡf4Evvfx]B S;ay>0>C eMSSS=SS rW WS SSS-1> )#Cartesian (Meter)| 255 -9999 0 -9999 red 255 -9999 0 -9999 green 255 -9999 0 -9999 blue ??@S@terra/inst/ex/meuse.tif0000644000176200001440000001556314536376240014626 0ustar liggesusersII*Ps3=S R jH *bG r7G|y  1736 -9999 138 -9999 meuse D@D@AbA#      )#     J@y5@b0>?A`BAmtr@@TXAunknown|WGS 84|-32768($ APd. CQN-EQn=GR$M%IRd]-KSm5MS}=OT%EQTe.G*mVBx#@TլRX $WB{a=kd&CAG l "H ^T7W'`4 K@!h |6I9LZ77 B^OP &@$Mf[EM`#('(v:G\0 O`4~]lLR *@&.H n` #1""sO$pUf(F8X2@ @DvD2:c cxFxQ$8;F@@bV@,H VP>"i ®!!D.L<̂J#@ ! !(o1"B8ΩAFK#5W O@"!Ue 3@,  /'xo S`x6uZZ"@F% :xp SȩB^vz&B }14  ! @`;5i q8y4Um`R}@a6xVӨ !` 4 m`ybO b`vvPz7@@ii 4ǝ@ zO&L!WP@ⷘ@` _T  Nͣ'Xv]U5OrgXƸkpm/bb$VʜǢG0)DA~e(.1h.y9+ZP,:&\#d='n\JIbd_"Y*`Xv!DVH‚g 18jBU[Nb1K-WCeP iĴ@ %4u ;7 QʀhMـRf0P 3uX|?0# pad{r1/}G R2jܚL2 nc `$@PQR9cgqb<.DP @b&h uX;iqn-0/]h@s``5{pE$i0E : qu0 "!S06l-@xs! Q2GFBZ?@  ,`(@0iūD\7B[+pP%Ӊ )@EQPZ;@R`3d.:`F>e;5w:|GNal(p(xZ; ) sRl9댋—UUčq Z@$ YK( 1!B2%AJ ŭ}qVj[<./ ;QPkbA |` E A\@ahs5!@7НڥqD=0 1ȆBPJ`>+#Z5ߖPTA4G_ˌoaѺmh`NPU4@OjuCB&E[fwo2̶6ť$^m!($ APd.[FA"4"@kZ`,, 8@%p l@' @(M)mVVUUH.G`JڠH^!`sY`dX(C0MCөYm"[gZ9*l D1e"Dc*0 D`I$|Ԍ2i<>80lj` XPp8lW ! | -`jkC$=+g7#PX>f0[$7!x!0#h2"P'pvk"BC,;-KD$Hٶ@ I B8T N͂ "۩"րx 3, K̽M<A0mN3P$T@ 3JF 2!&"x !KY pAɽ{(.S5-` (# ZO.!r!!gZ"3IZXm 8ȑ+HKqyy!@@`A,h hz#Z@25EYDIzc 8e/ t btt""~r FY+3*Bw1Unzhshjƿ•4MiJ&FV ,uW3 p|P/n gOhIOX[Y}[`x]42'~8(\.ޡ%S~u"v v ]Fc qAg(1( 8I E``%跑rDW$ Gy xn)@y>ʖ\(F !zR'>P5 滰tTSb_154a$ĸ+gN> J8o9+|^G%$CPX o!JsE'PO>Q+A wON18j50l |OLf1+sb j0-`+6Šo~6-xxݓbc y^ uMS4!0 @i?t94l͙QD$QϘ6', x#LC  V(Z{y,QJdIvؿldA"7”#KZ\!z@A hD6_cI ` # bGL:s2D  p%(Eg(3`hL)^@G3O{2.+XHHì]!|1 JajA(f5I6خ$MXk pV0 @|y㷀"ը? +\, 0o>-EPX-B'QbTE ::},d`*Tgf(5ܟ[xLYUP0 }l'Db_*Gŀ;8@jBQ.)@UZ.BgT\DtL:8V3H _XV`E{I0A%@ %sP2Xq(Måjܞ>:Lɡq[2BhDnlVbq%3'` &N`BO oz8`3"l'tgnCOQ"'p[ǾE\G(jTU =n(RP<@NLҌz@@Ad!:!6&z&\lHQxWæ1V1exH*(-0a>cd 6P up4 @/*v`T2FX(CRHĆ10c'OJ*IGOʄjAP/-cfC9cmi n@:A'B500JR.( Pg11cy30qUoyZ,d@F@&7` PB Fp!DptW|9e!p_솤xQ b#/j@lbJ LuDMҀ(@A//czhfttE'EWܥFx\' K4%Fa a`aE<@(Y$Q iRigS%#vU\0U`{x0dXWHĢ&fxp_&~%'C(ETh:aafT`ja@ sBiNJB_B;.=^2HfLy@GdsGyHN€*A^#v`@aRx *N8#.QT3W4Vz\lH2bmz(]P%xr>r-]Hv!Q`<  .Fހ4a%@S>3\?eZ*Ft\8OUA|1=Ĥn^:#FH@@P'Da bhvAL@`X˖p3R;<8%H%cdJ.K9ZU&]\%Iذa@Dn/ "hj#!L @$T!MFHbWRЄ\~v2.agHt_(kGG _gl';P?g;$?%#?f@8E)qpM08c FÐ(BgWa _$u\kbr0b;DlMZM6D8BS4!1-oE/&c\2HȆ9gy șIL裖^6Op2@F3"=l͗RAtN# =8\1#Pexx> s`-']p8J~z\-q%c\EX8g\*D&]yK:(jfi@>1g 7bOĄJ" ! ` <)p Y#`4/"D=& *HPP*%EQTe.M @q] xxV,&<L@F`ut*IC@ ('rU[B!>@! c@) ʹvSP Fͨ&: A;&v-8BNF`C[HAf pK%c%hޝ1:L>C WGmCL̙ DU% H ΋" GslX*DXYE1Bh`p!D}'`? 547 -9999 141 -9999 elevation ??wwwww@I@#  mtr@@TXAunknown|-32768($ APd. CQN-EQn=!.cTY/F\ 9(Pf4*%AyM)N @A. t[kh:-gV\ wS@(AްYnXVV+66яFX 0`:%d6YbX@@e\xE+ cm{26aaW\ 3.` 3Zӭ] ?]GK~8s:@({0-ـ׀%l&Ͱʼ{+. n۾ϳ)[T޷భo°ocLhD1|-Alp2c1k .+늒$5Q̣X%۲e1e@SokLQ웮KU gv <`k2A4)MjjLPU +lH2ڸ睎` /(42*EauO$ɫXF~5 -Z+k|H$EQ؎6m-VNS0lJ⸬e$Yѫ,]7F/ɚҍjoɼˋJ7L$& V\N\Zj놭Ajs2լBO@.L$U$[y2~&! _rh@ T .8_O~۵z[MCH7.9mSgu5c4:ږͣ[֦ܐ6QA H`W3=0$sD(jKZjpհT7ޥ-wwRڭ6B()$HE#PҌ%/2(W(1x|N7!2Pԣ:qˊ*B` @@[v/|Pe #n]@?OR"kN|$ەfY37Y9<j!0@ gjB~ _B8Cak %+0E_ Oy['l#@ V (;!9>ƨSqo-,AEM))1럗O08CccAp#X LLAķsJy@M 66+Hx:#h/u0DF76(MH2f{A2I<)<Ę ny.nвCqYC" Oh ̿!-Dvb`Yh#xAl;:Du.e+'vԌJ @`=E RD5fM3VT<%%$0Бm_HD_!7 rBPܙvpO<(xBzu 7YZhx+`aVSuEV Y[ Adcbq_&Û6#6&.mgo0&7NH<avvՀY% ¾@O1/MxYJ08'I t f@%GĘs& [Pno A$kPgnÛoV`J$(xVa9`Nռo&;dv{@0xƔC12Zrj k8fcD˘}tߒ x#>\K@S`Ļ3 $ )8-\m2o̗ńe[9rp?: bIj€|1]N͆A¸t#X7|Kؠ;)cxN ;:wݩuT}n~ nSs"ġSOZ-15F<\ 7 9hP/@&:[$`%"v|+m~2( g@͕Dty-n$d2t+ %p U` pvD79e!KnX2WkL8Z3nVLnf~ @ w 6ؓC{V-ƝXOr6v5z_ )/eܭ{*Q23fa-ը`a[PdS8Fr b0xe0|Dj`G!qYa԰h<M<[͹Pǘ(c0);ω[o   + nCH Bojij(婂8m'Gd.+ eBC00d5N<8d<$pi"j0>ję&',ԿLMx8io'Hvg8C5D>BD&bP¶V#Ni$ 8N8I$AȮDt|Ir| *n{ܼZPp.࿧| X-HK(~1J'jH' $Bj~m4h)#J/Ö9( 2fĚ#dHG `H~vx` G.KXMDJr)8jJm)": m(nšC  `. . $.@ d@* ( ' f$ O@'9M,@SOk4|F5`f@OR0#`Z`8K희dP,O-eÂ@, ,@.|cUc1% .Kd% v@&.R` P4@$@$! P` T%"8'Kp,,` ZJҡ` PQ"0ؾF˸"ێm?`jH J@M !&!lK9΢p3"0h8 dL`Xt@'` b! "H\%-Hxk"-^%HN?-(.ȱ '#0K h ') !B ޑ溮Oh k>"x oPzcsFI{U&̿6ؓ l` 7dCS#Km28,v!t6 ^i)]~A@=$C#h+@Cxdj±'P4ne? q`,[j>Md_ϣJc7<Kr`"bМ/ؐ^$𲓣RsiE Q&(s?wu?B= dfIeV-%H?82dLI7iҔӂ[@-!8cr0bRU=%ҦVdWE;fW2`L$"~X`"(8YmZǤ};wFj@ x-I47X^)|=|RE~)MFdT 8\X( -oƁ;NaiI s%TZWpB)<)I!Rx)py`cQ a8g+N*ådW=le}}7Z4>!sz^QH/+ҡΑ'|&C[RJxhqeY# 'Ɉ"LDW$|;їOPKrPPe6xǓBKq04cO., &"xY.K0 |sAr2/LHBBp/<<VRoJ/"~VA((DJ0>h$iFdY dJN(f'ļY tk&9Pyd0=0$̆:@DL jJjz+d(<' ~㨗 j@aXhnF",8sNFn;xc`"'¾LDLOp(8x\Vg|W'4s–&&~%f%8pp_;~Q<*dJ1t~%zς, LGV bL j)+'C(XFp<HCiQjxf0ƀ$^#FbiC.xkVn O)]BsA_vBH'F00@j="dLq/̂0"|= N8]B;,XE0H,dZ.D~Y9/12GHN^(\wpx@e`'rOK$>ErOL @E'1c8"+KDYfD LC*',"+Dē^K8Znh;;F3B8#:@8#.',tL̳KVB ,nAfJmH!c>@;/ *u(@b%] KR@B@H}Sf)8ȚrmE>WYŢ-e],]v gs jyb?uuW0#i򂆫JmX}EcY]KQ!~EXøhAm|Y~]CA'ꕎt0K#JAf"̫m9F|-$XRD]K^>KKrKc -iXh h&2O@xYFuDdZ%$돘2X.&08¿_W҅YQ; sԒ n +\LD,;;2*JṰEWPd* @p9jj \Y DF"1VgNyˠwwOp'82Sf<NR1VYDء0iZF%š+I jc,$5JH2 sǒ*p($ APd.f* *3K@P9ƀ#P ,x 6]aO1 @}0OT$XhRr%RrQ[j:]WV‡`]c[Wu]W4terra/inst/ex/countries.rds0000644000176200001440000002135114536376240015521 0ustar liggesusers}oؖϖdGWwUwUef0/SK^&HP%⇊7fE7%U ,d @"@l+/%Q3Ew]{>~CoϤ-WSdk볭]j(ğ] qp&+"ka쏃ٮq8wˀz\qxe׿һ{pǧcz0f O/d7/x({A(1Sz)<2-dr惊h č'~=SO,e08')o봄o`DzFCp2C-qBn(Y0H%Q }Z/b?f.K?]hDܜNyN0;S^37?zxRCKf^ wRG"!.&q]0QFjh p'"Ւ6mUx:)1zaEqg"eߢO~ ~b?>evBDl}FY5h<Ye5+x/ Ǔ+$ߒ.-h6.xc"}$SZ!~`/9w@Vpt-Zބ_}/~K66w) Oy x.9!w.e.Q1E͂",H(Ik]59j݄Y<6Ofι>L!#]fLFpNdpA ;.yd*B 3ON|].߇D} >P8>ίw>Pq|aXAJ箈y>tCa>kJ hL8.qspp-IIį "EgGN 2yK8j.60_߲GיT"`$fON{np}z P-G WTr ¶zzͻSya8^6`z(&im˞Ʋ^r Ȧ=9ᙟ(ꑶg4Z >ޛ&MpB<!k-T{oE㷳tD?bٞ 1ڋ'+~{5]oIcþȗH7p:ˑ)2\}04d,w_}J|? Cվ?A!90Qd<2Ld _)ohLд_" aJĀ.p UaT:(zJs\s\B&f(`v^'|WJf ͖idu4M1t`^Z妇17t4571B74ۙ&4Lnr_M8Gb%TnijŽ`*7j-q{6zWpdʺꮎu `j9e2uur]bAK^+0;67Y{'WA esr[]nb{aUMpwݺ.DzLNwɔ2 T OqrylҞ=u]{L}&> # #3 <&`I9D hih9hhh&y<[ ZZIuRlp#A_shzbb :8&h1-XG8RYRU@).:%PANR^\7@u [TnA 40Y4@JjX$ @n#iM`KIMMd`R s@U 0[ K-"oIˤŠZPIp1r;EǼ:E-3 h&XzI#WAKpw@)`\%V ٫dA\GI,X5s LQ`e&k5A /wMpqdbm&dL^2IB)!|$ļE&Yஅ9,#K(@=B tA  Z)'?w.CP+uY@J ])IH%D˒ `H$pr0RyPqd BX!㩓B !5\pޅLXKn* nAE\p=FLB5BF"<adԗ${xP(A.(H HHE2*>}0 ԇfB!R~pfYJXpNj+z*ղ5]>[CRQQ\Z AY=!+R5SwN}WqZX15GWKvN)8#u,-vkk%{)z,+Ns=G12+7tXs~.U=g0[kFKi imKm[Њ)!a<1; r-CipIV-i֕VR1]]t*˱ֲ' E br΃+tIyWۆ9#2 >+ ;:qMU z:n72e{_8$4Yi&h^@mB\Uەh9 ~ 93ߎ֑ H=Mn䯩BUmBɐeL[%U)MËΩݙچmYm*]Mk"=Zȶv_U{"{R<ʑIRQc o)b Uk$SMk -,SAAP ihdfHRZGpU9Ps= .iflz،=5kv'kV9M_7F[S1KtKM86?3uձ-Օ}54LRR=+G. NW]ԉwZ:٬![AfC3JKh⣤r uOKr4 \UFw,winO3G31ydڏ2KkYqoښB6yV7d#p$_M[ѡv"DN 1ZnviUw%۪&dX QkJ+5UVtQK)H<.+jS9@*^G9V:LѬ#(Qig ̄ZGw~y>R/;6~+ޡtT6[jv^E(¦^πtIJ/?m"K{jT6 C'H4::cԵv{(jшG=\1=펙A Ù*@WLhB&d-U 5G,U17:zBӺm0_ZC j6v|kԯ_43{W$ <{BU3e;I$h`E(1XW]a-XѮKBLb8ɳa b.]괒 0Gd_} :s|?|(֞(02lThk3ݞ$֌QյL֖7 a]1xya3` زg]R\xl6H;u&$="AbuOX=089£1da"w[m+0XFQ(P)z΄DzϼlhןRm %Ϯ7WUT"F`*3)xH`i<9QtL],".ȦfțS;{mmSa;2)qD2_ Lܫ)3{u-?iȮ4U;J^KӄY`F75$P.ivLJ taZrU 4i|e 0Uy{)yO"\pr#+}E~#+4eNt݋ja Zܟc~v&/zn([˶0>[**^=?,*BJ#ÇSleBӚD%k)Io)ōg]Irc-ϲIvP}s}%j< FooN!z&EVk0~RIeTdr@^1f8J>Ec YFWD'MDr:ô>'~NP.ez,x:l ^3Su[EQۗ|GcAJ6{"m§e6I $՛كϵ`Eˢ <WM4zNRIबIYYrrF\Sk:<4sZ>ДJuGd%޹όJzb\S$M)4GdK*갬Y]/>vEhk2Ղ& F3"/&gUI#P_O`D ]&$.E 잊@4l0@2sՠgJı%2ZAIzܸߧ#7?GI^di/wV [ (5e Rz攠dzJS8[$Th0\Pg(bjWjMEY)<GaIGRočlMiMN~ Vrc\ɦc#ٝL2J[SF< $ JWa,0m½o͏XUMR)q2R}tW=9rӹvS.`}# X3idKL V  3Ix^wtL+]JHr_=ī&*\ל(ySfrVE8hh!_X4?l&:OFJ(%`7}6':mfOfu35_Qն%?t*XhJR!cBZ"OIP} BIoEb׳ ~\PjV^ ,)lD*,T%AQqP{q\Ej est+" u9O 5ǀS"WffD%~_D`%|k8-G@iV;=`/>ewDe`pB?#?̕~5U_uy.nR)] _礔=_}N?ŪDsb%6BnBvفҿ+d_[Vi>٧Dҋ}φ ,gA* [?EULpg>hW%<9 u7E A~W$umG01b$;ly/Ċ:;h KBy#B޴LeU>fmqBYat. X$N9*99=V _N{5e~J̳H˗bAVaFqswH{AVoJ*6ŭ pKS2,&w"^\]2bP]( s XbY\&KP*.-HX< /Q¾EfA鰠H uCQ^ԑEp-"哬2WŪP×&HVh9%GTW[lbt^.e1{) $XF, @*vź4i/I #TPEYY9E-.FH B+K j($=` +\puE, Mi(DUȺB/ZZ?E T9BEC(Y,匲gTV2+bKP\d|NP߰x#{. WHjv7_ 48=+9W]e\5_uSc}!s~O_ɫ{R=7{z,]۫V2e9kU9)j7VEoOua]\yUu^1-e'Nc+M.8Qm[:Rd][I71j̕vB6wUJrV>܌oe1wL%('Kb}eUb]$SKqwnSh}ۨWR@+ I/nw &W[/[FIo^"*ʧy!% !yKqJ 2Bo6m,QJtn\JHi96T['%ZbپVn}Z6 -◓`dy.mNӱu~[7$^׍`6.}SC[Fooމko{NnPJW CC` vFW]`}3,ny7Oo/K2\M |JQ-%cPK:oK["wNTi>VۺkeW:qrܛ^bv_s4?xճo쪶К͓}:G)ͽ3V4}7>]#OGM*terra/build/0000755000176200001440000000000014757467212012505 5ustar liggesusersterra/build/partial.rdb0000644000176200001440000000007514757467212014634 0ustar liggesusersb```b`aab`b1g``d`aҬy@D?M7terra/configure0000755000176200001440000047044114757467215013332 0ustar liggesusers#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.72. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, # Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case e in #( e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Use a proper internal environment variable to ensure we don't fall # into an infinite loop, continuously re-executing ourselves. if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then _as_can_reexec=no; export _as_can_reexec; # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else case e in #( e) case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : else case e in #( e) exitcode=1; echo positional parameters were not saved. ;; esac fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah)) test x\"\$blah\" = xblah || exit 1 test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" if (eval "$as_required") 2>/dev/null then : as_have_required=yes else case e in #( e) as_have_required=no ;; esac fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : else case e in #( e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$as_shell as_have_required=yes if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null then : break 2 fi fi done;; esac as_found=false done IFS=$as_save_IFS if $as_found then : else case e in #( e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then : CONFIG_SHELL=$SHELL as_have_required=yes fi ;; esac fi if test "x$CONFIG_SHELL" != x then : export CONFIG_SHELL # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi if test x$as_have_required = xno then : printf "%s\n" "$0: This script requires a shell more modern than all" printf "%s\n" "$0: the shells that I found on your system." if test ${ZSH_VERSION+y} ; then printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should" printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later." else printf "%s\n" "$0: Please tell bug-autoconf@gnu.org about your system, $0: including any error possibly output before this $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 fi ;; esac fi fi SHELL=${CONFIG_SHELL-/bin/sh} export SHELL # Unset more variables known to interfere with behavior of common tools. CLICOLOR_FORCE= GREP_OPTIONS= unset CLICOLOR_FORCE GREP_OPTIONS ## --------------------- ## ## M4sh Shell Functions. ## ## --------------------- ## # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else case e in #( e) as_fn_append () { eval $1=\$$1\$2 } ;; esac fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else case e in #( e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } ;; esac fi # as_fn_arith # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_lineno_1=$LINENO as_lineno_1a=$LINENO as_lineno_2=$LINENO as_lineno_2a=$LINENO eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' t clear :clear s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # If we had to re-execute with $CONFIG_SHELL, we're ensured to have # already done that, so ensure we don't try to do so again and fall # in an infinite loop. This has already happened in practice. _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" as_tr_sh="eval sed '$as_sed_sh'" # deprecated test -n "$DJDIR" || exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME='' PACKAGE_TARNAME='' PACKAGE_VERSION='' PACKAGE_STRING='' PACKAGE_BUGREPORT='' PACKAGE_URL='' ac_unique_file="src/read_ogr.cpp" # Factoring default headers for most tests. ac_includes_default="\ #include #ifdef HAVE_STDIO_H # include #endif #ifdef HAVE_STDLIB_H # include #endif #ifdef HAVE_STRING_H # include #endif #ifdef HAVE_INTTYPES_H # include #endif #ifdef HAVE_STDINT_H # include #endif #ifdef HAVE_STRINGS_H # include #endif #ifdef HAVE_SYS_TYPES_H # include #endif #ifdef HAVE_SYS_STAT_H # include #endif #ifdef HAVE_UNISTD_H # include #endif" ac_header_c_list= ac_subst_vars='LTLIBOBJS LIBOBJS GEOS_CONFIG PROJ_LIBS PROJ_CPPFLAGS SQLITE3_LIBS OBJEXT EXEEXT ac_ct_CC CPPFLAGS LDFLAGS CFLAGS CC PKG_LIBS PKG_CPPFLAGS GDAL_CONFIG target_alias host_alias build_alias LIBS ECHO_T ECHO_N ECHO_C DEFS mandir localedir libdir psdir pdfdir dvidir htmldir infodir docdir oldincludedir includedir runstatedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir bindir program_transform_name prefix exec_prefix PACKAGE_URL PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR SHELL' ac_subst_files='' ac_user_opts=' enable_option_checking with_gdal_config with_data_copy with_proj_data with_sqlite3_lib with_proj_include with_proj_api with_proj_lib with_proj_share with_geos_config ' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS LIBS CPPFLAGS' # Initialize some variables set by options. ac_init_help= ac_init_version=false ac_unrecognized_opts= ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' runstatedir='${localstatedir}/run' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -runstatedir | --runstatedir | --runstatedi | --runstated \ | --runstate | --runstat | --runsta | --runst | --runs \ | --run | --ru | --r) ac_prev=runstatedir ;; -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ | --run=* | --ru=* | --r=*) runstatedir=$ac_optarg ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: '$ac_useropt'" ac_useropt_orig=$ac_useropt ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) as_fn_error $? "unrecognized option: '$ac_option' Try '$0 --help' for more information" ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) as_fn_error $? "invalid variable name: '$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2 : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir runstatedir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; esac # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: '$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF 'configure' configures this package to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print 'checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for '--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or '..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, 'make install' will install all the files in '$ac_default_prefix/bin', '$ac_default_prefix/lib' etc. You can specify an installation prefix other than '$ac_default_prefix' using '--prefix', for instance '--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-gdal-config=GDAL_CONFIG the location of gdal-config --with-data-copy=yes/no local copy of data directories in package, default no --with-proj-data=DIR location of PROJ data directory --with-sqlite3-lib=LIB_PATH the location of sqlite3 libraries --with-proj-include=DIR location of proj header files --with-proj-api=yes/no use the deprecated proj_api.h even when PROJ 6 is available; default no --with-proj-lib=LIB_PATH the location of proj libraries --with-proj-share=SHARE_PATH the location of proj metadata files --with-geos-config=GEOS_CONFIG the location of geos-config Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory LIBS libraries to pass to the linker, e.g. -l CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for configure.gnu first; this name is used for a wrapper for # Metaconfig's "Configure" on case-insensitive file systems. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF configure generated by GNU Autoconf 2.72 Copyright (C) 2023 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## # ac_fn_c_try_compile LINENO # -------------------------- # Try to compile conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext then : ac_retval=0 else case e in #( e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 ;; esac fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile # ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES # ------------------------------------------------------- # Tests whether HEADER exists and can be compiled using the include files in # INCLUDES, setting the cache variable VAR accordingly. ac_fn_c_check_header_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 printf %s "checking for $2... " >&6; } if eval test \${$3+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $4 #include <$2> _ACEOF if ac_fn_c_try_compile "$LINENO" then : eval "$3=yes" else case e in #( e) eval "$3=no" ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi eval ac_res=\$$3 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 printf "%s\n" "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_link () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || test -x conftest$ac_exeext } then : ac_retval=0 else case e in #( e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 ;; esac fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link ac_configure_args_raw= for ac_arg do case $ac_arg in *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac as_fn_append ac_configure_args_raw " '$ac_arg'" done case $ac_configure_args_raw in *$as_nl*) ac_safe_unquote= ;; *) ac_unsafe_z='|&;<>()$`\\"*?[ '' ' # This string ends in space, tab. ac_unsafe_a="$ac_unsafe_z#~" ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g" ac_configure_args_raw=` printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;; esac cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by $as_me, which was generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac printf "%s\n" "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done { ac_configure_args0=; unset ac_configure_args0;} { ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Sanitize IFS. IFS=" "" $as_nl" # Save into config.log some information that might help in debugging. { echo printf "%s\n" "## ---------------- ## ## Cache variables. ## ## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo printf "%s\n" "## ----------------- ## ## Output variables. ## ## ----------------- ##" echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then printf "%s\n" "## ------------------- ## ## File substitutions. ## ## ------------------- ##" echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac printf "%s\n" "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then printf "%s\n" "## ----------- ## ## confdefs.h. ## ## ----------- ##" echo cat confdefs.h echo fi test "$ac_signal" != 0 && printf "%s\n" "$as_me: caught signal $ac_signal" printf "%s\n" "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h printf "%s\n" "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. if test -n "$CONFIG_SITE"; then ac_site_files="$CONFIG_SITE" elif test "x$prefix" != xNONE; then ac_site_files="$prefix/share/config.site $prefix/etc/config.site" else ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi for ac_site_file in $ac_site_files do case $ac_site_file in #( */*) : ;; #( *) : ac_site_file=./$ac_site_file ;; esac if test -f "$ac_site_file" && test -r "$ac_site_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file See 'config.log' for more details" "$LINENO" 5; } fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special files # actually), so we avoid doing that. DJGPP emulates it as a regular file. if test /dev/null != "$cache_file" && test -f "$cache_file"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 printf "%s\n" "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 printf "%s\n" "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Test code for whether the C compiler supports C89 (global declarations) ac_c_conftest_c89_globals=' /* Does the compiler advertise C89 conformance? Do not test the value of __STDC__, because some compilers set it to 0 while being otherwise adequately conformant. */ #if !defined __STDC__ # error "Compiler does not advertise C89 conformance" #endif #include #include struct stat; /* Most of the following tests are stolen from RCS 5.7 src/conf.sh. */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int); static char *e (char **p, int i) { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* C89 style stringification. */ #define noexpand_stringify(a) #a const char *stringified = noexpand_stringify(arbitrary+token=sequence); /* C89 style token pasting. Exercises some of the corner cases that e.g. old MSVC gets wrong, but not very hard. */ #define noexpand_concat(a,b) a##b #define expand_concat(a,b) noexpand_concat(a,b) extern int vA; extern int vbee; #define aye A #define bee B int *pvA = &expand_concat(v,aye); int *pvbee = &noexpand_concat(v,bee); /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not \xHH hex character constants. These do not provoke an error unfortunately, instead are silently treated as an "x". The following induces an error, until -std is added to get proper ANSI mode. Curiously \x00 != x always comes out true, for an array size at least. It is necessary to write \x00 == 0 to get something that is true only with -std. */ int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) '\''x'\'' int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int), int, int);' # Test code for whether the C compiler supports C89 (body of main). ac_c_conftest_c89_main=' ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]); ' # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals=' /* Does the compiler advertise C99 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif // See if C++-style comments work. #include extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t); extern void free (void *); // Check varargs macros. These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare // FILE and stderr. #define debug(...) dprintf (2, __VA_ARGS__) #define showlist(...) puts (#__VA_ARGS__) #define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) static void test_varargs_macros (void) { int x = 1234; int y = 5678; debug ("Flag"); debug ("X = %d\n", x); showlist (The first, second, and third items.); report (x>y, "x is %d but y is %d", x, y); } // Check long long types. #define BIG64 18446744073709551615ull #define BIG32 4294967295ul #define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) #if !BIG_OK #error "your preprocessor is broken" #endif #if BIG_OK #else #error "your preprocessor is broken" #endif static long long int bignum = -9223372036854775807LL; static unsigned long long int ubignum = BIG64; struct incomplete_array { int datasize; double data[]; }; struct named_init { int number; const wchar_t *name; double average; }; typedef const char *ccp; static inline int test_restrict (ccp restrict text) { // Iterate through items via the restricted pointer. // Also check for declarations in for loops. for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i) continue; return 0; } // Check varargs and va_copy. static bool test_varargs (const char *format, ...) { va_list args; va_start (args, format); va_list args_copy; va_copy (args_copy, args); const char *str = ""; int number = 0; float fnumber = 0; while (*format) { switch (*format++) { case '\''s'\'': // string str = va_arg (args_copy, const char *); break; case '\''d'\'': // int number = va_arg (args_copy, int); break; case '\''f'\'': // float fnumber = va_arg (args_copy, double); break; default: break; } } va_end (args_copy); va_end (args); return *str && number && fnumber; } ' # Test code for whether the C compiler supports C99 (body of main). ac_c_conftest_c99_main=' // Check bool. _Bool success = false; success |= (argc != 0); // Check restrict. if (test_restrict ("String literal") == 0) success = true; char *restrict newvar = "Another string"; // Check varargs. success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234); test_varargs_macros (); // Check flexible array members. struct incomplete_array *ia = malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); ia->datasize = 10; for (int i = 0; i < ia->datasize; ++i) ia->data[i] = i * 1.234; // Work around memory leak warnings. free (ia); // Check named initializers. struct named_init ni = { .number = 34, .name = L"Test wide string", .average = 543.34343, }; ni.number = 58; int dynamic_array[ni.number]; dynamic_array[0] = argv[0][0]; dynamic_array[ni.number - 1] = 543; // work around unused variable warnings ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\'' || dynamic_array[ni.number - 1] != 543); ' # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals=' /* Does the compiler advertise C11 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif // Check _Alignas. char _Alignas (double) aligned_as_double; char _Alignas (0) no_special_alignment; extern char aligned_as_int; char _Alignas (0) _Alignas (int) aligned_as_int; // Check _Alignof. enum { int_alignment = _Alignof (int), int_array_alignment = _Alignof (int[100]), char_alignment = _Alignof (char) }; _Static_assert (0 < -_Alignof (int), "_Alignof is signed"); // Check _Noreturn. int _Noreturn does_not_return (void) { for (;;) continue; } // Check _Static_assert. struct test_static_assert { int x; _Static_assert (sizeof (int) <= sizeof (long int), "_Static_assert does not work in struct"); long int y; }; // Check UTF-8 literals. #define u8 syntax error! char const utf8_literal[] = u8"happens to be ASCII" "another string"; // Check duplicate typedefs. typedef long *long_ptr; typedef long int *long_ptr; typedef long_ptr long_ptr; // Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1. struct anonymous { union { struct { int i; int j; }; struct { int k; long int l; } w; }; int m; } v1; ' # Test code for whether the C compiler supports C11 (body of main). ac_c_conftest_c11_main=' _Static_assert ((offsetof (struct anonymous, i) == offsetof (struct anonymous, w.k)), "Anonymous union alignment botch"); v1.i = 2; v1.w.k = 5; ok |= v1.i != 5; ' # Test code for whether the C compiler supports C11 (complete). ac_c_conftest_c11_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} ${ac_c_conftest_c11_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} ${ac_c_conftest_c11_main} return ok; } " # Test code for whether the C compiler supports C99 (complete). ac_c_conftest_c99_program="${ac_c_conftest_c89_globals} ${ac_c_conftest_c99_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} ${ac_c_conftest_c99_main} return ok; } " # Test code for whether the C compiler supports C89 (complete). ac_c_conftest_c89_program="${ac_c_conftest_c89_globals} int main (int argc, char **argv) { int ok = 0; ${ac_c_conftest_c89_main} return ok; } " as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H" as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H" as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H" as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H" as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H" as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H" as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H" as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H" as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H" # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5 printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5 printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5 printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5 printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: former value: '$ac_old_val'" >&5 printf "%s\n" "$as_me: former value: '$ac_old_val'" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: current value: '$ac_new_val'" >&5 printf "%s\n" "$as_me: current value: '$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu : ${R_HOME=`R RHOME`} if test -z "${R_HOME}"; then echo "could not determine R_HOME" exit 1 fi RBIN="${R_HOME}/bin/R" # https://github.com/r-spatial/sf/issues/1054: # RVER=`"${RBIN}" --version | head -1 | cut -f3 -d" "` RSCRIPT="${R_HOME}/bin/Rscript" RVER=`"${RSCRIPT}" -e 'writeLines(paste(sep=".", base::version$major, base::version$minor))'` RVER_MAJOR=`echo ${RVER} | cut -f1 -d"."` RVER_MINOR=`echo ${RVER} | cut -f2 -d"."` RVER_PATCH=`echo ${RVER} | cut -f3 -d"."` #if test [$RVER_MAJOR = "development"]; then CXX=`"${RBIN}" CMD config CXX` #else # if test [$RVER_MAJOR -lt 3] -o [$RVER_MAJOR -eq 3 -a $RVER_MINOR -lt 3]; then # AC_MSG_ERROR([terra is not compatible with R versions before 3.3.0]) # else # CXX=`"${RBIN}" CMD config CXX` # fi #fi # pick all flags for testing from R : ${CC=`"${RBIN}" CMD config CC`} : ${CFLAGS=`"${RBIN}" CMD config CFLAGS`} : ${CPPFLAGS=`"${RBIN}" CMD config CPPFLAGS`} : ${CXXFLAGS=`"${RBIN}" CMD config CXXFLAGS`} : ${LDFLAGS=`"${RBIN}" CMD config LDFLAGS`} # AC_SUBST([CC],["clang"]) # AC_SUBST([CXX],["clang++"]) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: CC: ${CC}" >&5 printf "%s\n" "$as_me: CC: ${CC}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: CXX: ${CXX}" >&5 printf "%s\n" "$as_me: CXX: ${CXX}" >&6;} # AC_MSG_NOTICE([${PACKAGE_NAME}: ${PACKAGE_VERSION}]) GENERIC_INSTALL_MESSAGE=" *** Installing this package from source requires the prior *** installation of external software, see for details *** https://rspatial.github.io/terra/" #GDAL GDAL_CONFIG="gdal-config" GDAL_CONFIG_SET="no" # Check whether --with-gdal-config was given. if test ${with_gdal_config+y} then : withval=$with_gdal_config; gdal_config=$withval fi if test -n "$gdal_config" ; then GDAL_CONFIG_SET="yes" GDAL_CONFIG="${gdal_config}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: gdal-config set to $GDAL_CONFIG" >&5 printf "%s\n" "$as_me: gdal-config set to $GDAL_CONFIG" >&6;} fi if test "$GDAL_CONFIG_SET" = "no" ; then # Extract the first word of ""$GDAL_CONFIG"", so it can be a program name with args. set dummy "$GDAL_CONFIG"; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_path_GDAL_CONFIG+y} then : printf %s "(cached) " >&6 else case e in #( e) case $GDAL_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_GDAL_CONFIG="$GDAL_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_path_GDAL_CONFIG="$as_dir$ac_word$ac_exec_ext" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_path_GDAL_CONFIG" && ac_cv_path_GDAL_CONFIG=""no"" ;; esac ;; esac fi GDAL_CONFIG=$ac_cv_path_GDAL_CONFIG if test -n "$GDAL_CONFIG"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $GDAL_CONFIG" >&5 printf "%s\n" "$GDAL_CONFIG" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "$GDAL_CONFIG" = "no" ; then as_fn_error $? "gdal-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking gdal-config exists" >&5 printf %s "checking gdal-config exists... " >&6; } if test -r "${GDAL_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else as_fn_error $? "gdal-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking gdal-config executable" >&5 printf %s "checking gdal-config executable... " >&6; } if test -x "${GDAL_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else as_fn_error $? "gdal-config not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking gdal-config usability" >&5 printf %s "checking gdal-config usability... " >&6; } if test `${GDAL_CONFIG} --version`; then GDAL_CPPFLAGS=`${GDAL_CONFIG} --cflags` GDAL_VERSION=`${GDAL_CONFIG} --version` GDAL_LIBS=`${GDAL_CONFIG} --libs` GDAL_DEP_LIBS=`${GDAL_CONFIG} --dep-libs` GDAL_DATADIR=`${GDAL_CONFIG} --datadir` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else as_fn_error $? "gdal-config not found. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GDAL: ${GDAL_VERSION}" >&5 printf "%s\n" "$as_me: GDAL: ${GDAL_VERSION}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL version >= 2.0.1" >&5 printf %s "checking GDAL version >= 2.0.1... " >&6; } GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MIN_VER=`echo $GDAL_VERSION | cut -d "." -f2` GDAL_PATCH_VER=`echo $GDAL_VERSION | cut -d "." -f3` if test ${GDAL_MAJ_VER} -lt 2 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "terra is not compatible with GDAL versions below 2.0.1" "$LINENO" 5 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi #if test [${GDAL_MAJ_VER} -eq 3] -a [${GDAL_MIN_VER} -eq 6] -a [${GDAL_PATCH_VER} -eq 0] ; then if test "${GDAL_VERSION}" = "3.6.0" ; then as_fn_error $? "GDAL version 3.6.0 has been withdrawn, please update GDAL" "$LINENO" 5 fi INLIBS="${LIBS}" INCPPFLAGS="${CPPFLAGS}" INPKG_CPPFLAGS="${PKG_CPPFLAGS}" INPKG_LIBS="${PKG_LIBS}" PKG_CPPFLAGS="${INPKG_CPPFLAGS} ${GDAL_CPPFLAGS}" PKG_LIBS="${INPKG_LIBS} ${GDAL_LIBS}" # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS}" gdalok=yes ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@" fi fi fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args. set dummy ${ac_tool_prefix}clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 printf "%s\n" "$CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "clang", so it can be a program name with args. set dummy clang; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_prog_ac_ct_CC+y} then : printf %s "(cached) " >&6 else case e in #( e) if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="clang" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi ;; esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 printf "%s\n" "$ac_ct_CC" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi fi test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH See 'config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 set X $ac_compile ac_compiler=$2 for ac_option in --version -v -V -qversion -version; do { { ac_try="$ac_compiler $ac_option >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? if test -s conftest.err; then sed '10a\ ... rest of stderr output deleted ... 10q' conftest.err >conftest.er1 cat conftest.er1 >&5 fi rm -f conftest.er1 conftest.err printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 printf %s "checking whether the C compiler works... " >&6; } ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # The possible output files: ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { { ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link_default") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'. # So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an '-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else case e in #( e) ac_file='' ;; esac fi if test -z "$ac_file" then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables See 'config.log' for more details" "$LINENO" 5; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; } { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 printf "%s\n" "$ac_file" >&6; } ac_exeext=$ac_cv_exeext rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 printf %s "checking for suffix of executables... " >&6; } if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : # If both 'conftest.exe' and 'conftest' are 'present' (well, observable) # catch 'conftest.exe'. For instance with Cygwin, 'ls conftest' will # work properly (i.e., refer to 'conftest.exe'), while it won't with # 'rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else case e in #( e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link See 'config.log' for more details" "$LINENO" 5; } ;; esac fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 printf "%s\n" "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int main (void) { FILE *f = fopen ("conftest.out", "w"); if (!f) return 1; return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF ac_clean_files="$ac_clean_files conftest.out" # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 printf %s "checking whether we are cross compiling... " >&6; } if test "$cross_compiling" != yes; then { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } if { ac_try='./conftest$ac_cv_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs. If you meant to cross compile, use '--host'. See 'config.log' for more details" "$LINENO" 5; } fi fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } rm -f conftest.$ac_ext conftest$ac_cv_exeext \ conftest.o conftest.obj conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" printf "%s\n" "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>&5 ac_status=$? printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } then : for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else case e in #( e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5 printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile See 'config.log' for more details" "$LINENO" 5; } ;; esac fi rm -f conftest.$ac_cv_objext conftest.$ac_ext ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5 printf %s "checking whether the compiler supports GNU C... " >&6; } if test ${ac_cv_c_compiler_gnu+y} then : printf %s "(cached) " >&6 else case e in #( e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_compiler_gnu=yes else case e in #( e) ac_compiler_gnu=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; } ac_compiler_gnu=$ac_cv_c_compiler_gnu if test $ac_compiler_gnu = yes; then GCC=yes else GCC= fi ac_test_CFLAGS=${CFLAGS+y} ac_save_CFLAGS=$CFLAGS { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 printf %s "checking whether $CC accepts -g... " >&6; } if test ${ac_cv_prog_cc_g+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes else case e in #( e) CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : else case e in #( e) ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_g=yes fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; } if test $ac_test_CFLAGS; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi ac_prog_cc_stdc=no if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5 printf %s "checking for $CC option to enable C11 features... " >&6; } if test ${ac_cv_prog_cc_c11+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c11_program _ACEOF for ac_arg in '' -std=gnu11 do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c11=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC ;; esac fi if test "x$ac_cv_prog_cc_c11" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else case e in #( e) if test "x$ac_cv_prog_cc_c11" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; } CC="$CC $ac_cv_prog_cc_c11" ;; esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11 ac_prog_cc_stdc=c11 ;; esac fi fi if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5 printf %s "checking for $CC option to enable C99 features... " >&6; } if test ${ac_cv_prog_cc_c99+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c99_program _ACEOF for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99= do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c99=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC ;; esac fi if test "x$ac_cv_prog_cc_c99" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else case e in #( e) if test "x$ac_cv_prog_cc_c99" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; } CC="$CC $ac_cv_prog_cc_c99" ;; esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 ac_prog_cc_stdc=c99 ;; esac fi fi if test x$ac_prog_cc_stdc = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5 printf %s "checking for $CC option to enable C89 features... " >&6; } if test ${ac_cv_prog_cc_c89+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_c_conftest_c89_program _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO" then : ac_cv_prog_cc_c89=$ac_arg fi rm -f core conftest.err conftest.$ac_objext conftest.beam test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC ;; esac fi if test "x$ac_cv_prog_cc_c89" = xno then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; } else case e in #( e) if test "x$ac_cv_prog_cc_c89" = x then : { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; } else case e in #( e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; } CC="$CC $ac_cv_prog_cc_c89" ;; esac fi ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 ac_prog_cc_stdc=c89 ;; esac fi fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_header= ac_cache= for ac_item in $ac_header_c_list do if test $ac_cache; then ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default" if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then printf "%s\n" "#define $ac_item 1" >> confdefs.h fi ac_header= ac_cache= elif test $ac_header; then ac_cache=$ac_item else ac_header=$ac_item fi done if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes then : printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h fi for ac_header in gdal.h do : ac_fn_c_check_header_compile "$LINENO" "gdal.h" "ac_cv_header_gdal_h" "$ac_includes_default" if test "x$ac_cv_header_gdal_h" = xyes then : printf "%s\n" "#define HAVE_GDAL_H 1" >>confdefs.h else case e in #( e) gdalok=no ;; esac fi done if test "${gdalok}" = no; then as_fn_error $? "gdal.h not found in given locations.. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi NEED_DEPS=no LIBS="${INLIBS} ${PKG_LIBS}" cat > gdal_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif int main(void) { GDALAllRegister(); } #ifdef __cplusplus } #endif _EOCONF { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: linking with --libs only" >&5 printf %s "checking GDAL: linking with --libs only... " >&6; } ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdalok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${gdalok}" = no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: linking with --libs and --dep-libs" >&5 printf %s "checking GDAL: linking with --libs and --dep-libs... " >&6; } LIBS="${LIBS} ${GDAL_DEP_LIBS}" gdalok=yes ${CXX} ${CPPFLAGS} -o gdal_test gdal_test.cpp ${LIBS} 2>> errors.txt if test `echo $?` -ne 0 ; then gdalok=no fi if test "${gdalok}" = yes; then NEED_DEPS=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi fi if test "${gdalok}" = no; then cat errors.txt { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Install failure: compilation and/or linkage problems." >&5 printf "%s\n" "$as_me: Install failure: compilation and/or linkage problems." >&6;} as_fn_error $? "GDALAllRegister not found in libgdal. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi rm -f gdal_test errors.txt gdal_test.cpp GDAL_GE_250="no" GDAL_MAJ_VER=`echo $GDAL_VERSION | cut -d "." -f1` GDAL_MOD_VER=`echo $GDAL_VERSION | cut -d "." -f2` if test "${GDAL_MAJ_VER}" = 2 ; then if test "${GDAL_MOD_VER}" -ge 5 ; then GDAL_GE_250="yes" fi else if test "${GDAL_MAJ_VER}" -ge 3 ; then GDAL_GE_250="yes" fi fi GDAL_DATA_TEST_FILE="${GDAL_DATADIR}/pcs.csv" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: ${GDAL_DATADIR}/pcs.csv readable" >&5 printf %s "checking GDAL: ${GDAL_DATADIR}/pcs.csv readable... " >&6; } if test -r "${GDAL_DATA_TEST_FILE}" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } if test "${GDAL_GE_250}" = "no" ; then as_fn_error $? "pcs.csv not found in GDAL data directory. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi fi # Optional local copy of GDAL datadir and PROJ_LIB data_copy=no if test "${PROJ_GDAL_DATA_COPY}" ; then data_copy=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ_GDAL_DATA_COPY used." >&5 printf "%s\n" "$as_me: PROJ_GDAL_DATA_COPY used." >&6;} else # Check whether --with-data-copy was given. if test ${with_data_copy+y} then : withval=$with_data_copy; data_copy=$withval fi fi if test "${data_copy}" = "yes" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Copy data for:" >&5 printf "%s\n" "$as_me: Copy data for:" >&6;} proj_lib0="${PROJ_LIB}" # Check whether --with-proj-data was given. if test ${with_proj_data+y} then : withval=$with_proj_data; proj_lib1=$withval fi if test -n "${proj_lib0}" ; then proj_lib="${proj_lib0}" else proj_lib="${proj_lib1}" fi if test -n "${proj_lib}" ; then if test -d "${proj_lib}" ; then cp -r "${proj_lib}" "${R_PACKAGE_DIR}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ: ${proj_lib}" >&5 printf "%s\n" "$as_me: PROJ: ${proj_lib}" >&6;} else as_fn_error $? "PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR." "$LINENO" 5 fi else as_fn_error $? "PROJ data files not found; set environment variable PROJ_LIB=DIR or --with-proj-data=DIR." "$LINENO" 5 fi if test -d "${GDAL_DATADIR}" ; then cp -r "${GDAL_DATADIR}" "${R_PACKAGE_DIR}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GDAL: ${GDAL_DATADIR}" >&5 printf "%s\n" "$as_me: GDAL: ${GDAL_DATADIR}" >&6;} else as_fn_error $? "GDAL data files not found." "$LINENO" 5 fi fi # # test whether PROJ is available to gdal: # gdal_has_proj=no cat > gdal_proj.cpp <<_EOCONF #include #include #include int main(int argc, char *argv[]) { OGRSpatialReference *dest = new OGRSpatialReference; OGRSpatialReference *src = new OGRSpatialReference; src->importFromEPSG(4326); dest->importFromEPSG(3857); OGRCoordinateTransformation *ct = OGRCreateCoordinateTransformation(src, dest); return(ct == NULL); // signals PROJ is not available through gdal } _EOCONF { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: checking whether PROJ is available for linking:" >&5 printf %s "checking GDAL: checking whether PROJ is available for linking:... " >&6; } ${CXX} ${CPPFLAGS} -o gdal_proj gdal_proj.cpp ${LIBS} 2> errors.txt if test `echo $?` -ne 0 ; then gdal_has_proj=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else gdal_has_proj=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${gdal_has_proj}" = no; then cat errors.txt { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Install failure: compilation and/or linkage problems." >&5 printf "%s\n" "$as_me: Install failure: compilation and/or linkage problems." >&6;} as_fn_error $? "cannot link projection code. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GDAL: checking whether PROJ is available for running:" >&5 printf %s "checking GDAL: checking whether PROJ is available for running:... " >&6; } if test "x$cross_compiling" = "xyes"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: cross compiling" >&5 printf "%s\n" "cross compiling" >&6; } else ./gdal_proj if test `echo $?` -ne 0 ; then gdal_has_proj=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else gdal_has_proj=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${gdal_has_proj}" = no; then as_fn_error $? "OGRCoordinateTransformation() does not return a coord.trans: PROJ not available? ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi fi rm -fr errors.txt gdal_proj.cpp gdal_proj { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GDAL: ${GDAL_VERSION}" >&5 printf "%s\n" "$as_me: GDAL: ${GDAL_VERSION}" >&6;} # sqlite3 # Check whether --with-sqlite3-lib was given. if test ${with_sqlite3_lib+y} then : withval=$with_sqlite3_lib; sqlite3_lib_path=$withval fi if test -n "$sqlite3_lib_path" ; then SQLITE3_LIBS="-L${sqlite3_lib_path}" fi # # PROJ # PROJ_CONFIG="pkg-config proj" if `$PROJ_CONFIG --exists` ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: pkg-config proj exists, will use it" >&5 printf "%s\n" "$as_me: pkg-config proj exists, will use it" >&6;} proj_config_ok=yes else proj_config_ok=no fi # Check whether --with-proj-include was given. if test ${with_proj_include+y} then : withval=$with_proj_include; proj_include_path=$withval fi if test -n "$proj_include_path" ; then PROJ_CPPFLAGS="-I${proj_include_path}" else if test "${proj_config_ok}" = yes; then PROJ_INCLUDE_PATH=`${PROJ_CONFIG} --cflags` PROJ_CPPFLAGS="${PROJ_INCLUDE_PATH}" fi fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt # Check whether --with-proj-api was given. if test ${with_proj_api+y} then : withval=$with_proj_api; proj_api=$withval fi PROJ6="no" PROJH="no" if test "${proj_config_ok}" = yes; then PROJ_VERSION=`${PROJ_CONFIG} --modversion` PROJV1=`echo "${PROJ_VERSION}" | cut -c 1` if test "${PROJV1}" -ge 6; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" if test "${proj_api}" = yes; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: using proj_api.h even with PROJ 5/6" >&5 printf "%s\n" "$as_me: using proj_api.h even with PROJ 5/6" >&6;} PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DACCEPT_USE_OF_DEPRECATED_PROJ_API_H" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: using proj.h." >&5 printf "%s\n" "$as_me: using proj.h." >&6;} PROJH="yes" fi fi else if test "${PROJH}" = no ; then PROJH=yes for ac_header in proj.h do : ac_fn_c_check_header_compile "$LINENO" "proj.h" "ac_cv_header_proj_h" "$ac_includes_default" if test "x$ac_cv_header_proj_h" = xyes then : printf "%s\n" "#define HAVE_PROJ_H 1" >>confdefs.h else case e in #( e) PROJH=no ;; esac fi done if test "${PROJH}" = yes; then PROJ6="yes" PROJ_CPPFLAGS="${PROJ_CPPFLAGS} -DHAVE_PROJ_H" fi fi fi CPPFLAGS="${INCPPFLAGS} ${PKG_CPPFLAGS} ${PROJ_CPPFLAGS}" if test "${PROJH}" = no then proj4ok=yes for ac_header in proj_api.h do : ac_fn_c_check_header_compile "$LINENO" "proj_api.h" "ac_cv_header_proj_api_h" "$ac_includes_default" if test "x$ac_cv_header_proj_api_h" = xyes then : printf "%s\n" "#define HAVE_PROJ_API_H 1" >>confdefs.h else case e in #( e) proj4ok=no ;; esac fi done if test "${proj4ok}" = no; then as_fn_error $? "proj_api.h not found in standard or given locations." "$LINENO" 5 fi fi # dnl ditto for a library path # Check whether --with-proj-lib was given. if test ${with_proj_lib+y} then : withval=$with_proj_lib; proj_lib_path=$withval fi if test -n "$proj_lib_path" ; then PROJ_LIBS="-L${proj_lib_path} ${INPKG_LIBS} -lproj" else if test "${proj_config_ok}" = yes; then if test `uname` = "Darwin"; then PROJ_LIB_PATH=`${PROJ_CONFIG} --libs --static` else PROJ_LIB_PATH=`${PROJ_CONFIG} --libs` fi PROJ_LIBS="${PROJ_LIB_PATH} ${INPKG_LIBS}" proj_version=`${PROJ_CONFIG} --modversion` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ: ${proj_version}" >&5 printf "%s\n" "$as_me: PROJ: ${proj_version}" >&6;} else PROJ_LIBS="${PKG_LIBS} -lproj" fi fi LIBS="${PROJ_LIBS} ${INLIBS} ${PKG_LIBS}" if test "${PROJH}" = no; then proj4ok=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for pj_init_plus in -lproj" >&5 printf %s "checking for pj_init_plus in -lproj... " >&6; } if test ${ac_cv_lib_proj_pj_init_plus+y} then : printf %s "(cached) " >&6 else case e in #( e) ac_check_lib_save_LIBS=$LIBS LIBS="-lproj $LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. The 'extern "C"' is for builds by C++ compilers; although this is not generally supported in C code supporting it here has little cost and some practical benefit (sr 110532). */ #ifdef __cplusplus extern "C" #endif char pj_init_plus (void); int main (void) { return pj_init_plus (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO" then : ac_cv_lib_proj_pj_init_plus=yes else case e in #( e) ac_cv_lib_proj_pj_init_plus=no ;; esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext LIBS=$ac_check_lib_save_LIBS ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_proj_pj_init_plus" >&5 printf "%s\n" "$ac_cv_lib_proj_pj_init_plus" >&6; } if test "x$ac_cv_lib_proj_pj_init_plus" = xyes then : printf "%s\n" "#define HAVE_LIBPROJ 1" >>confdefs.h LIBS="-lproj $LIBS" else case e in #( e) proj4ok=no ;; esac fi if test "${proj4ok}" = no; then as_fn_error $? "libproj not found in standard or given locations." "$LINENO" 5 fi cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d\n", PJ_VERSION); exit(0); } _EOCONF else cat > proj_conf_test.cpp <<_EOCONF #include #include #include int main(void) { proj_context_create(); exit(0); } _EOCONF #AC_CHECK_LIB(proj,proj_context_create,,proj6ok=no) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: checking whether PROJ and sqlite3 are available for linking:" >&5 printf %s "checking PROJ: checking whether PROJ and sqlite3 are available for linking:... " >&6; } ${CXX} ${CPPFLAGS} -o proj_conf_test proj_conf_test.cpp ${LIBS} $SQLITE3_LIBS -lsqlite3 2> errors.txt if test `echo $?` -ne 0 ; then proj6ok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else proj6ok=yes { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${proj6ok}" = no; then as_fn_error $? "libproj or sqlite3 not found in standard or given locations." "$LINENO" 5 fi cat > proj_conf_test.c <<_EOCONF #include #include #include int main(void) { printf("%d.%d.%d\n", PROJ_VERSION_MAJOR, PROJ_VERSION_MINOR, PROJ_VERSION_PATCH); exit(0); } _EOCONF fi #AC_MSG_NOTICE([PKG_LIBS: ${PKG_LIBS}]) ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} proj_version=`./proj_conf_test` # Check whether --with-proj-share was given. if test ${with_proj_share+y} then : withval=$with_proj_share; proj_share_path=$withval fi if test -n "$proj_share_path" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: PROJ_LIB: ${proj_share_path}" >&5 printf "%s\n" "$as_me: PROJ_LIB: ${proj_share_path}" >&6;} fi if test ${PROJ6} = "no"; then cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "epsg", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test -n "$proj_share_path" ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: epsg found and readable" >&5 printf %s "checking PROJ: epsg found and readable... " >&6; } if test ${proj_share} -eq 1 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } STOP="stop" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/epsg not found" echo "Either install missing proj support files, for example" echo "the proj-nad and proj-epsg RPMs on systems using RPMs," echo "or if installed but not autodetected, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi else # proj >= 6 if test "${PROJH}" = no; then cat > proj_conf_test.c <<_EOCONF #include #include int main(void) { PAFile fp; projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "proj.db", "rb"); if (fp == NULL) exit(1); pj_ctx_fclose(ctx, fp); exit(0); } _EOCONF ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test -n "$proj_share_path" ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: proj.db found and readable" >&5 printf %s "checking PROJ: proj.db found and readable... " >&6; } if test ${proj_share} -eq 1 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } STOP="stop" else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi rm -f proj_conf_test.c proj_conf_test if test "$STOP" = "stop" ; then echo "Error: proj/proj.db not found" echo "Either install missing proj support files, set PROJ_LIB to the" echo "correct path, and if need be use the --with-proj-share=" echo "configure argument." exit 1 fi cat > proj_conf_test.c <<_EOCONF #include #include #if PJ_VERSION <= 480 FILE *pj_open_lib(projCtx, const char *, const char *); #endif int main(void) { #if PJ_VERSION <= 480 FILE *fp; #else PAFile fp; #endif projCtx ctx; ctx = pj_get_default_ctx(); fp = pj_open_lib(ctx, "conus", "rb"); if (fp == NULL) exit(1); #if PJ_VERSION <= 480 fclose(fp); #else pj_ctx_fclose(ctx, fp); #endif exit(0); } _EOCONF ${CC} ${CFLAGS} ${CPPFLAGS} -o proj_conf_test proj_conf_test.c ${PROJ_LIBS} if test -n "$proj_share_path" ; then PROJ_LIB="${proj_share_path}" ./proj_conf_test proj_share=`echo $?` else ./proj_conf_test proj_share=`echo $?` fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking PROJ: conus found and readable" >&5 printf %s "checking PROJ: conus found and readable... " >&6; } if test ${proj_share} -eq 1 ; then WARN="warn" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi rm -f proj_conf_test.c proj_conf_test if test "$WARN" = "warn" ; then echo "Note: proj/conus not found" echo "No support available in PROJ4 for NAD grid datum transformations" echo "If required, consider re-installing from source with the contents" echo "of proj-datumgrid-1..zip from http://download.osgeo.org/proj/ in nad/." fi fi # PROJH = no fi # proj >= 6 # # GEOS: # GEOS_CONFIG="geos-config" GEOS_CONFIG_SET="no" # Check whether --with-geos-config was given. if test ${with_geos_config+y} then : withval=$with_geos_config; geos_config=$withval fi if test -n "$geos_config" ; then GEOS_CONFIG_SET="yes" GEOS_CONFIG="${geos_config}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: geos-config set to $GEOS_CONFIG" >&5 printf "%s\n" "$as_me: geos-config set to $GEOS_CONFIG" >&6;} fi if test "$GEOS_CONFIG_SET" = "no" ; then # Extract the first word of ""$GEOS_CONFIG"", so it can be a program name with args. set dummy "$GEOS_CONFIG"; ac_word=$2 { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 printf %s "checking for $ac_word... " >&6; } if test ${ac_cv_path_GEOS_CONFIG+y} then : printf %s "(cached) " >&6 else case e in #( e) case $GEOS_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_GEOS_CONFIG="$GEOS_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then ac_cv_path_GEOS_CONFIG="$as_dir$ac_word$ac_exec_ext" printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_path_GEOS_CONFIG" && ac_cv_path_GEOS_CONFIG=""no"" ;; esac ;; esac fi GEOS_CONFIG=$ac_cv_path_GEOS_CONFIG if test -n "$GEOS_CONFIG"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $GEOS_CONFIG" >&5 printf "%s\n" "$GEOS_CONFIG" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } fi if test "$GEOS_CONFIG" = "no" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "geos-config not found or not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos-config exists" >&5 printf %s "checking geos-config exists... " >&6; } if test -r "${GEOS_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "geos-config not found - configure argument error. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos-config executable" >&5 printf %s "checking geos-config executable... " >&6; } if test -x "${GEOS_CONFIG}"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "geos-config not executable. ${GENERIC_INSTALL_MESSAGE}" "$LINENO" 5 fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos-config usability" >&5 printf %s "checking geos-config usability... " >&6; } if test `${GEOS_CONFIG} --version` then GEOS_CLIBS="`${GEOS_CONFIG} --clibs`" #GEOS_DEP_CLIBS=`geos-config --static-clibs` -- this gives -m instead of -lm, which breaks clang # fixed in 3.7.0 at https://github.com/libgeos/libgeos/pull/73#issuecomment-262208677 GEOS_DEP_CLIBS=`${GEOS_CONFIG} --static-clibs | sed 's/-m/-lm/g'` GEOS_CPPFLAGS=`${GEOS_CONFIG} --cflags` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "${GEOS_CONFIG} not usable" "$LINENO" 5 fi GEOS_VERSION=`${GEOS_CONFIG} --version` { printf "%s\n" "$as_me:${as_lineno-$LINENO}: GEOS: ${GEOS_VERSION}" >&5 printf "%s\n" "$as_me: GEOS: ${GEOS_VERSION}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GEOS version >= 3.4.0" >&5 printf %s "checking GEOS version >= 3.4.0... " >&6; } # GDAL 2.0.1 requires GEOS 3.1.0 GEOS_VER_DOT=`echo $GEOS_VERSION | tr -d ".[:alpha:]"` if test ${GEOS_VER_DOT} -lt 340 ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } as_fn_error $? "upgrade GEOS to 3.4.0 or later" "$LINENO" 5 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi PKG_CPPFLAGS="${INPKG_CPPFLAGS} ${PROJ_CPPFLAGS} ${GDAL_CPPFLAGS} ${GEOS_CPPFLAGS}" PKG_LIBS="${INPKG_LIBS} ${GDAL_LIBS}" if test "${NEED_DEPS}" = yes; then PKG_LIBS="${PKG_LIBS} ${GDAL_DEP_LIBS}" fi # honor PKG_xx overrides # for CPPFLAGS we will superfluously double R's flags # since we'll set PKG_CPPFLAGS with this, but that shouldn't hurt CPPFLAGS="${CPPFLAGS} ${PKG_CPPFLAGS}" LIBS="${LIBS} ${PKG_LIBS}" geosok=yes for ac_header in geos_c.h do : ac_fn_c_check_header_compile "$LINENO" "geos_c.h" "ac_cv_header_geos_c_h" "$ac_includes_default" if test "x$ac_cv_header_geos_c_h" = xyes then : printf "%s\n" "#define HAVE_GEOS_C_H 1" >>confdefs.h else case e in #( e) geosok=no ;; esac fi done if test "${geosok}" = no; then as_fn_error $? "geos_c.h not found in given locations." "$LINENO" 5 fi cat > geos_test.cpp <<_EOCONF #include #ifdef __cplusplus extern "C" { #endif static void __errorHandler(const char *fmt, ...) { return; } static void __warningHandler(const char *fmt, ...) { return; } int main(void) { GEOSContextHandle_t r = initGEOS_r((GEOSMessageHandler) __warningHandler, (GEOSMessageHandler) __errorHandler); finishGEOS_r(r); } #ifdef __cplusplus } #endif _EOCONF #echo "${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${LIBS}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos: linking with ${GEOS_CLIBS}" >&5 printf %s "checking geos: linking with ${GEOS_CLIBS}... " >&6; } ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } else PKG_LIBS="${PKG_LIBS} ${GEOS_CLIBS}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi if test "${geosok}" = no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking geos: linking with ${GEOS_DEP_CLIBS}" >&5 printf %s "checking geos: linking with ${GEOS_DEP_CLIBS}... " >&6; } ${CXX} ${CPPFLAGS} -o geos_test geos_test.cpp ${GEOS_DEP_CLIBS} 2> errors.txt if test `echo $?` -ne 0 ; then geosok=no { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5 printf "%s\n" "no" >&6; } cat errors.txt { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Install failure: compilation and/or linkage problems." >&5 printf "%s\n" "$as_me: Install failure: compilation and/or linkage problems." >&6;} as_fn_error $? "initGEOS_r not found in libgeos_c." "$LINENO" 5 else PKG_LIBS="${PKG_LIBS} ${GEOS_DEP_CLIBS}" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5 printf "%s\n" "yes" >&6; } fi fi rm -f geos_test errors.txt geos_test.cpp # # add PROJ_LIBS # PKG_LIBS="${PROJ_LIBS} ${PKG_LIBS}" # # concluding substitution # { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Package CPP flags: ${PKG_CPPFLAGS}" >&5 printf "%s\n" "$as_me: Package CPP flags: ${PKG_CPPFLAGS}" >&6;} { printf "%s\n" "$as_me:${as_lineno-$LINENO}: Package LIBS: ${PKG_LIBS}" >&5 printf "%s\n" "$as_me: Package LIBS: ${PKG_LIBS}" >&6;} ac_config_files="$ac_config_files src/Makevars" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # 'ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* 'ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # 'set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # 'set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then if test "x$cache_file" != "x/dev/null"; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 printf "%s\n" "$as_me: updating cache $cache_file" >&6;} if test ! -f "$cache_file" || test -h "$cache_file"; then cat confcache >"$cache_file" else case $cache_file in #( */* | ?:*) mv -f confcache "$cache_file"$$ && mv -f "$cache_file"$$ "$cache_file" ;; #( *) mv -f confcache "$cache_file" ;; esac fi fi else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. ac_script=' :mline /\\$/{ N s,\\\n,, b mline } t clear :clear s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote s/[][ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\$/$$/g H :any ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} export SHELL _ASEOF cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case e in #( e) case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac ;; esac fi # Reset variables that may have inherited troublesome values from # the environment. # IFS needs to be set, to space, tab, and newline, in precisely that order. # (If _AS_PATH_WALK were called with IFS unset, it would have the # side effect of setting IFS to empty, thus disabling word splitting.) # Quoting is to prevent editors from complaining about space-tab. as_nl=' ' export as_nl IFS=" "" $as_nl" PS1='$ ' PS2='> ' PS4='+ ' # Ensure predictable behavior from utilities with locale-dependent output. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # We cannot yet rely on "unset" to work, but we need these variables # to be unset--not just set to an empty or harmless value--now, to # avoid bugs in old shells (e.g. pre-3.0 UWIN ksh). This construct # also avoids known problems related to "unset" and subshell syntax # in other old shells (e.g. bash 2.01 and pdksh 5.2.14). for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH do eval test \${$as_var+y} \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done # Ensure that fds 0, 1, and 2 are open. if (exec 3>&0) 2>/dev/null; then :; else exec 0&1) 2>/dev/null; then :; else exec 1>/dev/null; fi if (exec 3>&2) ; then :; else exec 2>/dev/null; fi # The user is always right. if ${PATH_SEPARATOR+false} :; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS case $as_dir in #((( '') as_dir=./ ;; */) ;; *) as_dir=$as_dir/ ;; esac test -r "$as_dir$0" && as_myself=$as_dir$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi printf "%s\n" "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null then : eval 'as_fn_append () { eval $1+=\$2 }' else case e in #( e) as_fn_append () { eval $1=\$$1\$2 } ;; esac fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null then : eval 'as_fn_arith () { as_val=$(( $* )) }' else case e in #( e) as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } ;; esac fi # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # Determine whether it's possible to make 'echo' print without a newline. # These variables are no longer used directly by Autoconf, but are AC_SUBSTed # for compatibility with existing Makefiles. ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac # For backward compatibility with old third-party macros, we provide # the shell variables $as_echo and $as_echo_n. New code should use # AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively. as_echo='printf %s\n' as_echo_n='printf %s' rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable. # In both cases, we have to default to 'cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g" as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated # Sed expression to map a string onto a valid variable name. as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g" as_tr_sh="eval sed '$as_sed_sh'" # deprecated exec 6>&1 ## ----------------------------------- ## ## Main body of $CONFIG_STATUS script. ## ## ----------------------------------- ## _ASEOF test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by $as_me, which was generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF case $ac_config_files in *" "*) set x $ac_config_files; shift; ac_config_files=$*;; esac cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ '$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit --config print configuration, then exit -q, --quiet, --silent do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to the package provider." _ACEOF ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"` ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"` cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ config.status configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" Copyright (C) 2023 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; --*=) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg= ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) printf "%s\n" "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) printf "%s\n" "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) printf "%s\n" "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error $? "unrecognized option: '$1' Try '$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX printf "%s\n" "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "src/Makevars") CONFIG_FILES="$CONFIG_FILES src/Makevars" ;; *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test ${CONFIG_FILES+y} || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to '$tmp'. $debug || { tmp= ac_tmp= trap 'exit_status=$? : "${ac_tmp:=$tmp}" { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. # This happens for instance with './config.status config.h'. if test -n "$CONFIG_FILES"; then ac_cr=`echo X | tr X '\015'` # On cygwin, bash can eat \r inside `` if the user requested igncr. # But we know of no other shell where ac_cr would be empty at this # point, so we can use a bashism as a fallback. if test "x$ac_cr" = x; then eval ac_cr=\$\'\\r\' fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF { echo "cat >conf$$subs.awk <<_ACEOF" && echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl t repl s/'"$ac_delim"'$// t delim :nl h s/\(.\{148\}\)..*/\1/ t more1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b repl :more1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\)..*/\1/ t more2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :more2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim ' >$CONFIG_STATUS || ac_write_fail=1 rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" } { line = $ 0 nfields = split(line, field, "@") substed = 0 len = length(field[1]) for (i = 2; i < nfields; i++) { key = field[i] keylen = length(key) if (S_is_set[key]) { value = S[key] line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) len += length(value) + length(field[++i]) substed = 1 } else len += 1 + keylen } print line } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF # VPATH may cause trouble with some makes, so we remove sole $(srcdir), # ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ h s/// s/^/:/ s/[ ]*$/:/ s/:\$(srcdir):/:/g s/:\${srcdir}:/:/g s/:@srcdir@:/:/g s/^:*// s/:*$// x s/\(=[ ]*\).*/\1/ G s/\n// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" eval set X " :F $CONFIG_FILES " shift for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain ':'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is 'configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 printf "%s\n" "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`printf "%s\n" "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$ac_tmp/stdin" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || printf "%s\n" X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= ac_sed_dataroot=' /datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 printf "%s\n" "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when '$srcdir' = '.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_sed_extra="$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&5 printf "%s\n" "$as_me: WARNING: $ac_file contains a reference to the variable 'datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" case $ac_file in -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac done # for ac_tag as_fn_exit 0 _ACEOF ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi terra/man/0000755000176200001440000000000014757467211012160 5ustar liggesusersterra/man/vrt.Rd0000644000176200001440000000447514734172536013272 0ustar liggesusers\name{vrt} \docType{methods} \alias{vrt} \alias{vrt,character-method} \alias{vrt,SpatRasterCollection-method} \title{Virtual Raster Dataset} \description{ Create a Virtual Raster Dataset (VRT) from a collection of file-based raster datasets (tiles). See \href{https://gdal.org/en/latest/programs/gdalbuildvrt.html}{gdalbuildvrt} for details. } \usage{ \S4method{vrt}{character}(x, filename="", options=NULL, overwrite=FALSE, set_names=FALSE, return_filename=FALSE) \S4method{vrt}{SpatRasterCollection}(x, filename="", options=NULL, overwrite=FALSE, return_filename=FALSE) } \arguments{ \item{x}{SpatRasterCollection or character vector with filenames of raster "tiles". That is, files that have data for, typically non-overlapping, sub-regions of an raster. See \code{\link{makeTiles}}} \item{filename}{character. output VRT filename} \item{options}{character. All arguments as separate vector elements. Options as for \href{https://gdal.org/en/latest/programs/gdalbuildvrt.html}{gdalbuildvrt}} \item{overwrite}{logical. Should \code{filename} be overwritten if it exists?} \item{set_names}{logical. Add the layer names of the first tile to the vrt?} \item{return_filename}{logical. If \code{TRUE} the filename is returned, otherwise a SpatRaster is returned} } \value{ SpatRaster } \note{ A VRT can reference very many datasets. These are not all opened at the same time. The default is to open not more than 100 files. To increase performance, this maximum limit can be increased by setting the GDAL_MAX_DATASET_POOL_SIZE configuration option to a bigger value with \code{\link{setGDALconfig}}. Note that a typical user process on Linux is limited to 1024 simultaneously opened files. } \seealso{ \code{\link{makeTiles}} to create tiles; \code{\link{makeVRT}} to create a .vrt file for a binary raster file that does not have a header file. \code{\link{vrt_tiles}} to get the filenames of the tiles in a VRT. } \examples{ r <- rast(ncols=100, nrows=100) values(r) <- 1:ncell(r) x <- rast(ncols=2, nrows=2) filename <- paste0(tempfile(), "_.tif") ff <- makeTiles(r, x, filename) ff #vrtfile <- paste0(tempfile(), ".vrt") #v <- vrt(ff, vrtfile) ## output in lower resolution #vrtfile <- paste0(tempfile(), ".vrt") #v <- vrt(ff, vrtfile, options = c("-tr", 5, 5)) #head(readLines(vrtfile)) #v } \keyword{methods} \keyword{spatial} terra/man/quantile.Rd0000644000176200001440000000250314536376240014265 0ustar liggesusers\name{quantile} \docType{methods} \alias{quantile} \alias{quantile,SpatRaster-method} \alias{quantile,SpatVector-method} \title{Quantiles of spatial data} \description{ Compute quantiles for each cell across the layers of a SpatRaster. You can use use \code{\link{global}(x, fun=quantile)} to instead compute quantiles across cells for each layer. You can also use this method to compute quantiles of the numeric variables of a SpatVector. } \usage{ \S4method{quantile}{SpatRaster}(x, probs=seq(0, 1, 0.25), na.rm=FALSE, filename="", ...) \S4method{quantile}{SpatVector}(x, probs=seq(0, 1, 0.25), ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{probs}{numeric vector of probabilities with values in [0,1]} \item{na.rm}{logical. If \code{TRUE}, \code{NA}'s are removed from \code{x} before the quantiles are computed} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster with layers representing quantiles } \seealso{ \code{\link{app}} } \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) rr <- c(r/2, r, r*2) qr <- quantile(rr) qr \dontrun{ # same but slower qa <- app(rr, quantile) } #quantile by layer instead of by cell qg <- global(r, quantile) } \keyword{methods} \keyword{spatial} terra/man/plot_extent.Rd0000644000176200001440000000104314536376240015006 0ustar liggesusers\name{plot_extent} \docType{methods} \alias{plot,SpatExtent,missing-method} \title{Plot a SpatExtent} \description{ Plot a SpatExtent. Use \code{\link{lines}} to add a SpatExtent to an existing map. See \code{\link{plot}} for plotting other object types. } \usage{ \S4method{plot}{SpatExtent,missing}(x, y, ...) } \arguments{ \item{x}{SpatExtent} \item{y}{missing} \item{...}{additional graphical arguments for lines} } \seealso{ \code{\link{plot}} } \examples{ r <- rast() plot(ext(r)) } \keyword{methods} \keyword{spatial} terra/man/scale_linear.Rd0000644000176200001440000000134614730376763015076 0ustar liggesusers\name{scale_linear} \alias{scale_linear} \alias{scale_linear,SpatRaster-method} \title{Scale values linearly} \description{ Linear scaling of raster cell values between a specified minimum and maximum value. } \usage{ \S4method{scale_linear}{SpatRaster}(x, min=0, max=1, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{min}{minimum value to scale to} \item{max}{maximum value to scale to} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{scale}} } \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) s1 <- scale_linear(r) s2 <- scale_linear(r, 1, 10) } \keyword{ spatial } terra/man/scale.Rd0000644000176200001440000000244414727672127013543 0ustar liggesusers\name{scale} \alias{scale} \alias{scale,SpatRaster-method} \title{Scale values} \description{ Center and/or scale raster data. For details see \code{\link[base]{scale}} } \usage{ \S4method{scale}{SpatRaster}(x, center=TRUE, scale=TRUE) } \arguments{ \item{x}{SpatRaster} \item{center}{logical or numeric. If \code{TRUE}, centering is done by subtracting the layer means (omitting \code{NA}s), and if \code{FALSE}, no centering is done. If \code{center} is a numeric vector (recycled to \code{nlyr(x)}), then each layer of \code{x} has the corresponding value from center subtracted from it.} \item{scale}{logical or numeric. If \code{TRUE}, scaling is done by dividing the (centered) layers of \code{x} by their standard deviations if \code{center} is \code{TRUE}, and the root mean square otherwise. If scale is \code{FALSE}, no scaling is done. If \code{scale} is a numeric vector (recycled to \code{nlyr(x)}), each layer of \code{x} is divided by the corresponding value. Scaling is done after centering.} } \value{ SpatRaster } \seealso{ \code{\link{scale_linear}} } \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) s <- scale(r) ## the equivalent, computed in steps m <- global(r, "mean") rr <- r - m[,1] rms <- global(rr, "rms") ss <- rr / rms[,1] } \keyword{ spatial } terra/man/segregate.Rd0000644000176200001440000000270114536376240014411 0ustar liggesusers\name{segregate} \docType{methods} \alias{segregate} \alias{segregate,SpatRaster-method} \title{segregate} \description{ Create a SpatRaster with a layer for each class (value, or subset of the values) in the input SpatRaster. For example, if the input has vegetation types, this function will create a layer (presence/absence; dummy variable) for each of these classes. This is called "one-hot encoding" or "dummy encoding" (for a dummy encoding scheme you can remove (any) one of the output layers as it is redundant). } \usage{ \S4method{segregate}{SpatRaster}(x, classes=NULL, keep=FALSE, other=0, round=FALSE, digits=0, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{classes}{numeric. The values (classes) for which layers should be made. If \code{NULL} all classes are used} \item{keep}{logical. If \code{TRUE}, cells that are of the class represented by a layer get that value, rather than a value of 1} \item{other}{numeric. Value to assign to cells that are not of the class represented by a layer} \item{round}{logical. Should the values be rounded first?} \item{digits}{integer. Number of digits to round the values to} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ r <- rast(nrows=5, ncols=5) values(r) <- rep(c(1:4, NA), each=5) b <- segregate(r) bb <- segregate(r, keep=TRUE, other=NA) } \keyword{spatial} terra/man/image.Rd0000644000176200001440000000154414536376240013531 0ustar liggesusers\name{image} \docType{methods} \alias{image} \alias{image,SpatRaster-method} \title{SpatRaster image method} \description{ Plot (make a map of) the values of a SpatRaster via \code{\link[graphics]{image}}. See \code{\link[terra]{plot}} if you need more fancy options such as a legend. } \usage{ \S4method{image}{SpatRaster}(x, y=1, maxcell=500000, ...) } \arguments{ \item{x}{SpatRaster} \item{y}{positive integer indicating the layer to be plotted, or a character indicating the name of the layer} \item{maxcell}{positive integer. Maximum number of cells to use for the plot} \item{...}{additional arguments as for \code{graphics::\link[graphics]{image}} } } \seealso{ \code{\link[terra]{plot}} } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) image(r) image(r, col=rainbow(24)) } \keyword{methods} \keyword{spatial} terra/man/geometry.Rd0000644000176200001440000000465114736272261014304 0ustar liggesusers\name{geom} \docType{methods} \alias{geom} \alias{geom,SpatVector-method} \title{Get the geometry (coordinates) of a SpatVector} \description{ Get the geometry of a SpatVector. If \code{wkt=FALSE}, this is a five-column matrix or data.frame: the vector object ID, the IDs for the parts of each object (e.g. five polygons that together are one spatial object), the x (longitude) and y (latitude) coordinates, and a flag indicating whether the part is a "hole" (only relevant for polygons). If \code{wkt=TRUE}, the "well-known text" representation is returned as a character vector. If \code{hex=TRUE}, the "hexadecimal" representation is returned as a character vector. If \code{wkb=TRUE}, the "well-known binary" representation is returned as a list of raw vectors. } \usage{ \S4method{geom}{SpatVector}(x, wkt=FALSE, hex=FALSE, wkb=FALSE, df=FALSE, list=FALSE, xnm="x", ynm="y") } \arguments{ \item{x}{SpatVector} \item{wkt}{logical. If \code{TRUE} the WKT geometry is returned (unless \code{hex} is also \code{TRUE})} \item{hex}{logical. If \code{TRUE} the hexadecimal geometry is returned} \item{wkb}{logical. If \code{TRUE} the raw WKB geometry is returned (unless either of \code{hex} or \code{wkt} is also \code{TRUE})} \item{df}{logical. If \code{TRUE} a \code{data.frame} is returned instead of a matrix (only if \code{wkt=FALSE}, \code{hex=FALSE}, and \code{list=FALSE})} \item{list}{logical. If \code{TRUE} a nested \code{list} is returned with data.frames of coordinates} \item{xnm}{character. If \code{list=TRUE} the "x" column name for the coordinates data.frame } \item{ynm}{character. If \code{list=TRUE} the "y" column name for the coordinates data.frame} } \value{ matrix, vector, data.frame, or list } \seealso{ \code{\link{crds}}, \code{\link{xyFromCell}} } \examples{ x1 <- rbind(c(-175,-20), c(-140,55), c(10, 0), c(-140,-60)) x2 <- rbind(c(-125,0), c(0,60), c(40,5), c(15,-45)) x3 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55)) x4 <- rbind(c(80,0), c(105,13), c(120,2), c(105,-13)) z <- rbind(cbind(object=1, part=1, x1), cbind(object=2, part=1, x2), cbind(object=3, part=1, x3), cbind(object=3, part=2, x4)) colnames(z)[3:4] <- c('x', 'y') z <- cbind(z, hole=0) z[(z[, "object"]==3 & z[,"part"]==2), "hole"] <- 1 p <- vect(z, "polygons") geom(p) f <- system.file("ex/lux.shp", package="terra") v <- vect(f) g <- geom(v) head(g) w <- geom(v, wkt=TRUE) substr(w, 1, 60) } \keyword{spatial} terra/man/focal.Rd0000644000176200001440000001110114536376240013521 0ustar liggesusers\name{focal} \alias{focal} \alias{focal,SpatRaster-method} \title{Focal values} \description{ Calculate focal ("moving window") values for each cell. } \usage{ \S4method{focal}{SpatRaster}(x, w=3, fun="sum", ..., na.policy="all", fillvalue=NA, expand=FALSE, silent=TRUE, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{w}{window. The window can be defined as one (for a square) or two numbers (row, col); or with an odd-sized weights matrix. See Details.} \item{fun}{function that takes multiple numbers, and returns a numeric vector (one or multiple numbers). For example mean, modal, min or max} \item{...}{additional arguments passed to \code{fun} such as \code{na.rm}} \item{na.policy}{character. Can be used to determine the cells of \code{x} for which focal values should be computed. Must be one of "all" (compute for all cells), "only" (only for cells that are \code{NA}) or "omit" (skip cells that are \code{NA}). Note that the value of this argument does not affect which cells around each focal cell are included in the computations (use \code{na.rm=TRUE} to ignore cells that are \code{NA} for that)} \item{fillvalue}{numeric. The value of the cells in the virtual rows and columns outside of the raster} \item{expand}{logical. If \code{TRUE} The value of the cells in the virtual rows and columns outside of the raster are set to be the same as the value on the border. Only available for "build-in" \code{fun}s such as mean, sum, min and max} \item{silent}{logical. If \code{TRUE} error messages are printed that may occur when trying \code{fun} to determine the length of the returned value. This can be useful in debugging a \code{fun} that does not work} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{additional arguments for writing files as in \code{\link{writeRaster}}} } \details{ \code{focal} The window used must have odd dimensions. If you need even sides, you can use a matrix and add a column or row of \code{NA}'s to mask out values. Window values are typically 1 or \code{NA} to indicate whether a value is used or ignored in computations, respectively. \code{NA} values in \code{w} can be useful for creating non-rectangular (e.g. circular) windows. A weights matrix of numeric values can also be supplied to \code{w}. In the case of a weights matrix, cells with \code{NA} weights will be ignored, and the rest of the values in the focal window will be multiplied by the corresponding weight prior to `fun` being applied. Note, \code{na.rm} does not need to be \code{TRUE} if \code{w} contains \code{NA} values as these cells are ignored in computations. The "mean" function is a special case, where supplying weights to \code{w} will instead calculate a weighted mean. The "sum" function returns \code{NA} if all focal cells are \code{NA} and \code{na.rm=TRUE}. R would normally return a zero in these cases. See the difference between \code{focal(x, fun=sum, na.rm=TRUE)} and \code{focal(x, fun=\(i) sum(i, na.rm=TRUE))} Example weight matrices Laplacian filter: \code{filter=matrix(c(0,1,0,1,-4,1,0,1,0), nrow=3)} Sobel filters (for edge detection): \code{fx=matrix(c(-1,-2,-1,0,0,0,1,2,1), nrow=3)} \code{fy=matrix(c(1,0,-1,2,0,-2,1,0,-1), nrow=3)} } \note{ When using global lon/lat rasters, the focal window "wraps around" the date-line. } \value{SpatRaster} \seealso{ \code{\link{focalMat}}, \code{\link{focalValues}}, \code{\link{focal3D}}, \code{\link{focalPairs}}, \code{\link{focalReg}}, \code{\link{focalCpp}} } \examples{ r <- rast(ncols=10, nrows=10, ext(0, 10, 0, 10)) values(r) <- 1:ncell(r) f <- focal(r, w=3, fun=function(x, ...) quantile(x, c(.25, .5, .75), ...), na.rm=TRUE) f <- focal(r, w=3, fun="mean") # the following two statements are equivalent: a <- focal(r, w=matrix(1/9, nc=3, nr=3)) b <- focal(r, w=3, fun=mean, na.rm=FALSE) # but this is different d <- focal(r, w=3, fun=mean, na.rm=TRUE) ## illustrating the effect of different ## combinations of na.rm and na.policy v <- vect(system.file("ex/lux.shp", package="terra")) r <- rast(system.file("ex/elev.tif", package="terra")) r[45:50, 45:50] <- NA # also try "mean" or "min" f <- "sum" # na.rm=FALSE plot(focal(r, 5, f) , fun=lines(v)) # na.rm=TRUE plot(focal(r, 5, f, na.rm=TRUE), fun=lines(v)) # only change cells that are NA plot(focal(r, 5, f, na.policy="only", na.rm=TRUE), fun=lines(v)) # do not change cells that are NA plot(focal(r, 5, f, na.policy="omit", na.rm=TRUE), fun=lines(v)) # does not do anything # focal(r, 5, f, na.policy="only", na.rm=FALSE) } \keyword{spatial} terra/man/app.Rd0000644000176200001440000000763314536376240013234 0ustar liggesusers\name{app} \docType{methods} \alias{app} \alias{app,SpatRaster-method} \alias{app,SpatRasterDataset-method} \title{Apply a function to the cells of a SpatRaster} \description{ Apply a function to the values of each cell of a SpatRaster. Similar to \code{\link[base]{apply}} -- think of each layer in a SpatRaster as a column (or row) in a matrix. This is generally used to summarize the values of multiple layers into one layer; but this is not required. \code{app} calls function \code{fun} with the raster data as first argument. Depending on the function supplied, the raster data is represented as either a matrix in which each layer is a column, or a vector representing a cell. The function should return a vector or matrix that is divisible by ncell(x). Thus, both "sum" and "rowSums" can be used, but "colSums" cannot be used. You can also apply a function \code{fun} across datasets by layer of a \code{SpatRasterDataset}. In that case, summarization is by layer across SpatRasters. } \usage{ \S4method{app}{SpatRaster}(x, fun, ..., cores=1, filename="", overwrite=FALSE, wopt=list()) \S4method{app}{SpatRasterDataset}(x, fun, ..., cores=1, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster or SpatRasterDataset} \item{fun}{a function that operates on a vector or matrix. This can be a function that is defined in base-R or in a package, or a function you write yourself (see examples). Functions that return complex output (e.g. a list) may need to be wrapped in your own function to simplify the output to a vector or matrix. The following functions have been re-implemented in C++ for speed: "sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first". To use the base-R function for say, "min", you could use something like \code{fun=function(i) min(i)} or the equivalent \code{fun = \(i) min(i)}} \item{...}{additional arguments for \code{fun}. These are typically numerical constants. They should *never* be another SpatRaster} \item{cores}{positive integer. If \code{cores > 1}, a 'parallel' package cluster with that many cores is created and used. You can also supply a cluster object. Ignored for functions that are implemented by terra in C++ (see under fun)} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \details{ To speed things up, parallelization is supported, but this is often not helpful, and it may actually be slower. There is only a speed gain if you have many cores (> 8) and/or a very complex (slow) function \code{fun}. If you write \code{fun} yourself, consider supplying a \code{cppFunction} made with the Rcpp package instead (or go have a cup of tea while the computer works for you). } \seealso{ \code{\link{lapp}}, \code{\link{tapp}}, \code{\link[terra]{Math-methods}}, \code{\link{roll}} } \examples{ r <- rast(ncols=10, nrows=10) values(r) <- 1:ncell(r) x <- c(r, sqrt(r), r+50) s <- app(x, fun=sum) s # for a few generic functions like # "sum", "mean", and "max" you can also do sum(x) ## SpatRasterDataset sd <- sds(x, x*2, x/3) a <- app(sd, max) a # same as max(x, x*2, x/3) # and as (but slower) b <- app(sd, function(i) max(i)) ## also works for a single layer f <- function(i) (i+1) * 2 * i + sqrt(i) s <- app(r, f) # same as above, but that is not memory-safe # and has no filename argument s <- f(r) \dontrun{ #### multiple cores test0 <- app(x, sqrt) test1 <- app(x, sqrt, cores=2) testfun <- function(i) { 2 * sqrt(i) } test2 <- app(x, fun=testfun, cores =2) ## this fails because testfun is not exported to the nodes # test3 <- app(x, fun=function(i) testfun(i), cores=2) ## to export it, add it as argument to fun test3 <- app(x, fun=function(i, ff) ff(i), cores =3, ff=testfun) } } \keyword{methods} \keyword{spatial} terra/man/NIPD.Rd0000644000176200001440000000346114633631501013171 0ustar liggesusers\docType{methods} \name{NIDP} \alias{NIDP} \alias{NIDP,SpatRaster-method} \title{Number of immediate adjacent cells flowing into each cell} \description{ Compute the number of immediate adjacent cells flowing into each cell } \usage{ \S4method{NIDP}{SpatRaster}(x, filename="",...) } \arguments{ \item{x}{SpatRaster with flow-direction. see \code{\link{terrain}}} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \details{ NDIP is computed first to compute flow-accumulation with the algorithm by Zhou at al, 2019. } \references{ Zhou, G., Wei, H. & Fu, S. A fast and simple algorithm for calculating flow accumulation matrices from raster digital elevation. Front. Earth Sci. 13, 317–326 (2019). https://doi.org/10.1007/s11707-018-0725-9 \url{https://link.springer.com/article/10.1007/s11707-018-0725-9} } \seealso{\code{\link{flowAccumulation}}} \author{Emanuele Cordano } \examples{ elev1 <- array(NA,c(9,9)) elev2 <- elev1 dx <- 1 dy <- 1 for (r in 1:nrow(elev1)) { y <- (r-5)*dx for (c in 1:ncol(elev1)) { x <- (c-5)*dy elev1[r,c] <- 5*(x^2+y^2) elev2[r,c] <- 10+5*(abs(x))-0.001*y ### 5*(x^2+y^2) } } ## Elevation Raster elev1 <- rast(elev1) elev2 <- rast(elev2) t(array(elev1[],rev(dim(elev1)[1:2]))) t(array(elev2[],rev(dim(elev2)[1:2]))) plot(elev1) plot(elev2) ## Flow Direction Raster flowdir1<- terrain(elev1,v="flowdir") flowdir2<- terrain(elev2,v="flowdir") t(array(flowdir1[],rev(dim(flowdir1)[1:2]))) t(array(flowdir2[],rev(dim(flowdir2)[1:2]))) plot(flowdir1) plot(flowdir2) ## nidp1 <- NIDP((flowdir1)) nidp2 <- NIDP((flowdir2)) t(array(nidp1[],rev(dim(nidp1)[1:2]))) t(array(nidp2[],rev(dim(nidp2)[1:2]))) plot(nidp1) plot(nidp2) } \keyword{spatial} terra/man/grid.Rd0000644000176200001440000000217114646602655013375 0ustar liggesusers\name{add_grid} \alias{add_grid} \title{add a grid to a map made with terra} \description{ Adaptation of \code{\link[graphics]{grid}} that allows adding a grid to a map. This function will place the legend in the locations within the mapped area as delineated by the axes. Also see \code{\link{graticule}} } \usage{ add_grid(nx=NULL, ny=nx, col="lightgray", lty="dotted", lwd=1) } \arguments{ \item{nx, ny}{number of cells of the grid in x and y direction. When NULL, as per default, the grid aligns with the tick marks on the corresponding default axis (i.e., tickmarks as computed by axTicks). When NA, no grid lines are drawn in the corresponding direction} \item{col}{character or (integer) numeric; color of the grid lines} \item{lty}{character or (integer) numeric; line type of the grid lines} \item{lwd}{non-negative numeric giving line width of the grid lines} } \seealso{\code{\link{graticule}}, \code{\link{add_legend}}, \code{\link{add_box}}, \code{\link{add_grid}}, \code{\link{add_mtext}}} \examples{ v <- vect(system.file("ex/lux.shp", package="terra")) plot(v) add_grid() } \keyword{methods} \keyword{spatial} terra/man/wrap.Rd0000644000176200001440000000267114722370304013412 0ustar liggesusers\name{wrap} \alias{wrap} \alias{unwrap} \alias{wrap,SpatExtent-method} \alias{wrap,SpatVector-method} \alias{wrap,SpatRaster-method} \alias{wrap,SpatRasterDataset-method} \alias{wrap,SpatRasterCollection-method} \alias{unwrap,ANY-method} \alias{unwrap,PackedSpatExtent-method} \alias{unwrap,PackedSpatRaster-method} \alias{unwrap,PackedSpatRasterDC-method} \alias{unwrap,PackedSpatVector-method} \title{wrap and unwrap} \description{ Use \code{wrap} to pack a SpatVector or SpatRaster* to create a Packed* object. Packed objects can be passed over a connection that serializes (e.g. to nodes on a computer cluster). At the receiving end they need to be unpacked with \code{unwrap}. } \usage{ \S4method{wrap}{SpatRaster}(x, proxy=FALSE) \S4method{wrap}{SpatRasterDataset}(x, proxy=FALSE) \S4method{wrap}{SpatRasterCollection}(x, proxy=FALSE) \S4method{wrap}{SpatVector}(x) \S4method{unwrap}{ANY}(x) } \arguments{ \item{x}{SpatVector, SpatRaster, SpatRasterDataset or SpatRasterCollection} \item{proxy}{logical. If \code{FALSE} raster cell values are forced to memory if possible. If \code{TRUE}, a reference to source filenames is stored for data sources that are not in memory} } \value{ \code{wrap}: Packed* object \code{unwrap}: SpatVector, SpatRaster, SpatRasterCollection, SpatRasterDataset } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) p <- wrap(v) p vv <- vect(p) vv } \keyword{ spatial } \keyword{ methods } terra/man/trim.Rd0000644000176200001440000000142714536376240013422 0ustar liggesusers\name{trim} \alias{trim} \alias{trim,SpatRaster-method} \title{Trim a SpatRaster} \description{ Trim (shrink) a SpatRaster by removing outer rows and columns that are \code{NA} or another value. } \usage{ \S4method{trim}{SpatRaster}(x, padding=0, value=NA, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{padding}{integer. Number of outer rows/columns to keep} \item{value}{numeric. The value of outer rows or columns that are to be removed} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ r <- rast(ncols=10, nrows=10, xmin=0,xmax=10,ymin=0,ymax=10) v <- rep(NA, ncell(r)) v[c(12,34,69)] <- 1:3 values(r) <- v s <- trim(r) } \keyword{spatial} terra/man/compare-generics.Rd0000644000176200001440000000701614547073770015676 0ustar liggesusers\name{Compare-methods} \docType{methods} \alias{Compare-methods} \alias{Logic-methods} \alias{logic} \alias{compare} \alias{Compare,SpatRaster,SpatRaster-method} \alias{Compare,numeric,SpatRaster-method} \alias{Compare,SpatRaster,numeric-method} \alias{Compare,SpatRaster,character-method} \alias{Compare,SpatRaster,matrix-method} \alias{Compare,matrix,SpatRaster-method} \alias{Logic,SpatRaster,SpatRaster-method} \alias{Logic,SpatRaster,numeric-method} \alias{Logic,numeric,SpatRaster-method} \alias{Logic,SpatRaster,logical-method} \alias{Logic,logical,SpatRaster-method} \alias{Compare,SpatExtent,SpatExtent-method} \alias{is.na,SpatRaster-method} \alias{is.nan,SpatRaster-method} \alias{!,SpatRaster-method} \alias{is.finite,SpatRaster-method} \alias{is.infinite,SpatRaster-method} \alias{logic,SpatRaster-method} \alias{compare,SpatRaster-method} \title{Compare and logical methods} \description{ Standard comparison and logical operators for computations with SpatRasters. Computations are local (applied on a cell by cell basis). If multiple SpatRasters are used, these must have the same geometry (extent and resolution). These operators have been implemented: \bold{Logical}: \code{!, &, |, isTRUE, isFALSE} \bold{Compare}: \code{ ==, !=, >, <, <=, >=, is.na, is.nan, is.finite, is.infinite} See \code{\link{not.na}} for the inverse of \code{is.na}, and \code{\link{noNA}} to detect cells with missing value across layers. The \code{compare} and \code{logic} methods implement these operators in a method that can return \code{NA} istead of \code{FALSE} and allows for setting an output filename. The terra package does not distinguish between \code{NA} (not available) and \code{NaN} (not a number). In most cases this state is represented by \code{NaN}. If you use a SpatRaster with a vector of multiple numbers, each element in the vector is considered a layer (with a constant value). If you use a SpatRaster with a matrix, the number of columns of the matrix must match the number of layers of the SpatRaster. The rows are used to match the cells. That is, if there are two rows, these match cells 1 and 2, and they are recycled to 3 and 4, etc. The following method has been implemented for \bold{(SpatExtent, SpatExtent)}: \code{==} } \usage{ \S4method{compare}{SpatRaster}(x, y, oper, falseNA=FALSE, filename="", overwrite=FALSE, ...) \S4method{logic}{SpatRaster}(x, oper, falseNA=FALSE, filename="", overwrite=FALSE, ...) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatRaster or numeric} \item{oper}{character. Operator name. For \code{compare} this can be one of \code{"==", "!=", ">", "<", ">=", "<="} and for \code{logic} it can be one of \code{"!", "is.na", "allNA", "noNA", "is.infinite", "is.finite", "iSTRUE", "isFALSE"}} \item{falseNA}{logical. Should the result be \code{TRUE, NA} instead of \code{TRUE, FALSE}?} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{all.equal}}, \link{Arith-methods}. See \code{\link{ifel}} to conveniently combine operations and \code{\link{Math-methods}} or \code{\link{app}} to apply any R function to a SpatRaster. } \value{ SpatRaster or SpatExtent } \examples{ r1 <- rast(ncols=10, nrows=10) values(r1) <- runif(ncell(r1)) r1[10:20] <- NA r2 <- rast(r1) values(r2) <- 1:ncell(r2) / ncell(r2) x <- is.na(r1) !x r1 == r2 compare(r1, r2, "==") compare(r1, r2, "==", TRUE) } \keyword{methods} \keyword{math} \keyword{spatial} terra/man/as.character.Rd0000644000176200001440000000076014536376240015004 0ustar liggesusers\name{as.character} \docType{methods} \alias{as.character,SpatExtent-method} \alias{as.character,SpatRaster-method} \title{Create a text representation of (the skeleton of) an object} \description{ Create a text representation of (the skeleton of) an object } \usage{ \S4method{as.character}{SpatExtent}(x) \S4method{as.character}{SpatRaster}(x) } \arguments{ \item{x}{SpatRaster} } \value{ character } \examples{ r <- rast() ext(r) ext(c(0, 20, 0, 20)) } \keyword{spatial} terra/man/split.Rd0000644000176200001440000000241114703346534013573 0ustar liggesusers\name{split} \docType{methods} \alias{split} \alias{split,SpatRaster,ANY-method} \alias{split,SpatVector,ANY-method} \alias{split,SpatVector,SpatVector-method} \title{Split a SpatRaster or SpatVector} \description{ Split a SpatRaster by layer, or a SpatVector by attributes. You can also split the geometry of a polygon SpatVector with another SpatVector. } \usage{ \S4method{split}{SpatRaster,ANY}(x, f) \S4method{split}{SpatVector,ANY}(x, f) \S4method{split}{SpatVector,SpatVector}(x, f) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{f}{If \code{x} is a SpatRaster: a vector of the length \code{nlyr(x)}. If \code{x} is a SpatVector: a field (variable) name or a vector of the same length as \code{x}; or, if \code{x} is a SpatVector of polygons, a SpatVector of lines or polygons to split the polygon geometries} } \value{ list or SpatVector } \examples{ ## split layers s <- rast(system.file("ex/logo.tif", package="terra")) y <- split(s, c(1,2,1)) sds(y) ## split attributes v <- vect(system.file("ex/lux.shp", package="terra")) x <- split(v, "NAME_1") ## split geometries v <- v[1:5,] line <- vect(matrix(c(5.79, 6.22, 5.75, 6.1, 5.8, 50.14, 50.05, 49.88, 49.85, 49.71), ncol=2), "line") s <- split(v, line) } \keyword{methods} \keyword{spatial} terra/man/union.Rd0000644000176200001440000000435314741531432013572 0ustar liggesusers\name{union} \docType{methods} \alias{union} \alias{union,SpatExtent,SpatExtent-method} \alias{union,SpatVector,SpatVector-method} \alias{union,SpatVector,SpatExtent-method} \alias{union,SpatVector,missing-method} \title{ Union SpatVector or SpatExtent objects } \description{ If you want to append polygon SpatVectors use \code{rbind} instead of \code{union}. \code{union} will also intersect overlapping polygons between, not within, objects. Union for lines and points simply combines the two data sets; without any geometric intersections. This is equivalent to \code{\link{rbind}}. Attributes are joined. If \code{x} and \code{y} have a different geometry type, a SpatVectorCollection is returned. If a single SpatVector is supplied, overlapping polygons are intersected. Original attributes are lost. New attributes allow for determining how many, and which, polygons overlapped. SpatExtent: Objects are combined into their union; this is equivalent to \code{+}. } \usage{ \S4method{union}{SpatVector,SpatVector}(x, y) \S4method{union}{SpatVector,missing}(x, y) \S4method{union}{SpatExtent,SpatExtent}(x, y) } \arguments{ \item{x}{SpatVector or SpatExtent} \item{y}{Same as \code{x} or missing} } \value{ SpatVector or SpatExtent } \seealso{ \code{\link[terra]{rbind}} \code{\link[terra]{intersect}} \code{\link[terra]{combineGeoms}} \code{\link{merge}} and \code{\link{mosaic}} to union SpatRasters. \code{\link{crop}} and \code{\link{extend}} for the union of SpatRaster and SpatExtent. \code{\link[terra]{merge}} for merging a data.frame with attributes of a SpatVector. \code{\link[terra]{aggregate}} to dissolve SpatVector objects. } \examples{ e1 <- ext(-10, 10, -20, 20) e2 <- ext(0, 20, -40, 5) union(e1, e2) #SpatVector v <- vect(system.file("ex/lux.shp", package="terra")) v <- v[,3:4] p <- vect(c("POLYGON ((5.8 49.8, 6 49.9, 6.15 49.8, 6 49.65, 5.8 49.8))", "POLYGON ((6.3 49.9, 6.2 49.7, 6.3 49.6, 6.5 49.8, 6.3 49.9))"), crs=crs(v)) values(p) <- data.frame(pid=1:2, value=expanse(p)) u <- union(v, p) plot(u, "pid") b <- buffer(v, 1000) u <- union(b) u$sum <- rowSums(as.data.frame(u)) plot(u, "sum") } \keyword{methods} \keyword{spatial} terra/man/colors.Rd0000644000176200001440000000245714536376240013754 0ustar liggesusers\name{colors} \docType{methods} \alias{has.colors} \alias{has.colors,SpatRaster-method} \alias{coltab} \alias{coltab,SpatRaster-method} \alias{coltab<-} \alias{coltab<-,SpatRaster-method} \title{Color table} \description{ Get or set color table(s) associated with a SpatRaster. Color tables are used for associating colors with values, for use in mapping (plot). } \usage{ \S4method{coltab}{SpatRaster}(x) \S4method{coltab}{SpatRaster}(x, ..., layer=1)<-value \S4method{has.colors}{SpatRaster}(x) } \arguments{ \item{x}{SpatRaster} \item{layer}{positive integer, the layer number or name} \item{value}{a two-column data.frame (first column the cell value, the second column the color); a vector of colors (the first one is the color for value 0 and so on); or a four (value,red,green,blue) or five (including alpha) column data.frame also from 0 to n; or NULL to remove the color table. You can also supply a list of such data.frames to set a color table to all layers} \item{...}{additional arguments (none implemented)} } \value{ data.frame } \examples{ r <- rast(ncols=3, nrows=2, vals=1:6) coltb <- data.frame(value=1:6, col=rainbow(6, end=.9)) coltb plot(r) has.colors(r) coltab(r) <- coltb plot(r) has.colors(r) tb <- coltab(r) class(tb) dim(tb[[1]]) } \keyword{methods} \keyword{spatial} terra/man/dimensions.Rd0000644000176200001440000000611614536376240014617 0ustar liggesusers\name{dimensions} \docType{methods} \alias{size} \alias{length} \alias{ncol} \alias{nrow} \alias{ncell} \alias{nlyr} \alias{nsrc} \alias{dim} \alias{res} \alias{xres} \alias{yres} \alias{ncol<-} \alias{nrow<-} \alias{nlyr<-} \alias{res<-} \alias{size,SpatRaster-method} \alias{ncell,ANY-method} \alias{nrow,SpatRaster-method} \alias{ncol,SpatRaster-method} \alias{nrow,SpatRasterDataset-method} \alias{ncol,SpatRasterDataset-method} \alias{nrow,SpatRasterCollection-method} \alias{ncol,SpatRasterCollection-method} \alias{nrow<-,SpatRaster,numeric-method} \alias{ncol<-,SpatRaster,numeric-method} \alias{nlyr,SpatRasterDataset-method} \alias{res<-,SpatRaster,numeric-method} \alias{nlyr,SpatRaster-method} \alias{nlyr<-,SpatRaster,numeric-method} \alias{nsrc,SpatRaster-method} \alias{ncell,SpatRaster-method} \alias{ncell,SpatRasterDataset-method} \alias{length,SpatRasterDataset-method} \alias{length,SpatRasterCollection-method} \alias{nlyr,SpatRasterCollection-method} \alias{dim,SpatRaster-method} \alias{dim,SpatRasterDataset-method} \alias{dim,SpatRasterCollection-method} \alias{dim<-,SpatRaster-method} \alias{dim,SpatVector-method} \alias{dim,SpatVectorProxy-method} \alias{res,SpatRasterDataset-method} \alias{res,SpatRaster-method} \alias{res<-,SpatRaster-method} \alias{xres,SpatRaster-method} \alias{yres,SpatRaster-method} \alias{nrow,SpatVector-method} \alias{ncol,SpatVector-method} \alias{length,SpatVector-method} \alias{length,SpatVectorCollection-method} \title{Dimensions of a SpatRaster or SpatVector and related objects} \description{ Get the number of rows (\code{nrow}), columns (\code{ncol}), cells (\code{ncell}), layers (\code{nlyr}), sources (\code{nsrc}), the size \code{size} (\code{nlyr(x)*ncell(x)}), or spatial resolution of a SpatRaster. \code{length} returns the number of sub-datasets in a SpatRasterDataset or SpatVectorCollection. For a SpatVector \code{length(x)} is the same as \code{nrow(x)}. You can also set the number of rows or columns or layers. When setting dimensions, all cell values are dropped. } \usage{ \S4method{ncol}{SpatRaster}(x) \S4method{nrow}{SpatRaster}(x) \S4method{nlyr}{SpatRaster}(x) \S4method{ncell}{SpatRaster}(x) \S4method{nsrc}{SpatRaster}(x) \S4method{ncol}{SpatRaster,numeric}(x)<-value \S4method{nrow}{SpatRaster,numeric}(x)<-value \S4method{nlyr}{SpatRaster,numeric}(x)<-value \S4method{res}{SpatRaster}(x) \S4method{res}{SpatRaster,numeric}(x)<-value \S4method{xres}{SpatRaster}(x) \S4method{yres}{SpatRaster}(x) \S4method{ncol}{SpatVector}(x) \S4method{nrow}{SpatVector}(x) \S4method{length}{SpatVector}(x) } \arguments{ \item{x}{SpatRaster or SpatVector or related objects} \item{value}{For ncol and nrow: positive integer. For res: one or two positive numbers } } \value{ integer } \seealso{ \link{ext}} \examples{ r <- rast() ncol(r) nrow(r) nlyr(r) dim(r) nsrc(r) ncell(r) rr <- c(r,r) nlyr(rr) nsrc(rr) ncell(rr) nrow(r) <- 18 ncol(r) <- 36 # equivalent to dim(r) <- c(18, 36) dim(r) dim(r) <- c(10, 10, 5) dim(r) xres(r) yres(r) res(r) res(r) <- 1/120 # different xres and yres res(r) <- c(1/120, 1/60) } \keyword{spatial} terra/man/mergeTime.Rd0000644000176200001440000000224114536376240014360 0ustar liggesusers\name{mergeTime} \docType{methods} \alias{mergeTime} \alias{mergeTime,SpatRasterDataset-method} \title{ merge SpatRasters by timelines to create a single timeseries } \description{ Combine SpatRasters with partly overlapping time-stamps to create a single time series. If there is no overlap between the SpatRasters there is no point in using this function (use \code{\link{c}} instead). Also note that time gaps are not filled. You can use \code{\link{fillTime}} to do that. } \usage{ \S4method{mergeTime}{SpatRasterDataset}(x, fun=mean, filename="", ...) } \arguments{ \item{x}{SpatRasterDataset} \item{fun}{A function that reduces a vector to a single number, such as \code{mean} or \code{min}} \item{filename}{character. Output filename} \item{...}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) s1 <- c(r, r) time(s1) <- as.Date("2001-01-01") + 0:5 s1 <- s1/10 time(s1) <- as.Date("2001-01-07") + 0:5 s2 <- s1*10 time(s2) <- as.Date("2001-01-05") + 0:5 x <- sds(s1, s1, s2) m <- mergeTime(x, mean) } \keyword{methods} \keyword{spatial} terra/man/headtail.Rd0000644000176200001440000000135514536376240014222 0ustar liggesusers\name{headtail} \docType{methods} \alias{head} \alias{head,SpatRaster-method} \alias{head,SpatVector-method} \alias{tail} \alias{tail,SpatRaster-method} \alias{tail,SpatVector-method} \title{head and tail of a SpatRaster or SpatVector} \description{ Show the head (first values) or tail (last values) of a SpatRaster or of the attributes of a SpatVector. } \usage{ head(x, ...) tail(x, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{...}{additional arguments passed on to other methods} } \value{ matrix (SpatRaster) or data.frame (SpatVector) } \seealso{ \code{\link{show}}, \code{\link{geom}} } \examples{ r <- rast(nrows=25, ncols=25) values(r) <- 1:ncell(r) head(r) tail(r) } \keyword{methods} \keyword{spatial} terra/man/contour.Rd0000644000176200001440000000325114757466737014155 0ustar liggesusers\name{contour} \docType{methods} \alias{contour} \alias{contour,SpatRaster-method} \alias{as.contour} \alias{as.contour,SpatRaster-method} \title{Contour plot} \description{ Contour lines (isolines) of a SpatRaster. Use \code{add=TRUE} to add the lines to the current plot. See \code{graphics::\link[graphics]{contour}} for details. if \code{filled=TRUE}, a new filled contour plot is made. See \code{graphics::\link[graphics]{filled.contour}} for details. \code{as.contour} returns the contour lines as a SpatVector. } \usage{ \S4method{contour}{SpatRaster}(x, maxcells=100000, filled=FALSE, ...) \S4method{as.contour}{SpatRaster}(x, maxcells=100000, ...) } \arguments{ \item{x}{SpatRaster. Only the first layer is used} \item{maxcells}{maximum number of pixels used to create the contours} \item{filled}{logical. If \code{TRUE}, a \code{\link[graphics]{filled.contour}} plot is made} \item{...}{any argument that can be passed to \code{\link[graphics]{contour}} or \code{\link[graphics]{filled.contour}} (graphics package)} } \seealso{ \code{\link[terra]{plot}} } \examples{ r <- rast(system.file("ex/elev.tif", package="terra")) plot(r) contour(r, add=TRUE) v <- as.contour(r) plot(r) lines(v) contour(r, filled=TRUE, nlevels=5) ## if you want a SpatVector with contour lines template <- disagg(rast(r), 10) rr <- resample(r, template) rr <- floor(rr/100) * 100 v <- as.polygons(rr) plot(v, 1, col=terrain.colors(7)) ## to combine filled contours with contour lines (or other spatial data) br <- seq(100, 600, 100) plot(r, breaks=br) lines(as.contour(r, levels=br)) ## or x <- as.polygons(classify(r, br)) plot(x, "elevation") } \keyword{methods} \keyword{spatial} terra/man/cover.Rd0000644000176200001440000000350114734060403013547 0ustar liggesusers\name{cover} \docType{methods} \alias{cover} \alias{cover,SpatRaster,SpatRaster-method} \alias{cover,SpatRaster,missing-method} \alias{cover,SpatVector,SpatVector-method} \title{Replace values with values from another object} \description{ Replace missing (\code{NA}) or other values in SpatRaster \code{x} with the values of SpatRaster \code{y}. Or replace missing values in the first layer with the first value encountered in other layers. For polygons: areas of \code{x} that overlap with \code{y} are replaced by \code{y} or, if \code{identity=TRUE} intersected with \code{y}. } \usage{ \S4method{cover}{SpatRaster,SpatRaster}(x, y, values=NA, filename="", ...) \S4method{cover}{SpatRaster,missing}(x, y, values=NA, filename="", ...) \S4method{cover}{SpatVector,SpatVector}(x, y, identity=FALSE, expand=TRUE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{y}{Same as \code{x} or missing if \code{x} is a SpatRaster} \item{values}{numeric. The cell values in \code{x} to be replaced by the values in \code{y}} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} \item{identity}{logical. If \code{TRUE} overlapping areas are intersected rather than replaced} \item{expand}{logical. Should parts of \code{y} that are outside of \code{x} be included?} } \value{ SpatRaster } \examples{ r1 <- r2 <- rast(ncols=36, nrows=18) values(r1) <- 1:ncell(r1) values(r2) <- runif(ncell(r2)) r2 <- classify(r2, cbind(-Inf, 0.5, NA)) r3 <- cover(r2, r1) p <- vect(system.file("ex/lux.shp", package="terra")) e <- as.polygons(ext(6, 6.4, 49.75, 50)) values(e) <- data.frame(y=10) cv <- cover(p, e) plot(cv, col=rainbow(12)) ci <- cover(p, e, identity=TRUE) lines(e, lwd=3) plot(ci, col=rainbow(12)) lines(e, lwd=3) } \keyword{methods} \keyword{spatial} terra/man/prcomp.Rd0000644000176200001440000000550514645310366013746 0ustar liggesusers\name{prcomp} \alias{prcomp} \alias{prcomp,SpatRaster-method} \title{SpatRaster PCA with prcomp} \description{ Compute principal components for SpatRaster layers. This method may be preferred to \code{\link{princomp}} for its greater numerical accuracy. However, it is slower and for very large rasters it can only be done with a sample. This may be good enough but see \code{\link{princomp}} if you want to use all values. Unlike \code{\link{princomp}}, in this method the sample variances are used with \code{n-1} as the denominator. } \usage{ \S4method{prcomp}{SpatRaster}(x, retx=TRUE, center=TRUE, scale.=FALSE, tol=NULL, rank.=NULL, maxcell=Inf) } \arguments{ \item{x}{SpatRaster} \item{retx}{a logical value indicating whether the rotated variables should be returned} \item{center}{a logical value indicating whether the variables should be shifted to be zero centered. Alternately, a vector of length equal the number of columns of x can be supplied. The value is passed to \code{\link{scale}}} \item{scale.}{a logical value indicating whether the variables should be scaled to have unit variance before the analysis takes place. The default is FALSE for consistency with S, but in general scaling is advisable. Alternatively, a vector of length equal the number of columns of x can be supplied. The value is passed to \code{\link{scale}}} \item{tol}{a value indicating the magnitude below which components should be omitted. (Components are omitted if their standard deviations are less than or equal to tol times the standard deviation of the first component.) With the default null setting, no components are omitted (unless \code{rank.} is specified less than \code{min(dim(x))}). Other settings for \code{tol} could be \code{tol = 0} or \code{tol = sqrt(.Machine$double.eps)}, which would omit essentially constant components} \item{rank.}{optionally, a number specifying the maximal rank, i.e., maximal number of principal components to be used. Can be set as alternative or in addition to tol, useful notably when the desired rank is considerably smaller than the dimensions of the matrix} \item{maxcell}{positive integer. The maximum number of cells to be used. If this is smaller than ncell(x), a regular sample of \code{x} is used} } \value{ prcomp object } \note{ \code{prcomp} may change the layer names if they are not valid. See \code{\link{make.names}}. In that case, you will get a warning, and would need to also make the layer names of \code{x} valid before using \code{predict}. Even better would be to change them before calling \code{prcomp}. } \seealso{ \code{\link{princomp}}, \code{\link[stats]{prcomp}}} \examples{ f <- system.file("ex/logo.tif", package = "terra") r <- rast(f) pca <- prcomp(r) x <- predict(r, pca) # use "index" to get a subset of the components p <- predict(r, pca, index=1:2) } \keyword{spatial} terra/man/nseg.Rd0000644000176200001440000000061014731660343013371 0ustar liggesusers\name{nseg} \alias{nseg} \alias{nseg,SpatVector-method} \title{Number of segments} \description{ Count the number of segements in a SpatVector of lines or polygons } \usage{ \S4method{nseg}{SpatVector}(x) } \arguments{ \item{x}{SpatVector} } \value{ numeric } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) nseg(v) } \keyword{methods} \keyword{spatial} terra/man/scoff.Rd0000644000176200001440000000245014536376240013544 0ustar liggesusers\name{scoff} \alias{scoff} \alias{scoff<-} \alias{scoff,SpatRaster-method} \alias{scoff<-,SpatRaster-method} \title{Scale (gain) and offset} \description{ These functions can be used to get or set the scale (gain) and offset parameters used to transform values when reading raster data from a file. The parameters are applied to the raw values using the formula below: \code{value <- value * scale + offset} The default value for scale is 1 and for offset is 0. 'scale' is sometimes referred to as 'gain'. Note that setting the scale and/or offset are intended to be used with values that are stored in a file. When values are memory, assigning scale or offset values will lead to the immediate computation of new values; in such cases it would be clearer to use \code{\link[terra]{Arith-methods}}. } \usage{ \S4method{scoff}{SpatRaster}(x) \S4method{scoff}{SpatRaster}(x)<-value } \arguments{ \item{x}{SpatRaster} \item{value}{two-column matrix with scale (first column) and offset (second column) for each layer. Or \code{NULL} to remove all scale and offset values} } \value{ matrix or changed SpatRaster } \examples{ r <- rast(system.file("ex/elev.tif", package="terra")) minmax(r) scoff(r) r[4603] scoff(r) <- cbind(10, 5) minmax(r) scoff(r) r[4603] } \keyword{ spatial } \keyword{ methods } terra/man/names.Rd0000644000176200001440000000276514536376240013560 0ustar liggesusers\name{names} \alias{name} \alias{name<-} \alias{names} \alias{names<-} \alias{names,SpatRaster-method} \alias{names<-,SpatRaster-method} \alias{names,SpatRasterDataset-method} \alias{names<-,SpatRasterDataset-method} \alias{names,SpatRasterCollection-method} \alias{names<-,SpatRasterCollection-method} \alias{names,SpatVector-method} \alias{names,SpatVectorCollection-method} \alias{names,SpatVectorProxy-method} \alias{names<-,SpatVector-method} \alias{names<-,SpatVectorCollection-method} \title{Names of Spat* objects} \description{ Get or set the names of the layers of a SpatRaster or the attributes of a SpatVector. See \code{\link{set.names}} for in-place setting of names. } \usage{ \S4method{names}{SpatRaster}(x) \S4method{names}{SpatRaster}(x)<-value \S4method{names}{SpatRasterDataset}(x) \S4method{names}{SpatRasterDataset}(x)<-value \S4method{names}{SpatVector}(x) \S4method{names}{SpatVector}(x)<-value } \arguments{ \item{x}{SpatRaster, SpatRasterDataset, or SpatVector} \item{value}{character (vector)} } \value{ character } \note{ terra enforces neither unique nor valid names. See \code{\link{make.unique}} to create unique names and \code{\link{make.names}} to make syntactically valid names. } \examples{ s <- rast(ncols=5, nrows=5, nlyrs=3) nlyr(s) names(s) names(s) <- c("a", "b", "c") names(s) # SpatVector names f <- system.file("ex/lux.shp", package="terra") v <- vect(f) names(v) names(v) <- paste0(substr(names(v), 1, 2), "_", 1:ncol(v)) names(v) } \keyword{spatial} terra/man/nearby.Rd0000644000176200001440000000333414730374256013727 0ustar liggesusers\name{nearest} \docType{methods} \alias{nearby} \alias{nearby,SpatVector-method} \alias{nearest} \alias{nearest,SpatVector-method} \title{nearby geometries} \description{ Identify geometries that are near to each other. Either get the index of all geometries within a certain distance, or the k nearest neighbors, or (with \code{nearest}) get the nearest points between two geometries. } \usage{ \S4method{nearby}{SpatVector}(x, y=NULL, distance=0, k=1, centroids=TRUE, symmetrical=TRUE, method="geo") \S4method{nearest}{SpatVector}(x, y, pairs=FALSE, centroids=TRUE, lines=FALSE, method="geo") } \arguments{ \item{x}{SpatVector} \item{y}{SpatVector or NULL} \item{distance}{numeric. maximum distance} \item{k}{positive integer. number of neighbors. Ignored if \code{distance > 0}} \item{centroids}{logical. Should the centroids of polygons be used?} \item{symmetrical}{logical. If \code{TRUE}, a near pair is only included once. That is, if geometry 1 is near to geometry 3, the implied nearness between 3 and 1 is not reported. Ignored if \code{k} neighbors are returned} \item{method}{character. One of "geo", "haversine", "cosine". With "geo" the most precise but slower method of Karney (2003) is used. The other two methods are faster but less precise} \item{pairs}{logical. If \code{TRUE} pairwise nearest points are returned (only relevant when using at least one SpatVector of lines or polygons} \item{lines}{logical. If \code{TRUE} lines between the nearest points instead of (the nearest) points } } \seealso{\code{\link{distance}}, \code{\link{relate}}, \code{\link{adjacent}}} \value{ matrix } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) nearby(v, distance=12000) } \keyword{spatial} terra/man/xmin.Rd0000644000176200001440000000347514536376240013427 0ustar liggesusers\name{xmin} \docType{methods} \alias{xmin} \alias{xmax} \alias{ymin} \alias{ymax} \alias{xmin<-} \alias{xmax<-} \alias{ymin<-} \alias{ymax<-} \alias{xmin,SpatExtent-method} \alias{xmin,SpatRaster-method} \alias{xmin,SpatVector-method} \alias{xmax,SpatExtent-method} \alias{xmax,SpatRaster-method} \alias{xmax,SpatVector-method} \alias{ymin,SpatExtent-method} \alias{ymin,SpatRaster-method} \alias{ymin,SpatVector-method} \alias{ymax,SpatExtent-method} \alias{ymax,SpatRaster-method} \alias{ymax,SpatVector-method} \alias{xmin<-,SpatExtent,numeric-method} \alias{xmin<-,SpatRaster,numeric-method} \alias{xmax<-,SpatExtent,numeric-method} \alias{xmax<-,SpatRaster,numeric-method} \alias{ymin<-,SpatExtent,numeric-method} \alias{ymin<-,SpatRaster,numeric-method} \alias{ymax<-,SpatExtent,numeric-method} \alias{ymax<-,SpatRaster,numeric-method} \title{Get or set single values of an extent} \description{ Get or set single values of an extent. Values can be set for a SpatExtent or SpatRaster, but not for a SpatVector) } \usage{ \S4method{xmin}{SpatExtent}(x) \S4method{xmax}{SpatExtent}(x) \S4method{ymin}{SpatExtent}(x) \S4method{ymax}{SpatExtent}(x) \S4method{xmin}{SpatRaster}(x) \S4method{xmax}{SpatRaster}(x) \S4method{ymin}{SpatRaster}(x) \S4method{ymax}{SpatRaster}(x) \S4method{xmin}{SpatVector}(x) \S4method{xmax}{SpatVector}(x) \S4method{ymin}{SpatVector}(x) \S4method{ymax}{SpatVector}(x) \S4method{xmin}{SpatRaster,numeric}(x)<-value \S4method{xmax}{SpatRaster,numeric}(x)<-value \S4method{ymin}{SpatRaster,numeric}(x)<-value \S4method{ymax}{SpatRaster,numeric}(x)<-value } \arguments{ \item{x}{SpatRaster, SpatExtent, or SpatVector} \item{value}{numeric} } \value{ SpatExtent or numeric coordinate } \examples{ r <- rast() ext(r) ext(c(0, 20, 0, 20)) xmin(r) xmin(r) <- 0 xmin(r) } \keyword{spatial} terra/man/identical.Rd0000644000176200001440000000156214547315614014403 0ustar liggesusers\name{identical} \docType{methods} \alias{identical} \alias{identical,SpatRaster,SpatRaster-method} \title{Compare two SpatRasters for equality} \description{ Compare two SpatRasters for equality. First the attributes of the objects are compared. If these are the same, a the raster cells are compared as well. This can be time consuming, and you may prefer to use a sample instead with \code{\link{all.equal}} } \usage{ \S4method{identical}{SpatRaster,SpatRaster}(x, y) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatRaster} } \seealso{\code{\link{all.equal}}, \code{\link{compareGeom}}} \value{ single logical value } \examples{ x <- sqrt(1:100) mat <- matrix(x, 10, 10) r1 <- rast(nrows=10, ncols=10, xmin=0, vals = x) r2 <- rast(nrows=10, ncols=10, xmin=0, vals = t(mat)) identical(r1, r2) identical(r1, r1*1) identical(rast(r1), rast(r2)) } \keyword{spatial} terra/man/extract.Rd0000644000176200001440000001450514736271542014123 0ustar liggesusers\name{extract} \docType{methods} \alias{extract} \alias{extract,SpatRaster,SpatVector-method} \alias{extract,SpatRaster,sf-method} \alias{extract,SpatRaster,SpatExtent-method} \alias{extract,SpatRaster,matrix-method} \alias{extract,SpatRaster,data.frame-method} \alias{extract,SpatRaster,numeric-method} \alias{extract,SpatVector,SpatVector-method} \alias{extract,SpatVector,matrix-method} \alias{extract,SpatVector,data.frame-method} \alias{extract,SpatRasterCollection,ANY-method} \alias{extract,SpatRasterDataset,ANY-method} \title{Extract values from a SpatRaster} \description{ Extract values from a SpatRaster for a set of locations. The locations can be a SpatVector (points, lines, polygons), a data.frame or matrix with (x, y) or (longitude, latitude -- in that order!) coordinates, or a vector with cell numbers. When argument \code{y} is a \code{SpatVector} the first column has the ID (record number) of the \code{SpatVector} used (unless you set \code{ID=FALSE}). Alternatively, you can use \code{\link{zonal}} after using \code{\link{rasterize}} with a \code{SpatVector} (this may be more efficient in some cases). } \usage{ \S4method{extract}{SpatRaster,SpatVector}(x, y, fun=NULL, method="simple", cells=FALSE, xy=FALSE, ID=TRUE, weights=FALSE, exact=FALSE, touches=is.lines(y), small=TRUE, layer=NULL, bind=FALSE, raw=FALSE, search_radius=0, ...) \S4method{extract}{SpatRaster,SpatExtent}(x, y, cells=FALSE, xy=FALSE) \S4method{extract}{SpatRaster,matrix}(x, y, cells=FALSE, method="simple") \S4method{extract}{SpatRaster,numeric}(x, y, xy=FALSE, raw=FALSE) \S4method{extract}{SpatVector,SpatVector}(x, y) } \arguments{ \item{x}{SpatRaster or SpatVector of polygons} \item{y}{SpatVector (points, lines, or polygons). Alternatively, for points, a 2-column matrix or data.frame (x, y) or (lon, lat). Or a vector with cell numbers} \item{fun}{function to summarize the extracted data by line or polygon geometry. You can use \code{fun=table} to tabulate raster values for each line or polygon geometry. If \code{weights=TRUE} or \code{exact=TRUE} only \code{mean}, \code{sum}, \code{min}, \code{max} and \code{table} are accepted). Ignored if \code{y} has point geometry} \item{method}{character. method for extracting values with points ("simple" or "bilinear"). With "simple" values for the cell a point falls in are returned. With "bilinear" the returned values are interpolated from the values of the four nearest raster cells} \item{cells}{logical. If \code{TRUE} the cell numbers are also returned, unless \code{fun} is not \code{NULL}. Also see \code{\link{cells}}} \item{xy}{logical. If \code{TRUE} the coordinates of the cells are also returned, unless \code{fun} is not \code{NULL}. See \code{\link{xyFromCell}}} \item{ID}{logical. Should an ID column be added? If so, the first column returned has the IDs (record numbers) of \code{y}} \item{weights}{logical. If \code{TRUE} and \code{y} has polygons, the approximate fraction of each cell that is covered is returned as well, for example to compute a weighted mean} \item{exact}{logical. If \code{TRUE} and \code{y} has polygons, the exact fraction of each cell that is covered is returned as well, for example to compute a weighted mean} \item{touches}{logical. If \code{TRUE}, values for all cells touched by lines or polygons are extracted, not just those on the line render path, or whose center point is within the polygon. Not relevant for points; and always considered \code{TRUE} when \code{weights=TRUE} or \code{exact=TRUE}} \item{small}{logical. If \code{TRUE}, values for all cells in touched polygons are extracted if none of the cells center points is within the polygon; even if \code{touches=FALSE}} \item{layer}{character or numeric to select the layer to extract from for each geometry. If \code{layer} is a character it can be a name in \code{y} or a vector of layer names. If it is numeric, it must be integer values between \code{1} and \code{nlyr(x)}} \item{bind}{logical. If \code{TRUE}, a SpatVector is returned consisting of the input SpatVector \code{y} and the \code{cbind}-ed extracted values} \item{raw}{logical. If \code{TRUE}, a matrix is returned with the "raw" numeric cell values. If \code{FALSE}, a data.frame is returned and the cell values are transformed to factor, logical, or integer values, where appropriate} \item{search_radius}{positive number. A search-radius that is used when \code{y} has point geometry. If this value is larger than zero, it is the maximum distance used to find the a cell with a value that is nearest to the cell that the point falls in if that cell that has a missing (\code{NA}) value. The value of this nearest cell, the distance to the original cell, and the new cell number are returned. The radius should be expressed in m if the data have lon/lat coordinates or in the distance unit of the crs in other cases (typically also m). For lon/lat data, the mean latitude of the points is used to compute the distances, so this may be imprecise for data with a large latitudinal range} \item{...}{additional arguments to \code{fun} if \code{y} is a SpatVector. For example \code{na.rm=TRUE}. Or arguments passed to the \code{SpatRaster,SpatVector} method if \code{y} is a matrix (such as the \code{method} and \code{cells} arguments)} } \value{data.frame, matrix or SpatVector} \seealso{\code{\link{values}, \link{zonal}, \link{extractAlong}, \link{extractRange}, \link{rapp}}} \examples{ r <- rast(ncols=5, nrows=5, xmin=0, xmax=5, ymin=0, ymax=5) values(r) <- 1:25 xy <- rbind(c(0.5,0.5), c(2.5,2.5)) p <- vect(xy, crs="+proj=longlat +datum=WGS84") extract(r, xy) extract(r, p) r[1,] r[5] r[,5] r[c(0:2, 99:101)] f <- system.file("ex/meuse.tif", package="terra") r <- rast(f) xy <- cbind(179000, 330000) xy <- rbind(xy-100, xy, xy+1000) extract(r, xy) p <- vect(xy) g <- geom(p) g extract(r, p) x <- r + 10 extract(x, p) i <- cellFromXY(r, xy) x[i] r[i] y <- c(x,x*2,x*3) y[i] ## extract with a polygon f <- system.file("ex/lux.shp", package="terra") v <- vect(f) v <- v[1:2,] rf <- system.file("ex/elev.tif", package="terra") x <- rast(rf) extract(x, v, mean, na.rm=TRUE) z <- rast(v, resolution=.1, names="test") values(z) <- 1:ncell(z) e <- extract(z, v, ID=TRUE) e tapply(e[,2], e[,1], mean, na.rm=TRUE) x <- c(z, z*2, z/3) names(x) <- letters[1:3] e <- extract(x, v, ID=TRUE) de <- data.frame(e) aggregate(de[,2:4], de[,1,drop=FALSE], mean) } \keyword{methods} \keyword{spatial} terra/man/density.Rd0000644000176200001440000000140014536376240014115 0ustar liggesusers\name{density} \alias{density} \alias{density,SpatRaster-method} \docType{methods} \title{Density plot} \description{ Create density plots of the cell values of a SpatRaster } \usage{ \S4method{density}{SpatRaster}(x, maxcells=100000, plot=TRUE, main, ...) } \arguments{ \item{x}{SpatRaster} \item{maxcells}{the maximum number of (randomly sampled) cells to be used for creating the plot} \item{plot}{if \code{TRUE} produce a plot, else return a density object} \item{main}{character. Caption of plot(s)} \item{...}{additional arguments passed to \code{\link{plot}}} } \value{ density plot (and a density object, returned invisibly if \code{plot=TRUE)} } \examples{ logo <- rast(system.file("ex/logo.tif", package="terra")) density(logo) } \keyword{spatial} terra/man/as.polygons.Rd0000644000176200001440000000412314736322115014711 0ustar liggesusers\name{as.polygons} \docType{methods} \alias{as.polygons} \alias{as.polygons,SpatRaster-method} \alias{as.polygons,SpatVector-method} \alias{as.polygons,SpatExtent-method} \title{Conversion to a SpatVector of polygons} \description{ Conversion of a SpatRaster, SpatVector or SpatExtent to a SpatVector of polygons. } \usage{ \S4method{as.polygons}{SpatRaster}(x, round=TRUE, aggregate=TRUE, values=TRUE, na.rm=TRUE, na.all=FALSE, extent=FALSE, digits=0, ...) \S4method{as.polygons}{SpatVector}(x, extent=FALSE) \S4method{as.polygons}{SpatExtent}(x, crs="") } \arguments{ \item{x}{SpatRaster, SpatVector or SpatExtent} \item{round}{logical; If \code{TRUE} and \code{aggregate=TRUE}, values are rounded before aggregation. If this value is \code{FALSE} the SpatVector returned can have very many polygons and can be very large} \item{aggregate}{logical; combine cells with the same values? If \code{TRUE} only the first layer in \code{x} is processed} \item{values}{logical; include cell values as attributes?} \item{extent}{logical. if \code{TRUE}, a polygon for the extent of the SpatRaster or SpatVector is returned. If \code{x} is a SpatRaster, the polygon has vertices for each row and column, not just the four corners of the raster. This can be useful for more precise projection. If that is not required, it is more efficient to get the extent represented by only the four corners with \code{as.polygons(ext(x), crs=crs(x))}} \item{na.rm}{logical. If \code{TRUE} cells that are \code{NA} are ignored} \item{na.all}{logical. If \code{TRUE} cells are only ignored if \code{na.rm=TRUE} and their value is \code{NA} for \bold{all} layers instead of for \code{any} layer} \item{digits}{integer. The number of digits for rounding (if \code{round=TRUE})} \item{crs}{character. The coordinate reference system (see \code{\link{crs}})} \item{...}{additional arguments. For backward compatibility. Will be removed in the future} } \value{ SpatVector } \seealso{ \code{\link{as.lines}}, \code{\link{as.points}} } \examples{ r <- rast(ncols=2, nrows=2) values(r) <- 1:ncell(r) p <- as.polygons(r) p } \keyword{spatial} terra/man/erase.Rd0000644000176200001440000000352314536376240013545 0ustar liggesusers\name{erase} \docType{methods} \alias{erase} \alias{erase,SpatVector,SpatVector-method} \alias{erase,SpatVector,missing-method} \alias{erase,SpatVector,SpatExtent-method} \alias{erase,SpatGraticule,SpatVector-method} \title{ Erase parts of a SpatVector object} \description{ Erase parts of a SpatVector with another SpatVector or with a SpatExtent. You can also erase (parts of) polygons with the other polygons of the same SpatVector. } \usage{ \S4method{erase}{SpatVector,SpatVector}(x, y) \S4method{erase}{SpatVector,missing}(x, sequential=TRUE) \S4method{erase}{SpatVector,SpatExtent}(x, y) } \arguments{ \item{x}{SpatVector} \item{y}{SpatVector or SpatExtent} \item{sequential}{logical. Should areas be erased sequentially? See Details} } \value{ SpatVector or SpatExtent } \seealso{ \code{\link{crop}} and \code{\link{intersect}} for the inverse. The equivalent for SpatRaster is \code{\link{mask}} } \details{ If polygons are erased sequentially, everything that is covered by the first polygon is removed from all other polygons, then everything that is covered by (what is remaining of) the second polygon is removed, etc. If polygons are not erased sequentially, all overlapping areas are erased and only the areas covered by a single geometry are returned. } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) # polygons with polygons or extent e <- ext(5.6, 6, 49.55, 49.7) x <- erase(v, e) p <- vect("POLYGON ((5.8 49.8, 6 49.9, 6.15 49.8, 6 49.6, 5.8 49.8))") y <- erase(v, p) # lines with polygons lns <- as.lines(rast(v, ncol=10, nrow=10))[12:22] eln <- erase(lns, v) plot(v) lines(lns, col='blue', lwd=4, lty=3) lines(eln, col='red', lwd=2) ## self-erase h <- convHull(v[-12], "NAME_1") he <- erase(h) plot(h, lwd=2, border="red", lty=2) lines(he, col="gray", lwd=3) } \keyword{methods} \keyword{spatial} terra/man/is.rotated.Rd0000644000176200001440000000106714746471246014530 0ustar liggesusers\name{is.rotated} \docType{methods} \alias{is.rotated} \alias{is.rotated,SpatRaster-method} \title{Check for rotation} \description{ Check if a SpatRaster is "rotated" and needs to be rectified before it can be used See \code{\link{rectify}} } \usage{ \S4method{is.rotated}{SpatRaster}(x) } \arguments{ \item{x}{SpatRaster} } \value{ logical. One value for each raster data *source* } \seealso{ \code{\link{rectify}, \link{is.flipped}} } \examples{ r <- rast(nrows=10, ncols=10, vals=1:100) is.rotated(r) } \keyword{methods} \keyword{spatial} terra/man/subst.Rd0000644000176200001440000000344314715133002013571 0ustar liggesusers\name{subst} \docType{methods} \alias{subst} \alias{subst,SpatRaster-method} \title{replace cell values} \description{ Substitute(replace) cell values of a SpatRaster with a new value. See \code{\link{classify}} for more complex/flexible replacement. } \usage{ \S4method{subst}{SpatRaster}(x, from, to, others=NULL, raw=FALSE, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{from}{numeric value(s). Normally a vector of the same length as `to`. If \code{x} has multiple layers, it can also be a matrix of numeric value(s) where \code{nrow(x) == length(to)}. In that case the output has a single layer, with values based on the combination of the values of the input layers} \item{to}{numeric value(s). Normally a vector of the same length as `from`. If \code{x} has a single layer, it can also be a matrix of numeric value(s) where \code{nrow(x) == length(from)}. In that case the output has multiple layers, one for each column in \code{to}} \item{others}{numeric. If not \code{NULL} all values that are not matched are set to this value. Otherwise they retain their original value.} \item{raw}{logical. If \code{TRUE}, the values in from and to are the raw cell values, not the categorical labels. Only relevant if \code{is.factor(x)}} \item{filename}{character. Output filename} \item{...}{Additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{classify}}, \code{\link{clamp}}} \examples{ r <- rast(ncols=5, nrows=5, xmin=0, xmax=1, ymin=0, ymax=1, crs="") r <- init(r, 1:6) x <- subst(r, 3, 7) x <- subst(r, 2:3, NA) x <- subst(x, NA, 10) # multiple output layers z <- subst(r, 2:3, cbind(20,30)) # multiple input layers rr <- c(r, r+1, r+2) m <- rbind(c(1:3), c(3:5)) zz <- subst(rr, m, c(100, 200)) } \keyword{spatial} terra/man/roll.Rd0000644000176200001440000000453014757466720013425 0ustar liggesusers\name{roll} \alias{roll} \alias{roll,SpatRaster-method} \alias{roll,numeric-method} \title{Rolling (moving) functions} \description{ Compute "rolling" or "moving" values, such as the "rolling average" for each cell in a SpatRaster. See \code{\link{focal}} for spatially moving averages and similar computations. And see \code{\link{cumsum}} and other cum* functions to compute cumulate values. } \usage{ \S4method{roll}{SpatRaster}(x, n, fun=mean, type="around", circular=FALSE, na.rm=FALSE, filename="", ..., wopt=list()) \S4method{roll}{numeric}(x, n, fun=mean, type="around", circular=FALSE, na.rm=FALSE, ...) } \arguments{ \item{x}{SpatRaster or numeric} \item{n}{integer > 1. The size of the "window", that is, the number of sequential cells to use in \code{fun}} \item{fun}{a function like mean, min, max, sum} \item{type}{character. One of "around", "to", or "from". The choice indicates which values should be used in the computation. The focal cell is always used. If type is "around", \code{(n-1)/2} before and after the focal cell are also included. If type = "from", \code{n-1} cells are after the focal cell are included. If type = "to", \code{n-1} cells before the focal cell are included. For example, when using n=3 for element 5 of a vector; "around" used elements 4,5,6; "to" used elements 3,4,5, and "from" uses elements 5,6,7} \item{circular}{logical. If \code{TRUE}, the data are considered to have a circular nature (e.g. days or months of the year), such that there are no missing values before first or after the last value.} \item{na.rm}{logical. If \code{TRUE}, \code{NA} values should be ignored (by \code{fun})} \item{filename}{character. Output filename} \item{...}{additional arguments for \code{fun}} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ Same as \code{x} } \seealso{\code{\link{cumsum}}, \code{\link{focal}}} \examples{ ## numeric roll(1:12, 3, mean) roll(1:12, 3, mean, "to") roll(1:12, 3, mean, circular=TRUE) ## SpatRaster r <- rast(ncol=2, nrow=2, nlyr=10, vals=1) r[1,2] <- 2 r[2,2] <- 4 values(roll(r, n=3, "sum", "from", na.rm=FALSE)) values(roll(r, n=3, "sum", "from", na.rm=TRUE)) values(roll(r, n=3, "sum", "from", circular=TRUE)) values(roll(r, n=3, "sum", "to", na.rm=TRUE)) values(roll(r, n=3, "sum", "around", circular=TRUE)) } \keyword{spatial} terra/man/atan2.Rd0000644000176200001440000000176514536376240013461 0ustar liggesusers\name{atan2} \alias{atan2,SpatRaster,SpatRaster-method} \alias{atan2} \alias{atan_2,SpatRaster,SpatRaster-method} \alias{atan_2} \title{Two argument arc-tangent} \description{ For SpatRasters x and y, atan2(y, x) returns the angle in radians for the tangent y/x, handling the case when x is zero. See \code{\link[base]{Trig}} See \code{\link{Math-methods}} for other trigonometric and mathematical functions that can be used with SpatRasters. } \usage{ \S4method{atan2}{SpatRaster,SpatRaster}(y, x) \S4method{atan_2}{SpatRaster,SpatRaster}(y, x, filename, ...) } \arguments{ \item{y}{SpatRaster} \item{x}{SpatRaster} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{Math-methods}} } \examples{ r1 <- rast(nrows=10, ncols=10) r2 <- rast(nrows=10, ncols=10) values(r1) <- (runif(ncell(r1))-0.5) * 10 values(r2) <- (runif(ncell(r1))-0.5) * 10 atan2(r1, r2) } \keyword{math} \keyword{spatial} terra/man/is.lonlat.Rd0000644000176200001440000000321314536376240014345 0ustar liggesusers\name{is.lonlat} \alias{is.lonlat} \alias{is.lonlat,SpatRaster-method} \alias{is.lonlat,SpatVector-method} \alias{is.lonlat,character-method} \title{Check for longitude/latitude crs} \description{ Test whether a SpatRaster or SpatVector has a longitude/latitude coordinate reference system (CRS), or perhaps has one. That is, when the CRS is unknown (\code{""}) but the x coordinates are within -181 and 181 and the y coordinates are within -90.1 and 90.1. For a SpatRaster you can also test if it has a longitude/latitude CRS and it is "global" (covers all longitudes). A warning is given if the CRS is missing or if it is specified as longitude/latitude but the coordinates do not match that. } \usage{ \S4method{is.lonlat}{SpatRaster}(x, perhaps=FALSE, warn=TRUE, global=FALSE) \S4method{is.lonlat}{SpatVector}(x, perhaps=FALSE, warn=TRUE) \S4method{is.lonlat}{character}(x, perhaps=FALSE, warn=TRUE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{perhaps}{logical. If \code{TRUE} and the CRS is unknown, the method returns \code{TRUE} if the coordinates are plausible for longitude/latitude} \item{warn}{logical. If \code{TRUE}, a warning is given if the CRS is unknown but assumed to be lon/lat and \code{perhaps=TRUE}} \item{global}{logical. If \code{TRUE}, the method tests if the raster covers all longitudes (from -180 to 180 degrees) such that the extreme columns are in fact adjacent} } \value{ logical or NA } \examples{ r <- rast() is.lonlat(r) is.lonlat(r, global=TRUE) crs(r) <- "" is.lonlat(r) is.lonlat(r, perhaps=TRUE, warn=FALSE) crs(r) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84" is.lonlat(r) } \keyword{spatial} terra/man/focalReg.Rd0000644000176200001440000000350714536376240014172 0ustar liggesusers\name{focalReg} \alias{focalReg} \alias{focalReg,SpatRaster-method} \title{Focal regression} \description{ Calculate values for a moving-window by comparing the value in one layers with the values in one to many other layers. A typical case is the computation of the coefficients for a focal linear regression model. } \usage{ \S4method{focalReg}{SpatRaster}(x, w=3, fun="ols", ..., fillvalue=NA, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster with at least two layers. The first is the "Y" (dependent) variable and the remainder are the "X" (independent) variables} \item{w}{numeric or matrix to define the focal window. The window an be defined as one (for a square) or two numbers (row, col); or with an odd-sized weights matrix. See the Details section in \code{\link{focal}}. Note that if a matrix with numbers other than zero or one are used, the values are used as weights. For this to work, \code{fun} must have an argument \code{weights}} \item{fun}{a function with at least two arguments (one for each layer). There is a built-in function "ols" for both the weighted and unweighted Ordinary Least Square regression. This function has an additional argument \code{na.rm=FALSE} and \code{intercept=TRUE}} \item{...}{additional arguments for \code{fun}} \item{fillvalue}{numeric. The value of the cells in the virtual rows and columns outside of the raster} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \seealso{ \code{\link{focal}, \link{focal3D}}, \link{focalValues}} \examples{ r <- rast(ncols=10, nrows=10, ext(0, 10, 0, 10)) values(r) <- 1:ncell(r) x <- c(r, init(r, runif) * r) f <- focalReg(x, 3) } \keyword{spatial} terra/man/panel.Rd0000644000176200001440000000406514757466372013562 0ustar liggesusers\name{panel} \docType{methods} \alias{panel} \alias{panel,SpatRaster-method} \title{Map panel} \description{ Show multiple maps that share a single legend. } \usage{ \S4method{panel}{SpatRaster}(x, main, loc.main="topleft", nc, nr, maxnl=16, maxcell=500000, box=FALSE, pax=list(), plg=list(), range=NULL, halo=TRUE, type=NULL, ...) } \arguments{ \item{x}{SpatRaster} \item{main}{character. Main plot titles (one for each layer to be plotted). You can use arguments \code{cex.main}, \code{font.main}, \code{col.main} to change the appearance} \item{loc.main}{numeric of character to set the location of the main title. Either two coordinates, or a character value such as "topleft")} \item{nc}{positive integer. Optional. The number of columns to divide the plotting device in (when plotting multiple layers)} \item{nr}{positive integer. Optional. The number of rows to divide the plotting device in (when plotting multiple layers)} \item{maxnl}{positive integer. Maximum number of layers to plot (for a multi-layer object)} \item{maxcell}{positive integer. Maximum number of cells to use for the plot} \item{box}{logical. Should a box be drawn around the map?} \item{plg}{see \code{\link{plot}}} \item{pax}{see \code{\link{plot}}} \item{range}{numeric. minimum and maximum values to be used for the continuous legend } \item{halo}{logical. Use a halo around main (the title)?} \item{type}{character. Type of map/legend. One of "continuous", "classes", or "interval". If not specified, the type is chosen based on the data} \item{...}{arguments passed to \code{plot("SpatRaster", "numeric")} and additional graphical arguments} } \seealso{ \code{\link{plot}} and see \code{rasterVis::levelplot} and \code{tidyterra::autoplot} for more sophisticated panel plots. } \examples{ r <- rast(system.file("ex/elev.tif", package="terra")) v <- vect(system.file("ex/lux.shp", package="terra")) x <- c(r, r/2, r*2, r) names(x) <- paste0("(", LETTERS[1:4], ")") panel(x) panel(x, fun=function() lines(v), loc.main="topright") } \keyword{methods} \keyword{spatial} terra/man/subset.Rd0000644000176200001440000000413214536376240013750 0ustar liggesusers\name{subset} \alias{subset} \alias{subset,SpatRaster-method} \alias{subset,SpatVector-method} \title{Subset a SpatRaster or a SpatVector} \description{ Select a subset of layers from a SpatRaster or select a subset of records (row) and/or variables (columns) from a SpatVector. } \usage{ \S4method{subset}{SpatRaster}(x, subset, negate=FALSE, NSE=FALSE, filename="", overwrite=FALSE, ...) \S4method{subset}{SpatVector}(x, subset, select, drop=FALSE, NSE=FALSE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{subset}{ if \code{x} is a \code{SpatRaster}: integer or character to select layers if \code{x} is a \code{SpatVector}: logical expression indicating the rows to keep (missing values are taken as FALSE) } \item{select}{expression, indicating columns to select} \item{negate}{logical. If \code{TRUE} all layers that are \bold{not} in the subset are selected} \item{NSE}{logical. If \code{TRUE}, non-standard evaluation (the use of unquoted variable names) is allowed. Set this to \code{FALSE} when calling \code{subset} from a function} \item{drop}{logical. If \code{TRUE}, the geometries will be dropped, and a data.frame is returned} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ if \code{x} is a \code{SpatRaster}: SpatRaster if \code{x} is a \code{SpatVector}: SpatVector or, if \code{drop=TRUE}, a \code{data.frame}. } \examples{ ### SpatRaster s <- rast(system.file("ex/logo.tif", package="terra")) subset(s, 2:3) subset(s, c(3,2,3,1)) #equivalent to s[[ c(3,2,3,1) ]] s[[c("red", "green")]] s$red # expression based (partial) matching of names with single brackets s["re"] s["^re"] # not with double brackets # s[["re"]] ### SpatVector v <- vect(system.file("ex/lux.shp", package="terra")) subset(v, v$NAME_1 == "Diekirch", c("NAME_1", "NAME_2")) subset(v, NAME_1 == "Diekirch", c(NAME_1, NAME_2), NSE=TRUE) # or like this v[2:3,] v[1:2, 2:3] v[1:2, c("NAME_1", "NAME_2")] } \keyword{ spatial } terra/man/is.valid.Rd0000644000176200001440000000207714536376240014162 0ustar liggesusers\name{is.valid} \alias{is.valid} \alias{is.valid,SpatVector-method} \alias{is.valid,SpatExtent-method} \alias{makeValid} \alias{makeValid,SpatVector-method} \title{Check or fix polygon or extent validity} \description{ Check the validity of polygons or attempt to fix it. Or check the validity of a SpatExtent. } \usage{ \S4method{is.valid}{SpatVector}(x, messages=FALSE, as.points=FALSE) \S4method{makeValid}{SpatVector}(x) \S4method{is.valid}{SpatExtent}(x) } \arguments{ \item{x}{SpatVector or SpatExtent} \item{messages}{logical. If \code{TRUE} the error messages are returned} \item{as.points}{logical. If \code{TRUE}, it is attempted to return locations where polygons are invalid as a SpatVector or points} } \value{ logical } \seealso{\code{\link{topology}}} \examples{ w <- vect("POLYGON ((0 -5, 10 0, 10 -10, 0 -5))") is.valid(w) w <- vect("POLYGON ((0 -5, 10 0, 10 -10, 4 -2, 0 -5))") is.valid(w) is.valid(w, TRUE) plot(w) points(cbind(4.54, -2.72), cex=2, col="red") e <- ext(0, 1, 0, 1) is.valid(e) ee <- ext(0, 0, 0, 0) is.valid(ee) } \keyword{spatial} terra/man/depth.Rd0000644000176200001440000000105314536376240013546 0ustar liggesusers\name{depth} \alias{depth} \alias{depth<-} \alias{depth,SpatRaster-method} \alias{depth<-,SpatRaster-method} \title{depth of SpatRaster layers} \description{ Get or set the depth of the layers of a SpatRaster. Experimental. } \usage{ \S4method{depth}{SpatRaster}(x) \S4method{depth}{SpatRaster}(x)<-value } \arguments{ \item{x}{SpatRaster} \item{value}{numeric vector} } \value{ numeric } \seealso{\code{\link{time}}} \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) depth(s) <- 1:3 depth(s) } \keyword{spatial} terra/man/catalyze.Rd0000644000176200001440000000232514536376240014261 0ustar liggesusers\name{catalyze} \docType{methods} \alias{as.numeric} \alias{as.numeric,SpatRaster-method} \alias{catalyze} \alias{catalyze,SpatRaster-method} \title{Factors to numeric} \description{ Change a categorical layer into one or more numerical layers. With \code{as.numeric} you can transfer the active category values to cell values in a non-categorical SpatRaster. \code{catalyze} creates new layers for each category. } \usage{ \S4method{as.numeric}{SpatRaster}(x, index=NULL, filename="", ...) \S4method{catalyze}{SpatRaster}(x, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{index}{positive integer or category indicating the category to use. If \code{NULL} the active category is used} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{activeCat}}, \code{\link{cats}}} \examples{ set.seed(0) r <- rast(nrows=10, ncols=10) values(r) <- sample(3, ncell(r), replace=TRUE) + 10 d <- data.frame(id=11:13, cover=c("forest", "water", "urban"), letters=letters[1:3], value=10:12) levels(r) <- d catalyze(r) activeCat(r) <- 3 as.numeric(r) } \keyword{methods} \keyword{spatial} terra/man/approximate.Rd0000644000176200001440000000626014536376240015000 0ustar liggesusers\name{approximate} \docType{methods} \alias{approximate} \alias{approximate,SpatRaster-method} \title{Estimate values for cell values that are \code{NA} by interpolating between layers} \description{ approximate uses the \code{stats} function \code{\link{approx}} to estimate values for cells that are \code{NA} by interpolation across layers. Layers are considered equidistant, unless argument \code{z} is used, or \code{time(x)} returns values that are not \code{NA}, in which case these values are used to determine distance between layers. For estimation based on neighboring cells see \code{\link{focal}} } \usage{ \S4method{approximate}{SpatRaster}(x, method="linear", yleft, yright, rule=1, f=0, ties=mean, z=NULL, NArule=1,filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{method}{specifies the interpolation method to be used. Choices are "linear" or "constant" (step function; see the example in \code{\link{approx}}} \item{yleft}{the value to be returned before a non-\code{NA} value is encountered. The default is defined by the value of rule given below} \item{yright}{the value to be returned after the last non-\code{NA} value is encountered. The default is defined by the value of rule given below} \item{rule}{an integer (of length 1 or 2) describing how interpolation is to take place at for the first and last cells (before or after any non-\code{NA} values are encountered). If rule is 1 then NAs are returned for such points and if it is 2, the value at the closest data extreme is used. Use, e.g., \code{rule = 2:1}, if the left and right side extrapolation should differ} \item{f}{for method = "constant" a number between 0 and 1 inclusive, indicating a compromise between left- and right-continuous step functions. If y0 and y1 are the values to the left and right of the point then the value is \code{y0*(1-f)+y1*f} so that \code{f = 0)} is right-continuous and \code{f = 1} is left-continuous} \item{ties}{Handling of tied 'z' values. Either a function with a single vector argument returning a single number result or the string "ordered"} \item{z}{numeric vector to indicate the distance between layers (e.g., depth). The default is \code{time(x)} if these are not \code{NA} or else \code{1:nlys(x)} } \item{NArule}{single integer used to determine what to do when only a single layer with a non-\code{NA} value is encountered (and linear interpolation is not possible). The default value of 1 indicates that all layers will get this value for that cell; all other values do not change the cell values} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{ \link{focal}}, \code{\link{fillTime}} } \examples{ r <- rast(ncols=5, nrows=5) r1 <- setValues(r, runif(ncell(r))) r2 <- setValues(r, runif(ncell(r))) r3 <- setValues(r, runif(ncell(r))) r4 <- setValues(r, runif(ncell(r))) r5 <- setValues(r, NA) r6 <- setValues(r, runif(ncell(r))) r1[6:10] <- NA r2[5:15] <- NA r3[8:25] <- NA s <- c(r1,r2,r3,r4,r5,r6) s[1:5] <- NA x1 <- approximate(s) x2 <- approximate(s, rule=2) x3 <- approximate(s, rule=2, z=c(1,2,3,5,14,15)) } \keyword{spatial} terra/man/pairs.Rd0000644000176200001440000000210014536376240013552 0ustar liggesusers\name{pairs} \docType{methods} \alias{pairs} \alias{pairs,SpatRaster-method} \title{ Pairs plot (matrix of scatterplots) } \description{ Pair plots of layers in a SpatRaster. This is a wrapper around graphics function \code{\link[graphics]{pairs}}. } \usage{ \S4method{pairs}{SpatRaster}(x, hist=TRUE, cor=TRUE, use="pairwise.complete.obs", maxcells=100000, ...) } \arguments{ \item{x}{SpatRaster} \item{hist}{logical. If TRUE a histogram of the values is shown on the diagonal} \item{cor}{logical. If TRUE the correlation coefficient is shown in the upper panels} \item{use}{argument passed to the \code{\link[stats]{cor}} function} \item{maxcells}{integer. Number of pixels to sample from each layer of a large SpatRaster} \item{...}{additional arguments (graphical parameters)} } \seealso{ \code{\link{boxplot}, \link{hist}} } \examples{ r <-rast(system.file("ex/elev.tif", package="terra")) s <- c(r, 1/r, sqrt(r)) names(s) <- c("elevation", "inverse", "sqrt") pairs(s) # to make indvidual histograms: hist(r) # or scatter plots: plot(s[[1]], s[[2]]) } \keyword{spatial} terra/man/persp.Rd0000644000176200001440000000147014536376240013576 0ustar liggesusers\name{persp} \docType{methods} \alias{persp} \alias{persp,SpatRaster-method} \title{Perspective plot} \description{ Perspective plot of a SpatRaster. This is an implementation of a generic function in the graphics package. } \usage{ \S4method{persp}{SpatRaster}(x, maxcells=100000, ...) } \arguments{ \item{x}{SpatRaster. Only the first layer is used} \item{maxcells}{integer > 0. Maximum number of cells to use for the plot. If \code{maxpixels < ncell(x)}, \code{spatSample(method="regular")} is used before plotting} \item{...}{Any argument that can be passed to \code{\link[graphics]{persp}} (graphics package)} } \seealso{ \code{\link[graphics]{persp}}, \code{contour}, \code{plot} } \examples{ r <- rast(system.file("ex/elev.tif", package="terra")) persp(r) } \keyword{methods} \keyword{spatial} terra/man/surfArea.Rd0000644000176200001440000000176214731624170014214 0ustar liggesusers\name{surfArea} \alias{surfArea} \alias{surfArea,SpatRaster-method} \title{ Compute surface area from elevation data } \description{ It is often said that if Wales was flattened out it would have an area bigger than England. This function computes the surface area for a raster with elevation values, taking into account the sloping nature of the surface. } \usage{ \S4method{surfArea}{SpatRaster}(x, filename="", ...) } \arguments{ \item{x}{SpatRaster with elevation values. Currently the raster CRS must be planar and have the same distance units (e.g. m) as the elevation values} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \references{ Jenness, Jeff S., 2004. Calculating Landscape Surface Area from Digital Elevation Models. Wildlife Society Bulletin 32(3): 829-839 } \author{ Barry Rowlingson } \examples{ v <- rast(volcano, crs="local") x <- terra::surfArea(v) } \keyword{spatial} terra/man/global.Rd0000644000176200001440000000423214721437514013702 0ustar liggesusers\name{global} \alias{global} \alias{global,SpatRaster-method} \title{global statistics} \description{ Compute global statistics, that is summarized values of an entire SpatRaster. If \code{x} is very large \code{global} can fail, except when \code{fun} is one of these built-in functions "mean", "min", "max", "sum", "prod", "range" (min and max), "rms" (root mean square), "sd" (sample standard deviation), "std" (population standard deviation), "isNA" (number of cells that are NA), "notNA" (number of cells that are not NA), "anyNA", "anynotNA". Note that "anyNA" and "anynotNA" cannot be combined with other functions. The reason that this can fail with large raster and a custom function is that all values need to be loaded into memory. To circumvent this problem you can run \code{global} with a sample of the cells. You can compute a weighted mean or sum by providing a SpatRaster with weights. } \usage{ \S4method{global}{SpatRaster}(x, fun="mean", weights=NULL, maxcell=Inf, ...) } \arguments{ \item{x}{SpatRaster} \item{fun}{function to be applied to summarize the values by zone. Either as one or more of these built-in character values: "max", "min", "mean", "sum", "range", "rms" (root mean square), "sd", "std" (population sd, using \code{n} rather than \code{n-1}), "isNA", "notNA"; or a proper R function (but these may fail for very large SpatRasters unless you specify \code{maxcell})} \item{...}{additional arguments passed on to \code{fun}} \item{weights}{NULL or SpatRaster} \item{maxcell}{positive integer used to take a regular sample of \code{x}. Ignored by the built-in functions.} } \value{ A \code{data.frame} with a row for each layer } \seealso{\code{\link{zonal}} for "zonal" statistics, and \code{\link{app}} or \code{\link{Summary-methods}} for "local" statistics, and \code{\link{extract}} for summarizing values for polygons. Also see \code{\link{focal}} for "focal" or "moving window" operations.} \examples{ r <- rast(ncols=10, nrows=10) values(r) <- 1:ncell(r) global(r, "sum") global(r, "mean", na.rm=TRUE) x <- c(r, r/10) global(x, c("sum", "mean", "sd"), na.rm=TRUE) global(x, function(i) min(i) / max(i)) } \keyword{spatial} terra/man/setValues.Rd0000644000176200001440000000430314547074077014423 0ustar liggesusers\name{setValues} \docType{methods} \alias{values<-} \alias{values<-,SpatRaster,ANY-method} \alias{setValues} \alias{setValues,SpatRaster-method} \alias{setValues,SpatRaster,ANY-method} \alias{values<-,SpatVector,data.frame-method} \alias{values<-,SpatVector,matrix-method} \alias{values<-,SpatVector,ANY-method} \alias{values<-,SpatVector,NULL-method} \alias{setValues,SpatVector-method} \alias{setValues,SpatVector,ANY-method} \title{Set the values of raster cells or of geometry attributes} \description{ Set cell values of a SpatRaster or the attributes of a SpatVector. For large SpatRasters use \code{\link{init}} instead to set values. } \usage{ \S4method{values}{SpatRaster,ANY}(x)<-value \S4method{setValues}{SpatRaster,ANY}(x, values, keeptime=TRUE, keepunits=TRUE, keepnames=FALSE, props=FALSE) \S4method{values}{SpatVector,ANY}(x)<-value } \arguments{ \item{x}{SpatRaster or SpatVector} \item{value}{For SpatRaster: numeric, matrix or data.frame. The length of the numeric values must match the total number of cells (ncell(x) * nlyr(x)), or be a single value. The number of columns of the matrix or data.frame must match the number of layers of \code{x}, and the number of rows must match the number of cells of \code{x}. It is also possible to use a matrix with the same number of rows as \code{x} and the number of columns that matches \code{ncol(x) * nlyr(x)}. For SpatVector: data.frame, matrix, vector, or NULL} \item{values}{Same as for \code{value}} \item{keeptime}{logical. If \code{TRUE} the time stamps are kept} \item{keepunits}{logical. If \code{FALSE} the units are discarded} \item{keepnames}{logical. If \code{FALSE} the layer names are replaced by the column names in \code{y} (if present)} \item{props}{logical. If \code{TRUE} the properties (categories and color-table) are kept} } \value{ The same object type as \code{x} } \seealso{\code{\link{values}}, \code{\link{init}}} \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) x <- setValues(r, 1:ncell(r)) x values(x) <- runif(ncell(x)) x head(x) f <- system.file("ex/lux.shp", package="terra") v <- vect(f) values(v) <- data.frame(ID=1:12, name=letters[1:12]) head(v) } \keyword{spatial} \keyword{methods} terra/man/perim.Rd0000644000176200001440000000117614731657040013561 0ustar liggesusers\name{perim} \alias{perim} \alias{perim,SpatVector-method} \alias{perimeter} \alias{perimeter,SpatVector-method} \title{Perimeter or length} \description{ This method returns the length of lines or the perimeter of polygons. When the coordinate reference system is not longitude/latitude, you may get more accurate results by first transforming the data to longitude/latitude with \code{\link{project}} } \usage{ \S4method{perim}{SpatVector}(x) } \arguments{ \item{x}{SpatVector} } \value{ numeric (m) } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) perim(v) } \keyword{methods} \keyword{spatial} terra/man/plot_graticule.Rd0000644000176200001440000000546214536376240015467 0ustar liggesusers\name{plot_graticule} \docType{methods} \alias{plot,SpatGraticule,missing-method} \alias{lines,SpatGraticule,missing-method} \title{Plot a graticule} \description{ Plot a SpatGraticule. You can create a SpatGraticule with \code{\link{graticule}}. } \usage{ \S4method{plot}{SpatGraticule,missing}(x, y, background=NULL, col="black", mar=NULL, labels=TRUE, retro=FALSE, lab.loc=c(1,1), lab.lon=NULL, lab.lat=NULL, lab.cex=0.65, lab.col="black", off.lat=0.25, off.lon=0.25, box=FALSE, box.col="black", add=FALSE, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{y}{missing or positive integer or name indicating the layer(s) to be plotted} \item{background}{background color. If NULL, no background is drawn} \item{mar}{numeric vector of length 4 to set the margins of the plot. To make space for the legend you may use something like \code{c(3.1, 3.1, 2.1, 7.1)}. To fill the plotting canvas, you can use \code{c(0,0,0,0}. Use \code{NA} to not set the margins} \item{col}{character. Color for the graticule lines} \item{labels}{logical. If \code{TRUE}, show graticule labels} \item{retro}{logical. If \code{TRUE}, show "retro" instead of decimal labels with the graticule} \item{lab.loc}{numeric. The first number indicates where the longitude graticule labels should be drawn (1=bottom, 2=top, NA=not drawn, any other number=top and bottom). The second number indicates where the latitude graticule labels should be drawn (1=left, 2=right, NA=not drawn, any other number=left and right)} \item{lab.lon}{positive integers between 1 and the number of labels, indicating which longitude graticule labels should be included} \item{lab.lat}{positive integers between 1 and the number of labels, indicating which latitude graticule labels should be included} \item{lab.cex}{double. size of the label font} \item{lab.col}{character. color of the labels} \item{off.lon}{numeric. longitude labels offset} \item{off.lat}{numeric. latitude labels offset} \item{box}{logical. If \code{TRUE}, the outer lines of the graticule are drawn on top with a sold line \code{lty=1}} \item{box.col}{character. color of the outer lines of the graticule if \code{box=TRUE}} \item{add}{logical. Add the graticule to the current plot?} \item{...}{additional graphical arguments passed to \code{\link{lines}}} } \seealso{ \code{\link{graticule}}, \code{\link{plot}}, \code{\link{points}}, \code{\link{lines}}, \code{\link{polys}}, \code{\link{image}}, \code{scatter\link[terra:scatter]{plot}}, scale bar: \code{\link{sbar}}, north arrow: \code{\link{north}} } \examples{ g <- graticule(60, 30, crs="+proj=robin") plot(g, background="azure", col="red", lty=2, box=TRUE) plot(g, background="azure", col="light gray", lab.loc=c(1,2), lab.lon=c(2,4,6), lab.lat=3:5, lty=3, retro=TRUE) } \keyword{methods} \keyword{spatial} terra/man/draw.Rd0000644000176200001440000000270514732343234013377 0ustar liggesusers\name{draw} \alias{draw} \alias{draw,character-method} \alias{draw,missing-method} \title{ Draw a polygon, line, extent, or points } \description{ Draw on a plot (map) to get a SpatVector or SpatExtent object for later use. After calling the function, start clicking on the map. When you are done, press \code{ESC}. You can also preset the maximum number of clicks. Note that for many installations this does to work well on the default RStudio plotting device. To work around that, you can first run \code{dev.new(noRStudioGD = TRUE)} which will create a separate window for plotting, then use \code{plot()} followed by \code{draw()} and clicking on the map. It may also help to set your RStudio "Tools/Global Options/Appearance/Zoom" to 100% } \usage{ \S4method{draw}{character}(x="extent", col="red", lwd=2, id=FALSE, n=1000, xpd=TRUE, ...) } \arguments{ \item{x}{character. The type of object to draw. One of "extent", "polygon", "line", or "points"} \item{col}{the color to be used} \item{lwd}{the width of the lines to be drawn} \item{id}{logical. If \code{TRUE}, a numeric ID is shown on the map} \item{n}{the maximum number of clicks (does not apply when \code{x=="extent"} in which case \code{n} is always 2)} \item{xpd}{logical. If \code{TRUE}, you can draw outside the current plotting area} \item{...}{additional graphics arguments for drawing} } \value{ SpatVector or SpatExtent } \seealso{ \code{\link{click}} } \keyword{ spatial } terra/man/focalMat.Rd0000644000176200001440000000212214536376240014166 0ustar liggesusers\name{focalMat} \alias{focalMat} \title{Focal weights matrix} \description{ Make a focal ("moving window") weight matrix for use in the \code{\link{focal}} function. The sum of the values adds up to one. } \usage{ focalMat(x, d, type=c('circle', 'Gauss', 'rectangle'), fillNA=FALSE) } \arguments{ \item{x}{SpatRaster} \item{d}{numeric. If \code{type=circle}, the radius of the circle (in units of the crs). If \code{type=rectangle} the dimension of the rectangle (one or two numbers). If \code{type=Gauss} the size of sigma, and optionally another number to determine the size of the matrix returned (default is 3*sigma)} \item{type}{character indicating the type of filter to be returned} \item{fillNA}{logical. If \code{TRUE}, zeros are set to \code{NA} such that they are ignored in the computations. Only applies to \code{type="circle"}} } \value{ matrix that can be used with \code{\link{focal}} } \examples{ r <- rast(ncols=180, nrows=180, xmin=0) focalMat(r, 2, "circle") focalMat(r, c(2,3), "rect") # Gaussian filter for square cells gf <- focalMat(r, 1, "Gauss") } \keyword{spatial} terra/man/writeCDF.Rd0000644000176200001440000000552214736271127014116 0ustar liggesusers\name{writeCDF} \alias{writeCDF} \alias{writeCDF,SpatRasterDataset-method} \alias{writeCDF,SpatRaster-method} \title{Write raster data to a NetCDF file} \description{ Write a SpatRaster or SpatRasterDataset to a NetCDF file. When using a SpatRasterDataset, the varname, longname, and unit should be set in the object (see examples). Always use the \code{".nc"} or \code{".cdf"} file extension to assure that the file can be properly read again by GDAL } \usage{ \S4method{writeCDF}{SpatRaster}(x, filename, varname, longname="", unit="", split=FALSE, ...) \S4method{writeCDF}{SpatRasterDataset}(x, filename, overwrite=FALSE, zname="time", atts="", gridmap="", prec="float", compression=NA, missval, ...) } \arguments{ \item{x}{SpatRaster or SpatRasterDataset} \item{filename}{character. Output filename} \item{varname}{character. Name of the dataset} \item{longname}{character. Long name of the dataset} \item{unit}{character. Unit of the data} \item{split}{logical. If \code{TRUE} each layer of \code{x} is treated as a sub-dataset} \item{atts}{character. A vector of additional global attributes to write. The must be formatted like c("x=a value", "y=abc")} \item{gridmap}{character. The crs is always written to the file in standard formats. With this argument you can also write the format commonly used in netcdf files. Something like \code{c("grid_mapping_name=lambert_azimuthal_equal_area", "longitude_of_projection_origin=10", "latitude_of_projection_origin=52", "false_easting=4321000", "false_northing=3210000")}} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{zname}{character. The name of the "time" dimension} \item{prec}{character. One of "double", "float", "integer", "short", "byte" or "char"} \item{compression}{Can be set to an integer between 1 (least compression) and 9 (most compression)} \item{missval}{numeric, the number used to indicate missing values} \item{...}{additional arguments passed on to the SpatRasterDataset method, and from there possibly to \code{\link[ncdf4]{ncvar_def}}} } \value{ SpatRaster or SpatDataSet } \seealso{ see \code{\link{writeRaster}} for writing other file formats } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) fname <- paste0(tempfile(), ".nc") rr <- writeCDF(r, fname, overwrite=TRUE, varname="alt", longname="elevation in m above sea level", unit="m") a <- rast(ncols=5, nrows=5, nl=50) values(a) <- 1:prod(dim(a)) time(a) <- as.Date("2020-12-31") + 1:nlyr(a) aa <- writeCDF(a, fname, overwrite=TRUE, varname="power", longname="my nice data", unit="U/Pa") b <- sqrt(a) s <- sds(a, b) names(s) <- c("temp", "prec") longnames(s) <- c("temperature (C)", "precipitation (mm)") units(s) <- c("°C", "mm") ss <- writeCDF(s, fname, overwrite=TRUE) # for CRAN file.remove(fname) } \keyword{ spatial } \keyword{ methods } terra/man/k_means.Rd0000644000176200001440000000255214536376240014064 0ustar liggesusers\name{k_means} \alias{k_means} \alias{k_means,ANY-method} \alias{k_means,SpatRaster-method} \title{k_means} \description{ Compute k-means clusters for a SpatRaster. For large SpatRasters (with \code{ncell(x) > maxcell}) this is done in two steps. First a sample of the cells is used to compute the cluster centers. Then each cell is assigned to a cluster by computing the distance to these centers. } \usage{ \S4method{k_means}{SpatRaster}(x, centers=3, ..., maxcell=1000000, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{centers}{either the number of clusters, or a set of initial (distinct) cluster centres. If a number, a random set of (distinct) cells in \code{x} is chosen as the initial centres} \item{...}{additional arguments passed to \code{\link[stats]{kmeans}}} \item{maxcell}{positive integer. The size of the regular sample used if it is smaller than \code{ncell(x)}} \item{filename}{character. Output filename (ignored if \code{as.raster=FALSE})} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link[stats]{kmeans}} } \examples{ f <- system.file("ex/logo.tif", package = "terra") r <- rast(f) km <- k_means(r, centers=5) km } \keyword{spatial} terra/man/cartogram.Rd0000644000176200001440000000151014536376240014417 0ustar liggesusers\name{cartogram} \docType{methods} \alias{cartogram} \alias{cartogram,SpatVector-method} \title{Cartogram} \description{ Make a cartogram, that is, a map where the area of polygons is made proportional to another variable. This can be a good way to map raw count data (e.g. votes). } \usage{ \S4method{cartogram}{SpatVector}(x, var, type) } \arguments{ \item{x}{SpatVector} \item{var}{character. A variable name in \code{x}} \item{type}{character. Cartogram type, only "nc" (non-contiguous) is currently supported} } \value{ SpatVector } \seealso{ \code{\link{plot}}, \code{\link{rescale}} } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) v$value <- 1:12 p <- cartogram(v, "value", "nc") plot(v, col="light gray", border="gray") lines(p, col="red", lwd=2) } \keyword{methods} \keyword{spatial} terra/man/scatter.Rd0000644000176200001440000000261514536376240014114 0ustar liggesusers\name{scatterplot} \docType{methods} \alias{plot,SpatRaster,SpatRaster-method} \title{Scatterplot of two SpatRaster layers} \description{ Scatterplot of the values of two SpatRaster layers } \usage{ \S4method{plot}{SpatRaster,SpatRaster}(x, y, maxcell=100000, warn=TRUE, nc, nr, maxnl=16, smooth=FALSE, gridded=FALSE, ncol=25, nrow=25, ...) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatRaster} \item{maxcell}{positive integer. Maximum number of cells to use for the plot} \item{nc}{positive integer. Optional. The number of columns to divide the plotting device in (when plotting multiple layers)} \item{nr}{positive integer. Optional. The number of rows to divide the plotting device in (when plotting multiple layers)} \item{maxnl}{positive integer. Maximum number of layers to plot (for multi-layer objects)} \item{smooth}{logical. If \code{TRUE} show a smooth scatterplot} \item{gridded}{logical. If \code{TRUE} the scatterplot is gridded (counts by cells)} \item{warn}{boolean. Show a warning if a sample of the pixels is used (for scatterplot only)} \item{ncol}{positive integer. Number of columns for gridding} \item{nrow}{positive integer. Number of rows for gridding} \item{...}{additional graphical arguments} } \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) plot(s[[1]], s[[2]]) plot(s, sqrt(s[[3:1]])) } \keyword{methods} \keyword{spatial} terra/man/forceCCW.Rd0000644000176200001440000000071214536376240014076 0ustar liggesusers\name{forceCCW} \alias{forceCCW} \alias{forceCCW,SpatVector-method} \title{force counter-clockwise polygons} \description{ Assure that the nodes of outer rings of polygons are in counter-clockwise order. } \usage{ \S4method{forceCCW}{SpatVector}(x) } \arguments{ \item{x}{SpatVector of polygons} } \value{ SpatVector } \examples{ p <- vect("POLYGON ((2 45, 2 55, 18 55, 18 45, 2 45))") pcc <- forceCCW(p) geom(pcc, wkt=TRUE) } \keyword{spatial} terra/man/box.Rd0000644000176200001440000000102314646602602013223 0ustar liggesusers\name{add_box} \alias{add_box} \title{draw a box} \description{ Similar to \code{\link[graphics]{box}} allowing adding a box around a map. This function will place the box around the mapped area. } \usage{ add_box(...) } \arguments{ \item{...}{arguments passed to \code{\link{lines}}} } \seealso{\code{\link{add_legend}}, \code{\link{add_grid}}, \code{\link{add_mtext}}} \examples{ v <- vect(system.file("ex/lux.shp", package="terra")) plot(v) add_box(col="red", lwd=3, xpd=TRUE) } \keyword{methods} \keyword{spatial} terra/man/princomp.Rd0000644000176200001440000000532414560660121014265 0ustar liggesusers\name{princomp} \alias{princomp} \alias{princomp,SpatRaster-method} \title{SpatRaster PCA with princomp} \description{ Compute principal components for SpatRaster layers. This method can use all values to compute the principal components, even for very large rasters. This is because it computes the covariance matrix by processing the data in chunks, if necessary, using \code{\link{layerCor}}. The population covariance is used (not the sample, with \code{n-1} denominator, covariance). Alternatively, you can specify \code{maxcell} or sample raster values to a data.frame to speed up calculations for very large rasters (see the examples below). See \code{\link{prcomp}} for an alternative method that has higher numerical accuracy, but is slower, and for very large rasters can only be accomplished with a sample since all values must be read into memory. } \usage{ \S4method{princomp}{SpatRaster}(x, cor=FALSE, fix_sign=TRUE, use="pairwise.complete.obs", maxcell=Inf) } \arguments{ \item{x}{SpatRaster} \item{cor}{logical. If \code{FALSE}, the covariance matrix is used. Otherwise the correlation matrix is used} \item{fix_sign}{logical. If \code{TRUE}, the signs of the loadings and scores are chosen so that the first element of each loading is non-negative} \item{use}{character. To decide how to handle missing values. This must be (an abbreviation of) one of the strings "everything", "complete.obs", "pairwise.complete.obs", or "masked.complete". With "pairwise.complete.obs", the covariance between a pair of layers is computed for all cells that are not \code{NA} in that pair. Therefore, it may be that the (number of) cells used varies between pairs. The benefit of this approach is that all available data is used. Use "complete.obs", if you want to only use the values from cells that are not \code{NA} in any of the layers. By using "masked.complete" you indicate that all layers have NA values in the same cells} \item{maxcell}{positive integer. The maximum number of cells to be used. If this is smaller than ncell(x), a regular sample of \code{x} is used} } \value{ princomp object } \author{Alex Ilich and Robert Hijmans, based on a similar method by Benjamin Leutner} \seealso{ \code{\link{prcomp}} \code{\link[stats]{princomp}}} \examples{ f <- system.file("ex/logo.tif", package = "terra") r <- rast(f) pca <- princomp(r) x <- predict(r, pca) # use "index" to get a subset of the components p <- predict(r, pca, index=1:2) ### use princomp directly pca2 <- princomp(values(r), fix_sign = TRUE) p2 <- predict(r, pca2) ### may need to use sampling with a large raster ### here with prcomp instead of princomp sr <- spatSample(r, 100000, "regular") pca3 <- prcomp(sr) p3 <- predict(r, pca3) } \keyword{spatial} terra/man/minmax.Rd0000644000176200001440000000217714536376240013743 0ustar liggesusers\name{extremes} \alias{minmax} \alias{hasMinMax} \alias{setMinMax} \alias{minmax,SpatRaster-method} \alias{hasMinMax,SpatRaster-method} \alias{setMinMax,SpatRaster-method} \title{Get or compute the minimum and maximum cell values} \description{ The minimum and maximum value of a SpatRaster are returned or computed (from a file on disk if necessary) and stored in the object. } \usage{ \S4method{minmax}{SpatRaster}(x, compute=FALSE) \S4method{hasMinMax}{SpatRaster}(x) \S4method{setMinMax}{SpatRaster}(x, force=FALSE) } \arguments{ \item{x}{ SpatRaster } \item{compute}{logical. If \code{TRUE} min and max values are computed if they are not available} \item{force}{logical. If \code{TRUE} min and max values are recomputed even if already available} } \value{ minmax: numeric matrix of minimum and maximum cell values by layer hasMinMax: logical indicating whether the min and max values are available. setMinMax: nothing. Used for the side-effect of computing the minimum and maximum values of a SpatRaster } \examples{ r <- rast(system.file("ex/elev.tif", package="terra")) minmax(r) } \keyword{ spatial } \keyword{ methods } terra/man/flowAccumulation.Rd0000644000176200001440000000457114646547165015776 0ustar liggesusers\docType{methods} \name{flowAccumulation} \alias{flowAccumulation} \alias{flowAccumulation,SpatRaster-method} \title{Flow accumulation} \description{ Computes flow accumulation or the total contributing area in terms of numbers of cells upstream of each cell. } \usage{ \S4method{flowAccumulation}{SpatRaster}(x, weight=NULL, filename="", ...) } \arguments{ \item{x}{SpatRaster with flow direction, see \code{\link{terrain}}. } \item{weight}{SpatRaster with weight/score daa. For example, cell area or precipitation} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \details{ The algorithm is an adaptation of the one proposed by Zhou at al, 2019. } \seealso{\code{\link{terrain}},\code{\link{watershed}}, \code{\link{NIDP}}} \author{ Emanuele Cordano } \references{ Zhou, G., Wei, H. & Fu, S. A fast and simple algorithm for calculating flow accumulation matrices from raster digital elevation. Front. Earth Sci. 13, 317–326 (2019). doi:10.1007/s11707-018-0725-9. Also see: \url{https://ica-abs.copernicus.org/articles/1/434/2019/} } \examples{ elev1 <- array(NA,c(9,9)) elev2 <- elev1 dx <- 1 dy <- 1 for (r in 1:nrow(elev1)) { y <- (r-5)*dx for (c in 1:ncol(elev1)) { x <- (c-5)*dy elev1[r,c] <- 5*(x^2+y^2) elev2[r,c] <- 10+5*(abs(x))-0.001*y } } ## Elevation raster elev1 <- rast(elev1) elev2 <- rast(elev2) t(array(elev1[],rev(dim(elev1)[1:2]))) t(array(elev2[],rev(dim(elev2)[1:2]))) plot(elev1) plot(elev2) ## Flow direction raster flowdir1<- terrain(elev1,v="flowdir") flowdir2<- terrain(elev2,v="flowdir") t(array(flowdir1[],rev(dim(flowdir1)[1:2]))) t(array(flowdir2[],rev(dim(flowdir2)[1:2]))) plot(flowdir1) plot(flowdir2) ## flow_acc1 <- flowAccumulation((flowdir1)) flow_acc2 <- flowAccumulation((flowdir2)) weight <- elev1*0+10 flow_acc1w <- flowAccumulation(flowdir1,weight) flow_acc2w <- flowAccumulation(flowdir2,weight) t(array(flow_acc1w[],rev(dim(flow_acc1w)[1:2]))) t(array(flow_acc2w[],rev(dim(flow_acc2w)[1:2]))) plot(flow_acc1w) plot(flow_acc2w) ## Application wth example elevation data elev <- rast(system.file('ex/elev.tif',package="terra")) flowdir <- terrain(elev,"flowdir") weight <- cellSize(elev,unit="km") flowacc_weight <- flowAccumulation(flowdir,weight) flowacc <- flowAccumulation(flowdir) } \keyword{spatial} terra/man/regress.Rd0000644000176200001440000000256614536376240014126 0ustar liggesusers\name{regress} \docType{methods} \alias{regress} \alias{regress,SpatRaster,SpatRaster-method} \alias{regress,SpatRaster,numeric-method} \title{Cell level regression} \description{ Run a regression model for each cell of a SpatRaster. The independent variable can either be defined by a vector, or another SpatRaster to make it spatially variable. } \usage{ \S4method{regress}{SpatRaster,numeric}(y, x, formula=y~x, na.rm=FALSE, cores=1, filename="", overwrite=FALSE, ...) \S4method{regress}{SpatRaster,SpatRaster}(y, x, formula=y~x, na.rm=FALSE, cores=1, filename="", overwrite=FALSE, ...) } \arguments{ \item{y}{SpatRaster} \item{x}{SpatRaster or numeric (of the same length as \code{nlyr(x)}} \item{formula}{regression formula in the general form of \code{y ~ x}. You can add additional terms such as \code{I(x^2)} } \item{na.rm}{logical. Remove NA values?} \item{cores}{positive integer. If \code{cores > 1}, a 'parallel' package cluster with that many cores is created and used. You can also supply a cluster object.} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{...}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) x <- regress(s, 1:nlyr(s)) } \keyword{methods} \keyword{spatial} terra/man/activeCat.Rd0000644000176200001440000000216214536376240014347 0ustar liggesusers\name{activeCat} \docType{methods} \alias{activeCat} \alias{activeCat,SpatRaster-method} \alias{activeCat<-} \alias{activeCat<-,SpatRaster-method} \title{Active category} \description{ Get or set the active category of a multi-categorical SpatRaster layer } \usage{ \S4method{activeCat}{SpatRaster}(x, layer=1) \S4method{activeCat}{SpatRaster}(x, layer=1)<-value } \arguments{ \item{x}{SpatRaster} \item{layer}{positive integer, the layer number or name} \item{value}{positive integer or character, indicating which column in the categories to use. Note that when a number is used this index is zero based, and "1" refers to the second column. This is because the first column of the categories has the cell values, not categorical labels} } \value{ integer } \seealso{\code{\link{levels}}, \code{\link{cats}}} \examples{ set.seed(0) r <- rast(nrows=10, ncols=10) values(r) <- sample(3, ncell(r), replace=TRUE) + 10 d <- data.frame(id=11:13, cover=c("forest", "water", "urban"), letters=letters[1:3], value=10:12) levels(r) <- d activeCat(r) activeCat(r) <- 3 activeCat(r) } \keyword{methods} \keyword{spatial} terra/man/clamp.Rd0000644000176200001440000000254714715132714013542 0ustar liggesusers\name{clamp} \alias{clamp} \alias{clamp,SpatRaster-method} \alias{clamp,numeric-method} \title{Clamp values} \description{ Clamp values to a minimum and maximum value. That is, all values below a lower threshold value and above the upper threshold value become either \code{NA}, or, if \code{values=TRUE}, become the threshold value } \usage{ \S4method{clamp}{SpatRaster}(x, lower=-Inf, upper=Inf, values=TRUE, filename="", ...) \S4method{clamp}{numeric}(x, lower=-Inf, upper=Inf, values=TRUE, ...) } \arguments{ \item{x}{SpatRaster} \item{lower}{numeric with the lowest acceptable value (you can specify a different value for each layer). Or a SpatRaster that has a single layer or the same number of layers as \code{x}} \item{upper}{numeric with the highest acceptable value (you can specify a different value for each layer). Or a SpatRaster that has a single layer or the same number of layers as \code{x}} \item{values}{logical. If \code{FALSE} values outside the clamping range become \code{NA}, if \code{TRUE}, they get the extreme values} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{classify}, \link{subst}} } \examples{ r <- rast(ncols=10, nrows=10) values(r) <- 1:ncell(r) rc <- clamp(r, 25, 75) rc } \keyword{spatial} terra/man/as.points.Rd0000644000176200001440000000252014736322110014345 0ustar liggesusers\name{as.points} \docType{methods} \alias{as.points} \alias{as.points,SpatRaster-method} \alias{as.points,SpatVector-method} \alias{as.points,SpatExtent-method} \title{Conversion to a SpatVector of points} \description{ Conversion of a SpatRaster, SpatVector or SpatExtent to a SpatVector of points. } \usage{ \S4method{as.points}{SpatRaster}(x, values=TRUE, na.rm=TRUE, na.all=FALSE) \S4method{as.points}{SpatVector}(x, multi=FALSE, skiplast=TRUE) \S4method{as.points}{SpatExtent}(x, crs="") } \arguments{ \item{x}{SpatRaster, SpatVector or SpatExtent} \item{values}{logical; include cell values as attributes?} \item{multi}{logical. If \code{TRUE} a multi-point geometry is returned} \item{skiplast}{logical. If \code{TRUE} the last point of a polygon (which is the same as the first point) is not included} \item{na.rm}{logical. If \code{TRUE} cells that are \code{NA} are ignored} \item{na.all}{logical. If \code{TRUE} cells are only ignored if \code{na.rm=TRUE} and their value is \code{NA} for \bold{all} layers instead of for \code{any} layer} \item{crs}{character. The coordinate reference system (see \code{\link{crs}})} } \value{ SpatVector } \seealso{ \code{\link{as.lines}}, \code{\link{as.points}} } \examples{ r <- rast(ncols=2, nrows=2) values(r) <- 1:ncell(r) as.points(r) p <- as.polygons(r) as.points(p) } \keyword{spatial} terra/man/watershed.Rd0000644000176200001440000000163414633631501014425 0ustar liggesusers\docType{methods} \name{watershed} \alias{watershed} \alias{watershed,SpatRaster-method} \title{Catchment delineation} \description{ delineate the area covered by a catchment from a SpatRaster with flow direction and a pour-point (catchment outlet). } \usage{ \S4method{watershed}{SpatRaster}(x, pourpoint, filename="",...) } \arguments{ \item{x}{SpatRaster with flow direction. See \code{\link{terrain}}. } \item{pourpoint}{matrix or SpatVector with the pour point location} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \author{ Ezio Crestaz, Emanuele Cordano, Roman Seliger } \examples{ elev <- rast(system.file('ex/elev_vinschgau.tif', package="terra")) flowdir <- terrain(elev, "flowdir") ## pour point at Naturns pp <- cbind(653358.3, 5168222) w <- watershed(flowdir, pp) } \keyword{spatial} terra/man/tapp.Rd0000644000176200001440000000665714715623614013424 0ustar liggesusers\name{tapp} \docType{methods} \alias{tapp} \alias{tapp,SpatRaster-method} \title{Apply a function to subsets of layers of a SpatRaster} \description{ Apply a function to subsets of layers of a SpatRaster (similar to \code{\link[base]{tapply}} and \code{\link[stats]{aggregate}}). The layers are combined based on the \code{index}. The number of layers in the output SpatRaster equals the number of unique values in \code{index} times the number of values that the supplied function returns for a single vector of numbers. For example, if you have a SpatRaster with 6 layers, you can use \code{index=c(1,1,1,2,2,2)} and \code{fun=sum}. This will return a SpatRaster with two layers. The first layer is the sum of the first three layers in the input SpatRaster, and the second layer is the sum of the last three layers in the input SpatRaster. Indices are recycled such that \code{index=c(1,2)} would also return a SpatRaster with two layers (one based on the odd layers (1,3,5), the other based on the even layers (2,4,6)). The index can also be one of the following values to group by time period (if \code{x} has the appropriate \code{\link{time}} values): "years", "months", "yearmonths", "dekads", "yeardekads", "weeks" (the ISO 8601 week number, see Details), "yearweeks", "days", "doy" (day of the year), "7days" (seven-day periods starting at Jan 1 of each year), "10days", or "15days". It can also be a function that makes groups from time values. See \code{\link{app}} or \code{\link{Summary-methods}} if you want to use a more efficient function that returns multiple layers based on \bold{all} layers in the SpatRaster. } \usage{ \S4method{tapp}{SpatRaster}(x, index, fun, ..., cores=1, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{index}{factor or numeric (integer). Vector of length \code{nlyr(x)} (shorter vectors are recycled) grouping the input layers. It can also be one of the following values: "years", "months", "yearmonths", "days", "week" (ISO 8601 week number), or "doy" (day of the year)} \item{fun}{function to be applied. The following functions have been re-implemented in C++ for speed: "sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first". To use the base-R function for say, "min", you could use something like \code{fun = \(i) min(i)}} \item{...}{additional arguments passed to \code{fun}} \item{cores}{positive integer. If \code{cores > 1}, a 'parallel' package cluster with that many cores is created and used. You can also supply a cluster object. Ignored for functions that are implemented by terra in C++ (see under fun)} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \details{ "week" follows the ISO 8601 definition. Weeks start on Monday. If the week containing 1 January has four or more days in the new year, then it is considered week "01". Otherwise, it is the last week of the previous year (week "52" or "53", and the next week is week 1. } \seealso{\code{\link{app}}, \code{\link{Summary-methods}}} \examples{ r <- rast(ncols=10, nrows=10) values(r) <- 1:ncell(r) s <- c(r, r, r, r, r, r) s <- s * 1:6 b1 <- tapp(s, index=c(1,1,1,2,2,2), fun=sum) b1 b2 <- tapp(s, c(1,2,3,1,2,3), fun=sum) b2 } \keyword{methods} \keyword{spatial} terra/man/focal3D.Rd0000644000176200001440000000535714536376240013730 0ustar liggesusers\name{focal3D} \alias{focal3D} \alias{focal3D,SpatRaster-method} \title{Three-dimensional focal values} \description{ Calculate focal ("moving window") values for the three-dimensional neighborhood (window) of focal cells. See \code{\link{focal}} for two-dimensional focal computation. } \usage{ \S4method{focal3D}{SpatRaster}(x, w=3, fun=mean, ..., na.policy="all", fillvalue=NA, pad=FALSE, padvalue=fillvalue, expand=FALSE, silent=TRUE, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{w}{window. A rectangular prism (cuboid) defined by three numbers or by a three-dimensional array. The values are used as weights, and are usually zero, one, NA, or fractions. The window used must have odd dimensions. If you desire to use even sides, you can use an array, and pad the values with rows and/or columns that contain only \code{NA}s. } \item{fun}{function that takes multiple numbers, and returns one or multiple numbers for each focal area. For example mean, modal, min or max} \item{...}{additional arguments passed to \code{fun} such as \code{na.rm}} \item{na.policy}{character. Can be used to determine the cells of \code{x}, in the central layer, for which focal values should be computed. Must be one of "all" (compute for all cells), "only" (only for cells that are \code{NA}) or "omit" (skip cells that are \code{NA}). Note that the value of this argument does not affect which cells around each focal cell are included in the computations (use \code{na.rm=TRUE} to ignore cells that are \code{NA} in the computation of the focal value)} \item{fillvalue}{numeric. The value of the cells in the virtual rows and columns outside of the raster} \item{pad}{logical. Add virtual layers before the first and after the last layer} \item{padvalue}{numeric. The value of the cells in the virtual layers} \item{expand}{logical. Add virtual layers before the first or after the last layer that are the same as the first or last layers. If \code{TRUE}, arguments \code{pad} and \code{padvalue} are ignored} \item{silent}{logical. If \code{TRUE} error messages are printed that may occur when trying \code{fun} to determine the length of the returned value. This can be useful in debugging a function passed to \code{fun} that does not work} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \seealso{ \code{\link{focal}}} \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) x <- focal3D(r, c(5,5,3), na.rm=TRUE) a <- array(c(0,1,0,1,1,1,0,1,0, rep(1,9), 0,1,0,1,1,1,0,1,0), c(3,3,3)) a[a==0] <- NA z <- focal3D(r, a, na.rm=TRUE) } \keyword{spatial} terra/man/collapse.Rd0000644000176200001440000000117314547073746014256 0ustar liggesusers\name{tighten} \docType{methods} \alias{tighten} \alias{tighten,SpatRaster-method} \alias{tighten,SpatRasterDataset-method} \title{tighten SpatRaster or SpatRasterDataset objects} \description{ Combines data sources within a SpatRaster (that are in memory, or from the same file) to allow for faster processing. Or combine sub-datasets into a SpatRaster. } \usage{ \S4method{tighten}{SpatRaster}(x) \S4method{tighten}{SpatRasterDataset}(x) } \arguments{ \item{x}{SpatRaster or SpatRasterDataset} } \value{ SpatRaster } \examples{ r <- rast(nrow=5, ncol=9, vals=1:45) x <- c(r, r*2, r*3) x tighten(x) } \keyword{spatial} terra/man/zonal.Rd0000644000176200001440000001210314601144514013551 0ustar liggesusers\name{zonal} \alias{zonal} \alias{zonal,SpatRaster,SpatRaster-method} \alias{zonal,SpatRaster,SpatVector-method} \alias{zonal,SpatVector,SpatVector-method} \title{Zonal statistics} \description{ Compute zonal statistics, that is summarize values of a SpatRaster for each "zone" defined by another SpatRaster, or by a SpatVector with polygon geometry. If \code{fun} is a true R \code{function}, the method may fail when using very large SpatRasters, except for the functions ("mean", "min", "max", "sum", "isNA", and "notNA"). You can also summarize values of a SpatVector for each polygon (zone) defined by another SpatVector. } \usage{ \S4method{zonal}{SpatRaster,SpatRaster}(x, z, fun="mean", ..., w=NULL, wide=TRUE, as.raster=FALSE, filename="", overwrite=FALSE, wopt=list()) \S4method{zonal}{SpatRaster,SpatVector}(x, z, fun="mean", na.rm=FALSE, w=NULL, weights=FALSE, exact=FALSE, touches=FALSE, small=TRUE, as.raster=FALSE, as.polygons=FALSE, wide=TRUE, filename="", wopt=list()) \S4method{zonal}{SpatVector,SpatVector}(x, z, fun=mean, ..., weighted=FALSE, as.polygons=FALSE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{z}{SpatRaster with cell-values representing zones or a SpatVector with each polygon geometry representing a zone. \code{z} can have multiple layers to define intersecting zones} \item{fun}{function to be applied to summarize the values by zone. Either as character: "mean", "min", "max", "sum", "isNA", and "notNA" and, for relatively small SpatRasters, a proper function} \item{...}{additional arguments passed to fun, such as \code{na.rm=TRUE}} \item{w}{SpatRaster with weights. Should have a single-layer with non-negative values} \item{wide}{logical. Should the values returned in a wide format? For the \code{SpatRaster, SpatRaster} method this only affects the results when \code{nlyr(z) == 2}. For the \code{SpatRaster, SpatVector} method this only affects the results when \code{fun=table}} \item{as.raster}{logical. If \code{TRUE}, a SpatRaster is returned with the zonal statistic for each zone} \item{filename}{character. Output filename (ignored if \code{as.raster=FALSE}} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with additional arguments for writing files as in \code{\link{writeRaster}}} \item{weights}{logical. If \code{TRUE} and \code{y} has polygons, the approximate fraction of each cell that is covered is returned as well, for example to compute a weighted mean} \item{exact}{logical. If \code{TRUE} and \code{y} has polygons, the exact fraction of each cell that is covered is returned as well, for example to compute a weighted mean} \item{touches}{logical. If \code{TRUE}, values for all cells touched by lines or polygons are extracted, not just those on the line render path, or whose center point is within the polygon. Not relevant for points; and always considered \code{TRUE} when \code{weights=TRUE} or \code{exact=TRUE}} \item{small}{logical. If \code{TRUE}, values for all cells in touched polygons are extracted if none of the cells center points is within the polygon; even if \code{touches=FALSE}} \item{weighted}{logical. If \code{TRUE}, a weighted.mean is computed and \code{fun} is ignored. Weights are based on the length of the lines or the area of the polygons in \code{x} that intersect with \code{z}. This argument is ignored of \code{x} is a SpatVector or points} \item{as.polygons}{logical. Should the zonal statistics be combined with the geometry of \code{z}?} \item{na.rm}{logical. If \code{TRUE}, \code{NA}s are removed} } \value{ A \code{data.frame} with a value for each zone, or a SpatRaster, or SpatVector of polygons. } \seealso{ See \code{\link{global}} for "global" statistics (i.e., all of \code{x} is considered a single zone), \code{\link{app}} for local statistics, and \code{\link{extract}} for an alternative way to summarize values of a SpatRaster with a SpatVector. With \code{\link{aggregate}} you can compute statistics for cell blocks defined by a number of rows and columns. } \examples{ ### SpatRaster, SpatRaster r <- rast(ncols=10, nrows=10) values(r) <- 1:ncell(r) z <- rast(r) values(z) <- rep(c(1:2, NA, 3:4), each=20) names(z) <- "zone" zonal(r, z, "sum", na.rm=TRUE) # with weights w <- init(r, "col") zonal(r, z, w=w, "mean", na.rm=TRUE) # multiple layers r <- rast(system.file("ex/logo.tif", package = "terra")) # zonal layer z <- rast(r, 1) names(z) <- "zone" values(z) <- rep(c(1:2, NA, c(3:4)), each=ncell(r)/5, length.out=ncell(r)) zonal(r, z, "mean", na.rm = TRUE) # raster of zonal values zr <- zonal(r, z, "mean", na.rm = TRUE, as.raster=TRUE) ### SpatRaster, SpatVector x <- rast(ncol=2,nrow=2, vals=1:4, xmin=0, xmax=1, ymin=0, ymax=1, crs="+proj=utm +zone=1") p <- as.polygons(x) pp <- shift(p, .2) r <- disagg(x, 4) zonal(r, p) zonal(r, p, sum) zonal(x, pp, exact=TRUE) zonal(c(x, x*10), pp, w=x) ### SpatVector, SpatVector f <- system.file("ex/lux.shp", package="terra") v <- vect(f)[,c(2,4)] p <- spatSample(v, 100) values(p) <- data.frame(b2=1:100, ssep1=100:1) zonal(p, v, mean) } \keyword{spatial} terra/man/as.lines.Rd0000644000176200001440000000221314736322102014143 0ustar liggesusers\name{as.lines} \docType{methods} \alias{as.lines} \alias{as.lines,SpatRaster-method} \alias{as.lines,SpatVector-method} \alias{as.lines,SpatExtent-method} \alias{as.lines,matrix-method} \title{Conversion to a SpatVector of lines} \description{ Conversion of a SpatRaster, SpatVector or SpatExtent to a SpatVector of lines. } \usage{ \S4method{as.lines}{SpatRaster}(x) \S4method{as.lines}{SpatVector}(x) \S4method{as.lines}{SpatExtent}(x, crs="") \S4method{as.lines}{matrix}(x, crs="") } \arguments{ \item{x}{SpatRaster, SpatVector, SpatExtent or matrix. If \code{x} is a matrix it should have two columns for a single line, or four columns, where each row has the start and end coordinates (x, y) for lines} \item{crs}{character. The coordinate reference system (see \code{\link{crs}})} } \value{ SpatVector } \seealso{ \code{\link{as.points}}, \code{\link{as.polygons}} } \examples{ r <- rast(ncols=2, nrows=2) values(r) <- 1:ncell(r) as.lines(r) as.lines(ext(r), crs=crs(r)) p <- as.polygons(r) as.lines(p) ## with a matrix s <- cbind(1:5, 1:5) e <- cbind(1:5, 0) as.lines(s) as.lines(cbind(s, e), "+proj=longlat") } \keyword{spatial} terra/man/xapp.Rd0000644000176200001440000000221514555753620013415 0ustar liggesusers\name{xapp} \docType{methods} \alias{xapp} \alias{xapp,SpatRaster,SpatRaster-method} \title{Apply a function to the cells of a two SpatRasters} \description{ Apply a function to the values of each cell of two (multilayer) SpatRasters. } \usage{ \S4method{xapp}{SpatRaster,SpatRaster}(x, y, fun, ..., filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatRaster with the same geometry as \code{x}} \item{fun}{a function that operates on two vectors} \item{...}{additional arguments for \code{fun}. These are typically numerical constants. They should *never* be another SpatRaster} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{app}}, \code{\link{lapp}}, \code{\link{tapp}}, \code{\link[terra]{Math-methods}}, \code{\link{roll}} } \examples{ r <- rast(ncols=10, nrows=10, nlyr=5) set.seed(1) r <- init(r, runif) s <- init(r, runif) x <- xapp(r, s, fun=cor) } \keyword{methods} \keyword{spatial} terra/man/summarize-generics.Rd0000644000176200001440000001117614547074176016267 0ustar liggesusers\name{summarize} \docType{methods} \alias{Summary-methods} \alias{median} \alias{mean} \alias{min} \alias{max} \alias{which.min} \alias{which.max} \alias{any} \alias{all} \alias{prod} \alias{range} \alias{sum} \alias{anyNA} \alias{allNA} \alias{noNA} \alias{countNA} \alias{mean,SpatRaster-method} \alias{mean,SpatVector-method} \alias{mean,SpatExtent-method} \alias{median,SpatRaster-method} \alias{median,SpatVector-method} \alias{min,SpatRaster-method} \alias{max,SpatRaster-method} \alias{range,SpatRaster-method} \alias{which.min,SpatRaster-method} \alias{which.max,SpatRaster-method} \alias{any,SpatRaster-method} \alias{all,SpatRaster-method} \alias{prod,SpatRaster-method} \alias{range,SpatRaster-method} \alias{sum,SpatRaster-method} \alias{anyNA,SpatRaster-method} \alias{allNA,SpatRaster-method} \alias{noNA,SpatRaster-method} \alias{countNA,SpatRaster-method} \alias{stdev} \alias{stdev,SpatRaster-method} \title{Summarize} \description{ Compute summary statistics for cells, either across layers or between layers (parallel summary). The following summary methods are available for SpatRaster: \code{any, anyNA, all, allNA, max, min, mean, median, prod, range, stdev, sum, which.min, which.max}. See \code{\link{modal}} to compute the mode and \code{\link{app}} to compute summary statistics that are not included here. Because generic functions are used, the method applied is chosen based on the first argument: "\code{x}". This means that if \code{r} is a SpatRaster, \code{mean(r, 5)} will work, but \code{mean(5, r)} will not work. The \code{mean} method has an argument "trim" that is ignored. If \code{pop=TRUE} \code{stdev} computes the population standard deviation, computed as: \code{f <- function(x) sqrt(sum((x-mean(x))^2) / length(x))} This is different than the sample standard deviation returned by \code{sd} (which uses \code{n-1} as denominator). } \usage{ \S4method{min}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{max}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{range}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{prod}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{sum}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{any}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{all}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{range}{SpatRaster}(x, ..., na.rm=FALSE) \S4method{which.min}{SpatRaster}(x) \S4method{which.max}{SpatRaster}(x) \S4method{stdev}{SpatRaster}(x, ..., pop=TRUE, na.rm=FALSE) \S4method{mean}{SpatRaster}(x, ..., trim=NA, na.rm=FALSE) \S4method{median}{SpatRaster}(x, na.rm=FALSE, ...) \S4method{anyNA}{SpatRaster}(x) \S4method{countNA}{SpatRaster}(x, n=0) \S4method{noNA}{SpatRaster}(x, falseNA=FALSE) \S4method{allNA}{SpatRaster}(x, falseNA=FALSE) } \arguments{ \item{x}{SpatRaster} \item{...}{additional SpatRasters or numeric values; and arguments \code{par} for parallel summarization (see Details), and \code{filename}, \code{overwrite} and \code{wopt} as for \code{\link{writeRaster}}} \item{na.rm}{logical. If \code{TRUE}, \code{NA} values are ignored. If \code{FALSE}, \code{NA} is returned if \code{x} has any \code{NA} values} \item{trim}{ignored} \item{pop}{logical. If \code{TRUE}, the population standard deviation is computed. Otherwise the sample standard deviation is computed} \item{falseNA}{logical. If \code{TRUE}, cells that would otherwise be \code{FALSE} are set to \code{NA}} \item{n}{integer. If \code{n > 0}, cell values are \code{TRUE} if at least \code{n} of its layers are \code{NA}} } \value{SpatRaster} \details{ Additional argument \code{par} can be used for "parallel" summarizing a SpatRaster and a numeric or logical value. If a SpatRaster \code{x} has three layers, \code{max(x, 5)} will return a single layer (the number five is treated as a layer in which all cells have value five). In contrast \code{max(x, 5, par=TRUE)} returns three layers (the number five is treated as another SpatRaster with a single layer with all cells having the value five. } \seealso{\code{\link{app}}, \code{\link{Math-methods}}, \code{\link{modal}}, \code{\link{which.lyr}} } \examples{ set.seed(0) r <- rast(nrows=10, ncols=10, nlyrs=3) values(r) <- runif(ncell(r) * nlyr(r)) x <- mean(r) # note how this returns one layer x <- sum(c(r, r[[2]]), 5) # and this returns three layers y <- sum(r, r[[2]], 5) max(r) ## when adding a number, do you want 1 layer or all layers? # 1 layer max(r, 0.5) # all layers max(r, 0.5, par=TRUE) y <- stdev(r) # not the same as yy <- app(r, sd) z <- stdev(r, r*2) x <- mean(r, filename=paste0(tempfile(), ".tif")) v <- values(r) set.seed(3) v[sample(length(v), 50)] <- NA values(r) <- v is.na(r) anyNA(r) allNA(r) countNA(r) countNA(r, 2) } \keyword{methods} \keyword{spatial} terra/man/plet.Rd0000644000176200001440000001255014746025372013412 0ustar liggesusers\name{plet} \docType{methods} \alias{plet} \alias{plet,missing-method} \alias{plet,SpatRaster-method} \alias{plet,SpatVector-method} \alias{plet,SpatVectorCollection-method} \alias{lines,leaflet-method} \alias{points,leaflet-method} \alias{polys,leaflet-method} \title{Plot with leaflet} \description{ Plot the values of a SpatRaster or SpatVector to make an interactive leaflet map that is displayed in a browser. } \usage{ \S4method{plet}{SpatRaster}(x, y=1, col, alpha=0.8, main=names(x), tiles=c("Streets", "Esri.WorldImagery", "OpenTopoMap"), wrap=TRUE, maxcell=500000, stretch=NULL, legend="bottomright", shared=FALSE, panel=FALSE, collapse=TRUE, type=NULL, breaks=NULL, breakby="eqint", map=NULL, ...) \S4method{plet}{SpatVector}(x, y="", col,fill=0.2, main=y, cex=1, lwd=2, border="black", alpha=1, popup=TRUE, label=FALSE, split=FALSE, tiles=c("Streets", "Esri.WorldImagery", "OpenTopoMap"), wrap=TRUE, legend="bottomright", collapse=FALSE, type=NULL, breaks=NULL, breakby="eqint", sort=TRUE, decreasing=FALSE, map=NULL, ...) \S4method{plet}{SpatVectorCollection}(x, col, fill=0, cex=1, lwd=2, border="black", alpha=1, popup=TRUE, label=FALSE, tiles=c("Streets", "Esri.WorldImagery", "OpenTopoMap"), wrap=TRUE, legend="bottomright", collapse=FALSE, map=NULL) \S4method{lines}{leaflet}(x, y, col, lwd=2, alpha=1, ...) \S4method{points}{leaflet}(x, y, col, cex=1, alpha=1, label=1:nrow(y), popup=FALSE, ...) \S4method{polys}{leaflet}(x, y, col, fill=0.2, lwd=2, border="black", alpha=1, popup=TRUE, label=FALSE, ...) } \arguments{ \item{x}{SpatRaster, SpatVector, or leaflet object} \item{y}{missing, or positive integer, or character (variable or layer name) indicating the layer(s) to be plotted. If \code{x} is a SpatRaster, you can select multiple layers} \item{col}{character. Vector of colors or color generating function} \item{alpha}{Number between 0 and 1 to set the transparency for lines (0 is transparent, 1 is opaque)} \item{fill}{Number between 0 and 1 to set the transparency for polygon areas (0 is transparent, 1 is opaque)} \item{tiles}{character or NULL. Names of background tile providers} \item{wrap}{logical. if \code{TRUE}, tiles wrap around} \item{maxcell}{positive integer. Maximum number of cells to use for the plot} \item{stretch}{NULL or character ("lin" or "hist") to stretch RGB rasters. See \code{\link{plotRGB}}} \item{legend}{character to indicate the legend position ("bottomleft", "bottomright", "topleft" or "topright") or NULL to suppress the legend} \item{main}{character. Title for the legend. The length should be 1 if \code{x} is a SpatVector and length nlyr(x) if \code{x} is a SpatVector} \item{shared}{logical. Should the legend be the same for all rasters (if multiple layers of SpatRaster \code{x} are mapped)} \item{map}{leaflet object} \item{...}{additional arguments for drawing points, lines, or polygons passed on the the relevant leaflet function} \item{border}{character. Color for the polygon borders} \item{collapse}{logical. Should the layers "control" panel be collapsed?} \item{split}{logical. If \code{TRUE} a check-box is created to toggle each value in \code{y} (If \code{x} is a SpatVector)} \item{cex}{numeric. point size magnifier. See \code{\link{par}}} \item{lwd}{numeric, line-width. See \code{\link{par}}} \item{popup}{logical. Should pop-ups be created?} \item{label}{logical. Should mouse-over labels be added?} \item{panel}{logical. Should SpatRaster layers be shown as a panel"} \item{type}{character. Type of map/legend. One of "classes", or "interval". If not specified, the type is chosen based on the data. Use "" to suppress the legend} \item{breaks}{numeric. Either a single number to indicate the number of breaks desired, or the actual breaks. When providing this argument, the default legend becomes "interval"} \item{breakby}{character or function. Either "eqint" for equal interval breaks, "cases" for equal quantile breaks. If a function is supplied it should take a single argument (a vector of values) and create groups} \item{sort}{logical. If \code{TRUE} legends with character values are sorted. You can also supply a vector of the unique values, in the order in which you want them to appear in the legend} \item{decreasing}{logical. If \code{TRUE}, legends are sorted in decreasing order} } \seealso{ \code{\link{plot}} } \examples{ \dontrun{ if (require(leaflet) && (packageVersion("leaflet") > "2.1.1")) { v <- vect(system.file("ex/lux.shp", package="terra")) p <- spatSample(as.polygons(v, ext=T), 30) values(p) = data.frame(id=11:40, name=letters[1:30]) m <- plet(v, "NAME_1", tiles="", border="blue") m <- points(m, p, col="red", cex=2, popup=T) lines(m, v, lwd=1, col="white") plet(v, "NAME_1", split=TRUE, alpha=.2) |> points(p, col="gray", cex=2, popup=TRUE, clusterOptions = markerClusterOptions()) s <- svc(v, p) names(s) <- c("the polys", "set of points") plet(s, col=c("red", "blue"), lwd=1) r <- rast(system.file("ex/elev.tif", package="terra")) plet(r, main="Hi\nthere", tiles=NULL) |> lines(v, lwd=1) plet(r, tiles="OpenTopoMap") |> lines(v, lwd=2, col="blue") x <- c(r, 50*classify(r, 5)) names(x) <- c("first", "second") # each their own legend plet(x, 1:2, collapse=FALSE) |> lines(v, lwd=2, col="blue") # shared legend plet(x, 1:2, shared=TRUE, collapse=FALSE) |> lines(v, lwd=2, col="blue") }}} \keyword{methods} \keyword{spatial} terra/man/elongate.Rd0000644000176200001440000000167014740002046014230 0ustar liggesusers\name{elongate} \docType{methods} \alias{elongate} \alias{elongate,SpatVector-method} \title{ elongate lines } \description{ Elongate SpatVector lines } \usage{ \S4method{elongate}{SpatVector}(x, length=1, flat=FALSE) } \arguments{ \item{x}{SpatVector} \item{length}{positive number indicating how much the lines should be elongated at each end. The unit is meter is the crs is lonlat and it is the same as the linear unit of the crs on other cases (also meter in most cases)} \item{flat}{logical. If \code{TRUE}, the earth's curvature is ignored for lonlat data, and the distance unit is degrees, not meter} } \value{ SpatVector } \seealso{ \code{\link{buffer}}, \code{\link{crop}}, \code{\link{erase}}, \code{\link{extend}} } \examples{ v <- vect(cbind(c(0,1,2), c(0,0,2)), "lines", crs="lonlat") e <- elongate(v, 100000) plot(e) points(e) geom(e) } \keyword{methods} \keyword{spatial} terra/man/geomtype.Rd0000644000176200001440000000167014536376240014300 0ustar liggesusers\name{geomtype} \docType{methods} \alias{geomtype} \alias{geomtype,SpatVector-method} \alias{geomtype,SpatVectorProxy-method} \alias{geomtype,Spatial-method} \alias{is.points} \alias{is.lines} \alias{is.polygons} \alias{is.points,SpatVector-method} \alias{is.lines,SpatVector-method} \alias{is.polygons,SpatVector-method} \title{Geometry type of a SpatVector} \description{ Get the geometry type (points, lines, or polygons) of a SpatVector. See \code{\link{datatype}} for the data types of the fields (attributes, variables) of a SpatVector. } \usage{ \S4method{geomtype}{SpatVector}(x) \S4method{is.points}{SpatVector}(x) \S4method{is.lines}{SpatVector}(x) \S4method{is.polygons}{SpatVector}(x) } \arguments{ \item{x}{SpatVector} } \value{character} \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) geomtype(v) is.polygons(v) is.lines(v) is.points(v) names(v) datatype(v) } \keyword{methods} \keyword{spatial} terra/man/math-generics.Rd0000644000176200001440000000507114547074017015173 0ustar liggesusers\name{Math-methods} \docType{methods} \alias{Math-methods} \alias{Math2-methods} \alias{Math,SpatRaster-method} \alias{Math2,SpatRaster-method} \alias{Math,SpatExtent-method} \alias{Math2,SpatExtent-method} \alias{Math2,SpatVector-method} \alias{cumsum} \alias{cumsum,SpatRaster-method} \alias{log} \alias{log,SpatRaster-method} \alias{round} \alias{round,SpatRaster-method} \alias{round} \alias{round,SpatVector-method} \alias{sqrt} \alias{sqrt,SpatRaster-method} \alias{math} \alias{math,SpatRaster-method} \title{General mathematical methods} \description{ Standard mathematical methods for computations with SpatRasters. Computations are local (applied on a cell by cell basis). If multiple SpatRasters are used, these must have the same extent and resolution. These have been implemented: \code{abs, sign, sqrt, ceiling, floor, trunc, cummax, cummin, cumprod, cumsum, log, log10, log2, log1p, acos, acosh, asin, asinh, atan, atanh, exp, expm1, cos, cosh, sin, sinh, tan, tanh, round, signif} Instead of directly calling these methods, you can also provide their name to the \code{math} method. This is useful if you want to provide an output filename. The following methods have been implemented for \code{SpatExtent}: \code{round, floor, ceiling} \code{round} has also been implemented for \code{SpatVector}, to round the coordinates of the geometries. } \usage{ \S4method{sqrt}{SpatRaster}(x) \S4method{log}{SpatRaster}(x, base=exp(1)) \S4method{round}{SpatRaster}(x, digits=0) \S4method{math}{SpatRaster}(x, fun, digits=0, filename="", overwrite=FALSE, ...) \S4method{round}{SpatVector}(x, digits=4) \S4method{cumsum}{SpatRaster}(x) } \seealso{ See \code{\link{app}} to use mathematical functions not implemented by the package, and \code{\link{Arith-methods}} for arithmetical operations. Use \code{\link{roll}} for rolling functions. } \arguments{ \item{x}{SpatRaster} \item{base}{a positive or complex number: the base with respect to which logarithms are computed} \item{digits}{Number of digits for rounding} \item{fun}{character. Math function name} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster or SpatExtent } \examples{ r1 <- rast(ncols=10, nrows=10) v <- runif(ncell(r1)) v[10:20] <- NA values(r1) <- v r2 <- rast(r1) values(r2) <- 1:ncell(r2) / ncell(r2) r <- c(r1, r2) s <- sqrt(r) # same as math(r, "sqrt") round(s, 1) cumsum(r) } \keyword{methods} \keyword{math} \keyword{spatial} terra/man/focalCpp.Rd0000644000176200001440000000600714677272511014177 0ustar liggesusers\name{focalCpp} \alias{focalCpp} \alias{focalCpp,SpatRaster-method} \title{Compute focal values with an iterating C++ function} \description{ Calculate focal values with a C++ function that iterates over cells to speed up computations by avoiding an R loop (with apply). See \code{\link{focal}} for an easier to use method. } \usage{ \S4method{focalCpp}{SpatRaster}(x, w=3, fun, ..., fillvalue=NA, silent=TRUE, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{w}{window. The window can be defined as one (for a square) or two numbers (row, col); or with an odd-sized weights matrix. See the Details section in \code{\link{focal}}} \item{fun}{\code{\link[Rcpp]{cppFunction}} that iterates over cells. For C++ functions that operate on a single focal window, or for R functions use \code{\link{focal}} instead. The function must have at least three arguments. The first argument can have any name, but it must be a \code{Rcpp::NumericVector}, \code{Rcpp::IntegerVector} or a \code{std::vector}. This is the container that receives the focal values. The other two arguments \code{ni} and \code{wi} must be of type \code{size_t}. \code{ni} represents the number of cells and \code{nw} represents the size of (number of elements in) the window} \item{...}{additional arguments to \code{fun}} \item{fillvalue}{numeric. The value of the cells in the virtual rows and columns outside of the raster} \item{silent}{logical. If \code{TRUE} error messages are printed that may occur when trying \code{fun} to determine the length of the returned value. This can be useful in debugging a \code{fun} that does not work} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \seealso{ \code{\link{focal}}, \code{\link{focalValues}} } \examples{ \dontrun{ library(Rcpp) cppFunction( 'NumericVector sum_and_multiply(NumericVector x, double m, size_t ni, size_t nw) { NumericVector out(ni); // loop over cells size_t start = 0; for (size_t i=0; i 1}, a 'parallel' package cluster with that many cores is created and used} \item{cpkgs}{character. The package(s) that need to be loaded on the nodes to be able to run the model.predict function (see examples)} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{interpolate}} for spatial model prediction } \examples{ logo <- rast(system.file("ex/logo.tif", package="terra")) names(logo) <- c("red", "green", "blue") p <- matrix(c(48, 48, 48, 53, 50, 46, 54, 70, 84, 85, 74, 84, 95, 85, 66, 42, 26, 4, 19, 17, 7, 14, 26, 29, 39, 45, 51, 56, 46, 38, 31, 22, 34, 60, 70, 73, 63, 46, 43, 28), ncol=2) a <- matrix(c(22, 33, 64, 85, 92, 94, 59, 27, 30, 64, 60, 33, 31, 9, 99, 67, 15, 5, 4, 30, 8, 37, 42, 27, 19, 69, 60, 73, 3, 5, 21, 37, 52, 70, 74, 9, 13, 4, 17, 47), ncol=2) xy <- rbind(cbind(1, p), cbind(0, a)) # extract predictor values for points e <- extract(logo, xy[,2:3]) # combine with response (excluding the ID column) v <- data.frame(cbind(pa=xy[,1], e)) #build a model, here with glm model <- glm(formula=pa~., data=v) #predict to a raster r1 <- predict(logo, model) plot(r1) points(p, bg='blue', pch=21) points(a, bg='red', pch=21) # logistic regression model <- glm(formula=pa~., data=v, family="binomial") r1log <- predict(logo, model, type="response") # to get the probability and standard error r1se <- predict(logo, model, se.fit=TRUE) # or provide a custom predict function predfun <- function(model, data) { v <- predict(model, data, se.fit=TRUE) cbind(p=as.vector(v$fit), se=as.vector(v$se.fit)) } r2 <- predict(logo, model, fun=predfun) ### principal components of a SpatRaster pca <- prcomp(logo) # or use sampling if you have a large raster # and cannot process all cell values sr <- spatSample(logo, 100000, "regular") pca <- prcomp(sr) x <- predict(logo, pca) plot(x) ## parallelization \dontrun{ ## simple case with GLM model <- glm(formula=pa~., data=v) p <- predict(logo, model, cores=2) ## The above does not work with a model from a contributed ## package, as the package needs to be loaded in each core. ## Below are three approaches to deal with that library(randomForest) rfm <- randomForest(formula=pa~., data=v) ## approach 0 (not parallel) rp0 <- predict(logo, rfm) ## approach 1, use the "cpkgs" argument rp1 <- predict(logo, rfm, cores=2, cpkgs="randomForest") ## approach 2, write a custom predict function that loads the package rfun <- function(mod, dat, ...) { library(randomForest) predict(mod, dat, ...) } rp2 <- predict(logo, rfm, fun=rfun, cores=2) ## approach 3, write a parallelized custom predict function rfun <- function(mod, dat, ...) { ncls <- length(cls) nr <- nrow(dat) s <- split(dat, rep(1:ncls, each=ceiling(nr/ncls), length.out=nr)) unlist( parallel::clusterApply(cls, s, function(x, ...) predict(mod, x, ...)) ) } library(parallel) cls <- parallel::makeCluster(2) parallel::clusterExport(cls, c("rfm", "rfun", "randomForest")) rp3 <- predict(logo, rfm, fun=rfun) parallel::stopCluster(cls) plot(c(rp0, rp1, rp2, rp3)) ### with two output variables (probabilities for each class) v$pa <- as.factor(v$pa) rfm2 <- randomForest(formula=pa~., data=v) rfp <- predict(logo, rfm2, cores=2, type="prob", cpkgs="randomForest") } } \keyword{methods} \keyword{spatial} terra/man/subset_single.Rd0000644000176200001440000000677714536376240015332 0ustar liggesusers\name{subset_single} \alias{[} \alias{[,SpatExtent,missing,missing-method} \alias{[,SpatExtent,numeric,missing-method} \alias{[,SpatRaster,ANY,ANY,ANY-method} \alias{[,SpatRaster,ANY,ANY-method} \alias{[,SpatRasterDataset,logical,missing-method} \alias{[,SpatRasterDataset,character,missing-method} \alias{[,SpatRasterDataset,numeric,missing-method} \alias{[,SpatRasterDataset,numeric,numeric-method} \alias{[,SpatRasterDataset,numeric,logical-method} \alias{[,SpatRasterDataset,missing,numeric-method} \alias{[,SpatRasterDataset,missing,logical-method} \alias{[,SpatRasterCollection,numeric,missing-method} \alias{[,SpatVector,missing,missing-method} \alias{[,SpatVector,missing,numeric-method} \alias{[,SpatVector,missing,character-method} \alias{[,SpatVector,missing,logical-method} \alias{[,SpatVector,character,missing-method} \alias{[,SpatVector,numeric,missing-method} \alias{[,SpatVector,numeric,numeric-method} \alias{[,SpatVector,numeric,character-method} \alias{[,SpatVector,numeric,logical-method} \alias{[,SpatVector,logical,missing-method} \alias{[,SpatVector,logical,character-method} \alias{[,SpatVector,logical,numeric-method} \alias{[,SpatVector,logical,logical-method} \alias{[,SpatVector,data.frame,missing-method} \alias{[,SpatVector,data.frame,ANY-method} \alias{[,SpatVector,matrix,missing-method} \alias{[,SpatVector,SpatVector,missing-method} \alias{[,SpatVector,SpatExtent,missing-method} \alias{[,SpatRaster,SpatVector,missing-method} \alias{[,SpatRaster,missing,missing-method} \alias{[,SpatRaster,numeric,missing-method} \alias{[,SpatRaster,missing,numeric-method} \alias{[,SpatRaster,numeric,numeric-method} \alias{[,SpatRaster,data.frame,missing-method} \alias{[,SpatRaster,matrix,missing-method} \alias{[,SpatRaster,SpatRaster,missing-method} \alias{[,SpatRaster,SpatExtent,missing-method} \title{Extract values from a SpatRaster, SpatVector or SpatExtent} \description{ Extract values from a SpatRaster; a subset of records (row) and/or variables (columns) from a SpatVector; or a number from a SpatExtent. You can use indices (row, column, layer or cell numbers) to extract. You can also use other Spat* objects. } \usage{ \S4method{[}{SpatRaster,ANY,ANY,ANY}(x, i, j, k) \S4method{[}{SpatVector,numeric,numeric}(x, i, j, drop=FALSE) \S4method{[}{SpatVector,SpatVector,missing}(x, i, j) \S4method{[}{SpatExtent,numeric,missing}(x, i, j) } \arguments{ \item{x}{SpatRaster, SpatVector or SpatExtent} \item{i}{ if \code{x} is a \code{SpatRaster}: numeric, logical or missing to select rows or, if \code{j} is missing, to select cells numbers. if \code{x} is a \code{SpatVector}: numeric or missing to select rows. if \code{i} is another SpatVector: get a new SpatVector with the geometries that intersect. if \code{x} is a \code{SpatExtent}: integer between 1 and 4. } \item{j}{numeric, logical, or missing to select columns} \item{k}{numeric, character, or missing to select layers} \item{drop}{logical. If \code{FALSE} an object of the same class as \code{x} is returned} } \value{ numeric if \code{x} is a SpatExtent. Same as \code{x} if \code{drop=FALSE}. Otherwise a data.frame } \seealso{\code{\link{extract}}, \code{\link{subset}}, \code{\link{$}}, \code{\link{[[}}} \examples{ ### SpatRaster f <- system.file("ex/elev.tif", package="terra") r <- rast(f) r[3638] rowColFromCell(r, 2638) r[39, 28] x <- r[39:40, 28:29, drop=FALSE] as.matrix(x, wide=TRUE) ### SpatVector v <- vect(system.file("ex/lux.shp", package="terra")) v[2:3,] v[1:2, 2:3] v[1:2, 2:3, drop=TRUE] } \keyword{ spatial } terra/man/boxplot.Rd0000644000176200001440000000262714536376240014141 0ustar liggesusers\name{boxplot} \docType{methods} \alias{boxplot} \alias{boxplot,SpatRaster-method} \title{ Box plot of SpatRaster data } \description{ Box plot of layers in a SpatRaster } \usage{ \S4method{boxplot}{SpatRaster}(x, y=NULL, maxcell=100000, ...) } \arguments{ \item{x}{SpatRaster} \item{y}{NULL or a SpatRaster. If \code{x} is a SpatRaster it used to group the values of \code{x} by "zone"} \item{maxcell}{Integer. Number of cells to sample from datasets} \item{...}{additional arguments passed to \code{graphics::\link[graphics]{boxplot}}} } \value{ boxplot returns a list (invisibly) that can be used with \code{\link{bxp}} } \seealso{ \code{\link{pairs}, \link{hist}} } \examples{ r1 <- r2 <- r3 <- rast(ncols=10, nrows=10) set.seed(409) values(r1) <- rnorm(ncell(r1), 100, 40) values(r2) <- rnorm(ncell(r1), 80, 10) values(r3) <- rnorm(ncell(r1), 120, 30) s <- c(r1, r2, r3) names(s) <- c("Apple", "Pear", "Cherry") boxplot(s, notch=TRUE, col=c("red", "blue", "orange"), main="Box plot", ylab="random", las=1) op <- par(no.readonly = TRUE) par(mar=c(4,6,2,2)) boxplot(s, horizontal=TRUE, col="lightskyblue", axes=FALSE) axis(1) axis(2, at=0:3, labels=c("", names(s)), las=1, cex.axis=.9, lty=0) par(op) ## boxplot with 2 layers v <- vect(system.file("ex/lux.shp", package="terra")) r <- rast(system.file("ex/elev.tif", package="terra")) y <- rasterize(v, r, "NAME_2") b <- boxplot(r, y) bxp(b) } \keyword{spatial} terra/man/replace_values.Rd0000644000176200001440000000271714536376240015444 0ustar liggesusers \name{replace_values} \docType{methods} \alias{[<-} \alias{[<-,SpatRaster,ANY,ANY,ANY-method} \alias{[<-,SpatRaster,ANY,ANY-method} \alias{[<-,SpatExtent,numeric,missing-method} \alias{[<-,SpatVector,ANY,ANY-method} \alias{[<-,SpatVector,ANY,missing-method} \alias{[<-,SpatVector,missing,ANY-method} \title{Replace values of a SpatRaster} \description{ Replace values of a SpatRaster. These are convenience functions for smaller objects only. For larger rasters see \code{link{classify}} or \code{\link{subst}} } \usage{ \S4method{[}{SpatRaster,ANY,ANY,ANY}(x, i, j, k) <- value \S4method{[}{SpatVector,ANY,ANY}(x, i, j) <- value \S4method{[}{SpatExtent,numeric,missing}(x, i, j) <- value } \arguments{ \item{x}{SpatRaster} \item{i}{row numbers. numeric, logical, or missing for all rows. Can also be a SpatRaster or SpatVector} \item{j}{column numbers. numeric, logical or missing for all columns} \item{k}{layer number. numeric, logical or missing for all layers} \item{value}{numeric, matrix, or data.frame} } \value{SpatRaster} \seealso{\code{\link{classify}, \link{subst}, \link{set.values}, \link{values}, \link{[[<-}}} \examples{ ## SpatRaster r <- rast(ncols=5, nrows=5, xmin=0, xmax=5, ymin=0, ymax=5) r[] <- 1:25 r[1,] <- 5 r[,2] <- 10 r[r>10] <- NA ## SpatVector f <- system.file("ex/lux.shp", package="terra") v <- vect(f) v[2,2] <- "hello" v[1,] <- v[10,] v[,3] <- v[,1] v[2, "NAME_2"] <- "terra" head(v, 3) } \keyword{methods} \keyword{spatial} terra/man/writeVector.Rd0000644000176200001440000000353614716336246014771 0ustar liggesusers\name{writeVector} \alias{writeVector,SpatVector,character-method} \alias{writeVector} \title{Write SpatVector data to a file} \description{ Write a SpatVector to a file. You can choose one of many file formats. } \usage{ \S4method{writeVector}{SpatVector,character}(x, filename, filetype=NULL, layer=NULL, insert=FALSE, overwrite=FALSE, options="ENCODING=UTF-8") } \arguments{ \item{x}{SpatVector} \item{filename}{character. Output filename} \item{filetype}{character. A file format associated with a GDAL "driver" such as "ESRI Shapefile". See \code{gdal(drivers=TRUE)} or the \href{https://gdal.org/en/latest/drivers/vector/index.html}{GDAL docs}. If \code{NULL} it is attempted to guess the filetype from the filename extension} \item{layer}{character. Output layer name. If \code{NULL} the filename is used} \item{insert}{logical. If \code{TRUE}, a new layer is inserted into the file, or an existing layer overwritten (if \code{overwrite=TRUE}), if the format supports it (e.g. GPKG allows that). See \code{\link{vector_layers}} to remove a layer} \item{overwrite}{logical. If \code{TRUE} and \code{insert=FALSE}, \code{filename} is overwritten if the file format and layer structure permits it. If \code{TRUE} and \code{insert=TRUE}, only the target layer is overwritten if the format supports it (e.g. GPKG).} \item{options}{character. Format specific GDAL options such as "ENCODING=UTF-8". Use NULL or "" to not use any options} } \examples{ v <- vect(cbind(1:5,1:5)) crs(v) <- "+proj=longlat +datum=WGS84" v$id <- 1:length(v) v$name <- letters[1:length(v)] tmpf1 <- paste0(tempfile(), ".gpkg") writeVector(v, tmpf1, overwrite=TRUE) x <- vect(tmpf1) f <- system.file("ex/lux.shp", package="terra") v <- vect(f) tmpf2 <- paste0(tempfile(), ".gpkg") writeVector(v, tmpf2, overwrite=TRUE) y <- vect(tmpf2) } \keyword{ spatial } \keyword{ methods } terra/man/is.flipped.Rd0000644000176200001440000000106614746475255014514 0ustar liggesusers\name{is.flipped} \docType{methods} \alias{is.flipped} \alias{is.flipped,SpatRaster-method} \title{Check for rotation} \description{ Check if a SpatRaster is "flipped" vertically, and may need to be adjusted with \code{\link{flip}} before it can be used. } \usage{ \S4method{is.flipped}{SpatRaster}(x) } \arguments{ \item{x}{SpatRaster} } \value{ logical. One value for each raster data *source* } \seealso{ \code{\link{flip}, \link{is.rotated}} } \examples{ r <- rast(nrows=10, ncols=10) is.flipped(r) } \keyword{methods} \keyword{spatial} terra/man/symdif.Rd0000644000176200001440000000104514536376240013736 0ustar liggesusers\name{symdif} \docType{methods} \alias{symdif} \alias{symdif,SpatVector,SpatVector-method} \title{ Symmetrical difference } \description{ Symmetrical difference of polygons } \usage{ \S4method{symdif}{SpatVector,SpatVector}(x, y) } \arguments{ \item{x}{SpatVector} \item{y}{SpatVector} } \value{ SpatVector } \seealso{ \code{\link{erase}} } \examples{ p <- vect(system.file("ex/lux.shp", package="terra")) b <- as.polygons(ext(6, 6.4, 49.75, 50)) #sd <- symdif(p, b) #plot(sd, col=rainbow(12)) } \keyword{methods} \keyword{spatial} terra/man/rep.Rd0000644000176200001440000000066614536376240013241 0ustar liggesusers\name{rep} \docType{methods} \alias{rep} \alias{rep,SpatRaster-method} \title{Replicate layers} \description{ Replicate layers in a SpatRaster } \usage{ \S4method{rep}{SpatRaster}(x, ...) } \arguments{ \item{x}{SpatRaster} \item{...}{arguments as in \code{\link[base]{rep}}} } \value{ SpatRaster } \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) x <- rep(s, 2) nlyr(x) names(x) x } \keyword{spatial} terra/man/topology.Rd0000644000176200001440000000321714536376240014322 0ustar liggesusers\name{topology} \docType{methods} \alias{topology} \alias{makeNodes} \alias{mergeLines} \alias{removeDupNodes} \alias{emptyGeoms} \alias{snap} \alias{makeNodes,SpatVector-method} \alias{mergeLines,SpatVector-method} \alias{snap,SpatVector-method} \alias{removeDupNodes,SpatVector-method} \alias{emptyGeoms,SpatVector-method} \title{ Vector topology methods } \description{ \code{makeNodes} create nodes on lines \code{mergeLines} connect lines to form polygons \code{removeDupNodes} removes duplicate nodes in geometries and optionally rounds the coordinates \code{emptyGeoms} returns the indices of empty (null) geometries. \code{\link{is.na}} also checks if any of the coordinates is \code{NA}. \code{snap} makes boundaries of geometries identical if they are very close to each other. } \usage{ \S4method{mergeLines}{SpatVector}(x) \S4method{snap}{SpatVector}(x, y=NULL, tolerance) \S4method{removeDupNodes}{SpatVector}(x, digits = -1) \S4method{makeNodes}{SpatVector}(x) } \arguments{ \item{x}{SpatVector of lines or polygons} \item{y}{SpatVector of lines or polygons to snap to. If \code{NULL} snapping is to the other geometries in \code{x}} \item{tolerance}{numeric. Snapping tolerance (distance between geometries)} \item{digits}{numeric. Number of digits used in rounding. Ignored if < 0} } \value{ SpatVector } \seealso{\code{\link{sharedPaths}}, \code{\link{gaps}}, \code{\link{simplifyGeom}}, \code{\link{forceCCW}}} \examples{ p1 <- as.polygons(ext(0,1,0,1)) p2 <- as.polygons(ext(1.1,2,0,1)) p <- rbind(p1, p2) y <- snap(p, tol=.15) plot(p, lwd=3, col="light gray") lines(y, col="red", lwd=2) } \keyword{methods} \keyword{spatial} terra/man/vect.Rd0000644000176200001440000001262014744011126013373 0ustar liggesusers\name{vect} \docType{methods} \alias{vect} \alias{vect,character-method} \alias{vect,list-method} \alias{vect,SpatVector-method} \alias{vect,SpatVectorCollection-method} \alias{vect,SpatExtent-method} \alias{vect,data.frame-method} \alias{vect,matrix-method} \alias{vect,missing-method} \alias{vect,Spatial-method} \alias{vect,sf-method} \alias{vect,sfc-method} \alias{vect,XY-method} \alias{vect,PackedSpatVector-method} \alias{vect,SpatGraticule-method} \title{Create SpatVector objects} \description{ Methods to create a SpatVector from a filename or other R object. A filename can be for a Shapefile, GeoPackage, GeoJSON, Keyhole Markup Language (KML) or any other spatial vector file format. You can use a data.frame to make a SpatVector of points; or a "geom" matrix to make a SpatVector of any supported geometry (see examples and \code{\link{geom}}). You can supply a list of SpatVectors to append them into a single SpatVector. SpatVectors can also be created from "Well Known Text", and from spatial vector data objects defined in the \code{sf} or \code{sp} packages. } \usage{ \S4method{vect}{character}(x, layer="", query="", extent=NULL, filter=NULL, crs="", proxy=FALSE, what="", opts=NULL) \S4method{vect}{matrix}(x, type="points", atts=NULL, crs="") \S4method{vect}{data.frame}(x, geom=c("lon", "lat"), crs="", keepgeom=FALSE) \S4method{vect}{list}(x, type="points", crs="") \S4method{vect}{SpatExtent}(x, crs="") \S4method{vect}{SpatVectorCollection}(x) \S4method{vect}{sf}(x) } \arguments{ \item{x}{character. A filename; or a "Well Known Text" string; SpatExtent, data.frame (to make a SpatVector of points); a "geom" matrix to make a SpatVector of any supported geometry (see examples and \code{\link{geom}}); a spatial vector data object defined in the \code{sf} or \code{sp} packages; or a list with matrices with coordinates} \item{layer}{character. layer name to select a layer from a file (database) with multiple layers} \item{query}{character. A query to subset the dataset in the \href{https://gdal.org/en/latest/user/ogr_sql_dialect.html}{OGR-SQL dialect}} \item{extent}{Spat* object. The extent of the object is used as a spatial filter to select the geometries to read. Ignored if \code{filter} is not \code{NULL}} \item{filter}{SpatVector. Used as a spatial filter to select geometries to read (the convex hull is used for lines or points). It is guaranteed that all features that overlap with the extent of filter will be returned. It can happen that additional geometries are returned} \item{type}{character. Geometry type. Must be "points", "lines", or "polygons"} \item{atts}{data.frame with the attributes. The number of rows must match the number of geometrical elements} \item{crs}{character. The coordinate reference system in one of the following formats: WKT/WKT2, :, or PROJ-string notation (see \code{\link{crs}})} \item{proxy}{logical. If \code{TRUE} a SpatVectorProxy is returned} \item{what}{character indicating what to read. Either \code{""} for geometries and attributes, or \code{"geoms"} to only read the geometries, \code{"attributes"} to only read the attributes (that are returned as a data.frame)} \item{opts}{character. GDAL dataset open options. For example "ENCODING=LATIN1"} \item{geom}{character. The field name(s) with the geometry data. Either two names for x and y coordinates of points, or a single name for a single column with WKT geometries} \item{keepgeom}{logical. If \code{TRUE} the geom variable(s) is (are) also included in the attributes} } \seealso{\code{\link{geom}}, \code{\link{vector_layers}}} \value{SpatVector} \examples{ ### SpatVector from file f <- system.file("ex/lux.shp", package="terra") f v <- vect(f) v ## subsetting (large) files ## with attribute query v <- vect(f, query="SELECT NAME_1, NAME_2, ID_2 FROM lux WHERE ID_2 < 4") ## with an extent e <- ext(5.9, 6.3, 49.9, 50) v <- vect(f, extent=e) ## with polygons p <- as.polygons(e) v <- vect(f, filter=p) ### SpatVector from a geom matrix x1 <- rbind(c(-180,-20), c(-140,55), c(10, 0), c(-140,-60)) x2 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55)) x3 <- rbind(c(-125,0), c(0,60), c(40,5), c(15,-45)) hole <- rbind(c(80,0), c(105,13), c(120,2), c(105,-13)) z <- rbind(cbind(object=1, part=1, x1, hole=0), cbind(object=2, part=1, x3, hole=0), cbind(object=3, part=1, x2, hole=0), cbind(object=3, part=1, hole, hole=1)) colnames(z)[3:4] <- c('x', 'y') p <- vect(z, "polygons") p z[z[, "hole"]==1, "object"] <- 4 lns <- vect(z[,1:4], "lines") plot(p) lines(lns, col="red", lwd=2) ### from wkt v <- vect("POLYGON ((0 -5, 10 0, 10 -10, 0 -5))") wkt <- c("MULTIPOLYGON ( ((40 40, 20 45, 45 30, 40 40)), ((20 35, 10 30, 10 10, 30 5, 45 20, 20 35),(30 20, 20 15, 20 25, 30 20)))", "POLYGON ((0 -5, 10 0, 10 -10, 0 -5))") w <- vect(wkt) # combine two SpatVectors vw <- rbind(w, v) # add a data.frame d <- data.frame(id=1:2, name=c("a", "b")) values(w) <- d # add data.frame on creation, here from a geom matrix g <- geom(w) d <- data.frame(id=1:2, name=c("a", "b")) m <- vect(g, "polygons", atts=d, crs="+proj=longlat +datum=WGS84") ### SpatVector from a data.frame d$wkt <- wkt x <- vect(d, geom="wkt") d$wkt <- NULL d$lon <- c(0,10) d$lat <- c(0,10) x <- vect(d, geom=c("lon", "lat")) # SpatVector to sf #sf::st_as_sf(x) } \keyword{methods} \keyword{spatial} terra/man/terrain.Rd0000644000176200001440000001167414677057712014126 0ustar liggesusers\name{terrain} \alias{terrain} \alias{terrain,SpatRaster-method} \title{terrain characteristics} \description{ Compute terrain characteristics from elevation data. The elevation values should be in the same units as the map units (typically meter) for projected (planar) raster data. They should be in meter when the coordinate reference system is longitude/latitude. For accuracy, always compute these values on the original data (do not first change the projection). Distances (needed for slope and aspect) for longitude/latitude data are computed on the WGS84 ellipsoid with Karney's algorithm. } \usage{ \S4method{terrain}{SpatRaster}(x, v="slope", neighbors=8, unit="degrees", filename="", ...) } \arguments{ \item{x}{SpatRaster, single layer with elevation values. Values should have the same unit as the map units, or in meters when the crs is longitude/latitude} \item{v}{character. One or more of these options: slope, aspect, TPI, TRI, TRIriley, TRIrmsd, roughness, flowdir (see Details)} \item{unit}{character. "degrees" or "radians" for the output of "slope" and "aspect"} \item{neighbors}{integer. Indicating how many neighboring cells to use to compute slope or aspect with. Either 8 (queen case) or 4 (rook case)} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \details{ When \code{neighbors=4}, slope and aspect are computed according to Fleming and Hoffer (1979) and Ritter (1987). When \code{neighbors=8}, slope and aspect are computed according to Horn (1981). The Horn algorithm may be best for rough surfaces, and the Fleming and Hoffer algorithm may be better for smoother surfaces (Jones, 1997; Burrough and McDonnell, 1998). If slope = 0, aspect is set to 0.5*pi radians (or 90 degrees if unit="degrees"). When computing slope or aspect, the coordinate reference system of \code{x} must be known for the algorithm to differentiate between planar and longitude/latitude data. \code{terrain} is not vectorized over "neighbors" or "unit" -- only the first value is used. flowdir returns the "flow direction" (of water), that is the direction of the greatest drop in elevation (or the smallest rise if all neighbors are higher). They are encoded as powers of 2 (0 to 7). The cell to the right of the focal cell is 1, the one below that is 2, and so on: \tabular{rrr}{ 32 \tab64 \tab 128\cr 16 \tab x \tab 1 \cr 8 \tab 4 \tab 2 \cr } Cells without lower neighboring cells are encoded as zero. If two cells have the same drop in elevation, a random cell is picked. That is not ideal as it may prevent the creation of connected flow networks. ArcGIS implements the approach of Greenlee (1987) and I might adopt that in the future. Most terrain indices are according to Wilson et al. (2007), as in \href{https://gdal.org/en/latest/programs/gdaldem.html}{gdaldem}. TRI (Terrain Ruggedness Index) is the mean of the absolute differences between the value of a cell and its 8 surrounding cells. TPI (Topographic Position Index) is the difference between the value of a cell and the mean value of its 8 surrounding cells. Roughness is the difference between the maximum and the minimum value of a cell and its 8 surrounding cells. TRIriley (TRI according to Riley et al., 2007) returns the square root of summed squared differences between the value of a cell and its 8 surrounding cells. TRIrmsd computes the square root of the mean of the squared differences between these cells. These measures can also be computed with \code{\link{focal}} functions: TRI <- focal(x, w=3, fun=\(x) sum(abs(x[-5]-x[5]))/8) TPI <- focal(x, w=3, fun=\(x) x[5] - mean(x[-5])) rough <- focal(x, w=3, fun=\(x) max(x) - min(x)) } \seealso{\code{\link{viewshed}}} \references{ Burrough, P., and R.A. McDonnell, 1998. Principles of Geographical Information Systems. Oxford University Press. Fleming, M.D. and Hoffer, R.M., 1979. Machine processing of Landsat MSS data and DMA topographic data for forest cover type mapping. LARS Technical Report 062879. Laboratory for Applications of Remote Sensing, Purdue University, West Lafayette, Indiana. Horn, B.K.P., 1981. Hill shading and the reflectance map. Proceedings of the IEEE 69:14-47 Jones, K.H., 1998. A comparison of algorithms used to compute hill slope as a property of the DEM. Computers & Geosciences 24: 315-323 Karney, C.F.F., 2013. Algorithms for geodesics, J. Geodesy 87: 43-55. doi:10.1007/s00190-012-0578-z. Riley, S.J., De Gloria, S.D., Elliot, R. (1999): A Terrain Ruggedness that Quantifies Topographic Heterogeneity. Intermountain Journal of Science 5: 23-27. Ritter, P., 1987. A vector-based terrain and aspect generation algorithm. Photogrammetric Engineering and Remote Sensing 53: 1109-1111 Wilson et al 2007, Multiscale Terrain Analysis of Multibeam Bathymetry Data for Habitat Mapping on the Continental Slope. Marine Geodesy 30:3-35 } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) x <- terrain(r, "slope") } \keyword{spatial} terra/man/lines.Rd0000644000176200001440000000551214736320467013562 0ustar liggesusers\name{lines} \docType{methods} \alias{points} \alias{lines} \alias{polys} \alias{lines,SpatVector-method} \alias{lines,SpatRaster-method} \alias{lines,SpatGraticule-method} \alias{lines,SpatExtent-method} \alias{lines,sf-method} \alias{points,SpatVector-method} \alias{points,SpatRaster-method} \alias{points,SpatExtent-method} \alias{points,sf-method} \alias{polys,SpatVector-method} \alias{polys,SpatRaster-method} \alias{polys,SpatExtent-method} \alias{polys,sf-method} \title{Add points, lines, or polygons to a map} \description{ Add a vector geometries to a plot (map) with \code{points}, \code{lines}, or \code{polys}. These are simpler alternatives for \code{\link[terra:plot]{plot(x, add=TRUE)}} These methods also work for a small(!) SpatRaster. Only cells that are not NA in the first layer are used. } \usage{ \S4method{points}{SpatVector}(x, col, cex=0.7, pch=16, alpha=1, ...) \S4method{lines}{SpatVector}(x, y=NULL, col, lwd=1, lty=1, arrows=FALSE, alpha=1, ...) \S4method{polys}{SpatVector}(x, col, border="black", lwd=1, lty=1, alpha=1, ...) \S4method{points}{SpatRaster}(x, ...) \S4method{lines}{SpatRaster}(x, mx=10000, ...) \S4method{polys}{SpatRaster}(x, mx=10000, dissolve=TRUE, ...) \S4method{points}{SpatExtent}(x, col="black", alpha=1, ...) \S4method{lines}{SpatExtent}(x, col="black", alpha=1, ...) \S4method{polys}{SpatExtent}(x, col, alpha=1, ...) } \arguments{ \item{x}{SpatVector or SpatExtent} \item{y}{missing or SpatVector. If both \code{x} and \code{y} have point geometry and the same number of rows, lines are drawn between pairs of points} \item{col}{character. Colors} \item{border}{character. color(s) of the polygon borders. Use \code{NULL} or \code{NA} to not draw a border} \item{cex}{numeric. point size magnifier. See \code{\link{par}}} \item{pch}{positive integer, point type. See \code{\link{points}}. On some (linux) devices, the default symbol "16" is a not a very smooth circle. You can use "20" instead (it takes a bit longer to draw) or "1" for an open circle} \item{alpha}{number between 0 and 1 to set transparency} \item{lwd}{numeric, line-width. See \code{\link{par}}} \item{lty}{positive integer, line type. See \code{\link{par}}} \item{arrows}{logical. If \code{TRUE} and \code{y} is a SpatVector, arrows are drawn instead of lines. See \code{\link[graphics]{arrows}} for additional arguments} \item{mx}{positive number. If the number of cells of SpatRaster \code{x} is higher, the method will fail with an error message} \item{dissolve}{logical. Should boundaries between cells with the same value be removed?} \item{...}{additional graphical arguments such as \code{lwd}, \code{cex} and \code{pch}} } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) r <- rast(v) values(r) <- 1:ncell(r) plot(r) lines(v) points(v) } \keyword{methods} \keyword{spatial} terra/man/as.raster.Rd0000644000176200001440000000150014615160563014336 0ustar liggesusers\name{as.raster} \alias{as.raster} \alias{as.raster,SpatRaster-method} \title{Coerce to a "raster" object} \description{ Implementation of the generic \code{\link[grDevices]{as.raster}} function to create a "raster" (small r) object. Such objects can be used for plotting with the \code{\link[graphics]{rasterImage}} function. NOT TO BE CONFUSED with the Raster* (big R) objects defined by the 'raster' package! } \usage{ \S4method{as.raster}{SpatRaster}(x, maxcell=500000, col) } \arguments{ \item{x}{ SpatRaster } \item{maxcell}{positive integer. Maximum number of cells to use for the plot} \item{col}{vector of colors. The default is \code{map.pal("viridis", 100)}} } \value{ 'raster' object } \examples{ r <- rast(ncols=3, nrows=3) values(r) <- 1:ncell(r) as.raster(r) } \keyword{spatial} \keyword{methods} terra/man/boundaries.Rd0000644000176200001440000000275014536376240014602 0ustar liggesusers\name{boundaries} \alias{boundaries} \alias{boundaries,SpatRaster-method} \title{Detect boundaries (edges)} \description{ Detect boundaries (edges). Boundaries are cells that have more than one class in the 4 or 8 cells surrounding it, or, if \code{classes=FALSE}, cells with values and cells with \code{NA}. } \usage{ \S4method{boundaries}{SpatRaster}(x, classes=FALSE, inner=TRUE, directions=8, falseval=0, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{inner}{logical. If \code{TRUE}, "inner" boundaries are returned, else "outer" boundaries are returned} \item{classes}{character. Logical. If \code{TRUE} all different values are (after rounding) distinguished, as well as \code{NA}. If \code{FALSE} (the default) only edges between \code{NA} and non-\code{NA} cells are considered} \item{directions}{integer. Which cells are considered adjacent? Should be 8 (Queen's case) or 4 (Rook's case)} \item{falseval}{numeric. The value to use for cells that are not a boundary and not \code{NA}} \item{filename}{character. Output filename} \item{...}{options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster. Cell values are either 1 (a border) or 0 (not a border), or \code{NA} } \seealso{ \code{\link{focal}}, \code{\link{patches}} } \examples{ r <- rast(nrows=18, ncols=36, xmin=0) r[150:250] <- 1 r[251:450] <- 2 bi <- boundaries(r) bo <- boundaries(r, inner=FALSE) bc <- boundaries(r, classes=TRUE) #plot(bc) } \keyword{methods} \keyword{spatial} terra/man/bestMatch.Rd0000644000176200001440000000416614744354722014366 0ustar liggesusers\name{bestMatch} \alias{bestMatch} \alias{bestMatch,SpatRaster,SpatVector-method} \alias{bestMatch,SpatRaster,data.frame-method} \alias{bestMatch,SpatRaster,matrix-method} \title{bestMatch} \description{ Determine for each grid cell which reference it is most similar to. A reference consists of a SpatVector with reference locations, or a data.frame or matrix in which each column matches a layer name in the SpatRaster. Similarity is computed with the mean absolute or the mean squared differences between the cell and the reference, or with an alternative function you provide. It may be important to first scale the input. } \usage{ \S4method{bestMatch}{SpatRaster,SpatVector}(x, y, labels=NULL, fun="squared", ..., filename="", overwrite=FALSE, wopt=list()) \S4method{bestMatch}{SpatRaster,data.frame}(x, y, labels=NULL, fun="squared", ..., filename="", overwrite=FALSE, wopt=list()) \S4method{bestMatch}{SpatRaster,matrix}(x, y, labels=NULL, fun="squared", ..., filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatVector, data.frame or matrix} \item{labels}{character. labels that correspond to each class (row in \code{y}} \item{fun}{character. One of "abs" for the mean absolute difference, or "squared" for the mean squared difference. Or a true function like terra:::match_sqr} \item{...}{additional arguments passed to \code{fun}. For the built-in functions this can be \code{na.rm=TRUE}} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ f <- system.file("ex/logo.tif", package = "terra") r <- rast(f) # locations of interest pts <- vect(cbind(c(25.25, 34.324, 43.003), c(54.577, 46.489, 30.905))) pts$code <- LETTERS[1:3] plot(r) points(pts, pch=20, cex=2, col="red") text(pts, "code", pos=4, halo=TRUE) x <- scale(r) s1 <- bestMatch(x, pts, labels=pts$code) plot(s1) # same result e <- extract(x, pts, ID=FALSE) s2 <- bestMatch(x, e, labels=c("Ap", "Nt", "Ms")) } \keyword{spatial} terra/man/query.Rd0000644000176200001440000000343614536376240013616 0ustar liggesusers\name{query} \docType{methods} \alias{query} \alias{query,SpatVectorProxy-method} \title{Query a SpatVectorProxy object} \description{ Query a SpatVectorProxy to extract a subset } \usage{ \S4method{query}{SpatVectorProxy}(x, start=1, n=nrow(x), vars=NULL, where=NULL, extent=NULL, filter=NULL, sql=NULL, what="") } \arguments{ \item{x}{SpatVectorProxy} \item{start}{positive integer. The record to start reading at} \item{n}{positive integer. The number of records requested} \item{vars}{character. Variable names. Must be a subset of \code{names(x)}} \item{where}{character. expression like "NAME_1='California' AND ID > 3" , to subset records. Note that start and n are applied after executing the where statement} \item{extent}{Spat* object. The extent of the object is used as a spatial filter to select the geometries to read. Ignored if \code{filter} is not \code{NULL}} \item{filter}{SpatVector. Used as a spatial filter to select geometries to read (the convex hull is used for lines or points)} \item{sql}{character. Arbitrary SQL statement. If used, arguments "start", "n", "vars" and "where" are ignored} \item{what}{character indicating what to read. Either \code{""} for geometries and attributes, or \code{"geoms"} to only read the geometries, \code{"attributes"} to only read the attributes (that are returned as a data.frame)} } \seealso{\code{\link{vect}}} \value{SpatVector} \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f, proxy=TRUE) v x <- query(v, vars=c("ID_2", "NAME_2"), start=5, n=2) x query(v, vars=c("ID_2", "NAME_1", "NAME_2"), where="NAME_1='Grevenmacher' AND ID_2 > 6") ## with an extent e <- ext(5.9, 6.3, 49.9, 50) x <- query(v, extent=e) ## with polygons p <- as.polygons(e) x <- query(v, filter=p) x } \keyword{methods} \keyword{spatial} terra/man/svc.Rd0000644000176200001440000000341014677354331013237 0ustar liggesusers\name{svc} \docType{methods} \alias{svc} \alias{svc,missing-method} \alias{svc,character-method} \alias{svc,list-method} \alias{svc,sf-method} \alias{svc,SpatVector-method} \alias{[<-,SpatVectorCollection,numeric,missing-method} \alias{[,SpatVectorCollection,numeric,missing-method} \alias{[[,SpatVectorCollection,numeric,missing-method} \title{Create a SpatVectorCollection} \description{ Methods to create a SpatVectorCollection. This is an object to hold "sub-datasets", each a SpatVector, perhaps of different geometry type. } \usage{ \S4method{svc}{missing}(x) \S4method{svc}{SpatVector}(x, ...) \S4method{svc}{list}(x) \S4method{svc}{character}(x, layer="", query="", extent=NULL, filter=NULL) } \arguments{ \item{x}{SpatVector, character (filename), list with SpatVectors, or missing} \item{...}{Additional \code{SpatVector}s} \item{layer}{character. layer name to select a layer from a file (database) with multiple layers} \item{query}{character. A query to subset the dataset in the \href{https://gdal.org/en/latest/user/ogr_sql_dialect.html}{OGR-SQL dialect}} \item{extent}{Spat* object. The extent of the object is used as a spatial filter to select the geometries to read. Ignored if \code{filter} is not \code{NULL}} \item{filter}{SpatVector. Used as a spatial filter to select geometries to read (the convex hull is used for lines or points). It is guaranteed that all features that overlap with the extent of filter will be returned. It can happen that additional geometries are returned} } \value{ SpatVectorCollection } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) x <- svc() x <- svc(v, v[1:3,], as.lines(v[3:5,]), as.points(v)) length(x) x # extract x[3] # replace x[2] <- as.lines(v[1,]) } \keyword{methods} \keyword{spatial} terra/man/resample.Rd0000644000176200001440000000516214745614005014253 0ustar liggesusers\name{resample} \alias{resample} \alias{resample,SpatRaster,SpatRaster-method} \title{Transfer values of a SpatRaster to another one with a different geometry} \description{ resample transfers values between SpatRaster objects that do not align (have a different origin and/or resolution). See \code{\link{project}} to change the coordinate reference system (crs). If the origin and extent of the input and output are the same, you should consider using these other functions instead: \code{\link{aggregate}}, \code{\link{disagg}}, \code{\link{extend}} or \code{\link{crop}}. } \usage{ \S4method{resample}{SpatRaster,SpatRaster}(x, y, method, threads=FALSE, by_util=FALSE, filename="", ...) } \arguments{ \item{x}{SpatRaster to be resampled} \item{y}{SpatRaster with the geometry that \code{x} should be resampled to} \item{method}{character. Method used for estimating the new cell values. One of: \code{bilinear}: bilinear interpolation (3x3 cell window). This is used by default if the first layer of \code{x} is not categorical \code{average}: This can be a good choice with continuous variables if the output cells overlap with multiple input cells. \code{near}: nearest neighbor. This is used by default if the first layer of \code{x} is categorical. This method is not a good choice for continuous values. \code{mode}: The modal value. This can be a good choice for categrical rasters, if the output cells overlap with multiple input cells. \code{cubic}: cubic interpolation (5x5 cell window). \code{cubicspline}: cubic B-spline interpolation. (5x5 cell window). \code{lanczos}: Lanczos windowed sinc resampling. (7x7 cell window). \code{sum}: the weighted sum of all non-NA contributing grid cells. \code{min, q1, median, q3, max}: the minimum, first quartile, median, third quartile, or maximum value. \code{rms}: the root-mean-square value of all non-NA contributing grid cells. } \item{threads}{logical. If \code{TRUE} multiple threads are used (faster for large files)} \item{by_util}{logical. If \code{TRUE} the GDAL warp utility is used} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster } \seealso{ \code{\link{aggregate}}, \code{\link{disagg}}, \code{\link{crop}}, \code{\link{project}}} \examples{ r <- rast(nrows=3, ncols=3, xmin=0, xmax=10, ymin=0, ymax=10) values(r) <- 1:ncell(r) s <- rast(nrows=25, ncols=30, xmin=1, xmax=11, ymin=-1, ymax=11) x <- resample(r, s, method="bilinear") opar <- par(no.readonly =TRUE) par(mfrow=c(1,2)) plot(r) plot(x) par(opar) } \keyword{spatial} terra/man/window.Rd0000644000176200001440000000216014536376240013751 0ustar liggesusers\name{window} \docType{methods} \alias{window} \alias{window<-} \alias{window,SpatRaster-method} \alias{window<-,SpatRaster-method} \title{Set a window} \description{ Assign a window (area of interest) to a SpatRaster with a \code{SpatExtent}, or set it to \code{NULL} to remove the window. This is similar to \code{\link{crop}} without actually creating a new dataset. The window is intersect with the extent of the SpatRaster. It is envisioned that in a future version, the window may also go outside these boundaries. } \usage{ \S4method{window}{SpatRaster}(x)<-value \S4method{window}{SpatRaster}(x) } \arguments{ \item{x}{SpatRaster} \item{value}{SpatExtent} } \seealso{ \code{\link{crop}}, \code{\link{extend}} } \value{ none for \code{window<-} and logical for \code{window} } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) global(r, "mean", na.rm=TRUE) e <- ext(c(5.9, 6,49.95, 50)) window(r) <- e global(r, "mean", na.rm=TRUE) r x <- rast(f) xe <- crop(x, e) global(xe, "mean", na.rm=TRUE) b <- c(xe, r) window(b) b window(r) <- NULL r } \keyword{methods} \keyword{spatial} terra/man/replace_dollar.Rd0000644000176200001440000000206114536376240015412 0ustar liggesusers\name{replace_dollar} \alias{$<-} \alias{$<-,SpatExtent-method} \alias{$<-,SpatVector-method} \alias{$<-,SpatRaster-method} \title{Replace with $<-} \description{ Replace a layer of a SpatRaster, or an attribute variable of a SpatVector } \usage{ \S4method{$}{SpatRaster}(x, name) <- value \S4method{$}{SpatVector}(x, name)<-value \S4method{$}{SpatExtent}(x, name) <- value } \arguments{ \item{x}{SpatRaster, SpatVector or SpatExtent} \item{name}{character. If \code{x} is a SpatRaster: layer name. If \code{x} is a SpatVector: variable name. If \code{x} is a SpatExtent: "xmin", "xmax". "ymin" or "ymax"} \item{value}{if \code{x} is a SpatRaster, a SpatRaster for which this \code{TRUE}: \code{nlyr(value) == length(i)}; if \code{x} is a SpatVector, a vector of new values; if \code{x} is a SpatExtent a single number} } \value{ Same as \code{x} } \seealso{ \code{ \link{[[<-}, \link{[<-}, \link{$}} } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) v$ID_1 <- LETTERS[1:12] v$new <- sample(12) values(v) } \keyword{ spatial } terra/man/width.Rd0000644000176200001440000000303314536376240013561 0ustar liggesusers\name{width} \docType{methods} \alias{width} \alias{clearance} \alias{width,SpatVector-method} \alias{clearance,SpatVector-method} \title{ SpatVector geometric properties } \description{ \code{width} returns the minimum diameter of the geometry, defined as the smallest band that contains the geometry, where a band is a strip of the plane defined by two parallel lines. This can be thought of as the smallest hole that the geometry can be moved through, with a single rotation. \code{clearance} returns the minimum clearance of a geometry. The minimum clearance is the smallest amount by which a vertex could be moved to produce an invalid polygon, a non-simple linestring, or a multipoint with repeated points. If a geometry has a minimum clearance of 'mc', it can be said that: No two distinct vertices in the geometry are separated by less than 'mc' No vertex is closer than 'mc' to a line segment of which it is not an endpoint. If the minimum clearance cannot be defined for a geometry (such as with a single point, or a multipoint whose points are identical, NA is returned. } \usage{ \S4method{width}{SpatVector}(x, as.lines=FALSE) \S4method{clearance}{SpatVector}(x, as.lines=FALSE) } \arguments{ \item{x}{SpatVector of lines or polygons} \item{as.lines}{logical. If \code{TRUE} lines are returned that define the width or clearance} } \value{ numeric or SpatVector } \seealso{ \code{\link{minRect}} } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) width(v) clearance(v) } \keyword{methods} \keyword{spatial} terra/man/legend.Rd0000644000176200001440000000174014751712627013705 0ustar liggesusers\name{add_legend} \alias{add_legend} \title{add a custom legend} \description{ Wrapper around \code{\link[graphics]{legend}} that allows adding a custom legend to a map using a keyword such as "topleft" or "bottomright". This function will place the legend in the locations within the mapped area as delineated by the axes. } \usage{ add_legend(x, y, ...) } \arguments{ \item{x}{The keyword to be used to position the legend (or the x coordinate)} \item{y}{The y coordinate to be used to position the legend (is x is also a coordinate)} \item{...}{arguments passed to \code{\link[graphics]{legend}}} } \seealso{\code{\link{add_box}}, \code{\link{add_grid}}, \code{\link{add_mtext}}} \examples{ v <- vect(system.file("ex/lux.shp", package="terra")) plot(v) points(centroids(v), col="red") legend("topleft", legend = "centroids", pch = 20, xpd=NA, bg="white", col="red") add_legend("topright", legend = "centroids", pch = 20, col="red") } \keyword{methods} \keyword{spatial} terra/man/relate.Rd0000644000176200001440000001161414727136351013721 0ustar liggesusers\name{relate} \docType{methods} \alias{relate} \alias{is.related} \alias{relate,SpatVector,SpatVector-method} \alias{relate,SpatVector,missing-method} \alias{relate,SpatVector,SpatExtent-method} \alias{relate,SpatExtent,SpatVector-method} \alias{relate,SpatExtent,SpatExtent-method} \alias{relate,SpatVector,SpatRaster-method} \alias{relate,SpatRaster,SpatVector-method} \alias{relate,SpatExtent,SpatRaster-method} \alias{relate,SpatRaster,SpatExtent-method} \alias{relate,SpatRaster,SpatRaster-method} \alias{is.related,SpatVector,SpatVector-method} \alias{is.related,SpatVector,SpatExtent-method} \alias{is.related,SpatExtent,SpatVector-method} \alias{is.related,SpatVector,SpatRaster-method} \alias{is.related,SpatRaster,SpatVector-method} \alias{is.related,SpatRaster,SpatRaster-method} \alias{is.related,SpatExtent,SpatRaster-method} \alias{is.related,SpatRaster,SpatExtent-method} \title{ Spatial relationships between geometries } \description{ \code{relate} returns a logical matrix indicating the presence or absence of a specific spatial relationships between the geometries in \code{x} and \code{y}. \code{is.related} returns a logical vector indicating the presence or absence of a specific spatial relationships between \code{x} and any of the geometries in \code{y}. } \usage{ \S4method{relate}{SpatVector,SpatVector}(x, y, relation, pairs=FALSE, na.rm=TRUE) \S4method{relate}{SpatVector,missing}(x, y, relation, pairs=FALSE, na.rm=TRUE) \S4method{is.related}{SpatVector,SpatVector}(x, y, relation) } \arguments{ \item{x}{SpatVector or SpatExtent} \item{y}{missing or as for \code{x}} \item{relation}{character. One of "intersects", "touches", "crosses", "overlaps", "within", "contains", "covers", "coveredby", "disjoint", or "equals". It can also be a "DE-9IM" string such as "FF*FF****". See \href{https://en.wikipedia.org/wiki/DE-9IM}{Wikipedia} or \href{https://docs.geotools.org/stable/userguide/library/jts/dim9.html}{GeoTools doc}} \item{pairs}{logical. If \code{TRUE} a two-column matrix is returned with the indices of the cases where the requested relation is \code{TRUE}. This is especially helpful when dealing with many geometries as the returned value is generally much smaller} \item{na.rm}{logical. If \code{TRUE} and \code{pairs=TRUE}, geometries in \code{x} for which there is no related geometry in \code{y} are omitted} } \value{ matrix (relate) or vector (is.related) } \seealso{ \code{\link{compareGeom}} to check if the geometries are identical (equivalent to the "equals" relation) \code{\link{adjacent}}, \code{\link{nearby}}, \code{\link{intersect}}, \code{\link{crop}} } \examples{ # polygons p1 <- vect("POLYGON ((0 0, 8 0, 8 9, 0 9, 0 0))") p2 <- vect("POLYGON ((5 6, 15 6, 15 15, 5 15, 5 6))") p3 <- vect("POLYGON ((8 2, 9 2, 9 3, 8 3, 8 2))") p4 <- vect("POLYGON ((2 6, 3 6, 3 8, 2 8, 2 6))") p5 <- vect("POLYGON ((2 12, 3 12, 3 13, 2 13, 2 12))") p6 <- vect("POLYGON ((10 4, 12 4, 12 7, 11 7, 11 6, 10 6, 10 4))") p <- rbind(p1, p2, p3, p4, p5, p6) plot(p, col=rainbow(6, alpha=.5)) lines(p, lwd=2) text(p) ## relate SpatVectors relate(p1, p2, "intersects") relate(p1, p3, "touches") relate(p1, p5, "disjoint") relate(rbind(p1, p2), p4, "disjoint") ## relate geometries within SpatVectors # which are completely separated? relate(p, relation="disjoint") # which touch (not overlap or within)? relate(p, relation="touches") # which overlap (not merely touch, and not within)? relate(p, relation="overlaps") # which are within (not merely overlap)? relate(p, relation="within") # do they touch or overlap or are within? relate(p, relation="intersects") all(relate(p, relation="intersects") == (relate(p, relation="overlaps") | relate(p, relation="touches") | relate(p, relation="within"))) #for polygons, "coveredby" is "within" relate(p, relation="coveredby") # polygons, lines, and points pp <- rbind(p1, p2) L1 <- vect("LINESTRING(1 11, 4 6, 10 6)") L2 <- vect("LINESTRING(8 14, 12 10)") L3 <- vect("LINESTRING(1 8, 12 14)") lns <- rbind(L1, L2, L3) pts <- vect(cbind(c(7,10,10), c(3,5,6))) plot(pp, col=rainbow(2, alpha=.5)) text(pp, paste0("POL", 1:2), halo=TRUE) lines(pp, lwd=2) lines(lns, col=rainbow(3), lwd=4) text(lns, paste0("L", 1:3), halo=TRUE) points(pts, cex=1.5) text(pts, paste0("PT", 1:3), halo=TRUE, pos=4) relate(lns, relation="crosses") relate(lns, pp, relation="crosses") relate(lns, pp, relation="touches") relate(lns, pp, relation="intersects") relate(lns, pp, relation="within") # polygons can contain lines or points, not the other way around relate(lns, pp, relation="contains") relate(pp, lns, relation="contains") # points and lines can be covered by polygons relate(lns, pp, relation="coveredby") relate(pts, pp, "within") relate(pts, pp, "touches") relate(pts, lns, "touches") } \keyword{methods} \keyword{spatial} terra/man/datatype.Rd0000644000176200001440000000503014736271515014255 0ustar liggesusers\name{datatype} \docType{methods} \alias{datatype} \alias{datatype,SpatVector-method} \alias{datatype,SpatRaster-method} \title{Data type of a SpatRaster or SpatVector} \description{ Get the data types of the fields (attributes, variables) of a SpatVector or of the file(s) associated with a SpatRaster. A (layer of a) SpatRaster has no datatype if it has no values, or if the values are in memory. } \usage{ \S4method{datatype}{SpatRaster}(x, bylyr=TRUE) \S4method{datatype}{SpatVector}(x) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{bylyr}{logical. If \code{TRUE} a value is returned for each layer. Otherwise, a value is returned for each data source (such as a file)} } \details{ Setting the data type is useful if you want to write values to disk with \code{\link{writeRaster}}. In other cases you can use functions such as \code{round} and \code{floor}, or \code{\link{as.bool}} raster datatypes are described by 5 characters. The first three indicate whether the values are integer or decimal values. The fourth character indicates the number of bytes used to save the values on disk, and the last character indicates whether the numbers are signed (that is, can be negative and positive values) or not (only zero and positive values allowed) The following raster datatypes are available: \tabular{lll}{ \bold{Datatype definition} \tab \bold{minimum possible value} \tab \bold{maximum possible value} \cr \code{INT1U} \tab 0 \tab 255 \cr \code{INT2U} \tab 0 \tab 65,534 \cr \code{INT4U} \tab 0 \tab 4,294,967,296 \cr \code{INT8U} \tab 0 \tab 18,446,744,073,709,551,616\cr \code{INT2S} \tab -32,767\tab 32,767 \cr \code{INT4S} \tab -2,147,483,647 \tab 2,147,483,647 \cr \code{INT8S} \tab -9,223,372,036,854,775,808 \tab 9,223,372,036,854,775,808 \cr \code{FLT4S} \tab -3.4e+38 \tab 3.4e+38 \cr \code{FLT8S} \tab -1.7e+308 \tab 1.7e+308 \cr } For all integer types, except the single byte types, the lowest (signed) or highest (unsigned) value is used to store \code{NA}. Note that very large integer numbers may be imprecise as they are internally represented as decimal numbers. \code{INT4U} is available but they are best avoided as R does not support 32-bit unsigned integers. } \value{character} \seealso{ \code{\link[=is.bool]{Raster data types}} to check / set the type of SpatRaster values. } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) datatype(v) f <- system.file("ex/elev.tif", package="terra") r <- rast(f) datatype(r) # no data type datatype(rast()) } \keyword{methods} \keyword{spatial} terra/man/c.Rd0000644000176200001440000000304714643302261012660 0ustar liggesusers\name{c} \docType{methods} \alias{c} \alias{c,SpatRaster-method} \alias{c,SpatRasterDataset-method} \alias{c,SpatRasterCollection-method} \alias{c,SpatVector-method} \alias{c,SpatVectorCollection-method} \alias{c,SpatVector-method} \alias{rbind.SpatVector} \alias{rbind} \title{Combine SpatRaster or SpatVector objects} \description{ With \code{c} you can: -- Combine \code{SpatRaster} objects. They must have the same extent and resolution. However, if \code{x} is empty (has no cell values), its geometry is ignored with a warning. Two empty SpatRasters with the same geometry can also be combined (to get a summed number of layers). Also see \code{\link{add<-}} -- Add a \code{SpatRaster} to a \code{SpatRasterDataset} or \code{SpatRasterCollection} -- Add \code{SpatVector} objects to a new or existing \code{SpatVectorCollection} To append SpatVectors, use \code{rbind}. } \seealso{\code{\link{add<-}}} \usage{ \S4method{c}{SpatRaster}(x, ..., warn=TRUE) \S4method{c}{SpatRasterDataset}(x, ...) \S4method{c}{SpatRasterCollection}(x, ...) \S4method{c}{SpatVector}(x, ...) \S4method{c}{SpatVectorCollection}(x, ...) } \arguments{ \item{x}{SpatRaster, SpatVector, SpatRasterDataset or SpatVectorCollection} \item{warn}{logical. If \code{TRUE}, a warning is emitted if \code{x} is an empty SpatRaster} \item{...}{as for \code{x} (you can only combine raster with raster data and vector with vector data)} } \value{ Same class as \code{x} } \examples{ r <- rast(nrows=5, ncols=9) values(r) <- 1:ncell(r) x <- c(r, r*2, r*3) } \keyword{spatial} terra/man/inplace.Rd0000644000176200001440000000644514750560461014065 0ustar liggesusers\name{inplace} \alias{set.ext} \alias{set.ext,SpatRaster-method} \alias{set.ext,SpatVector-method} \alias{set.values} \alias{set.values,SpatRaster-method} \alias{set.values,SpatRasterDataset-method} \alias{set.RGB} \alias{set.RGB,SpatRaster-method} \alias{set.cats} \alias{set.cats,SpatRaster-method} \alias{set.names} \alias{set.names,SpatRaster-method} \alias{set.names,SpatRasterDataset-method} \alias{set.names,SpatRasterCollection-method} \alias{set.names,SpatVector-method} \alias{set.names,SpatVectorCollection-method} \alias{set.crs} \alias{set.crs,SpatRaster-method} \alias{set.crs,SpatVector-method} \alias{set.window} \alias{set.window,SpatRaster-method} \title{Change values in-place} \description{ These "in-place" replacement methods assign new value to an object without making a copy. That is efficient, but if there is a copy of the object that you made by standard assignment (e.g. with \code{y <- x}), that copy is also changed. \code{set.names} is the in-place replacement version of \code{\link{names<-}}. \code{set.ext} is the in-place replacement version of \code{\link{ext<-}} \code{set.values} is the in-place replacement version of \code{\link{[<-}}. \code{set.cats} is the in-place replacement version of \code{\link{categories}} \code{set.crs} is the in-place replacement version of \code{\link{crs<-}} \code{set.window} is the in-place replacement version of \code{\link{window<-}} } \usage{ \S4method{set.names}{SpatRaster}(x, value, index=1:nlyr(x), validate=FALSE) \S4method{set.names}{SpatRasterDataset}(x, value, index=1:length(x), validate=FALSE) \S4method{set.names}{SpatVector}(x, value, index=1:ncol(x), validate=FALSE) \S4method{set.ext}{SpatRaster}(x, value) \S4method{set.ext}{SpatVector}(x, value) \S4method{set.crs}{SpatRaster}(x, value) \S4method{set.crs}{SpatVector}(x, value) \S4method{set.values}{SpatRaster}(x, cells, values, layer=0) \S4method{set.values}{SpatRasterDataset}(x) \S4method{set.cats}{SpatRaster}(x, layer=1, value, active=1) \S4method{set.RGB}{SpatRaster}(x, value, type="rgb") } \arguments{ \item{x}{SpatRaster} \item{value}{character for \code{set.names}. For \code{set.cats}: a data.frame with columns (value, category) or vector with category names. For \code{set.RGB} 3 or 4 numbers indicating the RGB(A) layers} \item{index}{positive integer indicating layer(s) to assign a name to} \item{validate}{logical. Make names valid and/or unique?} \item{cells}{cell numbers or missing} \item{values}{replacement values or missing to load all values into memory} \item{layer}{positive integer(s) indicating to which layer(s) to you want to assign these categories or to which you want to set these values. A number < 1 indicates "all layers"} \item{active}{positive integer indicating the active category (column number in \code{value}, but not counting the first column} \item{type}{character. The color space. One of "rgb" "hsv", "hsi" and "hsl"} } \value{logical (invisibly)} \examples{ s <- rast(ncols=5, nrows=5, nlyrs=3) x <- s names(s) names(s) <- c("a", "b", "c") names(s) names(x) x <- s set.names(s, c("e", "f", "g")) names(s) names(x) set.ext(x, c(0,180,0,90)) f <- system.file("ex/elev.tif", package="terra") r <- rast(f) #values from file to memory set.values(r) # change values set.values(r, 1:1000, 900) } \keyword{spatial} terra/man/RGB.Rd0000644000176200001440000000555614722403253013060 0ustar liggesusers\name{RGB} \docType{methods} \alias{RGB} \alias{RGB,SpatRaster-method} \alias{RGB<-} \alias{RGB<-,SpatRaster-method} \alias{colorize} \alias{colorize,SpatRaster-method} \alias{has.RGB} \alias{has.RGB,SpatRaster-method} \title{Layers representing colors} \description{ With \code{RGB} you can get or set the layers to be used as Red, Green and Blue when plotting a SpatRaster. Currently, a benefit of this is that \code{\link[terra]{plot}} will send the object to \code{\link{plotRGB}}. You can also associated the layers with another color space (HSV, HSI or HSL) With \code{colorize} you can convert a three-layer RGB SpatRaster into other color spaces. You can also convert it into a single-layer SpatRaster with a color-table. } \usage{ \S4method{RGB}{SpatRaster}(x, value=NULL, type="rgb") \S4method{RGB}{SpatRaster}(x, ..., type="rgb")<-value \S4method{colorize}{SpatRaster}(x, to="hsv", alpha=FALSE, stretch=NULL, grays=FALSE, NAzero=FALSE, filename="", overwrite=FALSE, ...) \S4method{has.RGB}{SpatRaster}(x, strict=TRUE) } \arguments{ \item{x}{SpatRaster} \item{value}{three (or four) positive integers indicating the layers that are red, green and blue (and optionally a fourth transparency layer). Or \code{NULL} to remove the RGB settings} \item{type}{character. The color space. One of "rgb" "hsv", "hsi" and "hsl"} \item{to}{character. The color space to transform the values to. If \code{x} has RGB set, you can transform these to "hsv", "hsi" and "hsl", or use "col" to create a single layer with a color table. You can also use "rgb" to back transform to RGB} \item{alpha}{logical. Should an alpha (transparency) channel be included? Only used if \code{x} has a color-table and \code{to="rgb"}} \item{stretch}{character. Option to stretch the values to increase contrast: "lin" (linear) or "hist" (histogram). Only used for transforming RGB to col} \item{grays}{logical. If \code{TRUE}, a gray-scale color-table is created. Only used for transforming RGB to col} \item{NAzero}{logical. If \code{TRUE}, NAs are treated as zeros such that a color can be returned if at least one of the three channels has a value. Only used for transforming RGB to (\code{"col"})} \item{strict}{logical. If \code{TRUE}, the function returns \code{FALSE} if a color space such as "hsv", "hsi" and "hsl" is used} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{\code{\link{set.RGB}}} \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) RGB(r) plot(r) has.RGB(r) RGB(r) <- NULL has.RGB(r) plot(r) RGB(r) <- c(3,1,2) # same as # r <- RGB(r, c(3,1,2)) plot(r) RGB(r) <- 1:3 x <- colorize(r, "col") y <- colorize(r, "hsv") z <- colorize(y, "rgb") } \keyword{methods} \keyword{spatial} terra/man/is.bool.Rd0000644000176200001440000000412714536376240014014 0ustar liggesusers\name{is.bool} \docType{methods} \alias{is.bool} \alias{is.bool,SpatRaster-method} \alias{as.bool} \alias{as.bool,SpatRaster-method} \alias{isTRUE,SpatRaster-method} \alias{isFALSE,SpatRaster-method} \alias{as.logical,SpatRaster-method} \alias{is.int} \alias{is.int,SpatRaster-method} \alias{as.int} \alias{as.int,SpatRaster-method} \alias{as.integer,SpatRaster-method} \alias{is.factor} \alias{is.factor,SpatRaster-method} \alias{as.factor} \alias{as.factor,SpatRaster-method} \title{Raster value types} \description{ The values in a SpatRaster layer are by default numeric, but they can also be set to be logical (Boolean), integer, or categorical (factor). For a \code{SpatRaster}, \code{as.logical} and \code{isTRUE} is equivalent to \code{as.bool}. \code{isFALSE} is equivalent to \code{!as.bool}, and \code{as.integer} is the same as \code{as.int}. \code{as.bool} and \code{as.int} force the values into the correct range (e.g. whole integers) but in-memory cell values are still stored as numeric. They will behave like the assigned types, though, and will be written to files with that data type (if the file type supports it). See \code{\link{levels}} and \code{\link{cats}} to create categorical layers by setting labels. } \usage{ \S4method{is.bool}{SpatRaster}(x) \S4method{as.bool}{SpatRaster}(x, filename, ...) \S4method{is.int}{SpatRaster}(x) \S4method{as.int}{SpatRaster}(x, filename, ...) \S4method{is.factor}{SpatRaster}(x) \S4method{as.factor}{SpatRaster}(x) } \arguments{ \item{x}{SpatRaster} \item{filename}{character. Output filename} \item{...}{list with named options for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{levels}} and \code{\link{cats}} to create categorical layers (and set labels). } \value{ The \code{as.*} methods return a new \code{SpatRaster}, whereas the \code{is.*} methods return a \code{logical} value for each layer in \code{x}. } \examples{ r <- rast(nrows=10, ncols=10, vals=1:100) is.bool(r) z <- as.bool(r) is.bool(z) x <- r > 25 is.bool(x) rr <- r/2 is.int(rr) is.int(round(rr)) } \keyword{methods} \keyword{spatial} terra/man/stretch.Rd0000644000176200001440000000415314536376240014122 0ustar liggesusers\name{stretch} \alias{stretch} \alias{stretch,SpatRaster-method} \title{Stretch} \description{ Linear or histogram equalization stretch of values in a SpatRaster. For linear stretch, provide the desired output range (\code{minv} and \code{maxv}) and the lower and upper bounds in the original data, either as quantiles (\code{minq} and \code{maxq}, or as cell values (\code{smin} and \code{smax}). If \code{smin} and \code{smax} are both not \code{NA}, \code{minq} and \code{maxq} are ignored. For histogram equalization, these arguments are ignored, but you can provide the desired scale of the output and the maximum number of cells that is used to compute the histogram (empirical cumulative distribution function). } \usage{ \S4method{stretch}{SpatRaster}(x, minv=0, maxv=255, minq=0, maxq=1, smin=NA, smax=NA, histeq=FALSE, scale=1, maxcell=500000, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{minv}{numeric >= 0 and smaller than maxv. lower bound of stretched value} \item{maxv}{numeric <= 255 and larger than maxv. upper bound of stretched value} \item{minq}{numeric >= 0 and smaller than maxq. lower quantile bound of original value. Ignored if smin is supplied} \item{maxq}{numeric <= 1 and larger than minq. upper quantile bound of original value. Ignored if smax is supplied} \item{smin}{numeric < smax. user supplied lower value for the layers, to be used instead of a quantile computed by the function itself} \item{smax}{numeric > smin. user supplied upper value for the layers, to be used instead of a quantile computed by the function itself} \item{histeq}{logical. If \code{TRUE} histogram equalization is used instead of linear stretch} \item{scale}{numeric. The scale (maximum value) of the output if \code{histeq=TRUE}} \item{maxcell}{positive integer. The size of the regular sample used to compute the histogram} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ r <- rast(nc=10, nr=10) values(r) <- rep(1:25, 4) rs <- stretch(r) s <- c(r, r*2) sr <- stretch(s) } \keyword{spatial} terra/man/zoom.Rd0000644000176200001440000000153614536376240013434 0ustar liggesusers\name{zoom} \docType{methods} \alias{zoom} \alias{zoom,SpatRaster-method} \alias{zoom,SpatVector-method} \title{Zoom in on a map} \description{ Zoom in on a map (plot) by providing a new extent, by default this is done by clicking twice on the map. } \usage{ \S4method{zoom}{SpatRaster}(x, e=draw(), maxcell=100000, layer=1, new=FALSE, ...) \S4method{zoom}{SpatVector}(x, e=draw(), new=FALSE, ...) } \arguments{ \item{x}{SpatRaster} \item{e}{SpatExtent} \item{maxcell}{positive integer. Maximum number of cells used for the map} \item{layer}{positive integer to select the layer to be used} \item{new}{logical. If \code{TRUE}, the zoomed in map will appear on a new device (window)} \item{...}{additional arguments passed to \code{\link{plot}}} } \value{ SpatExtent (invisibly) } \seealso{ \code{\link{draw}}, \code{\link{plot}}} \keyword{spatial} terra/man/simplify.Rd0000644000176200001440000000207614536376240014304 0ustar liggesusers\name{simplifyGeom} \docType{methods} \alias{simplifyGeom} \alias{simplifyGeom,SpatVector-method} \title{ simplifyGeom geometries } \description{ Reduce the number of nodes used to represent geometries. } \usage{ \S4method{simplifyGeom}{SpatVector}(x, tolerance=0.1, preserveTopology=TRUE, makeValid=TRUE) } \arguments{ \item{x}{SpatVector of lines or polygons} \item{tolerance}{numeric. The minimum distance between nodes in units of the crs (i.e. degrees for long/lat)} \item{preserveTopology}{logical. If \code{TRUE} the topology of output geometries is preserved} \item{makeValid}{logical. If \code{TRUE}, \code{\link{makeValid}} is run after simplification to assure that the output polygons are valid} } \value{ SpatVector } \seealso{\code{\link{sharedPaths}}, \code{\link{gaps}}, \code{\link{is.valid}}} \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) w <- simplifyGeom(v, .02, makeValid=FALSE) e <- erase(w) g <- gaps(e) plot(e, lwd=5, border="light gray") polys(g, col="red", border="red") } \keyword{methods} \keyword{spatial} terra/man/cellSize.Rd0000644000176200001440000000455114743533256014224 0ustar liggesusers\name{cellSize} \alias{cellSize} \alias{cellSize,SpatRaster-method} \title{Area covered by each raster cell} \description{ Compute the area covered by individual raster cells. Computing the surface area of raster cells is especially relevant for longitude/latitude rasters. But note that for both angular (longitude/latitude) and for planar (projected) coordinate reference systems raster cells sizes are generally not constant, unless you are using an equal-area coordinate reference system. For planar CRSs, the area is therefore not computed based on the linear units of the coordinate reference system, but rather by transforming cells to longitude/latitude. If you do not want that correction, you can use \code{transform=FALSE} or \code{init(x, prod(res(x)))} } \usage{ \S4method{cellSize}{SpatRaster}(x, mask=FALSE, lyrs=FALSE, unit="m", transform=TRUE, rcx=100, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{mask}{logical. If \code{TRUE}, cells that are \code{NA} in \code{x} are also \code{NA} in the output} \item{lyrs}{logical. If \code{TRUE} and \code{mask=TRUE}, the output has the same number of layers as \code{x}. That is only useful if cases where the layers of \code{x} have different cells that are \code{NA}} \item{unit}{character. One of "m", "km", or "ha"} \item{transform}{logical. If \code{TRUE}, planar CRS data are transformed to lon/lat for accuracy} \item{rcx}{positive integer. The maximum number of rows and columns to be used to compute area of planar data if \code{transform=TRUE}. If \code{x} has more rows and/or columns, the raster is aggregated to match this limit, and values for the original cells are estimated by bilinear interpolation (see \code{resample}). This can save a lot of time} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{expanse}}} \examples{ # SpatRaster r <- rast(nrows=18, ncols=36) v <- 1:ncell(r) v[200:400] <- NA values(r) <- v # size of each raster cell a <- cellSize(r) # illustration of distortion r <- rast(ncols=90, nrows=45, ymin=-80, ymax=80) m <- project(r, "+proj=merc") bad <- init(m, prod(res(m)) / 1000000, wopt=list(names="naive")) good <- cellSize(m, unit="km", names="corrected") plot(c(good, bad), nc=1, mar=c(2,2,1,6)) } \keyword{methods} \keyword{spatial} terra/man/compareGeom.Rd0000644000176200001440000000421314721767504014704 0ustar liggesusers\name{compareGeom} \alias{compareGeom} \alias{compareGeom,SpatRaster,SpatRaster-method} \alias{compareGeom,SpatRaster,SpatRasterCollection-method} \alias{compareGeom,SpatRaster,list-method} \alias{compareGeom,SpatRasterCollection,missing-method} \alias{compareGeom,SpatVector,SpatVector-method} \alias{compareGeom,SpatVector,missing-method} \title{Compare geometries} \description{ Evaluate whether two SpatRasters have the same extent, number of rows and columns, projection, resolution, and origin (or a subset of these comparisons). Or evaluate whether two SpatVectors have the same geometries, or whether a SpatVector has duplicated geometries. } \usage{ \S4method{compareGeom}{SpatRaster,SpatRaster}(x, y, ..., lyrs=FALSE, crs=TRUE, warncrs=FALSE, ext=TRUE, rowcol=TRUE, res=FALSE, stopOnError=TRUE, messages=FALSE) \S4method{compareGeom}{SpatVector,SpatVector}(x, y, tolerance=0) \S4method{compareGeom}{SpatVector,missing}(x, y, tolerance=0) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{y}{Same as \code{x}. If \code{x} is a SpatRaster, \code{y} can also be a list of SpatRasters. If \code{x} is a SpatVector, \code{y} can be missing} \item{...}{Additional SpatRasters} \item{lyrs}{logical. If \code{TRUE}, the number of layers is compared} \item{crs}{logical. If \code{TRUE}, coordinate reference systems are compared} \item{warncrs}{logical. If \code{TRUE}, a warning is given if the crs is different (instead of an error)} \item{ext}{logical. If \code{TRUE}, bounding boxes are compared} \item{rowcol}{logical. If \code{TRUE}, number of rows and columns of the objects are compared} \item{res}{logical. If \code{TRUE}, resolutions are compared (redundant when checking extent and rowcol)} \item{stopOnError}{logical. If \code{TRUE}, code execution stops if raster do not match} \item{messages}{logical. If \code{TRUE}, warning/error messages are printed even if \code{stopOnError=FALSE}} \item{tolerance}{numeric} } \value{ logical (SpatRaster) or matrix of logical (SpatVector) } \examples{ r1 <- rast() r2 <- rast() r3 <- rast() compareGeom(r1, r2, r3) nrow(r3) <- 10 \dontrun{ compareGeom(r1, r3) } } \keyword{spatial} terra/man/select.Rd0000644000176200001440000000346614732343266013733 0ustar liggesusers\name{sel} \docType{methods} \alias{sel} \alias{sel,SpatRaster-method} \alias{sel,SpatVector-method} \title{ Spatial selection } \description{ Geometrically subset SpatRaster or SpatVector (to be done) by drawing on a plot (map). Note that for many installations this does to work well on the default RStudio plotting device. To work around that, you can first run \code{dev.new(noRStudioGD = TRUE)} which will create a separate window for plotting, then use \code{plot()} followed by \code{sel()} and click on the map. It may also help to set your RStudio "Tools/Global Options/Appearance/Zoom" to 100% } \usage{ \S4method{sel}{SpatRaster}(x, ...) \S4method{sel}{SpatVector}(x, use="rec", show=TRUE, col="cyan", draw=TRUE, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{use}{character indicating what to draw. One of "rec" (rectangle) or "pol" (polygon)} \item{show}{logical. If \code{TRUE} the selected geometries are shown on the map} \item{col}{color to be used for drawing if \code{draw=TRUE}} \item{draw}{logical. If \code{TRUE} the area drawn to select geometries is shown on the map} \item{...}{additional graphics arguments for drawing the selected geometries} } \seealso{ \code{\link{crop}} and \code{\link{intersect}} to make an intersection and \code{\link{click}} and \code{\link{text}} to see cell values or geometry attributes. Use \code{\link{draw}} to draw a SpatExtent of SpatVector that you want to keep. } \value{ SpatRaster or SpatVector } \examples{ \dontrun{ # select a subset of a SpatRaster r <- rast(nrows=10, ncols=10) values(r) <- 1:ncell(r) plot(r) s <- sel(r) # now click on the map twice # plot the selection on a new canvas: x11() plot(s) # vector f <- system.file("ex/lux.shp", package="terra") v <- vect(f) plot(v) x <- sel(v) # now click on the map twice x } } \keyword{spatial} terra/man/freq.Rd0000644000176200001440000000276014573257650013411 0ustar liggesusers\name{freq} \docType{methods} \alias{freq} \alias{freq,SpatRaster-method} \title{Frequency table} \description{ Frequency table of the values of a SpatRaster. \code{NA}s are not counted unless \code{value=NA}. You can provide a SpatVector or additional SpatRaster to define zones for which to do tabulations. } \usage{ \S4method{freq}{SpatRaster}(x, digits=0, value=NULL, bylayer=TRUE, usenames=FALSE, zones=NULL, wide=FALSE) } \arguments{ \item{x}{SpatRaster} \item{digits}{integer. Used for rounding the values before tabulation. Ignored if \code{NA}} \item{value}{numeric. An optional single value to only count the number of cells with that value. This value can be \code{NA}} \item{bylayer}{logical. If \code{TRUE} tabulation is done by layer} \item{usenames}{logical. If \code{TRUE} layers are identified by their names instead of their numbers Only relevant if \code{bylayer} is \code{TRUE}} \item{zones}{SpatRaster or SpatVector to define zones for which the tabulation should be done} \item{wide}{logical. Should the results by "wide" instead of "long"?} } \value{ A \code{data.frame} with 3 columns (layer, value, count) unless \code{bylayer=FALSE} in which case a\code{data.frame} with two columns is returned (value, count). } \examples{ r <- rast(nrows=10, ncols=10) set.seed(2) values(r) <- sample(5, ncell(r), replace=TRUE) freq(r) x <- c(r, r/3) freq(x, bylayer=FALSE) freq(x) freq(x, digits=1) freq(x, digits=-1) freq(x, value=5) } \keyword{spatial} \keyword{univar} terra/man/as.list.Rd0000644000176200001440000000345414556653240014026 0ustar liggesusers\name{as.list} \alias{as.list} \alias{as.list,SpatRaster-method} \alias{as.list,SpatRasterDataset-method} \alias{as.list,SpatRasterCollection-method} \alias{as.list,SpatVector-method} \alias{as.list,SpatVectorCollection-method} \title{Coerce a Spat* object to a list} \description{ Coerce a SpatRaster, SpatRasterCollection, SpatRasterDataset, SpatVector or SpatVectorCollection to a list. With a SpatRaster, each layer becomes a list element. With a SpatRasterCollection or SpatRasterDataset, each SpatRaster becomes a list element. With a SpatVector, each variable (attribute) becomes a list element. With a SpatVectorCollection, each SpatVector becomes a list element. } \usage{ \S4method{as.list}{SpatRaster}(x, geom=NULL, ...) \S4method{as.list}{SpatRasterCollection}(x, ...) \S4method{as.list}{SpatVector}(x, geom=NULL, ...) \S4method{as.list}{SpatVectorCollection}(x, ...) } \arguments{ \item{x}{SpatRaster, SpatRasterDataset, SpatRasterCollection, or SpatVector} \item{geom}{character or NULL. If not NULL, and \code{x} is a SpatVector, it should be either "WKT" or "HEX", to get the geometry included in Well-Known-Text or hexadecimal notation. If \code{x} has point geometry, it can also bey "XY" to add the coordinates of each point. If \code{x} is a SpatRaster, any value that is not NULL will return a list with the the parameters describing the geometry of the SpatRaster are returned} \item{...}{additional arguments. These are ignored} } \seealso{see \code{\link{coerce}} for \code{as.data.frame} with a SpatRaster; and \code{\link{geom}} to only extract the geometry of a SpatVector} \value{ list } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) as.list(v) s <- rast(system.file("ex/logo.tif", package="terra")) + 1 as.list(s) } \keyword{spatial} \keyword{methods} terra/man/makeVRT.Rd0000644000176200001440000000443714536376240013764 0ustar liggesusers\name{makeVRT} \alias{makeVRT} \title{Make a VRT header file} \description{ Create a VRT header file for a "flat binary" raster file that needs a header file to be able to read it, but does not have it. } \usage{ makeVRT(filename, nrow, ncol, nlyr=1, extent, xmin, ymin, xres, yres=xres, xycenter=TRUE, crs="+proj=longlat", lyrnms="", datatype, NAflag=NA, bandorder="BIL", byteorder="LSB", toptobottom=TRUE, offset=0, scale=1) } \arguments{ \item{filename}{character. raster filename (without the ".vrt" extension)} \item{nrow}{positive integer, the number of rows} \item{ncol}{positive integer, the number of columns} \item{nlyr}{positive integer, the number of layers} \item{extent}{SpatExtent or missing} \item{xmin}{numeric. minimum x coordinate (only used if \code{extent} is missing)} \item{ymin}{numeric. minimum y coordinate (only used if \code{extent} is missing)} \item{xres}{positive number. x resolution} \item{yres}{positive number. y resolution)} \item{xycenter}{logical. If \code{TRUE}, \code{xmin} and \code{xmax} represent the coordinates of the center of the extreme cell, in stead of the coordinates of the outside corner. Only used of \code{extent} is missing} \item{crs}{character. Coordinate reference system description} \item{lyrnms}{character. Layer names} \item{datatype}{character. One of "INT2S", "INT4S", "INT1U", "INT2U", "INT4U", "FLT4S", "FLT8S". If missing, this is guessed from the file size (INT1U for 1 byte per value, INT2S for 2 bytes and FLT4S for 4 bytes per value). This may be wrong because, for example, 2 bytes per value may in fact be INT2U (with the U for unsigned) values} \item{NAflag}{numeric. The value used as the "NA flag"} \item{bandorder}{character. One of "BIL", "BIP", or "BSQ". That is Band Interleaved by Line, or by Pixel, or Band SeQuential} \item{byteorder}{character. One of "LSB", "MSB". "MSB" is common for files generated on Linux systems, whereas "LSB" is common for files generated on windows} \item{toptobottom}{logical. If \code{FALSE}, the values are read bottom to top} \item{offset}{numeric. offset to be applied} \item{scale}{numeric. scale to be applied} } \value{ character (.VRT filename) } \seealso{\code{\link{vrt}} to create a vrt for a collection of raster tiles} \keyword{methods} \keyword{spatial} terra/man/interpNear.Rd0000644000176200001440000000334514536376240014557 0ustar liggesusers\name{interpNear} \docType{methods} \alias{interpNear} \alias{interpNear,SpatRaster,SpatVector-method} \alias{interpNear,SpatRaster,matrix-method} \title{Nearest neighbor interpolation} \description{ Nearest neighbor interpolation of points, using a moving window } \usage{ \S4method{interpNear}{SpatRaster,SpatVector}(x, y, field, radius, interpolate=FALSE, fill=NA, filename="", ...) \S4method{interpNear}{SpatRaster,matrix}(x, y, radius, interpolate=FALSE, fill=NA, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatVector or matrix with three columns (x,y,z)} \item{field}{character. field name in SpatVector \code{y}} \item{radius}{numeric. The radius of the circle (single number). If \code{interpolate=FALSE} it is also possible to use two or three numbers. Two numbers are interpreted as the radii of an ellipse (x and y-axis). A third number should indicated the desired, counter clockwise, rotation of the ellipse (in degrees)} \item{interpolate}{logical. Should the nearest neighbor values be linearly interpolated between points?} \item{fill}{numeric. value to use to fill empty cells} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{rasterizeWin}, \link{rasterize}, \link{interpIDW}, \link{interpolate}} } \value{ SpatRaster } \examples{ r <- rast(ncol=100, nrow=100, crs="local", xmin=0, xmax=50, ymin=0, ymax=50) set.seed(100) x <- runif(25, 5, 45) y <- runif(25, 5, 45) z <- sample(25) xyz <- cbind(x,y,z) x <- interpNear(r, xyz, radius=5) p <- vect(data.frame(xyz), geom=c("x", "y")) v <- voronoi(p) plot(x, col=rainbow(25)) lines(v) # plot(v, col=rainbow(25)); points(p) } \keyword{spatial} terra/man/rangeFill.Rd0000644000176200001440000000257614575026734014363 0ustar liggesusers\name{rangeFill} \alias{rangeFill} \alias{rangeFill,SpatRaster-method} \title{Fill layers with a range} \description{ Fill layers with cell-varying ranges defined by a start and end SpatRaster. The range must start at 1 and end at a user-defined maximum. Output values are either zero (not in the range) or one (in the range). For example, for a cell with \code{start=3}, \code{end=5} and with \code{limit=8}, the output for that cell would be \code{0,0,1,1,1,0,0,0} } \usage{ \S4method{rangeFill}{SpatRaster}(x, limit, circular=FALSE, filename="", ...) } \arguments{ \item{x}{SpatRaster with at two layers. The cell values of the first layer indicate the start of the range (1 based); the cell values are indicate the end of the range} \item{limit}{numeric > 1. The range size} \item{circular}{logical. If \code{TRUE} the values are considered circular, such as the days of the year. In that case, if first > last the layers used are c(first:limit, 1:last). Otherwise, if \code{circular=FALSE}, such a range would be considered invalid and \code{NA} would be used} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \seealso{ \code{\link{rapp}} } \examples{ x <- y <- rast(ncol=2, nrow=2) values(x) <- c(NA, 1:3) values(y) <- c(NA, 4:6) r <- rangeFill(c(x, y), 8) } \keyword{spatial} terra/man/clamp_ts.Rd0000644000176200001440000000224614536376240014251 0ustar liggesusers\name{clamp_ts} \alias{clamp_ts} \alias{clamp_ts,SpatRaster-method} \alias{clamp_ts,numeric-method} \title{clamp time series data} \description{ clamp time-series datat that are S shaped. The value in layers before the minimum value in a cell can be set to that minimum value, and the value in layers after the maximum value for a cell can be set to that maximum value. } \usage{ \S4method{clamp_ts}{SpatRaster}(x, min=FALSE, max=TRUE, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{min}{logical. If \code{TRUE} the time-series is clamped to the minimum value} \item{max}{logical. If \code{TRUE} the time-series is clamped to the maximum value} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{clamp}}, \code{\link{cummin}}, \code{\link{cummax}} } \examples{ sigm <- function(x) { .8 / (1 + exp(-(x-10))) + runif(length(x))/4 } r <- rast(ncols=10, nrows=10, nlyr=50) s <- seq(5.2, 15,.2) set.seed(1) values(r) <- t(replicate(100, sigm(s))) x <- clamp_ts(r, TRUE, TRUE) plot(unlist(r[4])) lines(unlist(x[4])) } \keyword{spatial} terra/man/rectify.Rd0000644000176200001440000000173314536376240014114 0ustar liggesusers\name{rectify} \alias{rectify} \alias{rectify,SpatRaster-method} \title{Rectify a SpatRaster} \description{ Rectify a rotated SpatRaster into a non-rotated object } \usage{ \S4method{rectify}{SpatRaster}(x, method="bilinear", aoi=NULL, snap=TRUE, filename="", ...) } \arguments{ \item{x}{SpatRaster to be rectified} \item{method}{character. Method used to for resampling. See \code{\link{resample}}} \item{aoi}{SpatExtent or SpatRaster to crop \code{x} to a smaller area of interest; Using a SpatRaster allowing to set the exact output extent and output resolution} \item{snap}{logical. If \code{TRUE}, the origin and resolution of the output are the same as would the case when \code{aoi = NULL}. Only relevant if \code{aoi} is a \code{SpatExtent}} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{\code{\link{is.rotated}}} \value{ SpatRaster } \keyword{spatial} terra/man/ifelse.Rd0000644000176200001440000000246114536376240013715 0ustar liggesusers\name{ifel} \alias{ifel} \alias{ifel,SpatRaster-method} \title{ifelse for SpatRasters} \description{ Implementation of \code{\link[base]{ifelse}} for SpatRasters. This method allows for a concise expression of what can otherwise be achieved with a combination of \code{\link{classify}}, \code{\link{mask}}, and \code{\link{cover}}. \code{ifel} is an \code{R} equivalent to the \code{Con} method in ArcGIS (arcpy). } \usage{ \S4method{ifel}{SpatRaster}(test, yes, no, filename="", ...) } \arguments{ \item{test}{SpatRaster with logical (TRUE/FALSE) values} \item{yes}{SpatRaster or numeric} \item{no}{SpatRaster or numeric} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ r <- rast(nrows=5, ncols=5, xmin=0, xmax=1, ymin=0, ymax=1) values(r) <- c(-10:0, NA, NA, NA, 0:10) x <- ifel(r > 1, 1, r) # same as a <- classify(r, cbind(1, Inf, 1)) # or b <- app(r, fun=function(i) {i[i > 1] <- 1; i}) # or d <- clamp(r, -Inf, 1) # or (not recommended for large datasets) e <- r e[e>1] <- 1 ## other examples f <- ifel(is.na(r), 100, r) z <- ifel(r > -2 & r < 2, 100, 0) # nested expressions y <- ifel(r > 1, 1, ifel(r < -1, -1, r)) k <- ifel(r > 0, r+10, ifel(r < 0, r-10, 3)) } \keyword{spatial} terra/man/mappal.Rd0000644000176200001440000000360514715574113013717 0ustar liggesusers\name{map.pal} \alias{map.pal} \title{color palettes for mapping} \description{ Get a color palette for mapping. These palettes were copied from GRASS. } \usage{ map.pal(name, n=50, ...) } \arguments{ \item{name}{character (name of a palette, see Details), or missing (to get the available names)} \item{n}{numeric. The number of colors} \item{...}{additional arguments that are passed to \code{\link{colorRamp}}} } \value{ none } \details{ \tabular{ll}{ Name \tab Description \cr aspect \tab aspect oriented grey colors\cr bcyr \tab blue through cyan through yellow to red\cr bgyr \tab blue through green through yellow to red\cr blues \tab white to blue\cr byg \tab blue through yellow to green\cr byr \tab blue through yellow to red\cr curvature \tab for terrain curvatures\cr differences \tab differences oriented colors\cr elevation \tab maps relative ranges of raster values to elevation color ramp\cr grass \tab GRASS GIS green (perceptually uniform)\cr greens \tab white to green\cr grey \tab grey scale\cr gyr \tab green through yellow to red\cr haxby \tab relative colors for bathymetry or topography\cr inferno \tab perceptually uniform sequential colors inferno\cr magma \tab perceptually uniform sequential colors\cr oranges \tab white to orange\cr plasma \tab perceptually uniform sequential colors\cr rainbow \tab rainbow colors\cr ramp \tab color ramp\cr random \tab random colors\cr reds \tab white to red\cr roygbiv \tab \cr rstcurv \tab terrain curvature\cr ryb \tab red through yellow to blue\cr ryg \tab red through yellow to green\cr sepia \tab yellowish-brown through to white\cr viridis \tab perceptually uniform sequential colors\cr water \tab water depth\cr wave \tab color wave\cr } } \seealso{ \code{\link{terrain.colors}} } \examples{ map.pal("elevation", 10) r <- rast(system.file("ex/elev.tif", package="terra")) plot(r, col=map.pal("elevation")) map.pal() } \keyword{spatial} terra/man/hist.Rd0000644000176200001440000000266614536376240013424 0ustar liggesusers\name{hist} \docType{methods} \alias{hist} \alias{hist,SpatRaster-method} \title{Histogram} \description{ Create a histogram of the values of a SpatRaster. For large datasets a sample of \code{maxcell} is used. } \usage{ \S4method{hist}{SpatRaster}(x, layer, maxcell=1000000, plot=TRUE, maxnl=16, main, ...) } \arguments{ \item{x}{SpatRaster} \item{layer}{positive integer or character to indicate layer numbers (or names). If missing, all layers up to \code{maxnl} are used} \item{maxcell}{integer. To regularly sample very large objects} \item{plot}{logical. Plot the histogram or only return the histogram values} \item{maxnl}{positive integer. The maximum number of layers to use. Ignored if \code{layer} is not missing} \item{main}{character. Main title(s) for the plot. Default is the value of \code{\link{names}}} \item{...}{additional arguments. See \code{\link[graphics]{hist}}} } \value{ This function is principally used for plotting a histogram, but it also returns an object of class "histogram" (invisibly if \code{plot=TRUE}). } \seealso{ \code{\link{pairs}, \link{boxplot}} } \examples{ r1 <- r2 <- rast(nrows=50, ncols=50) values(r1) <- runif(ncell(r1)) values(r2) <- runif(ncell(r1)) rs <- r1 + r2 rp <- r1 * r2 opar <- par(no.readonly =TRUE) par(mfrow=c(2,2)) plot(rs, main='sum') plot(rp, main='product') hist(rs) a <- hist(rp) a x <- c(rs, rp, sqrt(rs)) hist(x) par(opar) } \keyword{methods} \keyword{spatial} terra/man/gridDist.Rd0000644000176200001440000000420014736275005014207 0ustar liggesusers\name{gridDist} \alias{gridDist} \alias{gridDist,SpatRaster-method} \title{Distance on a grid} \description{ The function calculates the distance to cells of a SpatRaster when the path has to go through the centers of the eight neighboring raster cells. The default distance (when \code{scale=1}, is meters if the coordinate reference system (CRS) of the SpatRaster is longitude/latitude (\code{+proj=longlat}) and in the linear units of the CRS (typically meters) in other cases. Distances are computed by summing local distances between cells, which are connected with their neighbors in 8 directions. The shortest distance to the cells with the \code{target} value is computed for all cells that are not \code{NA}. Cells that are \code{NA} cannot be traversed and are ignored, unless the target itself is \code{NA}, in which case the distance to the nearest cell that is not \code{NA} is computed for all cells that are \code{NA}. } \usage{ \S4method{gridDist}{SpatRaster}(x, target=0, scale=1, maxiter=50, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{target}{numeric. value of the target cells (where to compute distance to)} \item{scale}{numeric. Scale factor. For longitude/latitude data 1 = "m" and 1000 = "km". For planar data that is also the case of the distance unit of the crs is "m"} \item{maxiter}{numeric. The maximum number of iterations. Increase this number if you get the warning that \code{costDistance} did not converge. Only relevant when target is not \code{NA}} \item{filename}{character. output filename (optional)} \item{...}{additional arguments as for \code{\link{writeRaster}}} } \seealso{See \code{\link[terra]{distance}} for "as the crow flies" distance, and \code{\link{costDist}} for distance across a landscape with variable friction} \value{SpatRaster} \examples{ # global lon/lat raster r <- rast(ncol=10,nrow=10, vals=1) r[48] <- 0 r[66:68] <- NA d <- gridDist(r) plot(d) # planar crs(r) <- "+proj=utm +zone=15 +ellps=GRS80 +datum=NAD83 +units=m +no_defs" d <- gridDist(r) plot(d) # distance to cells that are not NA rr <- classify(r, cbind(1, NA)) dd <- gridDist(rr, NA) } \keyword{spatial} terra/man/plotRGB.Rd0000644000176200001440000000654114545426426013764 0ustar liggesusers\name{plotRGB} \docType{methods} \alias{plotRGB} \alias{plotRGB,SpatRaster-method} \title{Red-Green-Blue plot of a multi-layered SpatRaster} \description{ Make a Red-Green-Blue plot based on three layers in a SpatRaster. The layers (sometimes referred to as "bands" because they may represent different bandwidths in the electromagnetic spectrum) are combined such that they represent the red, green and blue channel. This function can be used to make "true" (or "false") color images from Landsat and other multi-spectral satellite images. Note that the margins of the plot are set to zero (no axes or titles are visible) but can be set with the \code{mar} argument. An alternative way to plot RGB images is to first use \code{\link{colorize}} to create a single layer SpatRaster with a color-table and then use \code{\link[terra]{plot}}. } \usage{ \S4method{plotRGB}{SpatRaster}(x, r=1, g=2, b=3, a=NULL, scale=NULL, mar=0, stretch=NULL, smooth=TRUE, colNA="white", alpha=NULL, bgalpha=NULL, zlim=NULL, zcol=FALSE, axes=FALSE ,...) } \arguments{ \item{x}{SpatRaster} \item{r}{integer between 1 and \code{nlyr(x)}. Layer to use as the Red channel} \item{g}{integer between 1 and \code{nlyr(x)}. Layer to use as the Green channel} \item{b}{integer between 1 and \code{nlyr(x)}. Layer to use as the Blue channel} \item{a}{NULL or integer between 1 and \code{nlyr(x)}. Layer to use as the alpha (transparency) channel. If not NULL, argument \code{alpha} is ignored} \item{scale}{integer. Maximum (possible) value in the three channels. Defaults to 255 or to the maximum value of \code{x} if that is known and larger than 255} \item{mar}{numeric vector recycled to length 4 to set the margins of the plot. Use \code{mar=NULL} or \code{mar=NA} to not set the margins} \item{stretch}{character. Option to stretch the values to increase contrast: "lin" (linear) or "hist" (histogram). The linear stretch uses \code{\link{stretch}} with arguments \code{minq=0.02} and \code{maxq=0.98}} \item{smooth}{logical. If \code{TRUE}, smooth the image when drawing to get the appearance of a higher spatial resolution} \item{colNA}{color. The color used for cells that have NA values} \item{alpha}{transparency. Integer between 0 (transparent) and 255 (opaque)} \item{bgalpha}{Background transparency. Integer between 0 (transparent) and 255 (opaque)} \item{zlim}{numeric vector of length 2. Range of values to plot (optional). If this is set, and \code{stretch="lin"} is used, then the values are stretched within the range of \code{zlim}. This allows creating consistent coloring between SpatRasters with different cell-value ranges, even when stretching the colors for improved contrast} \item{zcol}{logical. If \code{TRUE} the values outside the range of zlim get the color of the extremes of the range. Otherwise, the values outside the zlim range get the color of \code{NA} values (see argument "colNA")} \item{axes}{logical. If \code{TRUE} axes are drawn (and arguments such as \code{main="title"} will be honored)} \item{...}{graphical parameters as in \code{\link{plot}}} } \seealso{ \code{\link{plot}}, \code{\link{colorize}}, \code{\link{RGB}} } \examples{ b <- rast(system.file("ex/logo.tif", package="terra")) plotRGB(b) plotRGB(b, mar=2) plotRGB(b, 3, 2, 1) b[1000:2000] <- NA plotRGB(b, 3, 2, 1, stretch="hist") } \keyword{methods} \keyword{spatial} terra/man/inset.Rd0000644000176200001440000000644214562663530013573 0ustar liggesusers\name{inset} \docType{methods} \alias{inset} \alias{inset,SpatVector-method} \alias{inset,SpatRaster-method} \alias{inext} \alias{inext,SpatVector-method} \title{Make an inset map} \description{ Make an inset map or scale the extent of a SpatVector } \usage{ \S4method{inset}{SpatVector}(x, e, loc="", scale=0.2, background="white", perimeter=TRUE, box=NULL, pper, pbox, offset=0.1, add=TRUE, ...) \S4method{inset}{SpatRaster}(x, e, loc="", scale=0.2, background="white", perimeter=TRUE, box=NULL, pper, pbox, offset=0.1, add=TRUE, ...) \S4method{inext}{SpatVector}(x, e, y=NULL, gap=0) } \arguments{ \item{x}{SpatVector, SpatRaster} \item{e}{SpatExtent to set the size and location of the inset. Or missing} \item{loc}{character. One of "bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right", "center"} \item{scale}{numeric. The relative size of the inset, used when x is missing} \item{background}{color for the background of the inset. Use \code{NA} for no background color} \item{perimeter}{logical. If \code{TRUE} a perimeter (border) is drawn around the inset} \item{box}{SpatExtent or missing, to draw a box on the inset, e.g. to show where the map is located in a larger area} \item{pper}{list with graphical parameters (arguments) such as \code{col} and \code{lwd} for the perimeter line} \item{pbox}{list with graphical parameters (arguments) such as \code{col} and \code{lwd} for the box (line)} \item{offset}{numeric. Value between 0.1 and 1 to indicate the relative distance between what is mapped and the bounding box} \item{add}{logical. Add the inset to the map?} \item{...}{additional arguments passed to plot for the drawing of \code{x}} \item{y}{SpatVector. If not NULL, \code{y} is scaled based with the parameters for \code{x}. This is useful, for example, when \code{x} represent boundaries, and \code{y} points within these boundaries} \item{gap}{numeric to add space between the SpatVector and the SpatExtent} } \seealso{\code{\link{sbar}}, \code{\link{rescale}}, \code{\link{shift}}} \value{scaled and shifted SpatVector or SpatRaster (returned invisibly)} \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) x <- v[v$NAME_2 == "Diekirch", ] plot(x, density=10, col="blue") inset(v) # more elaborate plot(x, density=10, col="blue") inset(v, col = "brown", border="lightgrey", perimeter=TRUE, pper=list(col="orange", lwd=3, lty=2), box=ext(x), pbox=list(col="blue", lwd=2)) cols <- rep("light grey", 12) cols[2] <- "red" e <- ext(c(6.2, 6.3, 49.9, 50)) b <- ext(x)+0.02 inset(v, e=e, col=cols, box=b) # with a SpatRaster ff <- system.file("ex/elev.tif", package="terra") r <- rast(ff) r <- crop(r, ext(x) + .01) plot(r, type="int", mar=c(2,2,2,2), plg=list(x="topright")) lines(v, lwd=1.5) lines(x, lwd=2.5) inset(v, col=cols, loc="topleft", scale=0.15) # a more complex one plot(r, plg=list(title="meter\n", shrink=.2, cex=.8)) lines(v, lwd=4, col="white") lines(v, lwd=1.5) lines(x, lwd=2.5) text(x, "NAME_2", cex=1.5, halo=TRUE) sbar(6, c(6.04, 49.785), type="bar", below="km", label=c(0,3,6), cex=.8) s <- inset(v, col=cols, box=b, scale=.2, loc="topright", background="light yellow", pbox=list(lwd=2, lty=5, col="blue")) # note the returned inset SpatVector s lines(s, col="orange") } \keyword{methods} \keyword{spatial} terra/man/unique.Rd0000644000176200001440000000341314536376240013752 0ustar liggesusers\name{unique} \docType{methods} \alias{unique} \alias{unique,SpatRaster-method} \alias{unique,SpatRaster,ANY-method} \alias{unique,SpatVector-method} \alias{unique,SpatVector,ANY-method} \title{Unique values} \description{ This method returns the unique values in a SpatRaster, or removes duplicates records (geometry and attributes) in a SpatVector. } \usage{ \S4method{unique}{SpatRaster}(x, incomparables=FALSE, digits=NA, na.rm=TRUE, as.raster=FALSE) \S4method{unique}{SpatVector}(x, incomparables=FALSE, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{incomparables}{logical. If \code{FALSE} and \code{x} is a SpatRaster: the unique values are determined for all layers together, and the result is a matrix. If \code{TRUE}, each layer is evaluated separately, and a list is returned. If \code{x} is a SpatVector this argument is as for a \code{data.frame}} \item{digits}{integer. The number of digits for rounding the values before finding the unique values. Use \code{NA} means to not do any rounding} \item{na.rm}{logical. If \code{TRUE}, \code{NaN} is included if there are any missing values} \item{as.raster}{logical. If \code{TRUE}, a single-layer categorical SpatRaster with the unique values is returned} \item{...}{additional arguments passed on to \code{\link[base]{unique}}} } \value{ If \code{x} is a SpatRaster: data.frame or list (if \code{incomparables=FALSE}) If \code{x} is a SpatVector: SpatVector } \examples{ r <- rast(ncols=5, nrows=5) values(r) <- rep(1:5, each=5) unique(r) s <- c(r, round(r/3)) unique(s) unique(s,TRUE) unique(s, as.raster=TRUE) v <- vect(cbind(x=c(1:5,1:5), y=c(5:1,5:1)), crs="+proj=utm +zone=1 +datum=WGS84") nrow(v) u <- unique(v) nrow(u) values(v) <- c(1:5, 1:3, 5:4) unique(v) } \keyword{spatial} terra/man/meta.Rd0000644000176200001440000000061314536376240013371 0ustar liggesusers\name{meta} \docType{methods} \alias{meta} \alias{meta,SpatRaster-method} \title{meta} \description{ Get metadata associated with the sources or layers of a SpatRaster } \usage{ \S4method{meta}{SpatRaster}(x, layers=FALSE) } \arguments{ \item{x}{SpatRaster} \item{layers}{logical. Should the layer level metadata be returned?} } \value{ list } \keyword{methods} \keyword{spatial} terra/man/ext.Rd0000644000176200001440000000422214743505546013246 0ustar liggesusers\name{ext} \docType{methods} \alias{ext} \alias{ext<-} \alias{ext,SpatExtent-method} \alias{ext,SpatRaster-method} \alias{ext,SpatVector-method} \alias{ext,SpatVectorCollection-method} \alias{ext,SpatVectorProxy-method} \alias{ext,SpatRasterDataset-method} \alias{ext,SpatRasterCollection-method} \alias{ext<-,SpatRaster,SpatExtent-method} \alias{ext<-,SpatRaster,numeric-method} \alias{ext,numeric-method} \alias{ext,matrix-method} \alias{ext,missing-method} \alias{ext,Spatial-method} \alias{ext,Raster-method} \alias{ext,Extent-method} \alias{ext,sf-method} \alias{ext,bbox-method} \title{Create, get or set a SpatExtent} \description{ Get a SpatExtent of a SpatRaster, SpatVector, or other spatial objects. Or create a SpatExtent from a vector (length=4; order=xmin, xmax, ymin, ymax) You can set the extent of a SpatRaster, but you cannot set the extent of a SpatVector (see \code{\link{rescale}} for that). See \code{\link{set.ext}} to set the extent in place. } \usage{ \S4method{ext}{SpatRaster}(x, cells=NULL) \S4method{ext}{SpatVector}(x) \S4method{ext}{numeric}(x, ..., xy=FALSE) \S4method{ext}{SpatRaster,SpatExtent}(x)<-value \S4method{ext}{SpatRaster,numeric}(x)<-value } \arguments{ \item{x}{SpatRaster, SpatVector, numeric vector of length four (xmin, xmax, ymin, ymax), or missing (in which case the output is the global extent in lon-lat coordinates)} \item{cells}{positive integer (cell) numbers to subset the extent to area covered by these cells} \item{value}{SpatExtent, or numeric vector of length four (xmin, xmax, ymin, ymax)} \item{...}{if \code{x} is a single numeric value, additional numeric values for xmax, ymin, and ymax} \item{xy}{logical. Set this to \code{TRUE} to indicate that coordinates are in (xmin, ymin, xmax, ymax) order, instead of in the terra standard order of (xmin, xmax, ymin, ymax)} } \value{ A \code{\link{SpatExtent}} object. } \examples{ ext() r <- rast() e <- ext(r) as.vector(e) as.character(e) ext(r) <- c(0, 2.5, 0, 1.5) r er <- ext(r) round(er) # go "in" floor(er) # go "out" ceiling(er) ext(r) <- e } \keyword{spatial} terra/man/classify.Rd0000644000176200001440000001016514715132750014256 0ustar liggesusers\name{classify} \docType{methods} \alias{classify} \alias{classify,SpatRaster-method} \title{Classify (or reclassify) cell values} \description{ Classify values of a SpatRaster. The function (re-)classifies groups of values to other values. The classification is done based on the argument \code{rcl}. You can classify ranges by specifying a three-column matrix "from-to-becomes" or change specific values by using a two-column matrix "is-becomes". You can also supply a vector with "cuts" or the "number of cuts". With "from-to-becomes" or "is-becomes" classification is done in the row order of the matrix. Thus, if there are overlapping ranges or values, the first time a number is within a range determines the reclassification value. With "cuts" the values are sorted, so that the order in which they are provided does not matter. } \usage{ \S4method{classify}{SpatRaster}(x, rcl, include.lowest=FALSE, right=TRUE, others=NULL, brackets=TRUE, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{rcl}{matrix for classification. This matrix must have 1, 2 or 3 columns. If there are three columns, the first two columns are "from" "to" of the input values, and the third column "becomes" has the new value for that range. The two column matrix ("is", "becomes") can be useful for classifying integer values. In that case, the arguments \code{right} and \code{include.lowest} are ignored. A single column matrix (or a vector) is interpreted as a set of cuts if there is more than one value. In that case the values are classified based on their location in-between the cut-values. If a single number is provided, that is used to make that number of cuts, at equal intervals between the lowest and highest values of the SpatRaster. } \item{include.lowest}{logical, indicating if a value equal to the lowest value in \code{rcl} (or highest value in the second column, for \code{right=FALSE}) should be included.} \item{right}{logical. If \code{TRUE}, the intervals are closed on the right (and open on the left). If \code{FALSE} they are open at the right and closed at the left. "open" means that the extreme value is *not* included in the interval. Thus, right-closed and left open is \code{(0,1] = {x | 0 < x <= 1}}. You can also close both sides with \code{right=NA}, that is only meaningful if you "from-to-becomes" classification with integers. For example to classify 1-5 -> 1, 6-10 -> 2, 11-15 -> 3. That may be easier to read and write than the equivalent 1-5 -> 1, 5-10 -> 2, 10-15 -> 3 with \code{right=TRUE} and \code{include.lowest=TRUE}} \item{others}{numeric. If not \code{NULL} all values that are not matched are set to this value. Otherwise they retain their original value.} \item{brackets}{logical. If \code{TRUE}, intervals are have parenthesis or brackets around them to indicate whether they are open or closed. Only applies if \code{rcl} is a vector (or single column matrix)} \item{filename}{character. Output filename} \item{...}{Additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{subst}} for simpler from-to replacement, and \code{\link{clamp}}} \note{ classify works with the "raw" values of categorical rasters, ignoring the levels (labels, categories). To change the labels of categorical rasters, use \code{\link{subst}} instead. For model-based classification see \code{\link{predict}} } \examples{ r <- rast(ncols=10, nrows=10) values(r) <- (0:99)/99 ## from-to-becomes # classify the values into three groups # all values >= 0 and <= 0.25 become 1, etc. m <- c(0, 0.25, 1, 0.25, 0.5, 2, 0.5, 1, 3) rclmat <- matrix(m, ncol=3, byrow=TRUE) rc1 <- classify(r, rclmat, include.lowest=TRUE) ## cuts # equivalent to the above, but now a categorical SpatRaster is returned rc2 <- classify(r, c(0, 0.25, 0.5, 1), include.lowest=TRUE, brackets=TRUE) freq(rc2) ## is-becomes x <- round(r*3) unique(x) # replace 0 with NA y <- classify(x, cbind(0, NA)) unique(y) # multiple replacements m <- rbind(c(2, 200), c(3, 300)) m rcx1 <- classify(x, m) unique(rcx1) rcx2 <- classify(x, m, others=NA) unique(rcx2) } \keyword{spatial} terra/man/extractRange.Rd0000644000176200001440000000317314735573745015110 0ustar liggesusers\name{extractRange} \docType{methods} \alias{extractRange} \alias{extractRange,SpatRaster-method} \alias{extractRange,SpatRaster,ANY-method} \title{Extract values for a range of layers from a SpatRaster} \description{ Extract values from a SpatRaster for a set of locations and a range of layers. To extract values for a single or all layers, use \code{\link{extract}} } \usage{ \S4method{extractRange}{SpatRaster}(x, y, first, last, lyr_fun=NULL, geom_fun=NULL, ID=FALSE, na.rm=TRUE, ...) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatVector (points, lines, or polygons). Alternatively, for points, a 2-column matrix or data.frame (x, y) or (lon, lat). Or a vector with cell numbers} \item{first}{layer name of number, indicating the first layer in the range of layers to be considered} \item{last}{layer name or number, indicating the last layer in the range to be considered} \item{lyr_fun}{function to summarize the extracted data across layers} \item{geom_fun}{function to summarize the extracted data for each line or polygon geometry. Ignored if \code{y} has point geometry} \item{ID}{logical. Should an ID column be added? If so, the first column returned has the IDs (record numbers) of \code{y}} \item{na.rm}{logical. Should missing values be ignored?} \item{...}{additional arguments passed to \code{extract}} } \value{numeric or data.frame} \seealso{\code{\link{extract}}} \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) xy <- data.frame(c(50,80), c(30, 60)) extract(r, xy) extract(r, xy, layer=c("red", "green")) extractRange(r, xy, first=1:2, last=3:2, lyr_fun=sum) } \keyword{methods} \keyword{spatial} terra/man/where.Rd0000644000176200001440000000160314536376240013555 0ustar liggesusers\name{where} \docType{methods} \alias{where.min} \alias{where.min,SpatRaster-method} \alias{where.max} \alias{where.max,SpatRaster-method} \title{Where are the cells with the min or max values?} \description{ This method returns the cell numbers for the cells with the min or max values of each layer in a SpatRaster. } \usage{ \S4method{where.min}{SpatRaster}(x, values=TRUE, list=FALSE) \S4method{where.max}{SpatRaster}(x, values=TRUE, list=FALSE) } \arguments{ \item{x}{SpatRaster} \item{values}{logical. If \code{TRUE} the min or max values are also returned} \item{list}{logical. If \code{TRUE} a list is returned instead of a matrix} } \value{ matrix or list } \seealso{\code{\link{which}} and \code{\link{Summary-methods}} for \code{which.min} and \code{which.max}} \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) where.min(r) } \keyword{spatial} terra/man/sort.Rd0000644000176200001440000000223614536376240013435 0ustar liggesusers\name{sort} \docType{methods} \alias{sort} \alias{sort,SpatRaster-method} \alias{sort,SpatVector-method} \alias{sort,data.frame-method} \title{Sort a SpatRaster or SpatVector} \description{ Sort the cell values of a SpatRaster across layers. You can also compute the sorting order. Or sort the records of SpatVector (or data.frame) by specifying the column number(s) or names(s) to sort on. } \usage{ \S4method{sort}{SpatRaster}(x, decreasing=FALSE, order=FALSE, filename="", ...) \S4method{sort}{SpatVector}(x, v, decreasing=FALSE) } \arguments{ \item{x}{SpatRaster} \item{decreasing}{logical. If \code{TRUE}, sorting is in decreasing order} \item{order}{logical. If \code{TRUE} the sorting order is returned instead of the sorted values} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} \item{v}{character or numeric indicating the column(s) to sort on} } \value{ SpatRaster } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) r <- c(r, r/2, r*2) sort(r) ord <- sort(r, order=TRUE) # these two are the same ord[[1]] which.min(r) } \keyword{spatial} terra/man/coerce.Rd0000644000176200001440000000273014745012505013676 0ustar liggesusers\name{coerce} \docType{methods} \alias{as.vector} \alias{as.matrix} \alias{as.array} \alias{as.vector,SpatRaster-method} \alias{as.matrix,SpatRaster-method} \alias{as.array,SpatRaster-method} \alias{as.array,SpatRasterDataset-method} \alias{as.vector,SpatExtent-method} \alias{as.matrix,SpatExtent-method} \title{Coercion to vector, matrix or array} \description{ Coercion of a SpatRaster to a vector, matrix or array. Or coerce a SpatExtent to a vector or matrix } \usage{ \S4method{as.vector}{SpatRaster}(x, mode='any') \S4method{as.matrix}{SpatRaster}(x, wide=FALSE, ...) \S4method{as.array}{SpatRaster}(x) \S4method{as.array}{SpatRasterDataset}(x) \S4method{as.vector}{SpatExtent}(x, mode='any') \S4method{as.matrix}{SpatExtent}(x, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{wide}{logical. If \code{FALSE} each layer in the SpatRaster becomes a column in the matrix and each cell in the SpatRaster becomes a row. If \code{TRUE} each row in the SpatRaster becomes a row in the matrix and each column in the SpatRaster becomes a column in the matrix } \item{mode}{this argument is ignored} \item{...}{additional arguments (none implemented)} } \value{ vector, matrix, or array } \seealso{\code{\link{as.data.frame}} and \code{\link{as.polygons}}} \examples{ r <- rast(ncols=2, nrows=2) values(r) <- 1:ncell(r) as.vector(r) as.matrix(r) as.matrix(r, wide=TRUE) as.data.frame(r, xy=TRUE) as.array(r) as.vector(ext(r)) as.matrix(ext(r)) } \keyword{spatial} terra/man/spin.Rd0000644000176200001440000000154114536376240013415 0ustar liggesusers\name{spin} \docType{methods} \alias{spin} \alias{spin,SpatVector-method} \title{spin a SpatVector} \description{ Spin (rotate) the geometry of a SpatVector. } \usage{ \S4method{spin}{SpatVector}(x, angle, x0, y0) } \arguments{ \item{x}{SpatVector} \item{angle}{numeric. Angle of rotation in degrees} \item{x0}{numeric. x-coordinate of the center of rotation. If missing, the center of the extent of \code{x} is used} \item{y0}{numeric. y-coordinate of the center of rotation. If missing, the center of the extent of \code{x} is used} } \value{ SpatVector } \seealso{\code{\link{rescale}}, \code{\link{t}}, \code{\link{shift}}} \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) w <- spin(v, 180) plot(v) lines(w, col="red") # lower-right corner as center e <- as.vector(ext(v)) x <- spin(v, 45, e[1], e[3]) } \keyword{spatial} terra/man/rcl.Rd0000644000176200001440000000235414536376240013227 0ustar liggesusers\name{rcl} \alias{rcl} \alias{rcl,SpatRaster-method} \title{Combine row, column, and layer numbers} \description{ Get a matrix with the combination of row, column, and layer numbers } \usage{ \S4method{rcl}{SpatRaster}(x, row=NULL, col=NULL, lyr=NULL) } \arguments{ \item{x}{SpatRaster} \item{row}{positive integer that are row number(s), a list thereof, or NULL for all rows} \item{col}{as above for columns} \item{lyr}{as above for layers} } \details{ If a list is used for at least one of \code{row}, \code{col} or \code{lyr}, these are evaluated in parallel. That is combinations are made for each list element, not across list elements. If, in this case another argument is not a list it has to have either length 1 (used for all cases) or have the same length as the (longest) list, in which case the value is coerced into a list with \code{as.list} If multiple arguments are a list but they have different lengths, theyare recycled to the longest list. } \value{ matrix } \seealso{ \code{\link{rowColCombine}}, \code{\link{cellFromRowCol}} } \examples{ x <- rast(ncol=5, nrow=5, nlyr=2) values(x) <- 1:size(x) rcl(x, 1, 2:3, 1:2) i <- rcl(x, 1, list(1:2, 3:4), 1:2) i # get the values for these cells x[i] } \keyword{spatial} terra/man/centroids.Rd0000644000176200001440000000141714536376240014440 0ustar liggesusers\name{centroids} \alias{centroids} \alias{centroids,SpatVector-method} \title{Centroids} \description{ Get the centroids of polygons or lines, or centroid-like points that are guaranteed to be inside the polygons or on the lines. } \usage{ \S4method{centroids}{SpatVector}(x, inside=FALSE) } \arguments{ \item{x}{SpatVector} \item{inside}{logical. If \code{TRUE} the points returned are guaranteed to be inside the polygons or on the lines, but they are not the true centroids. True centroids may be outside a polygon, for example when a polygon is "bean shaped", and they are unlikely to be on their line} } \value{SpatVector of points} \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) x <- centroids(v) y <- centroids(v, TRUE) } \keyword{spatial} terra/man/add.Rd0000644000176200001440000000154514547073726013205 0ustar liggesusers\name{add} \docType{methods} \alias{add<-} \alias{add<-,SpatRaster,SpatRaster-method} \alias{add<-,SpatRasterCollection,SpatRaster-method} \alias{add<-,SpatRasterDataset,SpatRaster-method} \title{Add (in place) a SpatRaster to another SpatRaster or to a SpatRasterDataset or SpatRasterCollection} \description{ Add (in place) a SpatRaster to another SpatRaster. Comparable with \code{\link{c}}, but without copying the object. } \usage{ \S4method{add}{SpatRaster,SpatRaster}(x)<-value \S4method{add}{SpatRasterDataset,SpatRaster}(x)<-value \S4method{add}{SpatRasterCollection,SpatRaster}(x)<-value } \arguments{ \item{x}{SpatRaster, SpatRasterDataset or SpatRasterCollection} \item{value}{SpatRaster} } \seealso{\code{\link{c}}} \value{ SpatRaster } \examples{ r <- rast(nrows=5, ncols=9, vals=1:45) x <- c(r, r*2) add(x) <- r*3 x } \keyword{spatial} terra/man/selectRange.Rd0000644000176200001440000000313514536376240014701 0ustar liggesusers\name{selectRange} \alias{selectRange} \alias{selectRange,SpatRaster-method} \title{Select the values of a range of layers, as specified by cell values in another SpatRaster} \description{ Use a single layer SpatRaster to select cell values from different layers in a multi-layer SpatRaster. The values of the SpatRaster to select layers (\code{y}) should be whole numbers between \code{1} and \code{nlyr(x)} (values outside this range are ignored). See \code{\link{rapp}} for applying a function to a range of variable size. See \code{\link{extract}} for extraction of values by cell, point, or otherwise. } \usage{ \S4method{selectRange}{SpatRaster}(x, y, z=1, repint=0, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatRaster. Cell values must be positive integers. They indicate the first layer to select for each cell} \item{z}{positive integer. The number of layers to select} \item{repint}{integer > 1 and < nlyr(x) allowing for repeated selection at a fixed interval. For example, if \code{x} has 36 layers, and the value of a cell in \code{y}=2 and \code{repint} = 12, the values for layers 2, 14 and 26 are returned} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{rapp}}, \code{\link{tapp}}, \code{\link{extract}}} \examples{ r <- rast(ncols=10, nrows=10) values(r) <- 1 s <- c(r, r+2, r+5) s <- c(s, s) set.seed(1) values(r) <- sample(3, ncell(r), replace=TRUE) x <- selectRange(s, r) x <- selectRange(s, r, 3) } \keyword{methods} \keyword{spatial} terra/man/add_mtext.Rd0000644000176200001440000000161014646635014014411 0ustar liggesusers\name{add_mtext} \alias{add_mtext} \title{draw a box} \description{ Similar to \code{\link[graphics]{mtext}} allowing adding a text to the margins of a map. This function useds the margins around the mapped area; not the margins that R would use. } \usage{ add_mtext(text, side=3, line=0, ...) } \arguments{ \item{text}{character or expression vector specifying the text to be written} \item{side}{ integer indicating the margin to use (1=bottom, 2=left, 3=top, 4=right)} \item{line}{ numeric to move the text in or outwards.} \item{...}{arguments passed to \code{\link{text}}} } \seealso{\code{\link{add_legend}}, \code{\link{add_grid}}, \code{\link{add_box}}} \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) plot(r, axes=FALSE, legend=FALSE) add_box() for (i in 1:4) add_mtext("margin text", i, cex=i, col=i, line=2-i) } \keyword{methods} \keyword{spatial} terra/man/focalValues.Rd0000644000176200001440000000163014536376240014707 0ustar liggesusers\name{focalValues} \docType{methods} \alias{focalValues} \alias{focalValues,SpatRaster-method} \title{Get focal values} \description{ Get a matrix in which each row had the focal values of a cell. These are the values of a cell and a rectangular window around it. } \usage{ \S4method{focalValues}{SpatRaster}(x, w=3, row=1, nrows=nrow(x), fill=NA) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{w}{window. The window can be defined as one (for a square) or two odd numbers (row, col); or with an odd sized matrix} \item{row}{positive integer. Row number to start from, should be between 1 and nrow(x)} \item{nrows}{positive integer. How many rows?} \item{fill}{numeric used as values for imaginary cells outside the raster} } \value{ matrix } \examples{ r <- rast(ncol=4, nrow=4, crs="+proj=utm +zone=1 +datum=WGS84") values(r) <- 1:ncell(r) focalValues(r) } \keyword{spatial} \keyword{methods} terra/man/densify.Rd0000644000176200001440000000303414536376240014104 0ustar liggesusers\name{densify} \docType{methods} \alias{densify} \alias{densify,SpatVector-method} \title{ Add additional nodes to lines or polygons } \description{ Add additional nodes to lines or polygons. This can be useful to do prior to using \code{project} such that the path does not change too much. } \usage{ \S4method{densify}{SpatVector}(x, interval, equalize=TRUE, flat=FALSE) } \arguments{ \item{x}{SpatVector} \item{interval}{positive number, specifying the desired minimum distance between nodes. The unit is meter for lonlat data, and in the linear unit of the crs for planar data} \item{equalize}{logical. If \code{TRUE}, new nodes are spread at equal intervals between old nodes} \item{flat}{logical. If \code{TRUE}, the earth's curvature is ignored for lonlat data, and the distance unit is degrees, not meter} } \value{ SpatVector } \examples{ v <- vect(rbind(c(-120,-20), c(-80,5), c(-40,-60), c(-120,-20)), type="polygons", crs="+proj=longlat") vd <- densify(v, 200000) p <- project(v, "+proj=robin") pd <- project(vd, "+proj=robin") # good plot(pd, col="gray", border="red", lwd=10) points(pd, col="gray") # bad lines(p, col="blue", lwd=3) points(p, col="blue", cex=2) plot(p, col="blue", alpha=.1, add=TRUE) legend("topright", c("good", "bad"), col=c("red", "blue"), lty=1, lwd=3) ## the other way around does not work ## unless the original data was truly planar (e.g. derived from a map) x <- densify(p, 250000) y <- project(x, "+proj=longlat") # bad plot(y) # good lines(vd, col="red") } \keyword{methods} \keyword{spatial} terra/man/thresh.Rd0000644000176200001440000000265614751713537013754 0ustar liggesusers\name{thresh} \docType{methods} \alias{thresh} \alias{thresh,SpatRaster-method} \title{Thresholding} \description{ Compute a threshold to divide the values of a SpatRaster into two groups, and use that threshold to classify the raster. } \usage{ \S4method{thresh}{SpatRaster}(x, method="otsu", maxcell=1000000, combine=FALSE, as.raster=TRUE, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{method}{character. One of "mean", "median" or "otsu" for Otsu's method} \item{maxcell}{positive integer. Maximum number of cells to use to compute the threshold} \item{combine}{logical. If \code{TRUE} the layers of \code{x} are combined to compute a single threshold} \item{as.raster}{logical. If \code{TRUE} a classified SpatRaster is returned. Otherwise the threshold(s) are returned} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ numeric or SpatRaster } \references{ Otsu, N. (1979). A Threshold Selection Method from Gray-Level Histograms. \emph{IEEE Transactions on Systems, Man, and Cybernetics}, \bold{9(1)}, 62-66. \doi{10.1109/TSMC.1979.4310076} } \seealso{\code{\link{divide}}} \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) thresh(s, "mean", as.raster=FALSE) thresh(s, "mean", combine=TRUE, as.raster=FALSE) plot(thresh(s, "otsu")) } \keyword{spatial} terra/man/sharedPaths.Rd0000644000176200001440000000144314536376240014713 0ustar liggesusers\name{sharedPaths} \docType{methods} \alias{sharedPaths} \alias{sharedPaths,SpatVector-method} \title{ Shared paths } \description{ Get shared paths of line or polygon geometries. This can for geometries in a single SpatVector, or between two SpatVectors } \usage{ \S4method{sharedPaths}{SpatVector}(x, y=NULL) } \arguments{ \item{x}{SpatVector of lines or polygons} \item{y}{missing or SpatVector of lines or polygons} } \value{ SpatVector } \seealso{ \code{\link{gaps}}, \code{\link{topology}} } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) plot(v, col="light gray") text(v, halo=TRUE) x <- sharedPaths(v) lines(x, col="red", lwd=2) text(x, col="blue", halo=TRUE, cex=0.8) head(x) z <- sharedPaths(v[3,], v[12,]) } \keyword{methods} \keyword{spatial} terra/man/weighted.mean.Rd0000644000176200001440000000246414536376240015170 0ustar liggesusers\name{weighted.mean} \alias{weighted.mean} \alias{weighted.mean,SpatRaster,numeric-method} \alias{weighted.mean,SpatRaster,SpatRaster-method} \title{Weighted mean of layers} \description{ Compute the weighted mean for each cell of the layers of a SpatRaster. The weights can be spatially variable or not. } \usage{ \S4method{weighted.mean}{SpatRaster,numeric}(x, w, na.rm=FALSE, filename="", ...) \S4method{weighted.mean}{SpatRaster,SpatRaster}(x, w, na.rm=FALSE, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{w}{A vector of weights (one number for each layer), or for spatially variable weights, a SpatRaster with weights (should have the same extent, resolution and number of layers as x)} \item{na.rm}{Logical. Should missing values be removed?} \item{filename}{character. Output filename} \item{...}{options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{Summary-methods}}, \code{\link[stats]{weighted.mean}} } \examples{ b <- rast(system.file("ex/logo.tif", package="terra")) # give least weight to first layer, most to last layer wm1 <- weighted.mean(b, w=1:3) # spatially varying weights # weigh by column number w1 <- init(b, "col") # weigh by row number w2 <- init(b, "row") w <- c(w1, w2, w2) wm2 <- weighted.mean(b, w=w) } terra/man/mask.Rd0000644000176200001440000000466014634055007013376 0ustar liggesusers\name{mask} \docType{methods} \alias{mask} \alias{mask,SpatRaster,SpatRaster-method} \alias{mask,SpatRaster,SpatVector-method} \alias{mask,SpatRaster,SpatExtent-method} \alias{mask,SpatRaster,sf-method} \alias{mask,SpatVector,SpatVector-method} \alias{mask,SpatVector,SpatExtent-method} \alias{mask,SpatVector,sf-method} \title{Mask values in a SpatRaster or SpatVector} \description{ If \code{x} is a \code{SpatRaster}: Create a new SpatRaster that has the same values as SpatRaster \code{x}, except for the cells that are \code{NA} (or other \code{maskvalue}) in another SpatRaster (the 'mask'), or the cells that are not covered by a SpatVector or SpatExtent. These cells become \code{NA} (or another \code{updatevalue}). If \code{x} is a SpatVector or SpatExtent: Select geometries of \code{x} that intersect, or not intersect, with the geometries of \code{y}. } \usage{ \S4method{mask}{SpatRaster,SpatRaster}(x, mask, inverse=FALSE, maskvalues=NA, updatevalue=NA, filename="", ...) \S4method{mask}{SpatRaster,SpatVector}(x, mask, inverse=FALSE, updatevalue=NA, touches=TRUE, filename="", ...) \S4method{mask}{SpatRaster,SpatExtent}(x, mask, inverse=FALSE, updatevalue=NA, touches=TRUE, filename="", ...) \S4method{mask}{SpatVector,SpatVector}(x, mask, inverse=FALSE) \S4method{mask}{SpatVector,SpatExtent}(x, mask, inverse=FALSE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{mask}{SpatRaster or SpatVector} \item{inverse}{logical. If \code{TRUE}, areas on mask that are _not_ the \code{maskvalue} are masked} \item{maskvalues}{numeric. The value(s) in \code{mask} that indicate which cells of \code{x} should be masked (change their value to \code{updatevalue} (default = \code{NA}))} \item{updatevalue}{numeric. The value that masked cells should become (if they are not \code{NA})} \item{touches}{logical. If \code{TRUE}, all cells touched by lines or polygons will be masked, not just those on the line render path, or whose center point is within the polygon} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \seealso{\code{\link{subst}}, \code{\link{crop}}} \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) msk <- ifel(r < 400, NA, 1) m <- mask(r, msk) f <- system.file("ex/lux.shp", package="terra") v <- vect(f)[1,] mv1 <- mask(r, v) mv2 <- crop(r, v, mask=TRUE) } \keyword{methods} \keyword{spatial} terra/man/convhull.Rd0000644000176200001440000000537514736542233014306 0ustar liggesusers\name{hull} \docType{methods} \alias{hull} \alias{hull,SpatVector-method} \alias{convHull} \alias{convHull,SpatVector-method} \alias{minRect} \alias{minRect,SpatVector-method} \alias{minCircle} \alias{minCircle,SpatVector-method} \title{ Convex, concave, rectangular and circular hulls } \description{ Compute hulls around SpatVector geometries. This can be the convex hull, the minimal bounding rotated rectangle, the minimal bounding circle, or a concave hull. The concaveness of the concave hull can be specified in different ways. The old methods \code{convHull}, \code{minRect} and \code{minCircle} are deprecated and will be removed in a future version. } \usage{ \S4method{hull}{SpatVector}(x, type="convex", by="", param=1, allowHoles=TRUE, tight=TRUE) } \arguments{ \item{x}{SpatVector} \item{type}{character. One of "convex", "rectangle", "circle", "concave_ratio", "concave_length"} \item{by}{character (variable name), to get a new geometry for groups of input geometries} \item{param}{numeric between 0 and 1. For the "concave_*" types only. For \code{type="concave_ratio"} this is The edge length ratio value, between 0 and 1. For \code{type="concave_length"} this the maximum edge length (a value > 0). For \code{type="concave_polygons"} thism specifies the maximum Edge Length as a fraction of the difference between the longest and shortest edge lengths between the polygons. This normalizes the maximum edge length to be scale-free. A value of 1 produces the convex hull; a value of 0 produces the original polygons} \item{allowHoles}{logical. May the output polygons contain holes? For "concave_*" methods only} \item{tight}{logical. Should the hull follow the outer boundaries of the input polygons? For "concave_length" with polygon geometry only} } \value{ SpatVector } \details{ A concave hull is a polygon which contains all the points of the input. It can be a better representation of the input data (typically points) than the convex hull. There are many possible convex hulls with different degrees of concaveness. These can be created with argument \code{param}. The hull is constructed by removing the longest outer edges of the Delaunay Triangulation of the space between the polygons, until the target criterion \code{param} is reached. If \code{type="concave_ratio"}, \code{param} expresses is the ratio between the lengths of the longest and shortest edges. 1 produces the convex hull; 0 produces a hull with maximum concaveness. If \code{type="concave_length"}, \code{param} specifies the maximm edge length. A large value produces the convex hull, 0 produces the hull of maximum concaveness. } \examples{ p <- vect(system.file("ex/lux.shp", package="terra")) h <- hull(p) hh <- hull(p, "convex", by="NAME_1") } \keyword{methods} \keyword{spatial} terra/man/selectHigh.Rd0000644000176200001440000000151714720177426014526 0ustar liggesusers\name{selectHighest} \docType{methods} \alias{selectHighest} \alias{selectHighest,SpatRaster-method} \title{select cells with high or low values} \description{ Identify n cells that have the highest or lowest values in the first layer of a SpatRaster. } \usage{ \S4method{selectHighest}{SpatRaster}(x, n, low=FALSE) } \arguments{ \item{x}{SpatRaster. Only the first layer is processed} \item{n}{The number of cells to select} \item{low}{logical. If \code{TRUE}, the lowest values are selected instead of the highest values} } \value{ SpatRaster } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) x <- selectHighest(r, 1000) y <- selectHighest(r, 1000, TRUE) m <- merge(y-1, x) levels(m) <- data.frame(id=0:1, elevation=c("low", "high")) plot(m) } \keyword{spatial} terra/man/crs.Rd0000644000176200001440000000612114611400504013213 0ustar liggesusers\name{crs} \docType{methods} \alias{crs} \alias{crs<-} \alias{crs,SpatExtent-method} \alias{crs,SpatRaster-method} \alias{crs,SpatRasterDataset-method} \alias{crs<-,SpatRaster-method} \alias{crs<-,SpatRaster,ANY-method} \alias{crs,SpatVector-method} \alias{crs,SpatVectorProxy-method} \alias{crs,SpatVectorCollection-method} \alias{crs<-,SpatVector-method} \alias{crs<-,SpatVector,ANY-method} \alias{crs,sf-method} \alias{crs,character-method} \title{ Get or set a coordinate reference system } \description{ Get or set the coordinate reference system (CRS), also referred to as a "projection", of a SpatRaster or SpatVector. Setting a new CRS does not change the data itself, it just changes the label. So you should only set the CRS of a dataset (if it does not come with one) to what it *is*, not to what you would *like it to be*. See \code{\link{project}} to *transform* an object from one CRS to another. } \usage{ \S4method{crs}{SpatRaster}(x, proj=FALSE, describe=FALSE, parse=FALSE) \S4method{crs}{SpatVector}(x, proj=FALSE, describe=FALSE, parse=FALSE) \S4method{crs}{character}(x, proj=FALSE, describe=FALSE, parse=FALSE) \S4method{crs}{SpatRaster}(x, warn=FALSE)<-value \S4method{crs}{SpatVector}(x, warn=FALSE)<-value } \arguments{ \item{x}{SpatRaster or SpatVector} \item{proj}{logical. If \code{TRUE} the crs is returned in PROJ-string notation} \item{describe}{logical. If \code{TRUE} the name, EPSG code, and the name and extent of the area of use are returned if known} \item{warn}{logical. If \code{TRUE}, a message is printed when the object already has a non-empty crs} \item{value}{character string describing a coordinate reference system. This can be in a WKT format, as a code such as "EPSG:4326", or a PROJ-string format such as "+proj=utm +zone=12" (see Note)} \item{parse}{logical. If \code{TRUE}, wkt parts are parsed into a vector (each line becomes an element)} } \note{ Projections are handled by the PROJ/GDAL libraries. The PROJ developers suggest to define a CRS with the WKT2 or : notation. It is not practical to define one's own custom CRS with WKT2, and the the : system only covers a handful of (commonly used) CRSs. To work around this problem it is still possible to use the deprecated PROJ-string notation (\code{+proj=...}) with one major caveat: the datum should be WGS84 (or the equivalent NAD83) -- if you want to transform your data to a coordinate reference system with a different datum. Thus as long as you use WGS84, or an ellipsoid instead of a datum, you can safely use PROJ-strings to represent your CRS; including to define your own custom CRS. You can also set the crs to "local" to get an informal coordinate system on an arbitrary Euclidean (Cartesian) plane with units in meter. } \value{ character or modified SpatRaster/Vector } \examples{ r <- rast() crs(r) crs(r, describe=TRUE, proj=TRUE) crs(r) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84" crs(r) # You can use epsg codes crs(r) <- "epsg:25831" crs(r, describe=TRUE)$area crs("epsg:25831", describe=TRUE) } \keyword{ spatial } terra/man/replace_layers.Rd0000644000176200001440000000250014536376240015432 0ustar liggesusers\name{replace_layers} \docType{methods} \alias{[[<-} \alias{[[<-,SpatRaster,character-method} \alias{[[<-,SpatRaster,numeric-method} \alias{[[<-,SpatVector,character-method} \alias{[[<-,SpatVector,numeric-method} \title{Replace layers or variables} \description{ Replace the layers of SpatRaster with (layers from) another SpatRaster or replace variables of a SpatVector. You can also create new layers/variables with these methods. } \value{SpatRaster} \usage{ \S4method{[[}{SpatRaster,numeric}(x, i) <- value \S4method{[[}{SpatRaster,character}(x, i) <- value \S4method{[[}{SpatVector,numeric}(x, i) <- value \S4method{[[}{SpatVector,character}(x, i) <- value } \arguments{ \item{x}{SpatRaster or SpatVector} \item{i}{if \code{x} is a SpatRaster: layer number(s) of name(s). If \code{x} is a SpatVector: variable number(s) or name(s) (column of the attributes)} \item{value}{if \code{x} is a SpatRaster: SpatRaster for which this \code{TRUE}: \code{nlyr(value) == length(i)}. if \code{x} is a SpatVector: vector or data.frame} } \seealso{\code{\link{$<-}, \link{[<-}}} \examples{ # raster s <- rast(system.file("ex/logo.tif", package="terra")) s[["red"]] <- mean(s) s[[2]] <- sqrt(s[[1]]) # vector v <- vect(system.file("ex/lux.shp", package="terra")) v[["ID_1"]] <- 12:1 } \keyword{methods} \keyword{spatial} terra/man/vector_layers.Rd0000644000176200001440000000106114536376240015322 0ustar liggesusers\name{vector_layers} \alias{vector_layers} \title{List or remove layers from a vector file} \description{ List or remove layers from a vector file that supports layers such as GPGK } \usage{ vector_layers(filename, delete="", return_error=FALSE) } \arguments{ \item{filename}{character. filename} \item{delete}{character. layers to be deleted (ignored if the value is \code{""}} \item{return_error}{logical. If \code{TRUE}, an error occurs if some layers cannot be deleted. Otherwise a warning is given} } \keyword{ spatial } \keyword{ methods } terra/man/buffer.Rd0000644000176200001440000000465314536456313013724 0ustar liggesusers\name{buffer} \alias{buffer} \alias{buffer,SpatRaster-method} \alias{buffer,SpatVector-method} \title{Create a buffer around vector geometries or raster patches} \description{ Calculate a buffer around all cells that are not \code{NA} in a SpatRaster, or around the geometries of a SpatVector. SpatRaster cells inside the buffer distance get a value of 1. Note that the distance unit of the buffer \code{width} parameter is meters if the CRS is (\code{+proj=longlat}), and in map units (typically also meters) if not. } \usage{ \S4method{buffer}{SpatRaster}(x, width, background=0, filename="", ...) \S4method{buffer}{SpatVector}(x, width, quadsegs=10, capstyle="round", joinstyle="round", mitrelimit=NA, singlesided=FALSE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{width}{numeric. Unit is meter if \code{x} has a longitude/latitude CRS, or in the units of the coordinate reference system in other cases (typically also meter). The value should be > 0 if \code{x} is a SpatRaster. If \code{x} is a SpatVector, this argument is vectorized, meaning that you can provide a different value for each geometry in \code{x}; and you can also use the name of a variable in \code{x} that has the widths} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} \item{background}{numeric. value to assign to cells outside the buffer. If this value is zero or FALSE, a boolean SpatRaster is returned} \item{quadsegs}{positive integer. Number of line segments to use to draw a quart circle} \item{capstyle}{character. One of "round", "square" or "flat". Ignored if \code{is.lonlat(x)}} \item{joinstyle}{character. One of "round", "mitre" or "bevel". Ignored if \code{is.lonlat(x)}} \item{mitrelimit}{numeric. Place an upper bound on a mitre join to avoid it from extending very far from acute angles in the input geometry. Ignored if \code{is.lonlat(x)}} \item{singlesided}{logical. If \code{TRUE} a buffer is constructed on only one side of each input line. Ignored if \code{is.lonlat(x)}} } \value{ Same as \code{x} } \seealso{ \code{\link{distance}}, \code{\link{elongate}} } \examples{ r <- rast(ncols=36, nrows=18) r[500] <- 1 b <- buffer(r, width=5000000) plot(b) v <- vect(rbind(c(10,10), c(0,60)), crs="+proj=merc") b <- buffer(v, 20) plot(b) points(v) crs(v) <- "+proj=longlat" b <- buffer(v, 1500000) plot(b) points(v) } \keyword{spatial} terra/man/rapp.Rd0000644000176200001440000000541014536376240013405 0ustar liggesusers\name{rapp} \docType{methods} \alias{rapp} \alias{rapp,SpatRaster-method} \title{Range-apply} \description{ Apply a function to a range of the layers of a SpatRaster that varies by cell. The range is specified for each cell with one or two SpatRasters (arguments \code{first} and \code{last}). For either \code{first} or \code{last} you can use a single number instead. You cannot use single numbers for both \code{first} and \code{last} because in that case you could use \code{\link{app}} or \code{\link{Summary-methods}}, perhaps \code{\link{subset}}ting the layers of a SpatRaster. See \code{\link{selectRange}} to create a new SpatRaster by extracting one or more values starting at a cell-varying layer. } \usage{ \S4method{rapp}{SpatRaster}(x, first, last, fun, ..., allyrs=FALSE, fill=NA, clamp=FALSE, circular=FALSE, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{first}{SpatRaster or positive integer between 1 and nlyr(x), indicating the first layer in the range of layers to be considered} \item{last}{SpatRaster or positive integer between 1 and nlyr(x), indicating the last layer in the range to be considered} \item{fun}{function to be applied} \item{...}{additional arguments passed to \code{fun}} \item{allyrs}{logical. If \code{TRUE}, values for all layers are passed to \code{fun} but the values outside of the range are set to \code{fill}} \item{fill}{numeric. The fill value for the values outside of the range, for when \code{allyrs=TRUE}} \item{clamp}{logical. If \code{FALSE} and the specified range is outside \code{1:nlyr(x)} all cells are considered \code{NA}. Otherwise, the invalid part of the range is ignored} \item{circular}{logical. If \code{TRUE} the values are considered circular, such as the days of the year. In that case, if first > last the layers used are c(first:nlyr(x), 1:last). Otherwise, the range would be considered invalid and \code{NA} would be returned} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{selectRange}}, \code{\link{app}}, \code{\link{Summary-methods}}, \code{\link{lapp}}, \code{\link{tapp}}} \examples{ r <- rast(ncols=9, nrows=9) values(r) <- 1:ncell(r) s <- c(r, r, r, r, r, r) s <- s * 1:6 s[1:2] <- NA start <- end <- rast(r) start[] <- 1:3 end[] <- 4:6 a <- rapp(s, start, end, fun="mean") b <- rapp(s, start, 2, fun="mean") # cumsum from start to nlyr(x). return all layers r <- rapp(s, start, nlyr(s), cumsum, allyrs=TRUE, fill=0) # return only the final value rr <- rapp(s, start, nlyr(s), function(i) max(cumsum(i))) } \keyword{methods} \keyword{spatial} terra/man/diff.Rd0000644000176200001440000000114414536376240013353 0ustar liggesusers\name{diff} \alias{diff} \alias{diff,SpatRaster-method} \title{Lagged differences} \description{ Compute the difference between consecutive layers in a SpatRaster. } \usage{ \S4method{diff}{SpatRaster}(x, lag=1, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{lag}{positive integer indicating which lag to use} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) d <- diff(s) } \keyword{methods} \keyword{spatial} terra/man/figures/0000755000176200001440000000000014536376240013620 5ustar liggesusersterra/man/figures/logo.png0000644000176200001440000010616714536376240015301 0ustar liggesusersPNG  IHDRq4<sBIT|d IDATxmp[ם?H($"5%mJ:ήHU#)j[z3v\՛l;qU:IS6{gUglUT?Iz3SI*lgXtbdlP = q{9離:{,s~+C{:$i, bCGA+K"" @ߝS,&ED HU ,N..)O߽@5wxt_ [*- v_T*^ OJ..yo}"cuH|AY'BZJՒ4}Q䧲T"#4HtచbI^)O{cԏ;D-8T*M.J9Y\8OߝT=@m` J%yaCx!<܉0!DnU*&E^맞S=vT*m`ܙx7_Q=@eTyFTuy_#8C UE5'Bh뽇ZJ" /җ}"@~=Ԋ P+!P?!\D^%@ BރsK0z./ DC=C_E{} p!lDA?%~З"C_G{0} !,%6/"` T{'6BK@e,C_!D{KMFVЗ%E/|lC_O"8!DCA=z`ї'BO{} MЗB{p} =ЗBG{p} Kx!ƒ=Gԣ/} "Dx={}З} !Dx={}ї} Dރ=9KG_0} Kazz/ F"Dރ=З} "4GAKG_{P} K!zzE_B%E={ї} "4@AЗP^{PZ%ԣ/B"@`} MЗP2zz} =ЗPzz} Kz{8z%Cp={&K8zzPK8a#zz} K8az{芾z%E={莾&K؂Q#zz0 } =З!"zz0} KԎa=z%#DTރ=&KT zz z/6B =KG_bu;{PKKG_be=/ }zK,mzXC_B=> ԣ@}K羄B={%4þ/B={%৾C={%K_³!ރzPz^Kx.D{Ԣ/ %<"=z/%@їPK} C=`y/adz& K"=@_B&%@o/i} C=%3/mz } Mhޗ.D{tKh"=} tKh"=Gz:%zzA_B%zzjA_B*zz@_B=U} B=C8zn%,]$zpk!=7їPT*MK{opN;@MAtI 6UDCck_',R*Uw@4;+&.ԑkC{:MǶj{:/VIJ' ٽ1wiKj{:/VT\\̏$l C{kl u=ЗPT*M66;v-!bݟ-@p=qRj P?y}CCTD^uP=z K(?y Hy XCvPXz㪇&OHf>zЗPPg ؚCw{X#?yR0p~RɄa D_]Rjcc`֎DMw56e=dl"@ 6e=wI4rƕ@bilhP_-o9D; m&<߈-=m'L8,t466 <1` +}w;$Ҿ@_cDdYKψ4|PPlgt: MA-=nQ= H`}=Uߩ ZD2 J K=jVDz%Uj ~DU!j\/=,]}clgD֯S=O }`U˚ּ{;<DK8T5˚֜b=(˖lTKSsr5|AWZ5> ,cїO ]Ϯ5Cޡ>)E_@?VxgKvԡ/Q@ T_whPej8@/Qf#V  ͖N;z/Qf#C})8>*`UX~LܺƝߗ2qVKҟ]ҧlD Zcc;KXmY:3'|OɄ# K$|Fv5Byr_}c$/_\&zH 6ۥLr1=PXbјI=}vIO"u zD2!)IϧeܤL)8?"+i"9%_x]PXH,xoK,c'O?U,%IWKb.mUoXM:?pM| %#y1(" pë-۷Ȯ][~X4v&7~=ą 92~f蛓'y\vrϼ//r߿} lWH'^uw}M$݃ez+7%Wxoi$H8ϭ?q#ge'%J8$r}9S$}9[dtψ f$[nDrJ)91ILU"ބCA;9}cE,rzx?= "Kb pܸ]oK{C@3{ Jo2ovgFgFI9:vL%#&($1}֫ etϨڥ{yÀOX t:/u%lo3"JE>cO艣r7y¹rH(,۷n>w `%A,6tɡwE?9(GOW=$DBa9|Ko/>Ģ]&N5n}u|_q`(y>`6/ܠ&יt'y܈Peb*|ڱW `_X y~Kvvɗ{RyUC+ ]U}*?3"۷7LPKu)oJ6Y8Ml`SPP7)^}ٗVb>0>ѳE#_#~z8ft&4yIJŢ%(Tw툶 C{k7SEO=SɄ}|ǵ%q$~ʳW.>3]`I&GƦDש'sz%@zV0 E?q"P^p64}Qh!ʗ{W3?H8X´,ewkٷgDؓGJuSk!5KO{s h xqD}Ί}{Fs|aPC],$b̸QvI3FTrp~3>Dp`r>yϩ x!8w\U= 6FT EkaJ"8.5Hpf#* FX_~+,VXҖ4"DpIcvQ--$f#*"}2@[GvKtɄy_&OJ"9%&ovPX¡{d黧Oٌ2gDNPr}Nۭ׏If>z(%)R'd'd7Bůόѱc"r}6zxwOqSm؏O"ɄL$2qnR!?=?'a?풁Zl[8Œ |r4_e Iy՗%FeF\ ܔ@7vF32vrL&MʩNrg/+}{FΔ+|v{Fdߞ׮׏ɑډ91&Q?$c8!)WوD2!c'**h'SH'$rgV>:@ B`;71%[}A&O:{䔼2q~ҵj8$՗]nVܹED$K$N">!'=2y~R&M^3ɬdҵK&/Lr}+o}7g۾^B|V{F\ۍi¤|/H"cd̸3.GH&/LTZsϱZ/|o|3GOUߕg#//|/v=B`؆.y`p9rGZ`;Nc'Ohuҫߖ#a /?vN 䃟"b`x&zo̒'\7S=Х³[J: DKnt "ϒpxl^X4qae9igmߩj%PDbјt@P؆.ǧKu5 G_%M249;$9e+{W> BQ&4i8kGB{}'>ʑczuj_LnN&d¥zrIgw3=;ܗOrfD$qٛ]i8[^ęĴ˼L&^9~H DOkއĵG_?zZ"X15|/EP͍ZG;Qls;KLtW|]2ƤkC-Q>wn罯Ǽ<@WuqDFP1Ayz7Cbz7˕4VH(,޸IOz$!&0c wOd/o˫U1>=KH'N`<. h;ULRw)_"w@vfBCTWL*m:S o=#oψP.PH)7v1Դ}6tɡ" dJMu@/=V=-3fDBac_v M"Kg2%UlCpH0h.nYi*^Ӟ9C`xP\[ǯe=D2!gޗD2!$$3uG_xf^3BL^the$ciqz}q•Y.nt""{2~fk~%[\Vz>#G&Gǎr=.+O5?=ە$ `8BzMǯ}뀄CaǯCFbzJ~vu<nn#|fǯK{x!@N$t S2vBӮ#|Ot:߸~15oЋYFPϼ5c'Oz(jϹeXDBǯW}׆!A` 4"}}]O<a" wo,_Z;=#Z͜""dkq}I瘅@`;ezNؓ[$C hōSU:# UWvC,%#oψ>3.}S&O=C}]u/(/80pe&]2v6DBa翪l 8r5(ޑhց7LF&.LTrJɄ$SO/z<vI,>mYm$'l}]?PD9yg 3O7|gUH8(M_^&H@|Z&Oer,%?9؆.9t3bkNǔ5auO<xM׮vɗ{ReHhO=+ #_mJ]|kŁJN'yk99/eedӒH&n[j %^'}=%]۾@uO˷6 qНkŁդ2~f\)pX- vjr&K$[}aY+'lA30 !+&O/>CXC9H}( H!Dp A:lZ2Af#TUM\XTaW5 DpI7"!`A#_󓪇dAD"9%O 믯;hf Srkx!2>:vLJ9{%H$X*؈@#_/<[ޔ7|ǯ "/u$1HN}3+q̸|!}SPUyҫlP@+Y y՗(aj)=/+2vrLP!DN"9%/|_1|F|ͳ fZi 33L~YEC2gD,Kg艣 G&coi3Yc&Y+L9 l$ۧzX:}f\N1Fx3S;yB HNI"yBNXKvvC02 I$80qp- ]>@ B` )v1:DrJc$.۷+>K$v| 'e̸LS2&1pkb`77&T#_.9Ʉ՛ƻo9^fG`]%ՃoV=I׆{7K,XK¡DBaEcUFz>#̜LMO]IH"9%&%10&4* lxoĢ]p("hl͠II$d_NO8oU. %ZYc!`z`9Jg2ܬ 3s"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB` !%"XB`IP`VٶmX[Nikd\vU&'~x !5kiiʎevK4-s֛LBj)DUG%[~%:adnb6,@ȶXM*yU Bߟf6Fg!ʘ諐/H:^kRWG>YOwW]V|2+Ug!fgIXtaD"|D'vg:þ}\!_X,2"D.OǧqK?Xԅ)K_?;s5:=g#F=z}rԜs gGq>Y2?=Wq\>`e$de~nDճbA&n_~6)LJJŵSpoԻ~,?[kK׵$)YAgX̦%{yB O'[#`]Zj]?G5 v >,D]˱Oخ/oliTMLVRɔ R,5*LVDxYՄ;1~|=Fuurٵ̵f3W%qce7f$},30!TBgpege÷t]˄YOKK Ob!Pk)5*5KV&#DxY쥉Iz⽚Wg#L(knie6G\Zҩ9|m֚%+2}9ho!DxYgʊdlb|-tjΑl ;SsU͒e3Y+PBG%:ٴdf#LݞU>AÀ cKS,Y|N_N;`!ƒTxҩg!n$EO941CYD7v2;3Z 7u-˻!ƒTBUł/Z>FT( jS,CMjrk\7 K5}f#@ٵZC-j|R!Dxb.mk ܩؘ-]0-ځ:XU瓒5P=BǼ??#)dᤴXPBjMgͫcsn`OJ@u3;;#KRJ]i-WbYzzsC(3 T-/:55aeJ(Y!DxЎ$m%7uk:5 Q&r?z3<,TVsc]p ZĮ@x!c"!ogٯgg vnz-5Ν5^+v| RzSb *ILq"!PurzgXL"UυٺX\ƶ[KG2X^ޯ~.shT~|N&ή DDJł%e-Yt#8!Tev%kqL] 7" VK([ٷ<%?^l1iIO'f9Mo??*7mmυ(sxJ|FNkߥSsZ+Qpԅ)C`a:3V$p-cDVtJ 饛@CPCY).n<]u$NH.q r3D;عa x~jy=Ssi_z(pX:5'y fK0T="KgEqՄ#բT,msw# Gw)[#  ~jyRIK_!_*$fuD뚅(?nD1\lp'TAD ʊd`W*" g}N1隞 YXGTb՝Y6v[̦%7}e6B=oLE wH*%k!0V[RA=KB:e\(wXF="rC\lͳ[;w=|*eo麖b(3^=I2u%g8q\y)Jy, ғkЁ]+\K:ڥł2?1ԃm gMs|]ԕKր;A입S<A5"ƥǝ;nO}?pN d%mCMt.3mK׵\K5L t+SW2P[Xx. iAԣ}c!"=+&WW*䥘-LWȋ EsI$gzɉer}YlPkHܿ)-$hvm;~iPI!_IO2SAZBm9 })ɦUcMRIJ%PĹ|&Bj͆oYپy4ݝ% ʳg+j9Xm[{an;%u-_MkNO" i )/{MsI>r]>[Qϖne闗vfEXdW%}zqz:a3]oꕎuss\7hVwWיZRɫeS{:LֳX !Bs֐-a` Жf*UN2!+9#3~KjL{d)?1L] K' oeֳŕI)s8%vjk:|fE6eaRWRFBq5^xax]'Wi IO]H^rFT\tˊ2#:8if#l淓M(J$qc_=. !d Dh̉尜=4XŜ;(%?cϮS-FhL±g$ud3YI%OleJ(Yr`9Ωz-cݲp5avo/,DIKVd3YzZ5)f!lZe[rTZpg+Y_۲TsK+[.FsWIL{vYeJ d߬>}6f!oo7bG;:u&wYT*Ϟ}azJ:kHkH&~uZn[Z̻zrh4wz?idl }wK>dSho/76KC˪\H{D ^)SW2;sMBB>xo"kնo&}|N{ܩb.ku g$+ IDAT8[Sx#y뭟 l -wФW""kii۰ވpjƗwmFnRk!D˩lOl~aͯQ͙Y̦X@?i[D \`}ů- 6-mo._ S&rsOƕ?W4>'nJV\n\z(qj X'.QMKeu!7}QZ~׹5gm}Z9%/I.yIDD[#7Si ŅKwB =3ʼ}v暴mh3j6b^x2u%+)3s O&GsIk t;6o`ScXH^\K촘MK!B:4 SyC[{yq=ietjNd3YI~߼^b!BN kհ$w]bA2gm N1 Qm=[= Ϭ>7I'4~&1c^ 0s T^up-^1f$sግR~ IL818Zbh얯~(SWb!B,'+9ub6-dj^(axף~s!_{y'L] 'YK7ƪyTvIyyWߒVNIG2ےK^tlL*l߼MazDSX_,er҆ѸoeJ8^ 5Bh<HUڭ6jhJc(rȋM2e@N~͎'uׅml&+LֈݚVX,LbS}P=MJv* 7v4ZiW#u%:%@E{ Wfl}=' d "qz 쳴nLĽ`,?ȕ‰NBvAuv'/0!!D(B0Xߩ25V׹uz#7?⩯8B,g`|gˍLZ8:l{af|Afg܊ :?`-4Ӷaτ55î8tЮԫmŢ||c9朜?sN&!D,ePو^x%9$*5KӖ~«% SdX,JXtjN\J"D)(SkdO[E)ϙk7-_u035zaҩ9ɭ9HXCpy>覬q;]uy.EC0w|RC a !E<췭'N'&q&[E]٧_ m%Bh6[俿h'pgٙkҶM=+l!U,hh֦e Vi\`T+ U=H%J="&nCMƻ炥%BNxڣH鱌C~u-ӗҽkܙkgS"$ҾnٯIXHWOListrRblrp4p?͚oYaobK׵-_ܖ>u5mJw֯bQ J#D8'~n Zu&D:CRAӝP Jf#D8={V NyNyª^?-c.;g٭l"i q`b )fgBnm)NO{uiǮe t/YئWnb kO8RɺAڣIMA{.qs6"u%zEm 8LVfg~]T*+<\~-7vH)(̚7mLΥQ髱)(Ɗ -Ҷa}Msѽ|&AFggf.LIqܠzԕDi#BD8X01 xK#*Ma++I=.DnU@P!‚ f!C%kt^=*ÊbXg7K֦,Q!?-IsI=2腛[7R, Z/"iirQ6m^J"rmb|K7n|šѨQftڴrJyc,+^ ?M9{邴Ɏ<8KO O~ èLbZ4;sM"ini^kө9er.=LVҩ9MY5噂eJfgIh]HZíKDTYXqf#tADDR_?a-U&Ԝ{MeR>IT2ZNM(SWBZBcɟ}9{ˣU7o3d՛[TO=ɛ%k?ה!D!f!PMIVc6Bw&M jkM+bܔ`^\ B*f!̺:Yy_5?{K#BlX{T0R$J'vC凛r3ۥN皒U `yjYNJr *fz)?ljٙknUe]vŎ,qDZC,-B-goP/J~uKX;Js+WnLz'n oP=qK_w)Y@ԅ)C[`K|~! pJW=%@cƑ衴XR=_!D Wz6ޥz0{F>NZ?|d6Bw:ө9TóF-@-"%/^SO:zF IK3ŝ㎴GdftټBGl +/k+JtAL~$[<"i[9wcIV^\U>5?usfkV[Z^k;pXkK׵w{ٜ?~c6NꎙČtG[ҩ˾&3;/%wihhP%.$M-R2qoޢÎs0$" %r"DPkJՒzIXo}K>~[Q_+TRQś(,%I\s3}A\r{em"}{+Fu陴ēbYT C*B^NךfeзZPz)D]ܑhoomK<)[>V%!2rH 3_ʙv[XnK ,Ʒ< [1vrt l9W&*Y%Lt1J Ǻ@C9uHKE"kYֻ-9vk*c#]ABK!˒ IHf{f0ܣ& mGnfrp?MVm?~ SS)غeʻ{IrG 6?;oLHXveI8v0*,$Y+Np3ba)A@'+vEJc3eIlKYm,+R9udpkgҏ41D.Pt6X ڝ{"tw&=ɺRɷjO;M׳QѨU}qsg=/_|"kx+Ch+]م9uc)x;#|]gҒJbQ~ڡQɫ݁܂+"k~8CY9岫X*ʹw?Z Gdh'#]a۶,T/Y~y-FNǏF@{+Q^cZ#_Ͱw&^i v]R$~z%Cˡ^#_^W(=\hۑ^7jGuVw]#ZvϑW5wMȝ~N4ڏ@o|ƯSYl۶%ůIOrBn˯yǞN4έ9*4zʍ__хӻA5ʧsDq` rL=5;#G>WQh8"9*{#xCd @\T.D?WhdItJ2@x#xCd  W:U~[T/p Np# slӹ@ ' C@ \,F)K &ggT/przFOy{DA D!]kZY"k<{#UlḰYu^Euw!k;Gn#_TdݳMBV`~{Ʋ#OZ.5"vKXrWxNiLw?:%o#(OuV͇ڳK3i)KZpDMW;A@km4h$55idͯGY;CGn#_Td =@Hak1,s D|"_Srp0'.2_{x|y]˘z=g.aޮd 98k}ALL1Zvp'[XHܹ7WXv RFE5|\G9" PW?7jO @d"`+#l*x5fm[iVrwpf fBԎ|f/DZc:_C`05_\Y(`.+%)ӎ-b{hT]b1lwCG^>z r<[~Q'n;T~Tb=J@ +Z>jva49';%k7{oV^Ӆ#aV riGn#_@d pRRS O+z!]#Bvބ\2P"k;fGNMzR{"< 0.\.Dj"k;aAPz!"!:Y9şǢKE|5Dovٽ Ԝ%!B^Bk|1DeukLx#_ 107YCtaO3@BlzZcrȗ׍?ҵ~_P"k¶@>S!vCѧQ5wMȝ:Ƣ~3^˦2|JwACdv!P囝Sݏ̻X,ʙ m9s!8u< ]ۓ},Dڢm|~bjc@\VX(H6ūN|o9L2V=ﰜe爩dzkLqC!= DD|y]^8Ģ 馽JT3NѪ.{Ǧ'U/P?^qg#ȗO2Q{CR,wȗ'vo w|aold 9)s`pECB'&9svU?sK+ 5ܔM=D֭c+t ynb(_0/Fܛz=(ILJBY!ׯM>7+ ˨zGn`* s9y8`:nn QpX>u@2pϙ~X*ޮr`^ˀ$w5LZlV #1DQvJC2pSnyU:/s|D0y?ٺ-!.V88F'&g'b(~߁N,Kv%I " ΡT/a]N<7GN8F߹7!wNgv̤LgU/>%]Ѳ{3]wnxѬ7'y!ٴoiW G뗮N}okL:я3wMe Dd8l5&}cj'X*ʩgT/㡑/;*쌜яM "R)WD֍a@ˎ>1OM785ͺO?6I "0D%p It8Wv^+t~]wJ39-"1D%>%'সsoB+?^\֮pC4Q;z 7?R#0Di{~'&QʏWC\|-Uʪ@<1yT(Yׁ!M=ґQuW_,hg v8[|1D)Ai}rꬷG)O?g^* *K=43uLpxʏϻOrkr\2(%%zsa@N<%l'A+|aQ~Ow6iU/"aٶkeh_hGMHͼ)G~3?UsP;;-_XS|aARh ݃e1 RUrDDdL#n=G$9f"аYoBHͥY9?g]_%;S IDAT<^yJъr,'n̩LVܢz 91DX%d܁K h?];/;%*㋟$uSzJv9ㆈ|aARLg8@k hXR/.>iW{G|:X*nG?n>zCzބݿN}Od_HMͩ^Qץgӎ~VĶm"`|:'E0Tʱ-rEsx ) ),}KkgaWmo̦2O%̑XǦe>h:>7YٹgWKG٥gض-ٴlߩib@o WL># )u at~n+?ɦ|&𪜕O$"19~ Ecg8 (,ddfXg]ɯ' ;>3D=JeI(ÄޟJ]F EغEm~|:g| Z\p$,v.tR2ʏ$%EkbNM3L@[m&doFTg^6'8fYU/mbIsbUn|:'9gJRx/YOq([% ^o~JH GŢ% hŶmedoݺ?DDv۹'zE^m[ gbYO! /nR)W$} ҳ[pUq& {yݵG2cab_ yu ܂TU̒u6'oY?U(/K_zXxsͧrE7r$[q~hKGOȷzdgB #X.tjZ Ac//&{MDd]{P(qf+2? 俼Nm{ݧ񩩔 ~mZJX&n!5TEcaT*\a=-?yXT۷+N[ZfIMcm@N.:  (vk}wDV .~lU0CJZ%[tnymr,][U/8ͶĶ@ob1YZZ|aA`v _ܻuﺈnJ6+2{k*ޟ|&/vnf'x tN≸oi|:J5塓 @_ H&qr뚌O+^tWX(Hz6-E.&}Z_|۵~|_D_iZ^B?tNrBl).5p$|AFH Ԏ=2xH];vCgU&;""e-"4O礸PxSۓhٴ%Za tNڷǺ3W# ˋGys" }""269.7d|r\8)lۖl*+ٹL^mdؙKf#aInOʃyI [Y%O-rEcg!(U,K:>`YmCbd8w=5d!bjTض-ٹ$w$%DmK< lMb@$ 98^wؠ61t>k̃ ==4Ǯ[?o_sxs]mVpݛH@#OsQ>,q1yeeƚNMKTԴL/-U*˧{{9Dъ-˓oS܍[؞%nGT2_5BtYoBd!݈KR$O 햎-,Kvſ X]dr^jCl[n۶Z" "F8^y~{m*˲$]s ⸵,EbG?)iQ?> z{!BD+/ܲ,䚂^1rEޜP /x݃sֺb>}.~تʶmY-Jq(-btn$5rz*/=!=e@,92xH )BAfJf6CB!{]l:Dܻu=}ݡ~+MeRYh,0܂gU/Q)Wj$S-?pLV @a۶OKjrN}p].?m6"DDiPHR.d1(]UUǧxOKٽUBMy;^am[2s;#EN]r҃ɯ'6}[C,b}ʰ&zop+TڝnP32:vC޺f)Otn_p‡|Ϻv"D_kzbpWH$r%U?.(Ov߿X$&{X,];vsO?+GI2‚ fG[~qo޻?|bpUP7+LN2`A=򕓘NM˅/.՛T/eM .'{ޡpWP{"ժe *Ķj$& q߿a?1lض^Zjz:;{ڬKf wZ GnKGOȋG9x&kv'٭i(NUA~B:9v_ ~][ lvّaI{pSa ٴymWm;>ko#7+ :êK^mVz ݸՓr5Rݛ>z|sA27t^ !$ tjvu޲7[فqzN|Œ,D}KoC/Gr?d)2nDMw'iXͱ!Bd&˲?`PϽn4DpKzvJGge4G|hB(|2#푘t@_?1Wo^+=;AV+0!B᥿B:5KOCݛl'o  =z卓K,SrP(25?ʠЈD>6F/. B#_=$5 2ǦKÃd֨oޒ|^R˶/.}pOخ "Gڶޤ;0DTdzx|22-`w֨QK ,ۖۖeyԅmn}`{{j˲EBϻJ"TV*%ƢbE,n[|CVnX1@e:5-ӯdv /E!$\Fbј$;&¢oS^Z^w󳸺sϬ9K8;ٹS~N%'=I:pL2y ľ}7 ُiY,,^N`ygCD zQ)W{Z_꧋eɮ=}-0_|v4ȰV W"1߿O<&=h__տT:F<"DOp ~.c%!B+T(75,KVp$,[mzy%rzJ2_቞:pLRxAvU޲_8ytk 5+h_U=V]z47p~}=zex*O@o Bl[,,?~9=|ZR*CRW.EWj9).%0@Mc\ݐgkr5Ã؝=ضܶCKZDF/D}؉h ;͉Ebrx!߿Oz{DNSWo^_zZ`wS=lD!B^Bch CDz_e˿L`Tv'CF"j%@/60D/Iow'b@ Krd<Cm2>^SBdddX>^>&1cMtzЩ{؈CDϽ%"o :'Z>t^X$}XrvFo;݃z6LkHjjNc-݃x L+_QCs~k.wNxAv1jyik.U%ȂK %t;jgzbZs sd\Š7/=zxE)`Fn;+v'Eݻ9DKK8q۳eYNHlK+ӟmےL5c.[%IJ,W֚Ã]@_?CC@ѯdteΡ{7ùTYF5q!y چK2_k݉}=ʠ(tY"D%tA/ WNJOw@\2X$|c˿{ЃF|3DK!Ƚv/4jҹEPحA&wQC/^{ W2<>\s*%≇~Cl={؈oz %xB~>_.W'Aޝ{POF|?DK^w+Lx丼ѯX9iwA~6!^B0KGOȋGO^4Q( y ~ݝ{Ѓ_jP^&9#c7dtbwA=1Dl^BpCJE!S2:vԥG}=tz{CD%@/1<GTq4hI,ĎAtchzpB2}|P*tj+JpK=q MP^H˦R2`a*5+JT"v'ԣ{hCD%@/zzSt f=5 -#/^}{GkjM]LzwAt`pzI2h`$۶+7o=(dr۲Bvԧo^0D8^B=z%)2<2,z)@S ?+rER .D<$/=! E7YRQ.}q[aBAҳi).T/%Ж-<K^j=ّa˶mIϤ%Q} P^||k04d۶dSYeĶm ,0Dx^B=z պP8dlr\Ύ MXt=x!cz0Ѵ0ye$ѴOs9;2,Wo]S)tz{P!B1z %$I{4&hLĪN]h%Atz`za@t=!B#zR/$ٙDkP*|reXSӪ4Atbzx@/($㉇ xm ~@1D^B=D=DgB[Ƥo耣Zt=!zpXQrKbyX/7AgRQݼ&Wo])^Y@`K衞^"_1<=Leڭk_{݃" E/^"O^| ,O@`6KO˛]^Yߠ{P"|^B엟e[6KZ)K#==CK[K~1LRQƧelr\ƦƹBa!z um{8Lah@="|^Bm]# IDAT/O~طT/V(etLetd<=G >G/z x)ȝq݃!" %@/pAt0KI߀ {C01Dzh丌ߐ7q+A=`c0z =K,{"@/ z וetz{@ CP^"DKG/L:{Pa%@/ RQGT/݃l^B569.~ {KG//RQ~s=z)rtz{@#"z %w%ddh= h%̓e7NB 4!MΎ ˅}@=b@%ԣ4Atp CC/>݃ztpCE/z 5ix݃^B+r5݃&^B=z w8== zu%`}t=K  %@1DszTjZ/vU@U" zz|p4݃CP^q_.V @+t=@ %8u X ݃h^BA%ҹ|xᴌNP@tz{"%z KJE%p݃3h^B=?7 %)+PCLK/D&ѱ2:~XAt0CA/zB(өi_uE!ơPO^P*ʵdtLi5=b%ӭ(r5KFLKAu/ K@}@?`/K^mےLI>S@{0DW%󪗸z|22L( lAt#zncrvdYM,$5{P~ߢЃSP=="{zhH2M=AP^P*Ȱ\+E C^Bz N\G!D/P?== "hz';%=)HXR=`D^BH0Qtz{@/^8ēhA=q *zh.vn'݃1D렗At"MKgYlݖ=CP'z %Wt=a@/h,*;vGq @%@/S=hCz %`==c@/tG!zn@8!p%݃w0D.P^*=pC2z %o0DB; %@/=Czh݃u"%ԣ@ԣ{c6C@ &%@/@! z{'@SK݃zt"K^"8@!0%At9"KG//tz{^B=z =G!0%Cl %@/?==zz{/ KG/b|^B=/%@/==z{ @KG/<a^B{L @@K^qtz{!8z %C" P^b}t=X!Cz݃1zr/Aa.z K=f"l^B t=CK݃4!@C%^At)K=@+"^B=z 8!@%s/ANaz =K="8^B=ս݃!k%SK=Gm \E//z ==COK^AtS9K= P^A=*1DP^Btz{C%Q/Q)W$={P."h^BDb RT\,KPR@{ڡ=C-K !%4tL;&a`z 1D0"^{`:ƣ)Cߠ C_nC_jt!Kkt!@ Kmt!@`K-t!@K)t!@`KYt!@K^t!^{o0D Xk!6@/L0<"`uj۟CЫC? P ۮ·,Ӗ?"g;yK~oveKu]Pm[Jemv_"^zZ>/!덪-ϻ1T 100) } \keyword{spatial} terra/man/adjacent.Rd0000644000176200001440000000552414743554112014216 0ustar liggesusers\name{adjacent} \docType{methods} \alias{adjacent} \alias{adjacent,SpatRaster-method} \alias{adjacent,SpatVector-method} \title{Adjacent cells or polygons} \description{ Identify cells that are adjacent to a set of raster cells. Or identify adjacent polygons } \usage{ \S4method{adjacent}{SpatRaster}(x, cells, directions="rook", pairs=FALSE, include=FALSE, symmetrical=FALSE) \S4method{adjacent}{SpatVector}(x, type="rook", pairs=TRUE, symmetrical=FALSE) } \arguments{ \item{x}{SpatRaster, or SpatVector of polygons} \item{cells}{vector of cell numbers for which adjacent cells should be found. Cell numbers start with 1 in the upper-left corner and increase from left to right and from top to bottom} \item{directions}{character or matrix to indicated the directions in which cells are considered connected. The following character values are allowed: "rook" or "4" for the horizontal and vertical neighbors; "bishop" to get the diagonal neighbors; "queen" or "8" to get the vertical, horizontal and diagonal neighbors; or "16" for knight and one-cell queen move neighbors. If \code{directions} is a matrix it should have odd dimensions and have logical (or 0, 1) values} \item{pairs}{logical. If \code{TRUE}, a two-column matrix of pairs of adjacent cells is returned. If \code{x} is a \code{SpatRaster} and \code{pairs} is \code{FALSE}, an \code{n*m} matrix is returned where the number of rows \code{n} is \code{length(cells)} and the number of columns \code{m} is the number of neighbors requested with \code{directions}} \item{include}{logical. Should the focal cells be included in the result?} \item{type}{character. One of "rook", "queen", "touches", or "intersects". "queen" and "touches" are synonyms. "rook" exclude polygons that touch at a single node only. "intersects" includes polygons that touch or overlap} \item{symmetrical}{logical. If \code{TRUE} and \code{pairs=TRUE}, an adjacent pair is only included once. For example, if polygon 1 is adjacent to polygon 3, the implied adjacency between 3 and 1 is not reported} } \note{ When using global lon/lat rasters, adjacent cells at the other side of the date-line are included. } \seealso{\code{\link{relate}, \link{nearby}, \link{nearest}}} \value{ matrix } \examples{ r <- rast(nrows=10, ncols=10) adjacent(r, cells=c(1, 5, 55), directions="queen") r <- rast(nrows=10, ncols=10, crs="+proj=utm +zone=1 +datum=WGS84") adjacent(r, cells=11, directions="rook") #same as rk <- matrix(c(0,1,0,1,0,1,0,1,0), 3, 3) adjacent(r, cells=11, directions=rk) ## note that with global lat/lon data the E and W connect r <- rast(nrows=10, ncols=10, crs="+proj=longlat +datum=WGS84") adjacent(r, cells=11, directions="rook") f <- system.file("ex/lux.shp", package="terra") v <- vect(f) a <- adjacent(v, symmetrical=TRUE) head(a) } \keyword{spatial} terra/man/SpatExtent-class.Rd0000644000176200001440000000122614547074142015644 0ustar liggesusers\name{SpatExtent-class} \docType{class} \alias{SpatExtent} \alias{SpatExtent-class} \alias{Rcpp_SpatExtent-class} \alias{show,SpatExtent-method} \title{Class "SpatExtent" } \description{ Objects of class SpatExtent are used to define the spatial extent (extremes) of objects of the SpatRaster class. } \section{Objects from the Class}{ You can use the \code{\link{ext}} function to create SpatExtent objects, or to extract them from a SpatRaster, SpatVector or related objects. } \section{Methods}{ \describe{ \item{show}{display values of a SpatExtent object } } } \examples{ e <- ext(-180, 180, -90, 90) e } \keyword{classes} \keyword{spatial} terra/man/wrapCache.Rd0000644000176200001440000000264114536376240014343 0ustar liggesusers\name{wrapCache} \alias{wrapCache} \alias{wrapCache,SpatRaster-method} \title{SpatRaster wrap with caching options} \description{ Use \code{wrap} to pack a SpatRaster with caching options. See \code{\link{wrap}} for the general approach that is easier and better to use in most cases. This method allows for specifying a folder, or filenames, to cache all sources of a SpatRaster in a specific location (on disk). } \usage{ \S4method{wrapCache}{SpatRaster}(x, filename=NULL, path=NULL, overwrite=FALSE, ...) } \arguments{ \item{x}{SpatRaster} \item{filename}{character. A single filename, or one filename per SpatRaster data source. If not \code{NULL}, the raster sources are saved in these files} \item{path}{character. If not \code{NULL}, the path where raster sources will be saved. Ignored if filenames is not \code{NULL}} \item{overwrite}{Should existing files be overwritten when \code{files} or \code{path} is not \code{NULL}? If this value is not \code{TRUE} or \code{FALSE}, only files that do not exist are created} \item{...}{Additional arguments for \code{writeRaster}. Only used for raster sources that are in memory, as other sources are cached by copying the files} } \value{ PackedSpatRaster } \seealso{\code{\link{wrap}}, \code{\link{unwrap}}} \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) x <- wrapCache(r, path=tempdir()) x } \keyword{ spatial } \keyword{ methods } terra/man/north.Rd0000644000176200001440000000343514536376240013602 0ustar liggesusers\name{north} \alias{north} \title{North arrow} \description{ Add a (North) arrow to a map } \usage{ north(xy=NULL, type=1, label="N", angle=0, d, head=0.1, xpd=TRUE, ...) } \arguments{ \item{xy}{numeric. x and y coordinate to place the arrow. It can also be one of following character values: "bottomleft", "bottom", "bottomright", topleft", "top", "topright", "left", "right", or NULL} \item{type}{integer between 1 and 12, or a character (unicode) representation of a right pointing arrow such as \code{"\u27A9"}} \item{label}{character, to be printed near the arrow} \item{angle}{numeric. The angle of the arrow in degrees} \item{d}{numeric. Distance covered by the arrow in plot coordinates. Only applies to \code{type=1}} \item{head}{numeric. The size of the arrow "head", for \code{type=1}} \item{xpd}{logical. If \code{TRUE}, the scale bar or arrow can be outside the plot area} \item{...}{graphical arguments to be passed to other methods } } \value{ none } \seealso{ \code{\link[terra]{sbar}}, \code{\link[terra]{plot}}, \code{\link[terra]{inset}} } \examples{ f <- system.file("ex/meuse.tif", package="terra") r <- rast(f) plot(r) north() north(c(178550, 332500), d=250) \dontrun{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) plot(r, type="interval") sbar(15, c(6.3, 50), type="bar", below="km", label=c(0,7.5,15), cex=.8) north(type=3, cex=.8) north(xy=c(6.7, 49.9), type=2, angle=45, label="NE") north(xy=c(6.6, 49.7), type=5, cex=1.25) north(xy=c(5.5, 49.6), type=9) north(d=.05, xy=c(5.5, 50), angle=180, label="S", lwd=2, col="blue") ## all arrows r <- rast(res=10) values(r) <- 1 plot(r, col="white", axes=FALSE, legend=FALSE, mar=c(0,0,0,0), reset=TRUE) for (i in 1:12) { x = -200+i*30 north(xy=cbind(x,30), type=i) text(x, -20, i, xpd=TRUE) } } } \keyword{spatial} terra/man/combineGeoms.Rd0000644000176200001440000000572114741531432015051 0ustar liggesusers\name{combineGeoms} \docType{methods} \alias{combineGeoms} \alias{combineGeoms,SpatVector,SpatVector-method} \title{ Combine geometries } \description{ Combine the geometries of one SpatVector with those of another. Geometries can be combined based on overlap, shared boundaries and distance (in that order of operation). The typical use-case of this method is when you are editing geometries and you have a number of small polygons in one SpatVector that should be part of the geometries of the another SpatVector; perhaps because they were small holes inbetween the borders of two SpatVectors. To append SpatVectors use `rbind` and see methods like \code{intersect} and \code{union} for "normal" polygons combinations. } \usage{ \S4method{combineGeoms}{SpatVector,SpatVector}(x, y, overlap=TRUE, boundary=TRUE, distance=TRUE, append=TRUE, minover=0.1, maxdist=Inf, dissolve=TRUE, erase=TRUE) } \arguments{ \item{x}{SpatVector of polygons} \item{y}{SpatVector of polygons geometries that are to be combined with \code{x}} \item{overlap}{logical. If \code{TRUE}, a geometry is combined with the geometry it has most overlap with, if the overlap is above \code{minover}} \item{boundary}{logical. If \code{TRUE}, a geometry is combined with the geometry it has most shared border with} \item{distance}{logical. If \code{TRUE}, a geometry is combined with the geometry it is nearest to} \item{append}{logical. Should remaining geometries be appended to the output? Not relevant if \code{distance=TRUE}} \item{minover}{numeric. The fraction of the geometry in \code{y} that overlaps with a geometry in \code{x}. Below this threshold, geometries are not considered overlapping} \item{maxdist}{numeric. Geometries further away from each other than this distance (in meters) will not be combined} \item{dissolve}{logical. Should internal boundaries be dissolved?} \item{erase}{logical. If \code{TRUE} no new overlapping areas are created} } \value{ SpatVector } \seealso{ \code{\link{union}}, \code{\link{erase}}, \code{\link{intersect}}, \code{\link{sharedPaths}}, \code{\link{aggregate}}, \code{\link{rbind}} } \examples{ x1 <- vect("POLYGON ((0 0, 8 0, 8 9, 0 9, 0 0))") x2 <- vect("POLYGON ((10 4, 12 4, 12 7, 11 7, 11 6, 10 6, 10 4))") y1 <- vect("POLYGON ((5 6, 15 6, 15 15, 5 15, 5 6))") y2 <- vect("POLYGON ((8 2, 9 2, 9 3, 8 3, 8 2))") y3 <- vect("POLYGON ((2 6, 3 6, 3 8, 2 8, 2 6))") y4 <- vect("POLYGON ((2 12, 3 12, 3 13, 2 13, 2 12))") x <- rbind(x1, x2) values(x) <- data.frame(xid=1:2) crs(x) <- "+proj=utm +zone=1" y <- rbind(y1, y2, y3, y4) values(y) <- data.frame(yid=letters[1:4]) crs(y) <- "+proj=utm +zone=1" plot(rbind(x, y), border=c(rep("red",2), rep("blue", 4)), lwd=2) text(x, "xid") text(y, "yid") v <- combineGeoms(x, y) plot(v, col=c("red", "blue")) v <- combineGeoms(x, y, boundary=FALSE, maxdist=1, minover=.05) plot(v, col=rainbow(4)) } \keyword{methods} \keyword{spatial} terra/man/all.equal.Rd0000644000176200001440000000310414540356057014316 0ustar liggesusers\name{all.equal} \docType{methods} \alias{all.equal} \alias{all.equal,SpatRaster,SpatRaster-method} \title{Compare two SpatRasters for equality} \description{ Compare two SpatRasters for (near) equality. First the attributes of the objects are compared. If these are the same, a (perhaps small) sample of the raster cells is compared as well. The sample size used can be increased with the \code{maxcell} argument. You can set it to \code{Inf}, but for large rasters your computer may not have sufficient memory. See the examples for a safe way to compare all values. } \usage{ \S4method{all.equal}{SpatRaster,SpatRaster}(target, current, maxcell=100000, ...) } \arguments{ \item{target}{SpatRaster} \item{current}{SpatRaster} \item{maxcell}{positive integer. The size of the regular sample used to compare cell values} \item{...}{additional arguments passed to \code{\link{all.equal.numeric}} to compare cell values} } \seealso{\code{\link{identical}}, \code{\link{compareGeom}}} \value{ Either \code{TRUE} or a character vector describing the differences between target and current. } \examples{ x <- sqrt(1:100) mat <- matrix(x, 10, 10) r1 <- rast(nrows=10, ncols=10, xmin=0, vals = x) r2 <- rast(nrows=10, ncols=10, xmin=0, vals = mat) all.equal(r1, r2) all.equal(r1, r1*1) all.equal(rast(r1), rast(r2)) # compare geometries compareGeom(r1, r2) # Compare all cell values for near equality # as floating point number imprecision can be a problem m <- minmax(r1 - r2) all(abs(m) < 1e-7) # comparison of cell values to create new SpatRaster e <- r1 == r2 } \keyword{spatial} terra/man/fillTime.Rd0000644000176200001440000000154214536376240014212 0ustar liggesusers\name{fillTime} \docType{methods} \alias{fillTime} \alias{fillTime,SpatRaster-method} \title{ Fill time gaps in a SpatRaster } \description{ Add empty layers in between existing layers such that the time step between each layer is the same. See \code{\link{approximate}} to estimate values for these layer (and other missing values) } \usage{ \S4method{fillTime}{SpatRaster}(x, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{filename}{character. Output filename} \item{...}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{approximate}} } \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) s <- c(r, r) time(s) <- as.Date("2001-01-01") + c(0:2, 5:7) time(s) ss <- fillTime(s) time(ss) a <- approximate(ss) } \keyword{methods} \keyword{spatial} terra/man/sample.Rd0000644000176200001440000001361614756470760013741 0ustar liggesusers\name{spatSample} \docType{methods} \alias{spatSample} \alias{spatSample,SpatRaster-method} \alias{spatSample,SpatExtent-method} \alias{spatSample,SpatVector-method} \title{Take a regular sample} \description{ Take a spatial sample from a SpatRaster, SpatVector or SpatExtent. Sampling a SpatVector or SpatExtent always returns a SpatVector of points. With a SpatRaster, you can get cell values, cell numbers (\code{cells=TRUE}), coordinates (\code{xy=TRUE}) or (when \code{method="regular"} and \code{as.raster=TRUE}) get a new SpatRaster with the same extent, but fewer cells. In order to assure regularity when requesting a regular sample, the number of cells or points returned may not be exactly the same as the \code{size} requested. } \usage{ \S4method{spatSample}{SpatRaster}(x, size, method="random", replace=FALSE, na.rm=FALSE, as.raster=FALSE, as.df=TRUE, as.points=FALSE, values=TRUE, cells=FALSE, xy=FALSE, ext=NULL, warn=TRUE, weights=NULL, exp=5, exhaustive=FALSE, exact=FALSE, each=TRUE) \S4method{spatSample}{SpatVector}(x, size, method="random", strata=NULL, chess="") \S4method{spatSample}{SpatExtent}(x, size, method="random", lonlat, as.points=FALSE, exact=FALSE) } \arguments{ \item{x}{SpatRaster, SpatVector or SpatExtent} \item{size}{numeric. The sample size. If \code{x} is a SpatVector, you can also provide a vector of the same length as \code{x} in which case sampling is done separately for each geometry. If \code{x} is a SpatRaster, and you are using \code{method="regular"} you can specify the size as two numbers (number of rows and columns). Note that when using \code{method="stratified"}, the sample size is returned for each stratum} \item{method}{character. Should be "regular" or "random", If \code{x} is a \code{SpatRaster}, it can also be "stratified" (each value in \code{x} is a stratum) or "weights" (each value in \code{x} is a probability weight)} \item{replace}{logical. If \code{TRUE}, sampling is with replacement (if \code{method="random"})} \item{na.rm}{logical. If \code{TRUE}, \code{NAs} are removed. Only used with random sampling of cell values. That is with \code{method="random", as.raster=FALSE, cells=FALSE}} \item{as.raster}{logical. If \code{TRUE}, a SpatRaster is returned} \item{as.df}{logical. If \code{TRUE}, a data.frame is returned instead of a matrix} \item{as.points}{logical. If \code{TRUE}, a SpatVector of points is returned} \item{values}{logical. If \code{TRUE} raster cell values are returned} \item{cells}{logical. If \code{TRUE}, cell numbers are returned. If \code{method="stratified"} this is always set to \code{TRUE} if \code{xy=FALSE}} \item{xy}{logical. If \code{TRUE}, cell coordinates are returned} \item{ext}{SpatExtent or NULL to restrict sampling to a subset of the area of \code{x}} \item{warn}{logical. Give a warning if the sample size returned is smaller than requested} \item{weights}{SpatRaster. Used to provide weights when \code{method="stratified"}} \item{lonlat}{logical. If \code{TRUE}, sampling of a SpatExtent is weighted by \code{cos(latitude)}. For SpatRaster and SpatVector this done based on the \code{\link{crs}}, but it is ignored if \code{as.raster=TRUE}} \item{exp}{numeric >= 1. "Expansion factor" that is multiplied with \code{size} to get an initial sample used for stratified samples and random samples with \code{na.rm=TRUE} to try to get at least \code{size} samples} \item{exhaustive}{logical. If \code{TRUE} and (\code{method=="random"} and \code{na.rm=TRUE}) or \code{method=="stratified"}, all cells that are not \code{NA} are determined and a sample is taken from these cells. This is useful when you are dealing with a very large raster that is sparse (most cells are \code{NA}). Otherwise, the default approach may not find enough samples. This should not be used in other cases, especially not with large rasters that mostly have values} \item{exact}{logical. If \code{TRUE} and \code{method=="regular"}, the sample returned is exactly \code{size}, perhaps at the expense of some regularity. Otherwise you get at least \code{size} many samples. Ignored for lon/lat rasters} \item{each}{logical. If \code{TRUE} and \code{method=="stratified"}, the sample returned is \code{size} for each stratum. Otherwise \code{size} is the total sample size} \item{strata}{if not NULL, stratified random sampling is done, taking \code{size} samples from each stratum. If \code{x} has polygon geometry, \code{strata} must be a field name (or index) in \code{x}. If \code{x} has point geometry, \code{strata} can be a SpatVector of polygons or a SpatRaster} \item{chess}{character. One of "", "white", or "black". For stratified sampling if \code{strata} is a SpatRaster. If not "", samples are only taken from alternate cells, organized like the "white" or "black" fields on a chessboard} } \value{ numeric matrix, data.frame, SpatRaster or SpatVector } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) s <- spatSample(r, 10, as.raster=TRUE) spatSample(r, 5) spatSample(r, 5, na.rm=TRUE) spatSample(r, 5, "regular") ## if you require cell numbers and/or coordinates size <- 6 spatSample(r, 6, "random", cells=TRUE, xy=TRUE, values=FALSE) # regular, with values spatSample(r, 6, "regular", cells=TRUE, xy=TRUE) # stratified rr <- rast(ncol=10, nrow=10, names="stratum") set.seed(1) values(rr) <- round(runif(ncell(rr), 1, 3)) spatSample(rr, 2, "stratified", xy=TRUE) s <- spatSample(rr, 5, "stratified", as.points=TRUE, each=FALSE) plot(rr, plg=list(title="raster")) plot(s, 1, add=TRUE, plg=list(x=185, y=1, title="points"), col=rainbow(5)) ## SpatExtent e <- ext(r) spatSample(e, 10, "random", lonlat=TRUE) ## SpatVector f <- system.file("ex/lux.shp", package="terra") v <- vect(f) # sample the geometries i <- sample(v, 3) # sample points in geometries p <- spatSample(v, 3) } \keyword{spatial} terra/man/serialize.Rd0000644000176200001440000000467214721464716014445 0ustar liggesusers\name{serialize} \alias{serialize} \alias{saveRDS} \alias{unserialize} \alias{readRDS} \alias{serialize,SpatExtent-method} \alias{serialize,SpatVector-method} \alias{serialize,SpatRaster-method} \alias{serialize,SpatRasterDataset-method} \alias{serialize,SpatRasterCollection-method} \alias{unserialize,ANY-method} \alias{saveRDS,SpatExtent-method} \alias{saveRDS,SpatVector-method} \alias{saveRDS,SpatRaster-method} \alias{saveRDS,SpatRasterCollection-method} \alias{saveRDS,SpatRasterDataset-method} \alias{readRDS,character-method} \title{saveRDS and serialize for SpatVector and SpatRaster*} \description{ serialize and saveRDS for SpatVector, SpatRaster, SpatRasterDataset and SpatRasterCollection. Note that these objects will first be "packed" with \code{\link{wrap}}, and after unserialize/readRDS they need to be unpacked with \code{rast} or \code{vect}. Extensive use of these functions is not recommended. Especially for SpatRaster it is generally much more efficient to use \code{\link{writeRaster}} and write, e.g., a GTiff file. } \usage{ \S4method{saveRDS}{SpatRaster}(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) \S4method{saveRDS}{SpatRasterDataset}(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) \S4method{saveRDS}{SpatRasterCollection}(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) \S4method{saveRDS}{SpatVector}(object, file="", ascii = FALSE, version = NULL, compress=TRUE, refhook = NULL) \S4method{serialize}{SpatRaster}(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) \S4method{serialize}{SpatVector}(object, connection, ascii = FALSE, xdr = TRUE, version = NULL, refhook = NULL) } \arguments{ \item{object}{SpatVector, SpatRaster, SpatRasterDataset or SpatRasterCollection} \item{file}{file name to save object to} \item{connection}{see \code{\link{serialize}}} \item{ascii}{see \code{\link{serialize}} or \code{\link{saveRDS}}} \item{version}{see \code{\link{serialize}} or \code{\link{saveRDS}}} \item{compress}{see \code{\link{serialize}} or \code{\link{saveRDS}}} \item{refhook}{see \code{\link{serialize}} or \code{\link{saveRDS}}} \item{xdr}{see \code{\link{serialize}} or \code{\link{saveRDS}}} } \value{ Packed* object } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) p <- serialize(v, NULL) head(p) x <- unserialize(p) x } \keyword{ spatial } \keyword{ methods } terra/man/rasterizeWin.Rd0000644000176200001440000000707114536376240015136 0ustar liggesusers\name{rasterizeWin} \docType{methods} \alias{rasterizeWin} \alias{rasterizeWin,SpatVector,SpatRaster-method} \alias{rasterizeWin,data.frame,SpatRaster-method} \title{Rasterize points with a moving window} \description{ Rasterize points using a circle (or ellipse) as moving window. For each raster cell, the points (\code{x, y}) that fall within the window centered on that cell are considered. A function is used to compute a summary value (e.g. "mean") for the values (\code{z}) associated with these points. This can result in much smoother results compared to the standard \code{\link{rasterize}} method. } \usage{ \S4method{rasterizeWin}{SpatVector,SpatRaster}(x, y, field, win="circle", pars, fun, ..., cvars=FALSE, minPoints=1, fill=NA, filename="", wopt=list()) \S4method{rasterizeWin}{data.frame,SpatRaster}(x, y, win="circle", pars, fun, ..., cvars=FALSE, minPoints=1, fill=NA, filename="", wopt=list()) } \arguments{ \item{x}{SpatVector or matrix with at least three columns ((x, y) coordinates and a variable to be rasterized)} \item{y}{SpatRaster} \item{field}{character. field name in SpatVector \code{x} with the values to rasterize} \item{win}{character to choose the window type. Can be "circle", "ellipse", "rectangle", or "buffer"} \item{pars}{parameters to define the window. If \code{win="circle"} or \code{win="buffer"}, a single number to set the radius of the circle or the width of the buffer. If \code{win="ellipse"}, either two numbers (the x and y-axis) or three numbers the axes and a rotation (in degrees). If \code{win="rectangle"}, either two (width, height) or three (width, height) and the rotation in degrees. The unit of the radius/width/height/axis parameters is that of the coordinate reference system (it is not expressed as cells). That is, if you have a lon/lat crs, there is no conversion of degrees to meters or vice-versa.} \item{fun}{function to summarize the values for each cell. If \code{cvars=FALSE}, functions must take a numeric vector and return (in all cases) one or more numbers. If \code{cvars=TRUE}, and multiple variables are used, the function must take a single argument (a data.frame with the names variables). For \code{win="circle"} and \code{win="ellipse"} there are two additional character values that can be used: \code{"distto"} (average distance to the points from the center of the cell) and \code{"distbetween"} (average distance between the points inside the window)} \item{...}{additional named arguments passed to \code{fun}} \item{minPoints}{numeric. The minimum number of points to use. If fewer points are found in a search ellipse it is considered empty and the fill value is returned} \item{fill}{numeric. value to use to fill cells with empty search areas} \item{cvars}{logical. When using multiple fields, should \code{fun} operate on all of them at once? If not, \code{fun} is applied to each variable separately} \item{filename}{character. Output filename} \item{wopt}{list with additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{rasterize}}, \code{\link{rasterizeGeom}}, \code{\link{interpNear}}, \code{\link{interpIDW}} } \value{ SpatRaster } \examples{ r <- rast(ncol=100, nrow=100, crs="local", xmin=0, xmax=50, ymin=0, ymax=50) set.seed(100) x <- runif(50, 5, 45) y <- runif(50, 5, 45) z <- sample(50) xyz <- data.frame(x,y,z) r <- rasterizeWin(xyz, r, fun="count", pars=5) rfuns <- c("count", "min", "max", "mean") x <- lapply(rfuns, function(f) rasterizeWin(xyz, r, fun=f, pars=5)) names(x) <- rfuns x <- rast(x) #plot(x) } \keyword{spatial} terra/man/na.omit.Rd0000644000176200001440000000154414536376240014014 0ustar liggesusers\name{na.omit} \alias{na.omit} \alias{na.omit,SpatVector-method} \alias{is.na,SpatVector-method} \title{Find and remove geometries that are NA} \description{ Find geometries that are NA; or remove geometries and/or records that are \code{NA}. } \usage{ \S4method{is.na}{SpatVector}(x) \S4method{na.omit}{SpatVector}(object, field=NA, geom=FALSE) } \arguments{ \item{x}{SpatVector} \item{object}{SpatVector} \item{field}{character or NA. If \code{NA}, missing values in the attributes are ignored. Other values are either one or more field (variable) names, or \code{""} to consider all fields} \item{geom}{logical. If \code{TRUE} empty geometries are removed} } \value{ SpatVector } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) v$test <- c(1,2,NA) nrow(v) x <- na.omit(v, "test") nrow(x) } \keyword{spatial} terra/man/readwrite.Rd0000644000176200001440000000707314746056115014437 0ustar liggesusers\name{readwrite} \docType{methods} \alias{readStart} \alias{readStop} \alias{readValues} \alias{writeStart} \alias{writeStop} \alias{writeValues} \alias{fileBlocksize} \alias{blocks} \alias{readStart,SpatRaster-method} \alias{readStop,SpatRaster-method} \alias{readStart,SpatRasterDataset-method} \alias{readStop,SpatRasterDataset-method} \alias{readValues,SpatRaster-method} \alias{readValues,SpatRasterDataset-method} \alias{writeStart,SpatRaster,character-method} \alias{writeStop,SpatRaster-method} \alias{writeValues,SpatRaster,vector-method} \alias{blocks,SpatRaster-method} \title{Read from, or write to, file} \description{ Methods to read from or write chunks of values to or from a file. These are low level methods for programmers. Use writeRaster if you want to save an entire SpatRaster to file in one step. It is much easier to use. To write chunks, begin by opening a file with \code{writeStart}, then write values to it in chunks using the list that is returned by \code{writeStart}. When writing is done, close the file with \code{writeStop}. \code{blocks} only returns chunk size information. This can be useful when reading, but not writing, raster data. } \usage{ \S4method{readStart}{SpatRaster}(x) \S4method{readStop}{SpatRaster}(x) \S4method{readValues}{SpatRaster}(x, row=1, nrows=nrow(x), col=1, ncols=ncol(x), mat=FALSE, dataframe=FALSE, ...) \S4method{writeStart}{SpatRaster,character}(x, filename="", overwrite=FALSE, n=4, sources="", ...) \S4method{writeStop}{SpatRaster}(x) \S4method{writeValues}{SpatRaster,vector}(x, v, start, nrows) \S4method{blocks}{SpatRaster}(x, n=4) fileBlocksize(x) } \arguments{ \item{x}{SpatRaster} \item{filename}{character. Output filename} \item{v}{vector with cell values to be written} \item{start}{integer. Row number (counting starts at 1) from where to start writing \code{v}} \item{row}{positive integer. Row number to start from, should be between 1 and nrow(x)} \item{nrows}{positive integer. How many rows?} \item{col}{positive integer. Column number to start from, should be between 1 and ncol(x)} \item{ncols}{positive integer. How many columns? Default is the number of columns left after the start column} \item{mat}{logical. If \code{TRUE}, values are returned as a numeric matrix instead of as a vector, except when \code{dataframe=TRUE}. If any of the layers of \code{x} is a factor, the level index is returned, not the label. Use \code{dataframe=TRUE} to get the labels} \item{dataframe}{logical. If \code{TRUE}, values are returned as a \code{data.frame} instead of as a vector (also if matrix is \code{TRUE})} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{n}{positive integer indicating how many copies the data may be in memory at any point in time. This is used to determine how many blocks (large) datasets need to be read} \item{sources}{character. Filenames that may not be overwritten because they are used as input to the function. Can be obtained with \code{sources(x)}} \item{...}{ For \code{writeStart}: additional arguments for writing files as in \code{\link{writeRaster}} For \code{readValues}: additional arguments for \code{\link{data.frame}} (and thus only relevant when \code{dataframe=TRUE}) } } \value{ \code{readValues} returns a vector, matrix, or data.frame \code{writeStart} returns a list that can be used for processing the file in chunks. The other methods invisibly return a logical value indicating whether they were successful or not. Their purpose is the side-effect of opening or closing files. } \keyword{ spatial } \keyword{ methods } terra/man/modal.Rd0000644000176200001440000000211314536376240013534 0ustar liggesusers\name{modal} \alias{modal} \alias{modal,SpatRaster-method} \title{modal value} \description{ Compute the mode for each cell across the layers of a SpatRaster. The mode, or modal value, is the most frequent value in a set of values. } \usage{ \S4method{modal}{SpatRaster}(x, ..., ties="first", na.rm=FALSE, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{...}{additional argument of the same type as \code{x} or numeric} \item{ties}{character. Indicates how to treat ties. Either "random", "lowest", "highest", "first", or "NA"} \item{na.rm}{logical. If \code{TRUE}, \code{NA} values are ignored. If \code{FALSE}, \code{NA} is returned if \code{x} has any \code{NA} values} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) r <- c(r/2, r, r*2) m <- modal(r) } \keyword{univar} \keyword{math} terra/man/viewshed.Rd0000644000176200001440000000371014736322131014252 0ustar liggesusers\name{viewshed} \alias{viewshed} \alias{viewshed,SpatRaster-method} \title{Compute a viewshed} \description{ Use elevation data to compute the locations that can be seen, or how much higher they would have to be to be seen, from a certain position. The raster data coordinate reference system must planar (not lon/lat), with the elevation values in the same unit as the distance unit of the coordinate reference system. } \usage{ \S4method{viewshed}{SpatRaster}(x, loc, observer=1.80, target=0, curvcoef=6/7, output="yes/no", filename="", ...) } \arguments{ \item{x}{SpatRaster, single layer with elevation values. Values should have the same unit as the map units} \item{loc}{location (x and y coordinates) or a cell number} \item{observer}{numeric. The height above the elevation data of the observer} \item{target}{numeric. The height above the elevation data of the targets} \item{curvcoef}{numeric. Coefficient to consider the effect of the curvature of the earth and refraction of the atmosphere. The elevation values are corrected with: \code{elevation = elevation - curvcoeff * (distance)^2 / (earth_diameter)}. This means that with the default value of 0.85714, you lose sight of about 1 meter of elevation for each 385 m of planar distance} \item{output}{character. Can be "yes/no" to get a binary (logical) output showing what areas are visible; "land" to get the height above the current elevation that would be visible; or "sea" the elevation above sea level that would be visible} \item{filename}{character. Output filename} \item{...}{Options for writing files as in \code{\link{writeRaster}}} } \seealso{\code{\link{terrain}}} \references{ The algorithm used is by Wang et al.: https://www.asprs.org/wp-content/uploads/pers/2000journal/january/2000_jan_87-90.pdf. } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) x <- project(r, "EPSG:2169") p <- cbind(70300, 96982) v <- viewshed(x, p, 0, 0, 0.85714) } \keyword{spatial} terra/man/dots.Rd0000644000176200001440000000223514536376240013416 0ustar liggesusers\name{dots} \docType{methods} \alias{dots} \alias{dots,SpatVector-method} \title{Make a dot-density map} \description{ Create the dots for a dot-density map and add these to the current map. Dot-density maps are made to display count data. For example of population counts, where each dot represents n persons. The dots are returned as a \code{SpatVector}. It there is an active graphics device, the dots are added to it with \code{\link{points}}. } \usage{ \S4method{dots}{SpatVector}(x, field, size, ...) } \arguments{ \item{x}{SpatVector} \item{field}{character of numeric indicating field name. Or numeric vector of the same length as \code{x}} \item{size}{positive number indicating the number of cases associated with each dot} \item{...}{graphical arguments passed to \code{points}} } \value{ SpatVector (invisibly) } \seealso{ \code{\link{plot}}, \code{\link{cartogram}}, \code{\link{points}} } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) v$population <- 1000*(1:12)^2 plot(v, lwd=3, col="light gray", border="white") d <- dots(v, "population", 1000, col="red", cex=.75) lines(v) d } \keyword{methods} \keyword{spatial} terra/man/interpIDW.Rd0000644000176200001440000000436714536376240014322 0ustar liggesusers\name{interpIDW} \docType{methods} \alias{interpIDW} \alias{interpIDW,SpatRaster,SpatVector-method} \alias{interpIDW,SpatRaster,matrix-method} \title{Interpolate points using a moving window} \description{ Interpolate points within a moving window using inverse distance weighting. The maximum number of points used can be restricted, optionally by selecting the nearest points. } \usage{ \S4method{interpIDW}{SpatRaster,SpatVector}(x, y, field, radius, power=2, smooth=0, maxPoints=Inf, minPoints=1, near=TRUE, fill=NA, filename="", ...) \S4method{interpIDW}{SpatRaster,matrix}(x, y, radius, power=2, smooth=0, maxPoints=Inf, minPoints=1, near=TRUE, fill=NA, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatVector or matrix with three columns (x,y,z)} \item{field}{character. field name in SpatVector \code{y}} \item{radius}{numeric. The radius of the circle (single number). If \code{near=FALSE}, it is also possible to use two or three numbers. Two numbers are interpreted as the radii of an ellipse (x and y-axis). A third number should indicated the desired, counter clockwise, rotation of the ellipse (in degrees)} \item{power}{numeric. Weighting power} \item{smooth}{numeric. Smoothing parameter} \item{minPoints}{numeric. The minimum number of points to use. If fewer points are found in a search ellipse it is considered empty and the fill value is returned} \item{maxPoints}{numeric. The maximum number of points to consider in a search area. Additional points are ignored. If fewer points are found, the fill value is returned} \item{near}{logical. Should the nearest points within the neighborhood be used if \code{maxPoints} is reached?} \item{fill}{numeric. value to use to fill empty cells} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{rasterizeWin}, \link{rasterize}, \link{interpNear}, \link{interpolate}} } \value{ SpatRaster } \examples{ r <- rast(ncol=100, nrow=100, crs="local", xmin=0, xmax=50, ymin=0, ymax=50) set.seed(100) x <- runif(25, 5, 45) y <- runif(25, 5, 45) z <- sample(25) xyz <- cbind(x,y,z) x <- interpIDW(r, xyz, radius=5, power=1, smooth=1, maxPoints=5) } \keyword{spatial} terra/man/rasterizeGeom.Rd0000644000176200001440000000322414536376240015264 0ustar liggesusers\name{rasterizeGeom} \docType{methods} \alias{rasterizeGeom} \alias{rasterizeGeom,SpatVector,SpatRaster-method} \title{Rasterize geometric properties of vector data} \description{ Rasterization of geometric properties of vector data. You can get the count of the number of geometries in each cell; the area covered by polygons; the length of the lines; or the number of lines that cross the boundary of each cell. See \code{\link{rasterize}} for standard rasterization (of attribute values associated with geometries). The area of polygons is intended for summing the area of polygons that are relatively small relative to the raster cells, and for when there may be multiple polygons per cell. See \code{rasterize(fun="sum")} for counting large polygons and \code{rasterize(cover=TRUE)} to get the fraction that is covered by larger polygons. } \usage{ \S4method{rasterizeGeom}{SpatVector,SpatRaster}(x, y, fun="count", unit="m", filename="", ...) } \arguments{ \item{x}{SpatVector} \item{y}{SpatRaster} \item{fun}{character. "count", "area", "length", or "crosses"} \item{unit}{character. "m" or "km"} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{rasterize}} } \value{ SpatRaster } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) r <- rast(v, res=.1) # length of lines lns <- as.lines(v) x <- rasterizeGeom(lns, r, fun="length", "km") # count of points set.seed(44) pts <- spatSample(v, 100) y <- rasterizeGeom(pts, r) # area of polygons pols <- buffer(pts, 1000) z <- rasterizeGeom(pols, r, fun="area") } \keyword{spatial} terra/man/barplot.Rd0000644000176200001440000000270714620344743014111 0ustar liggesusers\name{barplot} \docType{methods} \alias{barplot} \alias{barplot,SpatRaster-method} \title{Bar plot of a SpatRaster} \description{Create a barplot of the values of the first layer of a SpatRaster. For large datasets a regular sample with a size of approximately \code{maxcells} is used.} \usage{ \S4method{barplot}{SpatRaster}(height, maxcell=1000000, digits=0, breaks=NULL, col, ...) } \arguments{ \item{height}{SpatRaster} \item{maxcell}{integer. To regularly subsample very large datasets} \item{digits}{integer used to determine how to \code{\link{round}} the values before tabulating. Set to \code{NULL} or to a large number if you do not want any rounding } \item{breaks}{breaks used to group the data as in \code{\link[base]{cut}}} \item{col}{a color generating function such as \code{\link{rainbow}} (the default), or a vector of colors} \item{...}{additional arguments for plotting as in \code{\link[graphics]{barplot}}} } \seealso{ \code{\link{hist}, \link{boxplot}} } \value{ A numeric vector (or matrix, when \code{beside = TRUE}) of the coordinates of the bar midpoints, useful for adding to the graph. See \code{\link[graphics]{barplot}} } \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) barplot(r, digits=-1, las=2, ylab="Frequency") op <- par(no.readonly = TRUE) par(mai = c(1, 2, .5, .5)) barplot(r, breaks=10, col=c("red", "blue"), horiz=TRUE, digits=NULL, las=1) par(op) } \keyword{methods} \keyword{spatial} terra/man/mosaic.Rd0000644000176200001440000000313714536376240013722 0ustar liggesusers\name{mosaic} \docType{methods} \alias{mosaic} \alias{mosaic,SpatRaster,SpatRaster-method} \alias{mosaic,SpatRasterCollection,missing-method} \title{ mosaic SpatRasters } \description{ Combine adjacent and (partly) overlapping SpatRasters to form a single new SpatRaster. Values in overlapping cells are averaged (by default) or can be computed with another function. The SpatRasters must have the same origin and spatial resolution. This method is similar to the simpler, but much faster, \code{\link{merge}} method. } \usage{ \S4method{mosaic}{SpatRaster,SpatRaster}(x, y, ..., fun="mean", filename="", overwrite=FALSE, wopt=list()) \S4method{mosaic}{SpatRasterCollection,missing}(x, fun="mean", filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{y}{object of same class as \code{x}} \item{...}{additional SpatRasters} \item{fun}{character. One of "mean", "median", "min", "max", "modal", "sum", "first", "last"} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{merge}} } \examples{ x <- rast(xmin=-110, xmax=-60, ymin=40, ymax=70, res=1, vals=1) y <- rast(xmin=-95, xmax=-45, ymax=60, ymin=30, res=1, vals=2) z <- rast(xmin=-80, xmax=-30, ymax=50, ymin=20, res=1, vals=3) m1 <- mosaic(x, y, z) m2 <- mosaic(z, y, x) # with many SpatRasters, make a SpatRasterCollection from a list rlist <- list(x, y, z) rsrc <- sprc(rlist) m <- mosaic(rsrc) } \keyword{methods} \keyword{spatial} terra/man/gaps.Rd0000644000176200001440000000113214536376240013372 0ustar liggesusers\name{gaps} \docType{methods} \alias{gaps} \alias{gaps,SpatVector-method} \alias{gaps,SpatVector,SpatExtent-method} \title{Find gaps between polygons} \description{ Get the gaps between polygons of a SpatVector } \usage{ \S4method{gaps}{SpatVector}(x) } \arguments{ \item{x}{SpatVector} } \value{ SpatVector } \seealso{ \code{\link{sharedPaths}}, \code{\link{topology}}, and \code{\link{fillHoles}} to get or remove polygon holes } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) h <- convHull(v[-12], "NAME_1") g <- gaps(h) } \keyword{methods} \keyword{spatial} terra/man/direction.Rd0000644000176200001440000000231414733130546014417 0ustar liggesusers\name{direction} \alias{direction} \alias{direction,SpatRaster-method} \title{Direction} \description{ The direction (azimuth) to or from the nearest cell that is not \code{NA}. The direction is expressed in radians, unless you use argument \code{degrees=TRUE}. } \usage{ \S4method{direction}{SpatRaster}(x, from=FALSE, degrees=FALSE, method="cosine", filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{from}{Logical. Default is \code{FALSE}. If \code{TRUE}, the direction from (instead of to) the nearest cell that is not \code{NA} is returned} \item{degrees}{Logical. If \code{FALSE} (the default) the unit of direction is radians.} \item{method}{character. Should be "geo", or "cosine". With "geo" the most precise but slower geodesic method of Karney (2003) is used. The "cosine" method is faster but less precise} \item{filename}{Character. Output filename (optional)} \item{...}{Additional arguments as for \code{\link{writeRaster}}} } \value{SpatRaster} \seealso{ \code{\link[terra]{distance}} } \examples{ r <- rast(ncol=36,nrow=18, crs="+proj=merc") values(r) <- NA r[306] <- 1 b <- direction(r, degrees=TRUE) plot(b) crs(r) <- "+proj=longlat" b <- direction(r) plot(b) } \keyword{spatial} terra/man/plot.Rd0000644000176200001440000003055314741772645013436 0ustar liggesusers\name{plot} \docType{methods} \alias{plot} \alias{plot,SpatRaster,missing-method} \alias{plot,SpatRaster,numeric-method} \alias{plot,SpatRaster,character-method} \alias{plot,SpatVector,missing-method} \alias{plot,SpatVector,numeric-method} \alias{plot,SpatVector,data.frame-method} \alias{plot,SpatVector,character-method} \alias{plot,SpatVectorProxy,missing-method} \alias{plot,SpatVectorCollection,missing-method} \alias{plot,SpatVectorCollection,numeric-method} \title{Make a map} \description{ Plot the values of a SpatRaster or SpatVector to make a map. See \code{\link{points}}, \code{\link{lines}} or \code{\link{polys}} to add a SpatVector to an existing map (or use argument \code{add=TRUE}). There is a separate help file for plotting a \code{\link[=plot,SpatGraticule,missing-method]{SpatGraticule}} or \code{\link[=plot,SpatExtent,missing-method]{SpatExtent}}. } \usage{ \S4method{plot}{SpatRaster,numeric}(x, y=1, col, type=NULL, mar=NULL, legend=TRUE, axes=!add, plg=list(), pax=list(), maxcell=500000, smooth=FALSE, range=NULL, fill_range=FALSE, levels=NULL, all_levels=FALSE, breaks=NULL, breakby="eqint", fun=NULL, colNA=NULL, alpha=NULL, sort=FALSE, decreasing=FALSE, grid=FALSE, ext=NULL, reset=FALSE, add=FALSE, buffer=FALSE, background=NULL, box=axes, clip=TRUE, overview=NULL, ...) \S4method{plot}{SpatRaster,missing}(x, y, main, mar=NULL, nc, nr, maxnl=16, maxcell=500000, add=FALSE, ...) \S4method{plot}{SpatRaster,character}(x, y, ...) \S4method{plot}{SpatVector,character}(x, y, col=NULL, type=NULL, mar=NULL, add=FALSE, legend=TRUE, axes=!add, main="", buffer=TRUE, background=NULL, grid=FALSE, ext=NULL, sort=TRUE, decreasing=FALSE, plg=list(), pax=list(), nr, nc, colNA=NA, alpha=NULL, box=axes, clip=TRUE, ...) \S4method{plot}{SpatVector,numeric}(x, y, ...) \S4method{plot}{SpatVector,missing}(x, y, values=NULL, ...) \S4method{plot}{SpatVectorCollection,missing}(x, y, main, mar=NULL, nc, nr, maxnl=16, ...) \S4method{plot}{SpatVectorCollection,numeric}(x, y, main, mar=NULL, ext=NULL, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{y}{missing or positive integer or name indicating the layer(s) to be plotted} \item{col}{character vector to specify the colors to use. The default is \code{map.pal("viridis", 100)}. The default can be changed with the \code{terra.pal} option. For example: \code{options(terra.pal=terrain.colors(10))}. If \code{x} is a \code{SpatRaster}, it can also be a \code{data.frame} with two columns (value, color) to get a "classes" type legend or with three columns (from, to, color) to get an "interval" type legend} \item{type}{character. Type of map/legend. One of "continuous", "classes", or "interval". If not specified, the type is chosen based on the data} \item{mar}{numeric vector of length 4 to set the margins of the plot (to make space for the legend). The default is (3.1, 3.1, 2.1, 7.1) for a single plot with a legend and (3.1, 3.1, 2.1, 2.1) otherwise. The default for a RGB raster is 0. Use \code{mar=NA} to not set the margins} \item{legend}{logical or character. If not \code{FALSE} a legend is drawn. The character value can be used to indicate where the legend is to be drawn. For example "topright" or "bottomleft". Use \code{plg} for more refined placement. Not supported for continuous legends (the default for raster data)} \item{axes}{logical. Draw axes?} \item{buffer}{logical. If \code{TRUE} the plotting area is made slightly larger than the extent of \code{x}} \item{background}{background color. Default is no color (white)} \item{box}{logical. Should a box be drawn around the map?} \item{clip}{logical. Should the axes be clipped to the extent of \code{x}?} \item{overview}{logical. Should "overviews" be used for fast rendering? This can result in much faster plotting of raster files that have overviews (e.g. "COG" format) and are accessed over a http connection. However, these overviews generally show aggregate values, thus reducing the range of the actual values. If \code{NULL}, the argument is set to \code{TRUE} for rasters that are accessed over http and \code{FALSE} in other cases} \item{plg}{list with parameters for drawing the legend. For the classes and interval type legend see the arguments for \code{\link[graphics]{legend}}. For example \code{x} and \code{y} can be used to place the legend. You can also use keywords such as "topleft" and "bottomright" to place the legend at these locations inside the map rectangle. Some of these do not apply to a continuous legend, or they behave a little differently. For example, only the placement keywords "left", "right", "top", and "bottom" are recognized; and when using these keywords, the legend is placed outside of the map rectangle. Additional parameters for continuous legends include: \itemize{ \item \code{digits} to set the number of digits to print after the decimal point. \code{size} to change the height and/or width; the defaults are \code{c(1,1)}, negative values for size flip the order of the legend. \item \code{at} to set the location of the tic-marks \item \code{tic} One of these partially matched values: "through", "in", "out", or "none", to choose a tic-mark placement/length that is different from the default "through and out". } } \item{pax}{list with parameters for drawing axes. See the arguments for \code{\link{axis}}. Arguments \code{side}, \code{tick} and \code{lab} can be used to indicate for which of the four axes to draw a line (side), tick-mark, and/or the tick-mark labels. The default is \code{c(1:4)} for side and \code{1:2} for the other two. If \code{side} is changed the other two default to that value. Logical argument \code{retro} can be used to use a sexagesimal notation for the labels (degrees/minutes/hemisphere) instead of the standard decimal notation} \item{maxcell}{positive integer. Maximum number of cells to use for the plot} \item{smooth}{logical. If \code{TRUE} the cell values are smoothed (only if a continuous legend is used)} \item{range}{numeric. minimum and maximum values to be used for the continuous legend. You can use \code{NA} for one of these to only set the minimum or maximum value} \item{fill_range}{logical. If \code{TRUE}, values outside of \code{range} get the colors of the extreme values; otherwise they get colored as \code{NA}} \item{levels}{character. labels for the legend when \code{type="classes"} } \item{all_levels}{logical. If \code{TRUE}, the legend shows all levels of a categorical raster, even if they are not present in the data} \item{breaks}{numeric. Either a single number to indicate the number of breaks desired, or the actual breaks. When providing this argument, the default legend becomes "interval"} \item{breakby}{character or function. Either "eqint" for equal interval breaks, "cases" for equal quantile breaks. If a function is supplied, it should take a single argument (a vector of values) and create groups} \item{fun}{function to be called after plotting each SpatRaster layer to add something to each map (such as text, legend, lines). For example, with SpatVector \code{v}, you could do \code{fun=function() lines(v)}. The function may have one argument, representing the layer that is plotted (1 to the number of layers) } \item{colNA}{character. color for the NA values} \item{alpha}{Either a single numeric between 0 and 1 to set the transparency for all colors (0 is transparent, 1 is opaque) or a SpatRaster with values between 0 and 1 to set the transparency by cell. To set the transparency for a given color, set it to the colors directly} \item{sort}{logical. If \code{TRUE} legends with categorical values are sorted. If \code{x} is a \code{SpatVector} you can also supply a vector of the unique values, in the order in which you want them to appear in the legend} \item{decreasing}{logical. If \code{TRUE}, legends are sorted in decreasing order} \item{grid}{logical. If \code{TRUE} grid lines are drawn. Their properties such as type and color can be set with the \code{pax} argument} \item{nc}{positive integer. Optional. The number of columns to divide the plotting device in (when plotting multiple layers)} \item{nr}{positive integer. Optional. The number of rows to divide the plotting device in (when plotting multiple layers)} \item{main}{character. Main plot titles (one for each layer to be plotted). You can use arguments \code{cex.main}, \code{font.main}, \code{col.main} to change the appearance; and \code{loc.main} to change the location of the main title (either two coordinates, or a character value such as "topleft")} \item{maxnl}{positive integer. Maximum number of layers to plot (for a multi-layer object)} \item{add}{logical. If \code{TRUE} add the object to the current plot} \item{ext}{SpatExtent. Can be use instead of xlim and ylim to set the extent of the plot} \item{reset}{logical. If \code{TRUE} add the margins (see argument \code{mar}) are reset to what they were before calling plot; doing so may affect the display of additional objects that are added to the map (e.g. with \code{\link{lines}})} \item{values}{Either a vector with values to be used for plotting or a two-column data.frame, where the first column matches a variable in \code{x} and the second column has the values to be plotted} \item{...}{arguments passed to \code{plot("SpatRaster", "numeric")} and additional graphical arguments} } \seealso{ \code{\link{points}, \link{lines}, \link{polys}, \link{image}} Add map elements: \code{\link{text}, \link{sbar}, \link{north}, \link{add_legend}, \link{add_box}} plot a \code{\link[=plot,SpatGraticule,missing-method]{SpatGraticule}} or \code{\link[=plot,SpatExtent,missing-method]{SpatExtent}}, multiple layers: \code{\link{plotRGB}}, \code{\link{panel}} other plot types: \code{\link[=plot,SpatRaster,SpatRaster-method]{scatterplot}, \link{hist}, \link{pairs}, \link{density}, \link{persp}, \link{contour}, \link{boxplot}, \link{barplot}} } \examples{ ## SpatRaster f <- system.file("ex/elev.tif", package="terra") r <- rast(f) plot(r) plot(r, type="interval") e <- c(6.37, 6.41, 49.9, 50.1) plot(r, plg=list(ext=e, title="Legend\nTitle", title.cex=0.9), pax=list(side=1:4, retro=FALSE)) north(cbind(5.8, 50.1)) d <- classify(r, c(100,200,300,400,500,600)) plot(d, type="classes") plot(d, type="interval", breaks=1:5) plot(d, type="interval", breaks=c(1,4,5), plg=list(legend=c("1-4", "4-5"))) plot(d, type="classes", xlim=c(5.6, 6.6), plg=list(legend=c("Mr", "Xx", "As", "Zx", "Bb"), x="bottomleft")) x <- trunc(r/200) levels(x) <- data.frame(id=0:2, element=c("earth", "wind", "fire")) plot(x, plg=list(x="topright"),mar=c(2,2,2,2)) oldpar <- par(no.readonly=TRUE) # two plots with the same legend dev.new(width=6, height=4, noRStudioGD = TRUE) par(mfrow=c(1,2)) plot(r, range=c(50,600), mar=c(1,1,1,4)) plot(r/2, range=c(50,600), mar=c(1,1,1,4)) # as we only need one legend: par(mfrow=c(1,2)) plot(r, range=c(50,600), mar=c(2, 2, 2, 2), plg=list(size=0.9, cex=.8), pax=list(side=1:2, cex.axis=.6), box=FALSE) #text(182500, 335000, "Two maps, one plot", xpd=NA) plot(r/2, range=c(50,600), mar=c(2, 2, 2, 2), legend=FALSE, pax=list(side=c(1,4), cex.axis=.6), box=FALSE) par(oldpar) # multi-layer with RGB s <- rast(system.file("ex/logo.tif", package="terra")) s plot(s) # remove RGB plot(s*1) # or use layers plot(s, 1) plot(s, 1:3) # fix legend by linking values and colors x = rast(nrows = 2, ncols = 2, vals=1) y = rast(nrows = 2, ncols = 2, vals=c(1,2,2,1)) cols = data.frame(id=1:2, col=c("red", "blue")) plot(c(x,y), col=cols) r = rast(nrows=10, ncols=10, vals=1:100) dr = data.frame(from=c(5,33,66,150), to=c(33, 66, 95,200), col=rainbow(4)) plot(r, col=dr) ### SpatVector f <- system.file("ex/lux.shp", package="terra") v <- vect(f) plot(v) plot(v, "NAME_2", col=rainbow(12), border=c("gray", "blue"), lwd=3) plot(v, 2, pax=list(side=1:2), plg=list(x=6.16, y=50.17, cex=.8), xlim=c(5.7, 6.7)) plot(v, 4, pax=list(side=1:2), plg=list(x=6.2, y=50.2, ncol=2), main="", box=FALSE) plot(v, 1, plg=list(x=5.8, y=49.37, horiz=TRUE, cex=1.1), main="", mar=c(5,2,0.5,0.5)) plot(v, density=1:12, angle=seq(18, 360, 20), col=rainbow(12)) plot(v, "AREA", type="interval", breaks=3, mar=c(3.1, 3.1, 2.1, 3.1), plg=list(x="topright"), main="") plot(v, "AREA", type="interval", breaks=c(0,200,250,350), mar=c(2,2,2,2), xlim=c(5.7, 6.75), plg=list(legend=c("<200", "200-250", ">250"), cex=1, bty="o", x=6.3, y=50.15, box.lwd=2, bg="light yellow", title="My legend")) } \keyword{methods} \keyword{spatial} terra/man/SpatRaster-class.Rd0000644000176200001440000000302314536376240015634 0ustar liggesusers\name{SpatRaster-class} \docType{class} \alias{SpatRaster} \alias{SpatRaster-class} \alias{Rcpp_SpatRaster-class} \alias{PackedSpatRaster-class} \alias{SpatRasterCollection} \alias{SpatRasterDataset} \alias{SpatRasterCollection-class} \alias{SpatRasterDataset-class} \alias{RasterSource} \alias{RasterSource-class} \alias{Rcpp_RasterSource-class} \alias{SpatCategories} \alias{SpatCategories-class} \alias{Rcpp_SpatCategories-class} \alias{show,SpatRaster-method} \title{ SpatRaster class} \description{ A \code{SpatRaster} represents a rectangular part of the world that is sub-divided into rectangular cells of equal area (in terms of the units of the coordinate reference system). For each cell can have multiple values ("layers"). An object of the \code{SpatRaster} class can point to one or more files on disk that hold the cell values, and/or it can hold these values in memory. These objects can be created with the \code{\link{rast}} method. A \code{SpatRasterDataset} is a collection of sub-datasets, where each is a \code{SpatRaster} for the same area (extent) and coordinate reference system, but possibly with a different resolution. Sub-datasets are often used to capture variables (e.g. temperature and precipitation), or a fourth dimension (e.g. height, depth or time) if the sub-datasets already have three dimensions (multiple layers). A \code{SpatRasterCollection} is a collection of SpatRasters with no restriction in the extent or other geometric parameters. } \examples{ rast() } \keyword{classes} \keyword{spatial} terra/man/sapp.Rd0000644000176200001440000000321414757466400013411 0ustar liggesusers\name{sapp} \docType{methods} \alias{sapp} \alias{sapp,SpatRaster-method} \alias{sapp,SpatRasterDataset-method} \title{Apply a terra function that takes only a single layer and returns a SpatRaster to all layers of a SpatRaster} \description{ Apply to all layers of a SpatRaster a function that only takes a single layer SpatRaster and returns a SpatRaster (these are rare). In most cases you can also use \code{lapply} or \code{sapply} for this. Or apply the same method to each sub-dataset (SpatRaster) in a SpatRasterDataset } \usage{ \S4method{sapp}{SpatRaster}(x, fun, ..., filename="", overwrite=FALSE, wopt=list()) \S4method{sapp}{SpatRasterDataset}(x, fun, ..., filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster or SpatRasterDataset} \item{fun}{if \code{x} is a \code{SpatRaster}: a function that takes a SpatRaster argument and can be applied to each layer of \code{x} (e.g. \code{\link{terrain}}. if \code{x} is a \code{SpatRasterDataset}: a function that is applied to all layers of the SpatRasters in \code{x} (e.g. \code{mean}} \item{...}{additional arguments to be passed to \code{fun}} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{ \link{lapp}, \link{app}, \link[terra]{tapp}, \link{lapply}} } \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) + 1 #SpatRasterDataset sd <- sds(s*2, s/2) y <- sapp(sd, mean) z <- sapp(sd, function(i) 2 * mean(i)) } \keyword{methods} \keyword{spatial} terra/man/origin.Rd0000644000176200001440000000124614536376240013735 0ustar liggesusers\name{origin} \alias{origin} \alias{origin,SpatRaster-method} \alias{origin<-} \alias{origin<-,SpatRaster-method} \title{Origin} \description{ Get or set the coordinates of the point of origin of a SpatRaster. This is the point closest to (0, 0) that you could get if you moved towards that point in steps of the x and y resolution. } \usage{ \S4method{origin}{SpatRaster}(x) \S4method{origin}{SpatRaster}(x)<-value } \arguments{ \item{x}{SpatRaster} \item{value}{numeric vector of length 1 or 2} } \value{ A vector of two numbers (x and y coordinates) } \examples{ r <- rast(xmin=-0.5, xmax = 9.5, ncols=10) origin(r) origin(r) <- c(0,0) r } \keyword{spatial} terra/man/lapp.Rd0000644000176200001440000001034714746205515013403 0ustar liggesusers\name{lapp} \docType{methods} \alias{lapp} \alias{lapp,SpatRaster-method} \alias{lapp,SpatRasterDataset-method} \title{Apply a function to layers of a SpatRaster, or sub-datasets of a SpatRasterDataset} \description{ Apply a function to a SpatRaster, using layers as arguments. The number of arguments in function \code{fun} must match the number of layers in the SpatRaster (or the number of sub-datasets in the SpatRasterDataset). For example, if you want to multiply two layers, you could use this function: \code{fun=function(x,y){return(x*y)}} percentage: \code{fun=function(x,y){return(100 * x / y)}}. If you combine three layers you could use \code{fun=function(x,y,z){return((x + y) * z)}} Before you use the function, test it to make sure that it is vectorized. That is, it should work for vectors longer than one, not only for single numbers. Or if the input SpatRaster(s) have multiple layers, it should work for a matrix (multiple cells) of input data (or matrices in the case of a SpatRasterDataSet). The function must return the same number of elements as its input vectors, or multiples of that. Also make sure that the function is \code{NA}-proof: it should returns the same number of values when some or all input values are \code{NA}. And the function must return a vector or a matrix, not a \code{data.frame}. To test it, run it with \code{do.call(fun, data)} (see examples). Use \code{\link{app}} for summarize functions such as \code{sum}, that take any number of arguments; and \code{\link{tapp}} to do so for groups of layers. } \usage{ \S4method{lapp}{SpatRaster}(x, fun, ..., usenames=FALSE, cores=1, filename="", overwrite=FALSE, wopt=list()) \S4method{lapp}{SpatRasterDataset}(x, fun, ..., usenames=FALSE, recycle=FALSE, cores=1, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster or SpatRasterDataset} \item{fun}{a function that takes a vector and can be applied to each cell of \code{x}} \item{...}{additional arguments to be passed to \code{fun}} \item{usenames}{logical. Use the layer names (or dataset names if \code{x} is a SpatRasterDataset) to match the function arguments? If \code{FALSE}, argument matching is by position} \item{cores}{positive integer. If \code{cores > 1}, a 'parallel' package cluster with that many cores is created and used. You can also supply a cluster object. The benefit of using this option is often small, if it is even positive. Using a fast function \code{fun} can be a much more effective way to speed things up} \item{recycle}{logical. Recycle layers to match the subdataset with the largest number of layers} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{ \link{app}, \link[terra]{tapp}, \link[terra]{math}} } \note{ Use \code{\link{sapp}} or \code{lapply} to apply a function that takes a SpatRaster as argument to each layer of a SpatRaster (that is rarely necessary). } \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) + 1 ss <- s[[2:1]] fvi <- function(x, y){ (x - y ) / (x + y) } # test the function data <- list(c(1:5,NA), 6:1) do.call(fvi, data) x <- lapp(ss, fun=fvi ) # which is the same as supplying the layers to "fun" # in some cases this will be much faster y <- fvi(s[[2]], s[[1]]) f2 <- function(x, y, z){ (z - y + 1) / (x + y + 1) } p1 <- lapp(s, fun=f2 ) p2 <- lapp(s[[1:2]], f2, z=200) # the usenames argument fvi2 <- function(red, green){ (red - green ) / (red + green) } names(s) x1 <- lapp(s[[1:2]], fvi2, usenames=TRUE) x2 <- lapp(s[[2:1]], fvi2, usenames=TRUE) # x1 and x2 are the same, despite the change in the order of the layers # x4 is also the same, but x3 is not x3 <- lapp(s[[2:1]], fvi2, usenames=FALSE) # these fail because there are too many layers in s # x4 <- lapp(s, fvi2, usenames=TRUE) # x5 <- lapp(s, fvi2, usenames=FALSE) pairs(c(x1, x2, x3)) ## SpatRasterDataset x <- sds(s, s[[1]]+50) fun <- function(x, y) { x/y } # test "fun" data <- list(matrix(1:9, ncol=3), matrix(9:1, ncol=3)) do.call(fun, data) lapp(x, fun, recycle=TRUE) # the same, more concisely z <- s / (s[[1]]+50) } \keyword{methods} \keyword{spatial} terra/man/rescale.Rd0000644000176200001440000000207314536376240014063 0ustar liggesusers\name{rescale} \docType{methods} \alias{rescale} \alias{rescale,SpatRaster-method} \alias{rescale,SpatVector-method} \title{rescale} \description{ Rescale a SpatVector or SpatRaster. This may be useful to make small \code{\link{inset}} maps or for georeferencing. } \usage{ \S4method{rescale}{SpatRaster}(x, fx=0.5, fy=fx, x0, y0) \S4method{rescale}{SpatVector}(x, fx=0.5, fy=fx, x0, y0) } \arguments{ \item{x}{SpatVector or SpatRaster} \item{fx}{numeric > 0. The horizontal scaling factor} \item{fy}{numeric > 0. The vertical scaling factor} \item{x0}{numeric. x-coordinate of the center of rescaling. If missing, the center of the extent of \code{x} is used} \item{y0}{numeric. y-coordinate of the center of rescaling. If missing, the center of the extent of \code{x} is used} } \value{ Same as \code{x} } \seealso{\code{\link{t}}, \code{\link{shift}}, \code{\link{flip}}, \code{\link{rotate}}, \code{\link{inset}}} \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) w <- rescale(v, 0.2) plot(v) lines(w, col="red") } \keyword{spatial} terra/man/normalize.longitude.Rd0000644000176200001440000000111414536376240016431 0ustar liggesusers\name{normalize.longitude} \docType{methods} \alias{normalize.longitude} \alias{normalize.longitude,SpatVector-method} \title{normalize vector data that crosses the dateline} \description{ Normalize the longitude of geometries, move them if they are outside of the -180 to 180 degrees range. } \usage{ \S4method{normalize.longitude}{SpatVector}(x) } \arguments{ \item{x}{SpatVector} } \value{SpatVector} \seealso{\link{rotate} for SpatRaster} \examples{ p <- vect("POLYGON ((120 10, 230 75, 230 -75, 120 10))") normalize.longitude(p) } \keyword{methods} \keyword{spatial} terra/man/update.Rd0000644000176200001440000000141614735567576013746 0ustar liggesusers\name{update} \alias{update} \alias{update,SpatRaster-method} \title{Change values in a file} \description{ Change the contents of a file that is the data source of a SpatRaster. BE CAREFUL as you are overwriting values in an existing file. } \usage{ \S4method{update}{SpatRaster}(object, crs=FALSE, extent=FALSE) } \arguments{ \item{object}{SpatRaster} \item{crs}{logical. Should the coordinate reference system be updated?} \item{extent}{logical. Should the extent be updated?} } \value{SpatRaster (invisibly)} \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) fname <- paste0(tempfile(), ".tif") x <- writeRaster(s, fname) ext(x) <- ext(x) + 1 crs(x) <- "+proj=utm +zone=1" update(x, crs=TRUE, extent=TRUE) rast(fname) } \keyword{spatial} terra/man/values.Rd0000644000176200001440000000522614536376240013747 0ustar liggesusers\name{values} \docType{methods} \alias{values} \alias{values,SpatRaster-method} \alias{values,SpatVector-method} \title{Cell values and geometry attributes} \description{ Get the cell values of a SpatRaster or the attributes of a SpatVector. By default all values returned are numeric. This is because a vector or matrix can only store one data type, and a SpatRaster may consist of multiple data types. However, if all layers have integer or logical values, the returned values also have that datatype. Note that with \code{values(x, dataframe=TRUE)} and \code{\link[terra]{as.data.frame}(x)} the values returned match the type of each layer, and can be a mix of numeric, logical, integer, and factor. } \usage{ \S4method{values}{SpatRaster}(x, mat=TRUE, dataframe=FALSE, row=1, nrows=nrow(x), col=1, ncols=ncol(x), na.rm=FALSE, ...) \S4method{values}{SpatVector}(x, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{mat}{logical. If \code{TRUE}, values are returned as a matrix instead of as a vector, except when dataframe is \code{TRUE}} \item{dataframe}{logical. If \code{TRUE}, values are returned as a \code{data.frame} instead of as a vector (also if matrix is \code{TRUE})} \item{row}{positive integer. Row number to start from, should be between 1 and nrow(x)} \item{nrows}{positive integer. How many rows?} \item{col}{positive integer. Column number to start from, should be between 1 and ncol(x)} \item{ncols}{positive integer. How many columns? Default is the number of columns left after the start column} \item{na.rm}{logical. Remove \code{NA}s?} \item{...}{additional arguments passed to \code{\link{data.frame}}} } \details{ If \code{x} is a \code{SpatRaster}, and \code{mat=FALSE}, the values are returned as a vector. In cell-order by layer. If \code{mat=TRUE}, a matrix is returned in which the values of each layer are represented by a column (with \code{ncell(x)} rows). The values per layer are in cell-order, that is, from top-left, to top-right and then down by row. Use \code{\link{as.matrix}(x, wide=TRUE)} for an alternative matrix representation where the number of rows and columns matches that of \code{x}. } \note{ raster values that are \code{NA} (missing) are represented by \code{NaN} (not-a-number) unless argument \code{dataframe} is \code{TRUE}. } \value{ matrix or data.frame } \seealso{\code{\link{values<-}}, \code{\link{focalValues}}, \code{\link[terra]{as.data.frame}}} \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) r x <- values(r) x[3650:3655, ] r[3650:3655] ff <- system.file("ex/lux.shp", package="terra") v <- vect(ff) y <- values(v) head(y) } \keyword{spatial} \keyword{methods} terra/man/cells.Rd0000644000176200001440000000447314612664473013560 0ustar liggesusers\name{cells} \docType{methods} \alias{cells} \alias{cells,SpatRaster,missing-method} \alias{cells,SpatRaster,numeric-method} \alias{cells,SpatRaster,SpatVector-method} \alias{cells,SpatRaster,SpatExtent-method} \title{Get cell numbers} \description{ Get the cell numbers covered by a SpatVector or SpatExtent. Or that match values in a vector; or all non \code{NA} values. } \usage{ \S4method{cells}{SpatRaster,missing}(x, y) \S4method{cells}{SpatRaster,numeric}(x, y, pairs=FALSE) \S4method{cells}{SpatRaster,SpatVector}(x, y, method="simple", weights=FALSE, exact=FALSE, touches=is.lines(y), small=TRUE) \S4method{cells}{SpatRaster,SpatExtent}(x, y) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatVector, SpatExtent, 2-column matrix representing points, numeric representing values to match, or missing} \item{method}{character. Method for getting cell numbers for points. The default is "simple", the alternative is "bilinear". If it is "bilinear", the four nearest cells and their weights are returned} \item{weights}{logical. If \code{TRUE} and \code{y} has polygons, the approximate fraction of each cell that is covered is returned as well} \item{pairs}{logical. If \code{TRUE} the cell values matched area also returned} \item{exact}{logical. If \code{TRUE} and \code{y} has polygons, the exact fraction of each cell that is covered is returned as well} \item{touches}{logical. If \code{TRUE}, values for all cells touched by lines or polygons are extracted, not just those on the line render path, or whose center point is within the polygon. Not relevant for points} \item{small}{logical. If \code{TRUE}, values for all cells in touched polygons are extracted if none of the cells center points is within the polygon; even if \code{touches=FALSE}} } \value{ numeric vector or matrix } \examples{ r <- rast(ncols=10, nrows=10) values(r) <- 1:ncell(r) r[c(1:25, 31:100)] <- NA r <- ifel(r > 28, r + 10, r) # all cell numbers of cells that are not NA cells(r) # cell numbers that match values x <- cells(r, c(28,38)) x$lyr.1 # cells for points m <- cbind(x=c(0,10,-30), y=c(40,-10,20)) cellFromXY(r, m) v <- vect(m) cells(r, v) cells(r, v, method="bilinear") # cells for polygons f <- system.file("ex/lux.shp", package="terra") v <- vect(f) r <- rast(v) cv <- cells(r, v) } \keyword{methods} \keyword{spatial} terra/man/sprc.Rd0000644000176200001440000000257414547074171013422 0ustar liggesusers\name{sprc} \docType{methods} \alias{sprc} \alias{sprc,missing-method} \alias{sprc,list-method} \alias{sprc,SpatRaster-method} \alias{sprc,character-method} \title{Create a SpatRasterCollection} \description{ Methods to create a SpatRasterCollection. This is an object to hold a collection (list) of SpatRasters. There are no restrictions on the similarity of the SpatRaster geometry. They can be used to combine several SpatRasters to be used with \code{\link{merge}} or \code{\link{mosaic}} You can create a SpatRasterCollection from a file with subdatasets. } \usage{ \S4method{sprc}{character}(x, ids=0, opts=NULL, raw=FALSE) \S4method{sprc}{SpatRaster}(x, ...) \S4method{sprc}{list}(x) \S4method{sprc}{missing}(x) } \arguments{ \item{x}{SpatRaster, list with SpatRasters, missing, or filename} \item{ids}{optional. vector of integer subdataset ids. Ignored if the first value is not a positive integer} \item{opts}{character. GDAL dataset open options} \item{raw}{logical. If \code{TRUE}, scale and offset values are ignored} \item{...}{additional SpatRasters} } \value{ SpatRasterCollection } \seealso{ \code{\link{sds}} } \examples{ x <- rast(xmin=-110, xmax=-50, ymin=40, ymax=70, ncols=60, nrows=30) y <- rast(xmin=-80, xmax=-20, ymax=60, ymin=30) res(y) <- res(x) values(x) <- 1:ncell(x) values(y) <- 1:ncell(y) z <- sprc(x, y) z } \keyword{methods} \keyword{spatial} terra/man/concats.Rd0000644000176200001440000000173114536376240014077 0ustar liggesusers\name{concats} \docType{methods} \alias{concats} \alias{concats,SpatRaster-method} \title{Concatenate categorical rasters} \description{ Combine two categorical rasters by concatenating their levels. } \usage{ \S4method{concats}{SpatRaster}(x, y, filename="", ...) } \arguments{ \item{x}{SpatRaster (with a single, categorical, layer)} \item{y}{SpatRaster (with a single, categorical, layer)} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{\code{\link{cats}}} \examples{ set.seed(0) r <- rast(nrows=10, ncols=10) values(r) <- sample(3, ncell(r), replace=TRUE) levels(r) <- data.frame(id=1:3, cover=c("forest", "water", "urban")) rr <- rast(r) values(rr) <- sample(1:3, ncell(rr), replace=TRUE) levels(rr) <- data.frame(id=c(1:3), color=c("red", "green", "blue")) x <- concats(r, rr) x levels(x)[[1]] } \keyword{methods} \keyword{spatial} terra/man/crds.Rd0000644000176200001440000000341714536376240013403 0ustar liggesusers\name{crds} \docType{methods} \alias{crds} \alias{crds,SpatVector-method} \alias{crds,SpatRaster-method} \title{Get the coordinates of SpatVector geometries or SpatRaster cells} \description{ Get the coordinates of a SpatVector or SpatRaster cells. A matrix or data.frame of the x (longitude) and y (latitude) coordinates is returned. } \usage{ \S4method{crds}{SpatVector}(x, df=FALSE, list=FALSE) \S4method{crds}{SpatRaster}(x, df=FALSE, na.rm=TRUE, na.all=FALSE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{df}{logical. If \code{TRUE} a \code{data.frame} is returned instead of a matrix} \item{list}{logical. If \code{TRUE} a \code{list} is returned instead of a matrix} \item{na.rm}{logical. If \code{TRUE} cells that are \code{NA} are excluded. Ignored if the SpatRaster is a template with no associated cell values} \item{na.all}{logical. If \code{TRUE} cells are only ignored if \code{na.rm=TRUE} and their value is \code{NA} for \bold{all} layers instead of for \code{any} layer} } \value{ matrix or data.frame } \seealso{ \code{\link{geom}} returns the complete structure of SpatVector geometries. For SpatRaster see \code{\link{xyFromCell}} } \examples{ x1 <- rbind(c(-175,-20), c(-140,55), c(10, 0), c(-140,-60)) x2 <- rbind(c(-125,0), c(0,60), c(40,5), c(15,-45)) x3 <- rbind(c(-10,0), c(140,60), c(160,0), c(140,-55)) x4 <- rbind(c(80,0), c(105,13), c(120,2), c(105,-13)) z <- rbind(cbind(object=1, part=1, x1), cbind(object=2, part=1, x2), cbind(object=3, part=1, x3), cbind(object=3, part=2, x4)) colnames(z)[3:4] <- c('x', 'y') z <- cbind(z, hole=0) z[(z[, "object"]==3 & z[,"part"]==2), "hole"] <- 1 p <- vect(z, "polygons") crds(p) f <- system.file("ex/lux.shp", package="terra") v <- vect(f) g <- crds(v) head(g) } \keyword{spatial} terra/man/halo.Rd0000644000176200001440000000175114536376240013372 0ustar liggesusers\name{halo} \alias{halo} \title{Add halo-ed text to a plot} \description{ Add text to a plot that has a "halo". That is, a buffer around it to enhance visibility. } \usage{ halo(x, y=NULL, labels, col="black", hc="white", hw=0.1, ...) } \arguments{ \item{x,y}{numeric. coordinates where the text labels should be written} \item{labels}{character. The text to be written} \item{col}{character. The main color to be used} \item{hc}{character. The halo color} \item{hw}{numeric. The halo width} \item{...}{additional arguments to pass to \code{\link[graphics]{text}} } } \seealso{ \code{\link{text}, \link{plot}} } \examples{ r <- rast(nrows=4, ncols=4) values(r) <- 1:ncell(r) plot(r, col="blue", legend=FALSE) text(-100, 20, "hello", cex=2) halo(50, 20, "hello", cex=2) halo(0, -20, "world", font=3, hc="light blue", cex=2, hw=.2) halo(0, 90, "world", font=2, cex=2, hw=.2, xpd=TRUE, pos=2) halo(0, 90, "world", col="white", font=2, hc="blue", cex=2, hw=.2, xpd=TRUE, pos=4) } terra/man/layerCor.Rd0000644000176200001440000000651414547075203014226 0ustar liggesusers\name{layerCor} \alias{layerCor} \alias{layerCor,SpatRaster-method} \title{Correlation and (weighted) covariance} \description{ Compute correlation, (weighted) covariance, or similar summary statistics that compare the values of all pairs of the layers of a SpatRaster. } \usage{ \S4method{layerCor}{SpatRaster}(x, fun, w, asSample=TRUE, use="everything", maxcell=Inf, ...) } \arguments{ \item{x}{SpatRaster} \item{fun}{character. The statistic to compute: either "cov" (covariance), "weighted.cov" (weighted covariance), or "cor" (pearson correlation coefficient) or your own function that takes two vectors as argument to compute a single number} \item{w}{SpatRaster with the weights to compute the weighted covariance. It should have a single layer and the same geometry as \code{x}} \item{asSample}{logical. If \code{TRUE}, the statistic for a sample (denominator is \code{n-1}) is computed, rather than for the population (denominator is \code{n}). Only for the standard functions} \item{use}{character. To decide how to handle missing values. This must be (an abbreviation of) one of "everything", "complete.obs", "pairwise.complete.obs", "masked.complete". With "pairwise.complete.obs", the value for a pair of layers is computed for all cells that are not \code{NA} in that pair. Therefore, it may be that the (number of) cells used varies between pairs. The benefit of this approach is that all available data is used. Use "complete.obs", if you want to only use the values from cells that are not \code{NA} in any of the layers. By using "masked.complete" you indicate that all layers have NA values in the same cells} \item{maxcell}{positive integer. The maximum number of cells to be used. If this is smaller than ncell(x), a regular sample of \code{x} is used} \item{...}{additional arguments for \code{fun} (if it is a proper function)} } \value{ If \code{fun} is one of the three standard statistics, you get a list with three items: the correlation or (weighted) covariance matrix, the (weighted) means, and the number of data cells in each comparison. The means are also a matrix because they may depend on the combination of layers if different cells have missing values and these are excluded from the computation. The rows of the mean matrix represent the layer whose (weighted) mean is being calculated and the columns represent the layer it is being paired with. Only cells with non-missing observations for both layers are used in the calculation of the (weighted) mean. The diagonals of the mean and n matrices are set to missing. If \code{fun} is a function, you get a single matrix. } \references{ For the weighted covariance: \itemize{ \item {Canty, M.J. and A.A. Nielsen, 2008. Automatic radiometric normalization of multitemporal satellite imagery with the iteratively re-weighted MAD transformation. Remote Sensing of Environment 112:1025-1036.} \item {Nielsen, A.A., 2007. The regularized iteratively reweighted MAD method for change detection in multi- and hyperspectral data. IEEE Transactions on Image Processing 16(2):463-478.} } } \seealso{ \code{\link{global}}, \code{\link{cov.wt}}, \code{\link{weighted.mean}} } \examples{ b <- rast(system.file("ex/logo.tif", package="terra")) layerCor(b, "pearson") layerCor(b, "cov") # weigh by column number w <- init(b, fun="col") layerCor(b, "weighted.cov", w=w) } terra/man/linearUnits.Rd0000644000176200001440000000166014536376240014743 0ustar liggesusers\name{linearUnits} \alias{linearUnits} \alias{linearUnits,SpatRaster-method} \alias{linearUnits,SpatVector-method} \title{Linear units of the coordinate reference system} \description{ Get the linear units of the coordinate reference system (crs) of a SpatRaster or SpatVector expressed in m. The value returned is used internally to transform area and perimeter measures to meters. The value returned for longitude/latitude crs is zero. } \usage{ \S4method{linearUnits}{SpatRaster}(x) \S4method{linearUnits}{SpatVector}(x) } \arguments{ \item{x}{SpatRaster or SpatVector} } \value{ numeric (meter) } \seealso{\code{\link{crs}}} \examples{ x <- rast() crs(x) <- "" linearUnits(x) crs(x) <- "+proj=longlat +datum=WGS84" linearUnits(x) crs(x) <- "+proj=utm +zone=1 +units=cm" linearUnits(x) crs(x) <- "+proj=utm +zone=1 +units=km" linearUnits(x) crs(x) <- "+proj=utm +zone=1 +units=us-ft" linearUnits(x) } \keyword{spatial} terra/man/time.Rd0000644000176200001440000000401314741300054013363 0ustar liggesusers\name{time} \alias{time} \alias{time,SpatRaster-method} \alias{time,SpatRasterDataset-method} \alias{has.time} \alias{has.time,SpatRaster-method} \alias{has.time,SpatRasterDataset-method} \alias{time<-} \alias{time<-,SpatRaster-method} \alias{time<-,SpatRasterDataset-method} \alias{timeInfo} \alias{timeInfo,SpatRaster-method} \alias{timeInfo,SpatRasterDataset-method} \title{time of SpatRaster layers} \description{ Get or set the time of the layers of a SpatRaster. Time can be stored as \code{\link{POSIXlt}} (date and time, with a resolution of seconds, and a time zone), \code{\link{Date}}, "months", "years", or "yearmonths". \code{timeInfo} and \code{has.time} are helper functions to understand what a time data a SpatRaster has. } \usage{ \S4method{has.time}{SpatRaster}(x) \S4method{time}{SpatRaster}(x, format="") \S4method{time}{SpatRaster}(x, tstep="")<-value \S4method{timeInfo}{SpatRaster}(x) } \seealso{\code{\link{depth}}} \arguments{ \item{x}{SpatRaster or SpatRasterDataset} \item{format}{One of "", "seconds" (POSIXlt), "days" (Date), "yearmonths" (decimal years), "years", "months". If "", the returned format is (based on) the format that was used to set the time} \item{value}{\code{Date}, \code{POSIXt}, \code{yearmon} (defined in package zoo), or numeric} \item{tstep}{One of "years", "months", "yearmonths". Used when \code{value} is numeric. Ignored when \code{value} is of type \code{Date}, \code{POSIXt}, or \code{yearmon}} } \value{ \code{time}: POSIXlt, Date, or numeric \code{timeInfo}: data.frame with time step and time zone information (if available) \code{has.time}: logical } \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) # Date" d <- as.Date("2001-05-04") + 0:2 time(s) <- d time(s) # POSIX (date/time with a resolution of seconds) time(s) <- as.POSIXlt(d) time(s) # with time zone time(s) <- as.POSIXlt(Sys.time(), "America/New_York") + 0:2 time(s) timeInfo(s) # years time(s, tstep="years") <- 2000 + 0:2 s time(s, tstep="months") <- 1:3 s } \keyword{spatial} terra/man/transpose.Rd0000644000176200001440000000133114536376240014457 0ustar liggesusers\name{transpose} \docType{methods} \alias{t} \alias{t,SpatRaster-method} \alias{t,SpatVector-method} \alias{trans} \alias{trans,SpatRaster-method} \title{Transpose} \description{ Transpose a SpatRaster or SpatVector } \usage{ \S4method{t}{SpatRaster}(x) \S4method{t}{SpatVector}(x) \S4method{trans}{SpatRaster}(x, filename="", ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{flip}, \link{rotate}} } \examples{ r <- rast(nrows=18, ncols=36) values(r) <- 1:ncell(r) tr1 <- t(r) tr2 <- trans(r) ttr <- trans(tr2) } \keyword{spatial} terra/man/crosstab.Rd0000644000176200001440000000174514536376240014272 0ustar liggesusers\name{crosstab} \docType{methods} \alias{crosstab} \alias{crosstab,SpatRaster,missing-method} \title{Cross-tabulate} \description{ Cross-tabulate the layers of a SpatRaster to create a contingency table. } \usage{ \S4method{crosstab}{SpatRaster,missing}(x, digits=0, long=FALSE, useNA=FALSE) } \arguments{ \item{x}{SpatRaster} \item{digits}{integer. The number of digits for rounding the values before cross-tabulation} \item{long}{logical. If \code{TRUE} the results are returned in 'long' format data.frame instead of a table} \item{useNA}{logical, indicting if the table should includes counts of \code{NA} values} } \value{ A table or data.frame } \seealso{ \code{\link{freq}}, \code{\link{zonal}} } \examples{ r <- s <- rast(nc=5, nr=5) set.seed(1) values(r) <- runif(ncell(r)) * 2 values(s) <- runif(ncell(r)) * 3 x <- c(r, s) crosstab(x) rs <- r/s r[1:5] <- NA s[20:25] <- NA x <- c(r, s, rs) crosstab(x, useNA=TRUE, long=TRUE) } \keyword{methods} \keyword{spatial} terra/man/rowSums.Rd0000644000176200001440000000200214721145621014105 0ustar liggesusers\name{rowSums} \docType{methods} \alias{rowSums} \alias{rowSums,SpatRaster-method} \alias{colSums} \alias{colSums,SpatRaster-method} \alias{rowMeans} \alias{rowMeans,SpatRaster-method} \alias{colMeans} \alias{colMeans,SpatRaster-method} \title{row/col sums and means for SpatRaster} \description{ Sum or average values of SpatRaster layers by row or column. } \usage{ \S4method{rowSums}{SpatRaster}(x, na.rm=FALSE, dims=1L, ...) \S4method{colSums}{SpatRaster}(x, na.rm=FALSE, dims=1L, ...) \S4method{rowMeans}{SpatRaster}(x, na.rm=FALSE, dims=1L, ...) \S4method{colMeans}{SpatRaster}(x, na.rm=FALSE, dims=1L, ...) } \arguments{ \item{x}{SpatRaster} \item{na.rm}{logical. If \code{TRUE}, \code{NA} values are ignored} \item{dims}{this argument is ignored} \item{...}{additional arguments (none implemented)} } \value{ matrix } \seealso{ See \code{\link{global}} for summing all cells values } \examples{ r <- rast(ncols=2, nrows=5, nl=2, vals=1:20) rowSums(r) colSums(r) colMeans(r) } \keyword{spatial} terra/man/interpolate.Rd0000644000176200001440000001365614573262746015012 0ustar liggesusers\name{interpolation} \docType{methods} \alias{interpolate} \alias{interpolate,SpatRaster-method} \title{Spatial interpolation} \description{ Make a SpatRaster with interpolated values using a fitted model object of classes such as "gstat" (gstat package) or "Krige" (fields package), or any other model that has location (e.g., "x" and "y", or "longitude" and "latitude") as predictors (independent variables). If x and y are the only predictors, it is most efficient if you provide an empty (no associated data in memory or on file) SpatRaster for which you want predictions. If there are more spatial predictor variables, provide these as a SpatRaster in the first argument of the function. If you do not have x and y locations as implicit predictors in your model you should use \code{\link[terra]{predict}} instead. } \usage{ \S4method{interpolate}{SpatRaster}(object, model, fun=predict, ..., xyNames=c("x", "y"), factors=NULL, const=NULL, index = NULL, cores=1, cpkgs=NULL, na.rm=FALSE, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{object}{SpatRaster} \item{model}{model object} \item{fun}{function. Default value is "predict", but can be replaced with e.g. "predict.se" (depending on the class of \code{model}), or a custom function (see examples)} \item{...}{additional arguments passed to \code{fun}} \item{xyNames}{character. variable names that the model uses for the spatial coordinates. E.g., \code{c("longitude", "latitude")}} \item{factors}{list with levels for factor variables. The list elements should be named with names that correspond to names in \code{object} such that they can be matched. This argument may be omitted for some models from which the levels can be extracted from the \code{model} object} \item{const}{data.frame. Can be used to add a constant for which there is no SpatRaster for model predictions. This is particularly useful if the constant is a character-like factor value} \item{index}{positive integer or NULL. Allows for selecting of the variable returned if the model returns multiple variables} \item{cores}{positive integer. If \code{cores > 1}, a 'parallel' package cluster with that many cores is created and used} \item{cpkgs}{character. The package(s) that need to be loaded on the nodes to be able to run the model.predict function (see examples in \code{\link{predict}})} \item{na.rm}{logical. If \code{TRUE}, cells with \code{NA} values in the predictors are removed from the computation. This option prevents errors with models that cannot handle \code{NA} values. In most other cases this will not affect the output. An exception is when predicting with a model that returns predicted values even if some (or all!) variables are \code{NA} } \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{predict}}, \code{\link{interpIDW}}, \code{\link{interpNear}}} \examples{ r <- rast(system.file("ex/elev.tif", package="terra")) ra <- aggregate(r, 10) xy <- data.frame(xyFromCell(ra, 1:ncell(ra))) v <- values(ra) i <- !is.na(v) xy <- xy[i,] v <- v[i] \dontrun{ library(fields) tps <- Tps(xy, v) p <- rast(r) # use model to predict values at all locations p <- interpolate(p, tps) p <- mask(p, r) plot(p) ### change "fun" from predict to fields::predictSE to get the TPS standard error ## need to use "rast(p)" to remove the values se <- interpolate(rast(p), tps, fun=predictSE) se <- mask(se, r) plot(se) ### another predictor variable, "e" e <- (init(r, "x") * init(r, "y")) / 100000000 names(e) <- "e" z <- as.matrix(extract(e, xy)[,-1]) ## add as another independent variable xyz <- cbind(xy, z) tps2 <- Tps(xyz, v) p2 <- interpolate(e, tps2, xyOnly=FALSE) ## as a linear covariate tps3 <- Tps(xy, v, Z=z) ## Z is a separate argument in Krig.predict, so we need a new function ## Internally (in interpolate) a matrix is formed of x, y, and elev (Z) pfun <- function(model, x, ...) { predict(model, x[,1:2], Z=x[,3], ...) } p3 <- interpolate(e, tps3, fun=pfun) #### gstat examples library(gstat) library(sp) data(meuse) ### inverse distance weighted (IDW) r <- rast(system.file("ex/meuse.tif", package="terra")) mg <- gstat(id = "zinc", formula = zinc~1, locations = ~x+y, data=meuse, nmax=7, set=list(idp = .5)) z <- interpolate(r, mg, debug.level=0, index=1) z <- mask(z, r) ## with a model built with an `sf` object you need to provide custom function library(sf) sfmeuse <- st_as_sf(meuse, coords = c("x", "y"), crs=crs(r)) mgsf <- gstat(id = "zinc", formula = zinc~1, data=sfmeuse, nmax=7, set=list(idp = .5)) interpolate_gstat <- function(model, x, crs, ...) { v <- st_as_sf(x, coords=c("x", "y"), crs=crs) p <- predict(model, v, ...) as.data.frame(p)[,1:2] } zsf <- interpolate(r, mgsf, debug.level=0, fun=interpolate_gstat, crs=crs(r), index=1) zsf <- mask(zsf, r) ### kriging ### ordinary kriging v <- variogram(log(zinc)~1, ~x+y, data=meuse) mv <- fit.variogram(v, vgm(1, "Sph", 300, 1)) gOK <- gstat(NULL, "log.zinc", log(zinc)~1, meuse, locations=~x+y, model=mv) OK <- interpolate(r, gOK, debug.level=0) ## universal kriging vu <- variogram(log(zinc)~elev, ~x+y, data=meuse) mu <- fit.variogram(vu, vgm(1, "Sph", 300, 1)) gUK <- gstat(NULL, "log.zinc", log(zinc)~elev, meuse, locations=~x+y, model=mu) names(r) <- "elev" UK <- interpolate(r, gUK, debug.level=0) ## co-kriging gCoK <- gstat(NULL, 'log.zinc', log(zinc)~1, meuse, locations=~x+y) gCoK <- gstat(gCoK, 'elev', elev~1, meuse, locations=~x+y) gCoK <- gstat(gCoK, 'cadmium', cadmium~1, meuse, locations=~x+y) gCoK <- gstat(gCoK, 'copper', copper~1, meuse, locations=~x+y) coV <- variogram(gCoK) plot(coV, type='b', main='Co-variogram') coV.fit <- fit.lmc(coV, gCoK, vgm(model='Sph', range=1000)) coV.fit plot(coV, coV.fit, main='Fitted Co-variogram') coK <- interpolate(r, coV.fit, debug.level=0) plot(coK) } } \keyword{methods} \keyword{spatial} terra/man/factors.Rd0000644000176200001440000001011314740151017014066 0ustar liggesusers\name{factors} \docType{methods} \alias{droplevels} \alias{droplevels,SpatRaster-method} \alias{levels} \alias{levels,SpatRaster-method} \alias{levels<-} \alias{levels<-,SpatRaster-method} \alias{cats} \alias{cats,SpatRaster-method} \alias{categories} \alias{categories,SpatRaster-method} \alias{addCats} \alias{addCats,SpatRaster-method} \alias{combineLevels} \title{Categorical rasters} \description{ A SpatRaster layer can represent a categorical variable (factor). Like \code{\link{factor}}s, SpatRaster categories are stored as integers that have an associated label. The categories can be inspected with \code{levels} and \code{cats}. They are represented by a \code{data.frame} that must have two or more columns, the first one identifying the (integer) cell values and the other column(s) providing the category labels. If there are multiple columns with categories, you can set the "active" category to choose the one you want to use. \code{cats} returns the entire data.frame, whereas \code{levels} only return two columns: the index and the active category. To set categories for the first layer of a SpatRaster, you can provide \code{levels<-} with a data.frame or a list with a data.frame. To set categories for multiple layers you can provide \code{levels<-} with a list with one element (that either has a \code{data.frame} or is \code{NULL}) for each layer. Use \code{categories} to set the categories for a specific layer or specific layers. \code{droplevels} removes categories that are not used (declared but not present as values in the raster) if \code{levels=NULL}. \code{addCats} adds additional categories to a layer that already is categorical. It adds new variables, not new levels of an existing categorical variable. \code{combineLevels} combines the levels of all layers of \code{x} and sets them to all layers. That fails if there are labeling conflicts between layers } \usage{ \S4method{levels}{SpatRaster}(x) \S4method{levels}{SpatRaster}(x)<-value \S4method{cats}{SpatRaster}(x, layer) \S4method{categories}{SpatRaster}(x, layer=1, value, active=1, ...) \S4method{droplevels}{SpatRaster}(x, level=NULL, layer=1) \S4method{addCats}{SpatRaster}(x, value, merge=FALSE, layer=1) combineLevels(x, assign=TRUE) } \arguments{ \item{x}{SpatRaster} \item{layer}{the layer name or number (positive integer); or 0 for all layers} \item{value}{a data.frame (ID, category) that define the categories. Or \code{NULL} to remove them} \item{active}{positive integer, indicating the column in \code{value} to be used as the active category (zero based to skip the first column with the cell values; that is 1 is the second column in \code{value})} \item{level}{the categories to remove for the layer specified with \code{layer}} \item{merge}{logical. If \code{TRUE}, the categories are combined with \code{\link[base]{merge}} using the first column of \code{value} as ID. If \code{FALSE} the categories are combined with \code{cbind}} \item{...}{additional arguments (none)} \item{assign}{logical. Assign the combined levels to all layers of \code{x}? If \code{FALSE}, the levels are returned} } \value{ SpatRaster, data.frame, list of data.frames (levels, cats), or logical (is.factor) } \seealso{\code{\link{activeCat}}, \code{\link{catalyze}}, \code{\link{set.cats}}, \code{\link{as.factor}}, \code{\link{is.factor}}} \examples{ set.seed(0) r <- rast(nrows=10, ncols=10) values(r) <- sample(3, ncell(r), replace=TRUE) is.factor(r) cls <- data.frame(id=1:3, cover=c("forest", "water", "urban")) levels(r) <- cls is.factor(r) r plot(r, col=c("green", "blue", "light gray")) text(r, digits=3, cex=.75, halo=TRUE) # raster starts at 3 x <- r + 2 is.factor(x) # Multiple categories d <- data.frame(id=3:5, cover=cls[,2], letters=letters[1:3], value=10:12) levels(x) <- d x # get current index activeCat(x) # set index activeCat(x) <- 3 activeCat(x) activeCat(x) <- "letters" plot(x, col=c("green", "blue", "light gray")) text(x, digits=3, cex=.75, halo=TRUE) r <- as.numeric(x) r p <- as.polygons(x) plot(p, "letters", col=c("green", "blue", "light gray")) } \keyword{methods} \keyword{spatial} terra/man/voronoi.Rd0000644000176200001440000000254214733575507014147 0ustar liggesusers\name{voronoi} \alias{delaunay} \alias{voronoi} \alias{voronoi,SpatVector-method} \alias{delaunay,SpatVector-method} \title{Voronoi diagram and Delaunay triangles} \description{ Get a Voronoi diagram or Delaunay triangles for points, or the nodes of lines or polygons } \usage{ \S4method{voronoi}{SpatVector}(x, bnd=NULL, tolerance=0, as.lines=FALSE, deldir=FALSE) \S4method{delaunay}{SpatVector}(x, tolerance=0, as.lines=FALSE, constrained=FALSE) } \arguments{ \item{x}{SpatVector} \item{bnd}{SpatVector to set the outer boundary of the voronoi diagram} \item{tolerance}{numeric >= 0, snapping tolerance (0 is no snapping)} \item{as.lines}{logical. If \code{TRUE}, lines are returned without the outer boundary} \item{constrained}{logical. If \code{TRUE}, a constrained delaunay triangulation is returned} \item{deldir}{logical. If \code{TRUE}, the \code{\link[deldir]{deldir}} is used instead of the GEOS C++ library method. It has been reported that \code{deldir} does not choke on very large data sets} } \value{SpatVector} \examples{ wkt <- c("MULTIPOLYGON ( ((40 40, 20 45, 45 30, 40 40)), ((20 35, 10 30, 10 10, 30 5, 45 20, 20 35),(30 20, 20 15, 20 25, 30 20)))", "POLYGON ((0 -5, 10 0, 10 -10, 0 -5))") x <- vect(wkt) v <- voronoi(x) v d <- delaunay(x) d plot(v, lwd=2, col=rainbow(15)) lines(x, col="gray", lwd=2) points(x) } \keyword{spatial} terra/man/match.Rd0000644000176200001440000000217214536376240013541 0ustar liggesusers\name{match} \docType{methods} \alias{match} \alias{match,SpatRaster-method} \alias{\%in\%} \alias{\%in\%,SpatRaster-method} \title{Value matching for SpatRasters} \description{ \code{match} returns a SpatRaster with the position of the matched values. The cell values are the index of the table argument. \code{\%in\%} returns a 0/1 (FALSE/TRUE) SpatRaster indicating if the cells values were matched or not. } \usage{ match(x, table, nomatch = NA_integer_, incomparables = NULL) x \%in\% table } \arguments{ \item{x}{SpatRaster} \item{table}{vector of the values to be matched against} \item{nomatch}{the value to be returned in the case when no match is found. Note that it is coerced to integer} \item{incomparables}{a vector of values that cannot be matched. Any value in x matching a value in this vector is assigned the nomatch value. For historical reasons, FALSE is equivalent to NULL} } \value{ SpatRaster } \seealso{ \code{\link{app}, \link[base]{match}} } \examples{ r <- rast(nrows=10, ncols=10) values(r) <- 1:100 m <- match(r, c(5:10, 50:55)) n <- r \%in\% c(5:10, 50:55) } \keyword{spatial} \keyword{methods} terra/man/aggregate.Rd0000644000176200001440000000717114746603734014403 0ustar liggesusers\name{aggregate} \docType{methods} \alias{aggregate} \alias{aggregate,SpatRaster-method} \alias{aggregate,SpatVector-method} \title{Aggregate raster or vector data} \description{ Aggregate a SpatRaster to create a new SpatRaster with a lower resolution (larger cells). Aggregation groups rectangular areas to create larger cells. The value for the resulting cells is computed with a user-specified function. You can also aggregate ("dissolve") a SpatVector. This either combines all geometries into one geometry, or it combines the geometries that have the same value for the variable(s) specified with argument \code{by}. } \usage{ \S4method{aggregate}{SpatRaster}(x, fact=2, fun="mean", ..., cores=1, filename="", overwrite=FALSE, wopt=list()) \S4method{aggregate}{SpatVector}(x, by=NULL, dissolve=TRUE, fun="mean", count=TRUE, ...) } \arguments{ \item{x}{SpatRaster} \item{fact}{positive integer. Aggregation factor expressed as number of cells in each direction (horizontally and vertically). Or two integers (horizontal and vertical aggregation factor) or three integers (when also aggregating over layers)} \item{fun}{function used to aggregate values. Either an actual function, or for the following, their name: "mean", "max", "min", "median", "sum", "modal", "any", "all", "prod", "which.min", "which.max", "table", "sd" (sample standard deviation) and "std" (population standard deviation)} \item{...}{additional arguments passed to \code{fun}, such as \code{na.rm=TRUE}} \item{cores}{positive integer. If \code{cores > 1}, a 'parallel' package cluster with that many cores is created. Ignored for C++ level implemented functions that are listed under \code{fun}} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} \item{by}{character. The variable(s) used to group the geometries} \item{dissolve}{logical. Should borders between aggregated geometries be dissolved?} \item{count}{logical. If \code{TRUE} and \code{by} is not \code{NULL}, a variable "agg_n" is included that shows the number of input geometries for each output geometry} } \details{ Aggregation starts at the upper-left end of a SpatRaster. If a division of the number of columns or rows with \code{factor} does not return an integer, the extent of the resulting SpatRaster will be somewhat larger then that of the original SpatRaster. For example, if an input SpatRaster has 100 columns, and \code{fact=12}, the output SpatRaster will have 9 columns and the maximum x coordinate of the output SpatRaster is also adjusted. The function \code{fun} should take multiple numbers, and return one or more numeric values. If multiple numbers are returned, the length of the returned vector should always be the same, also, for example, when the input is only NA values. For that reason, \code{range} works, but \code{unique} will fail in most cases. } \seealso{\code{\link{disagg}} to disaggregate, and \code{\link{resample}} for more complex changes in resolution and alignment} \value{ SpatRaster } \examples{ r <- rast() # aggregated SpatRaster, no values ra <- aggregate(r, fact=10) values(r) <- runif(ncell(r)) # aggregated raster, max of the values ra <- aggregate(r, fact=10, fun=max) # multiple layers s <- c(r, r*2) x <- aggregate(s, 20) ## SpatVector f <- system.file("ex/lux.shp", package="terra") v <- vect(f) va <- aggregate(v, "ID_1") plot(va, "NAME_1", lwd=5, plg=list(x="topright"), mar=rep(2,4)) lines(v, lwd=3, col="light gray") lines(va) text(v, "ID_1", halo=TRUE) } \keyword{methods} \keyword{spatial} terra/man/focalPairs.Rd0000644000176200001440000000414714536376240014534 0ustar liggesusers\name{focalPairs} \alias{focalCor} \alias{focalCor,SpatRaster-method} \alias{focalPairs} \alias{focalPairs,SpatRaster-method} \title{Focal function across two layers} \description{ Calculate values such as a correlation coefficient for focal regions in two neighboring layers. A function is applied to the first and second layer, then to the second and third layer, etc. } \usage{ \S4method{focalPairs}{SpatRaster}(x, w=3, fun, ..., fillvalue=NA, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatRaster with at least two layers} \item{w}{numeric or matrix to define the focal window. The window an be defined as one (for a square) or two numbers (row, col); or with an odd-sized weights matrix. See the Details section in \code{\link{focal}}. Note that if a matrix with numbers other than zero or one are used, the values are used as weights. For this to work, \code{fun} must have an argument \code{weights}} \item{fun}{a function with at least two arguments (one for each layer). There is a built-in function "pearson" (for both the weighted and the unweighted Pearson correlation coefficient. This function has an additional argument \code{na.rm=FALSE}} \item{...}{additional arguments for \code{fun}} \item{fillvalue}{numeric. The value of the cells in the virtual rows and columns outside of the raster} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{SpatRaster} \seealso{ \code{\link{layerCor}}, \code{\link{focalReg}}, \code{\link{focal}}, \code{\link{focal3D}}} \examples{ r <- rast(system.file("ex/logo.tif", package="terra")) set.seed(0) r[[1]] <- flip(r[[1]], "horizontal") r[[2]] <- flip(r[[2]], "vertical") + init(rast(r,1), runif) r[[3]] <- init(rast(r,1), runif) x <- focalPairs(r, w=5, "pearson", na.rm=TRUE) plot(x) # suppress warning "the standard deviation is zero" suppressWarnings(x <- focalPairs(r, w=5, "pearson", use="complete.obs")) z <- focalPairs(r, w=9, function(x, y) mean(x) + mean(y)) } \keyword{spatial} terra/man/deepcopy.Rd0000644000176200001440000000123214754242002014237 0ustar liggesusers\name{deepcopy} \docType{methods} \alias{deepcopy} \alias{deepcopy,SpatRaster-method} \alias{deepcopy,SpatVector-method} \title{Deep copy} \description{ Make a deep copy of a SpatRaster or SpatVector. This is occasionally useful when using an in-place replacement function that does not make copy, such as \code{\link{set.ext}}. } \usage{ \S4method{deepcopy}{SpatRaster}(x) \S4method{deepcopy}{SpatVector}(x) } \arguments{ \item{x}{SpatRaster or SpatVector} } \value{ Same as \code{x} } \examples{ r <- rast(ncols=10, nrows=10, nl=3) x <- r y <- deepcopy(r) ext(r) set.ext(x, c(0,10,0,10)) ext(x) ext(r) ext(y) } \keyword{methods} \keyword{spatial} terra/man/distance.Rd0000644000176200001440000001466314745237460014251 0ustar liggesusers\name{distance} \alias{distance} \alias{distance,SpatRaster,missing-method} \alias{distance,SpatRaster,SpatVector-method} \alias{distance,SpatRaster,sf-method} \alias{distance,SpatVector,ANY-method} \alias{distance,SpatVector,SpatVector-method} \alias{distance,matrix,matrix-method} \alias{distance,matrix,missing-method} \alias{distance,data.frame,data.frame-method} \alias{distance,data.frame,missing-method} \title{Geographic distance} \description{ If \code{x} is a \bold{SpatRaster}: If \code{y} is \code{missing} this method computes the distance, for all cells that are \code{NA} in SpatRaster \code{x} to the nearest cell that is not \code{NA} (or other values, see arguments "target" and "exclude"). If \code{y} is a numeric value, the cells with that value are ignored. That is, distance to or from these cells is not computed (only if \code{grid=FALSE}). If \code{y} is a SpatVector, the distance to that SpatVector is computed for all cells, optionally after rasterization. The distance is always expressed in meter if the coordinate reference system is longitude/latitude, and in map units otherwise. Map units are typically meter, but inspect \code{crs(x)} if in doubt. Results are more precise, sometimes much more precise, when using longitude/latitude rather than a planar coordinate reference system, as these distort distance. If \code{x} is a \bold{SpatVector}: If \code{y} is \code{missing}, a distance matrix between all objects in \code{x} is computed. A distance matrix object of class "dist" is returned. If \code{y} is a SpatVector the geographic distance between all objects is computed (and a matrix is returned). If both sets have the same number of points, and \code{pairwise=TRUE}, the distance between each pair of objects is computed, and a vector is returned. If \code{x} is a \bold{matrix}: \code{x} should consist of two columns, the first with "x" (or longitude) and the second with "y" coordinates (or latitude). If \code{y} is a also a matrix, the distance between each points in \code{x} and all points in \code{y} is computed, unless \code{pairwise=TRUE} If \code{y} is missing, the distance between each points in \code{x} with all other points in \code{x} is computed, unless \code{sequential=TRUE} } \usage{ \S4method{distance}{SpatRaster,missing}(x, y, target=NA, exclude=NULL, unit="m", method="haversine", maxdist=NA, values=FALSE, filename="", ...) \S4method{distance}{SpatRaster,SpatVector}(x, y, unit="m", rasterize=FALSE, method="cosine", filename="", ...) \S4method{distance}{SpatVector,ANY}(x, y, sequential=FALSE, pairs=FALSE, symmetrical=TRUE, unit="m", method="geo") \S4method{distance}{SpatVector,SpatVector}(x, y, pairwise=FALSE, unit="m", method="cosine") \S4method{distance}{matrix,matrix}(x, y, lonlat, pairwise=FALSE, unit="m", method="geo") \S4method{distance}{matrix,missing}(x, y, lonlat, sequential=FALSE, pairs=FALSE, symmetrical=TRUE, unit="m", method="geo") } \arguments{ \item{x}{SpatRaster, SpatVector, or two-column matrix with coordinates (x,y) or (lon,lat)} \item{y}{missing, numeric, SpatVector, or two-column matrix} \item{target}{numeric. The value of the cells for which distances to cells that are not \code{NA} should be computed} \item{exclude}{numeric. The value of the cells that should not be considered for computing distances} \item{unit}{character. Can be either "m" or "km"} \item{method}{character. One of "geo", "cosine" or "haversine" (the latter cannot be used for distances to lines or polygons). With "geo" the most precise but slower method of Karney (2003) is used. The other two methods are faster but less precise} \item{maxdist}{numeric. Distance above this values are not set to \code{NA}} \item{values}{logical. If \code{TRUE}, the value of the nearest non-target cell is returned instead of the distance to that cell} \item{rasterize}{logical. If \code{TRUE} distance is computed from the cells covered by the geometries after rasterization. This can be much faster in some cases} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} \item{sequential}{logical. If \code{TRUE}, the distance between sequential geometries is returned} \item{pairwise}{logical. If \code{TRUE} and if x and y have the same size (number of rows), the pairwise distances are returned instead of the distances between all elements} \item{lonlat}{logical. If \code{TRUE} the coordinates are interpreted as angular (longitude/latitude). If \code{FALSE} they are interpreted as planar} \item{pairs}{logical. If \code{TRUE} a "from", "to", "distance" matrix is returned} \item{symmetrical}{logical. If \code{TRUE} and \code{pairs=TRUE}, the distance between a pair is only included once. The distance between geometry 1 and 3 is included, but the (same) distance between 3 and 1 is not} } \value{ SpatRaster, numeric, matrix, or a distance matrix (object of class "dist") } \note{ A distance matrix can be coerced into a regular matrix with \code{as.matrix} } \seealso{\code{\link{nearest}}, \code{\link{nearby}}} \references{ Karney, C.F.F., 2013. Algorithms for geodesics, J. Geodesy 87: 43-55. doi:10.1007/s00190-012-0578-z. } \examples{ #lonlat r <- rast(ncols=36, nrows=18, crs="+proj=longlat +datum=WGS84") r[500] <- 1 d <- distance(r, unit="km") plot(d / 1000) #planar rr <- rast(ncols=36, nrows=18, crs="+proj=utm +zone=1 +datum=WGS84") rr[500] <- 1 d <- distance(rr) rr[3:10, 3:10] <- 99 e <- distance(rr, exclude=99) p1 <- vect(rbind(c(0,0), c(90,30), c(-90,-30)), crs="+proj=longlat +datum=WGS84") dp <- distance(r, p1) d <- distance(p1) d as.matrix(d) p2 <- vect(rbind(c(30,-30), c(25,40), c(-9,-3)), crs="+proj=longlat +datum=WGS84") dd <- distance(p1, p2) dd pd <- distance(p1, p2, pairwise=TRUE) pd pd == diag(dd) # polygons, lines crs <- "+proj=utm +zone=1" p1 <- vect("POLYGON ((0 0, 8 0, 8 9, 0 9, 0 0))", crs=crs) p2 <- vect("POLYGON ((5 6, 15 6, 15 15, 5 15, 5 6))", crs=crs) p3 <- vect("POLYGON ((2 12, 3 12, 3 13, 2 13, 2 12))", crs=crs) p <- rbind(p1, p2, p3) L1 <- vect("LINESTRING(1 11, 4 6, 10 6)", crs=crs) L2 <- vect("LINESTRING(8 14, 12 10)", crs=crs) L3 <- vect("LINESTRING(1 8, 12 14)", crs=crs) lns <- rbind(L1, L2, L3) pts <- vect(cbind(c(7,10,10), c(3,5,6)), crs=crs) distance(p1,p3) distance(p) distance(p,pts) distance(p,lns) distance(pts,lns) } \keyword{spatial} terra/man/units.Rd0000644000176200001440000000146114536376240013607 0ustar liggesusers\name{units} \alias{units} \alias{units<-} \alias{units,SpatRaster-method} \alias{units<-,SpatRaster-method} \alias{units,SpatRasterDataset-method} \alias{units<-,SpatRasterDataset-method} \title{units of SpatRaster or SpatRasterDataSet} \description{ Get or set the units of the layers of a SpatRaster or the datasets in a SpatRasterDataSet. } \usage{ \S4method{units}{SpatRaster}(x) \S4method{units}{SpatRaster}(x)<-value \S4method{units}{SpatRasterDataset}(x) \S4method{units}{SpatRasterDataset}(x)<-value } \arguments{ \item{x}{SpatRaster} \item{value}{character} } \value{ character } \seealso{\code{\link{time}, \link{names}}} \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) units(s) <- c("m/s", "kg", "ha") units(s) s units(s) <- "kg" units(s) } \keyword{spatial} terra/man/sds.Rd0000644000176200001440000000363414547074073013243 0ustar liggesusers\name{sds} \docType{methods} \alias{sds} \alias{sds,missing-method} \alias{sds,character-method} \alias{sds,list-method} \alias{sds,array-method} \alias{sds,SpatRaster-method} \alias{sds,stars-method} \alias{sds,stars_proxy-method} \alias{[<-,SpatRasterDataset,numeric,missing-method} \title{Create a SpatRasterDataset} \description{ Methods to create a SpatRasterDataset. This is an object to hold "sub-datasets", each a SpatRaster that in most cases will have multiple layers. See \code{\link{describe}} for getting information about the sub-datasets present in a file. } \usage{ \S4method{sds}{missing}(x) \S4method{sds}{character}(x, ids=0, opts=NULL, raw=FALSE) \S4method{sds}{SpatRaster}(x, ...) \S4method{sds}{list}(x) \S4method{sds}{array}(x, crs="", extent=NULL) } \arguments{ \item{x}{character (filename), or SpatRaster, or list of SpatRasters, or missing. If multiple filenames are provided, it is attempted to make SpatRasters from these, and combine them into a SpatRasterDataset} \item{ids}{optional. vector of integer subdataset ids. Ignored if the first value is not a positive integer} \item{opts}{character. GDAL dataset open options} \item{raw}{logical. If \code{TRUE}, scale and offset values are ignored} \item{crs}{character. Description of the Coordinate Reference System (map projection) in \code{PROJ.4}, \code{WKT} or \code{authority:code} notation. If this argument is missing, and the x coordinates are within -360 .. 360 and the y coordinates are within -90 .. 90, longitude/latitude is assigned} \item{extent}{\code{\link{SpatExtent}}} \item{...}{additional \code{SpatRaster} objects} } \value{ SpatRasterDataset } \seealso{ \code{\link{describe}} } \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) x <- sds(s, s/2) names(x) <- c("first", "second") x length(x) # extract the second SpatRaster x[2] a <- array(1:9, c(3,3,3,3)) sds(a) } \keyword{methods} \keyword{spatial} terra/man/shift.Rd0000644000176200001440000000163414536376240013564 0ustar liggesusers\name{shift} \docType{methods} \alias{shift} \alias{shift,SpatRaster-method} \alias{shift,SpatExtent-method} \alias{shift,SpatVector-method} \title{Shift} \description{ Shift a SpatRaster, SpatVector or SpatExtent to another location. } \usage{ \S4method{shift}{SpatRaster}(x, dx=0, dy=0, filename="", ...) \S4method{shift}{SpatVector}(x, dx=0, dy=0) \S4method{shift}{SpatExtent}(x, dx=0, dy=0) } \arguments{ \item{x}{SpatRaster, SpatVector or SpatExtent} \item{dx}{numeric. The shift in horizontal direction} \item{dy}{numeric. The shift in vertical direction} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ Same as \code{x} } \seealso{ \code{\link{flip}}, \code{\link{rotate}}} \examples{ r <- rast(xmin=0, xmax=1, ymin=0, ymax=1) r <- shift(r, dx=1, dy=-1) e <- ext(r) shift(e, 5, 5) } \keyword{spatial} terra/man/merge.Rd0000644000176200001440000001100614756424112013534 0ustar liggesusers\name{merge} \docType{methods} \alias{merge} \alias{merge,SpatRaster,SpatRaster-method} \alias{merge,SpatRasterCollection,missing-method} \alias{merge,SpatVector,SpatVector-method} \alias{merge,SpatVector,data.frame-method} \title{ Merge SpatRasters, or merge a SpatVector with a data.frame } \description{ Merge multiple SpatRasters to create a new SpatRaster with a larger spatial extent. The SpatRasters should all have the same coordinate reference system. They should normally also have the same spatial origin and resolution, but automatic resampling can be done depending on the algorithm used (see argument \code{algo}). In areas where the SpatRasters overlap, the values of the SpatRaster that is first in the sequence of arguments (or in the SpatRasterCollection) will be retained (unless \code{first=FALSE}). There is also a method for merging SpatVector with a data.frame; that is, to join the data.frame to the attribute table of the SpatVector. } \usage{ \S4method{merge}{SpatRaster,SpatRaster}(x, y, ..., first=TRUE, na.rm=TRUE, algo=1, method=NULL, filename="", overwrite=FALSE, wopt=list()) \S4method{merge}{SpatRasterCollection,missing}(x, first=TRUE, na.rm=TRUE, algo=1, method=NULL, filename="", ...) \S4method{merge}{SpatVector,data.frame}(x, y, ...) } \arguments{ \item{x}{SpatRaster, SpatRasterCollection, or SpatVector} \item{y}{missing if \code{x} is a SpatRasterCollection. SpatRaster if \code{x} is a SpatRaster. data.frame if \code{x} is a SpatVector} \item{...}{if \code{x} is a SpatRaster: additional objects of the same class as \code{x}. If \code{x} is a SpatRasterCollection: options for writing files as in \code{\link{writeRaster}}. If \code{x} is a SpatVector, the same arguments as in \code{\link[base]{merge}}} \item{first}{logical. If \code{TRUE}, in areas where rasters overlap, the first value is used. Otherwise the last value is used} \item{na.rm}{logical. If \code{TRUE} missing values are are ignored. This is only used for algo 1; the other two always ignore missing values} \item{algo}{integer. You can use 1, 2 or 3 to pick a merge algorithm. algo 1 is generally faster than algo 2, but it may have poorer file compression. Algo 1 will resample input rasters (and that may slow it down), but algo 2 does not do that. You can increase the tolerance option to effectively get nearest neighbor resampling with, for example, \code{wopt=list(tolerance=.2)} allows misalignment of .2 times the resolution of the first input raster and effectively use nearest neighbor resampling. Algo 3 creates a virtual raster (see \code{\link{vrt}}). This is very quick and can be a good approach if the merge raster is used as input to a next step in the analysis. It allows any amount of misalignment (and does not respond to the tolerance option). Otherwise its speed is similar to that of algo 2} \item{method}{character. The interpolation method to be used if resampling is necessary (see argument \code{algo}). One of "nearest", "bilinear", "cubic", "cubicspline", "lanczos", "average", "mode" as in \code{\link{resample}}. If \code{NULL}, "nearest" is used for categorical rasters and "bilinear" for other rasters} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster or SpatVector } \seealso{ Combining tiles with \code{\link{vrt}} may be more efficient than using \code{merge}. See \code{\link{mosaic}} for averaging overlapping regions. See \code{\link{classify}} to merge a \code{SpatRaster} and a \code{data.frame} and \code{\link{union}} to combine SpatExtent objects. } \examples{ x <- rast(xmin=-110, xmax=-80, ymin=40, ymax=70, res=1, vals=1) y <- rast(xmin=-85, xmax=-55, ymax=60, ymin=30, res=1, vals=2) z <- rast(xmin=-60, xmax=-30, ymax=50, ymin=20, res=1, vals=3) m1 <- merge(x, y, z) m2 <- merge(z, y, x) m3 <- merge(y, x, z) # panel(c(m1, m2, m3)) # if you have many SpatRasters, it may be convenient # to make a SpatRasterCollection # s <- sprc(list(x, y, z)) s <- sprc(x, y, z) sm1 <- merge(s, algo=1, first=FALSE) sm2 <- merge(s, algo=2, first=FALSE) #sm3 <- merge(s, algo=3, first=FALSE) ## SpatVector with data.frame f <- system.file("ex/lux.shp", package="terra") p <- vect(f) dfr <- data.frame(District=p$NAME_1, Canton=p$NAME_2, Value=round(runif(length(p), 100, 1000))) dfr <- dfr[1:5, ] pm <- merge(p, dfr, all.x=TRUE, by.x=c('NAME_1', 'NAME_2'), by.y=c('District', 'Canton')) pm values(pm) } \keyword{methods} \keyword{spatial} terra/man/extend.Rd0000644000176200001440000000453214740002046013721 0ustar liggesusers\name{extend} \alias{extend} \alias{extend,SpatRaster-method} \alias{extend,SpatExtent-method} \title{Extend} \description{ Enlarge the spatial extent of a SpatRaster. See \code{\link{crop}} if you (also) want to remove rows or columns. Note that you can only enlarge SpatRasters with entire rows and columns. Therefore, the extent of the output SpatRaster may not be exactly the same as the requested. Depending on argument \code{snap} it may be a bit smaller or larger. You can also enlarge a SpatExtent with this method, or with an algebraic notation (see examples) } \usage{ \S4method{extend}{SpatRaster}(x, y, snap="near", fill=NA, filename="", overwrite=FALSE, ...) \S4method{extend}{SpatExtent}(x, y) } \arguments{ \item{x}{SpatRaster or SpatExtent} \item{y}{If \code{x} is a SpatRaster, \code{y} should be a SpatExtent, or an object from which it can be extracted (such as SpatRaster and SpatVector objects). Alternatively, you can provide one, two or four non-negative integers indicating the number of rows and columns that need to be added at each side (a single positive integer when the number of rows and columns to be added is equal; or 2 number (columns, rows), or four (left column, right column, bottom row, top row). If \code{x} is a SpatExtent, \code{y} should likewise be a numeric vector of 1, 2, or 4 elements} \item{snap}{character. One of "near", "in", or "out". Used to align \code{y} to the geometry of \code{x}} \item{fill}{numeric. The value used to for the new raster cells} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster or SpatExtent } \seealso{\code{\link{crop}}, \code{\link{merge}}, \code{\link{ext}}, \code{\link{resample}}, \code{\link{elongate}}} \examples{ r <- rast(xmin=-150, xmax=-120, ymin=30, ymax=60, ncols=36, nrows=18) values(r) <- 1:ncell(r) e <- ext(-180, -100, 40, 70) re <- extend(r, e) # extend with a number of rows and columns (at each side) re2 <- extend(r, c(2,10)) # SpatExtent e <- ext(r) e extend(e, 10) extend(e, c(10, -10, 0, 20)) # add 10 columns / rows on all sides e + 10 # double extent e * 2 # increase extent by 25% e * 1.25 } \keyword{spatial} terra/man/varnames.Rd0000644000176200001440000000370014536376240014257 0ustar liggesusers\name{varnames} \alias{varnames} \alias{varnames<-} \alias{longnames} \alias{longnames<-} \alias{varnames,SpatRaster-method} \alias{varnames<-,SpatRaster-method} \alias{longnames,SpatRaster-method} \alias{longnames<-,SpatRaster-method} \alias{varnames,SpatRasterDataset-method} \alias{varnames<-,SpatRasterDataset-method} \alias{longnames,SpatRasterDataset-method} \alias{longnames<-,SpatRasterDataset-method} \title{variable and long variable names} \description{ Set or get names for each dataset (variable) in a SpatRasterDataset. Each SpatRaster _data source_ can also have a variable name and a long variable name. They are set when reading a file with possibly multiple sub-datasets (e.g. netcdf or hdf5 format) into a single SpatRaster. Each sub-datset is a seperate "data-source" in the SpatRaster. Note that newly created or derived SpatRasters always have a single variable (data source), and therefore the variable names are lost when processing a multi-variable SpatRaster. Thus the variable names are mostly useful to understand a SpatRaster created from some files and for managing SpatRasterDatasets. See \code{link{names}} for the more commonly used _layer_ names. } \usage{ \S4method{varnames}{SpatRaster}(x) \S4method{varnames}{SpatRaster}(x)<-value \S4method{longnames}{SpatRaster}(x) \S4method{longnames}{SpatRaster}(x)<-value \S4method{varnames}{SpatRasterDataset}(x) \S4method{varnames}{SpatRasterDataset}(x)<-value \S4method{longnames}{SpatRasterDataset}(x) \S4method{longnames}{SpatRasterDataset}(x)<-value } \arguments{ \item{x}{SpatRaster, SpatRasterDataset} \item{value}{character (vector)} } \value{ character } \note{ terra enforces neither unique nor valid names. See \code{\link{make.unique}} to create unique names and \code{{make.names}} to make syntactically valid names. } \examples{ s <- rast(ncols=5, nrows=5, nlyrs=3) names(s) <- c("a", "b", "c") x <- sds(s, s) varnames(x) <- c("one", "two") x } \keyword{spatial} terra/man/subset_dollar.Rd0000644000176200001440000000264414624067663015317 0ustar liggesusers\name{subset_dollar} \alias{$} \alias{$,SpatRaster-method} \alias{$,SpatRasterDataset-method} \alias{$,SpatVector-method} \alias{$,SpatExtent-method} \alias{$,SpatVectorCollection-method} \title{Subset a SpatRaster or a SpatVector} \description{ Select a subset of layers from a SpatRaster or select a subset of records (row) and/or variables (columns) from a SpatVector. } \usage{ \S4method{$}{SpatExtent}(x, name) } \arguments{ \item{x}{SpatRaster, SpatVector or SpatExtent} \item{name}{character. If \code{x} is a SpatRaster: layer name. If \code{x} is a SpatVector: variable name. If \code{x} is a SpatExtent: xmin, xmax, ymin or ymax} } \value{ if \code{x} is a \code{SpatRaster}: SpatRaster if \code{x} is a \code{SpatVector}: SpatVector or, if \code{drop=TRUE}, a \code{data.frame}. } \seealso{\code{\link{subset}}, \code{\link{[}}, \code{\link{[[}}, \code{\link{extract}}} \examples{ ### SpatRaster s <- rast(system.file("ex/logo.tif", package="terra")) subset(s, 2:3) subset(s, c(3,2,3,1)) #equivalent to s[[ c(3,2,3,1) ]] s[[c("red", "green")]] s$red # expression based (partial) matching of names with single brackets s["re"] s["^re"] # not with double brackets # s[["re"]] ### SpatVector v <- vect(system.file("ex/lux.shp", package="terra")) v[2:3,] v[1:2, 2:3] subset(v, v$NAME_1 == "Diekirch", c("NAME_1", "NAME_2")) subset(v, NAME_1 == "Diekirch", c(NAME_1, NAME_2), NSE=TRUE) } \keyword{ spatial } terra/man/sbar.Rd0000644000176200001440000000473614536376240013404 0ustar liggesusers\name{sbar} \alias{sbar} \title{scale bar} \description{ Add a scale bar to a map } \usage{ sbar(d, xy=NULL, type="line", divs=2, below="", lonlat=NULL, labels, adj=c(0.5, -1), lwd=2, xpd=TRUE, ticks=FALSE, scaleby=1, halo=TRUE, ...) } \arguments{ \item{d}{numeric. Distance covered by the scale bar. For the scale bar, it should be in the units of the coordinates of the plot (map), and in km for angular (longitude/latitude) data; see argument \code{lonlat}. It can also be missing} \item{xy}{numeric. x and y coordinate to place the scale bar. It can also be one of following character values: "bottomleft", "bottom", "bottomright", topleft", "top", "topright", "left", "right", or NULL} \item{type}{for \code{sbar}: "line" or "bar"} \item{divs}{number of divisions for a bar: 2 or 4} \item{below}{character. Text to go below the scale bar (e.g., "kilometers")} \item{lonlat}{logical or NULL. If logical, \code{TRUE} indicates if the plot is using longitude/latitude coordinates. If \code{NULL} this is guessed from the plot's coordinates} \item{labels}{vector of three numbers to label the scale bar (beginning, midpoint, end)} \item{adj}{adjustment for text placement} \item{lwd}{line width for the "line" type of the scale bar} \item{xpd}{logical. If \code{TRUE}, the scale bar can be outside the plotting area} \item{ticks}{logical or numeric. If not \code{FALSE}, tick marks are added to a "line" scale bar. The length of the tick marks can be specified} \item{scaleby}{numeric. If \code{labels} is not provided. The labels are divided by this number. For example, use 1000 to go from m to km} \item{halo}{logical. If \code{TRUE} the "line" type scale bar gets a white background} \item{...}{graphical arguments to be passed to other methods } } \value{ none } \seealso{ \code{\link[terra]{north}}, \code{\link[terra]{plot}}, \code{\link[terra]{inset}} } \examples{ f <- system.file("ex/meuse.tif", package="terra") r <- rast(f) plot(r) sbar() sbar(1000, xy=c(178500, 333500), type="bar", divs=4, cex=.8) sbar(1000, xy="bottomright", divs=3, cex=.8, ticks=TRUE) north(d=250, c(178550, 332500)) f <- system.file("ex/elev.tif", package="terra") r <- rast(f) plot(r, type="interval") sbar(20, c(6.2, 50.1), type="bar", cex=.8, divs=4) sbar(15, c(6.3, 50), type="bar", below="km", label=c(0,7.5,15), cex=.8) sbar(15, c(6.65, 49.8), cex=.8, label=c(0,"km",15)) north(type=2) sbar(15, c(6.65, 49.7), cex=.8, label="15 kilometer", lwd=5) sbar(15, c(6.65, 49.6), divs=4, cex=.8, below="km") } \keyword{spatial} terra/man/xyCellFrom.Rd0000644000176200001440000000747514632362424014540 0ustar liggesusers\name{xyRowColCell} \alias{xFromCol} \alias{xFromCol,SpatRaster,numeric-method} \alias{xFromCol,SpatRaster,missing-method} \alias{yFromRow} \alias{yFromRow,SpatRaster,numeric-method} \alias{yFromRow,SpatRaster,missing-method} \alias{xyFromCell} \alias{xyFromCell,SpatRaster,numeric-method} \alias{xFromCell} \alias{xFromCell,SpatRaster,numeric-method} \alias{yFromCell} \alias{yFromCell,SpatRaster,numeric-method} \alias{cellFromRowCol} \alias{cellFromRowCol,SpatRaster,numeric,numeric-method} \alias{cellFromRowColCombine} \alias{cellFromRowColCombine,SpatRaster,numeric,numeric-method} \alias{rowColCombine} \alias{rowColCombine,SpatRaster,numeric,numeric-method} \alias{colFromX} \alias{colFromX,SpatRaster,numeric-method} \alias{rowFromY} \alias{rowFromY,SpatRaster,numeric-method} \alias{cellFromXY} \alias{cellFromXY,SpatRaster,matrix-method} \alias{cellFromXY,SpatRaster,data.frame-method} \alias{rowFromCell} \alias{rowFromCell,SpatRaster,numeric-method} \alias{colFromCell} \alias{colFromCell,SpatRaster,numeric-method} \alias{rowColFromCell} \alias{rowColFromCell,SpatRaster,numeric-method} \title{Coordinates from a row, column or cell number and vice versa} \description{ Get coordinates of the center of raster cells for a row, column, or cell number of a SpatRaster. Or get row, column, or cell numbers from coordinates or from each other. Cell numbers start at 1 in the upper left corner, and increase from left to right, and then from top to bottom. The last cell number equals the number of cells of the SpatRaster (see \code{\link{ncell}}). Row numbers start at 1 at the top, column numbers start at 1 at the left. When computing row, column, or cell numbers from coordinates, and coordinates fall on the edge of two or four cells, they are assigned to the right-most and/or lowest cell. That is, in these cases of ambiguity, the highest row, column, or cell number is returned. } \usage{ \S4method{xFromCol}{SpatRaster,numeric}(object, col) \S4method{yFromRow}{SpatRaster,numeric}(object, row) \S4method{xyFromCell}{SpatRaster,numeric}(object, cell) \S4method{xFromCell}{SpatRaster,numeric}(object, cell) \S4method{yFromCell}{SpatRaster,numeric}(object, cell) \S4method{colFromX}{SpatRaster,numeric}(object, x) \S4method{rowFromY}{SpatRaster,numeric}(object, y) \S4method{cellFromRowCol}{SpatRaster,numeric,numeric}(object, row, col) \S4method{cellFromRowColCombine}{SpatRaster,numeric,numeric}(object, row, col) \S4method{rowColCombine}{SpatRaster,numeric,numeric}(object, row, col) \S4method{rowFromCell}{SpatRaster,numeric}(object, cell) \S4method{colFromCell}{SpatRaster,numeric}(object, cell) \S4method{rowColFromCell}{SpatRaster,numeric}(object, cell) \S4method{cellFromXY}{SpatRaster,matrix}(object, xy) } \arguments{ \item{object}{SpatRaster} \item{cell}{integer. cell number(s)} \item{col}{integer. column number(s) or missing (equivalent to all columns)} \item{row}{integer. row number(s) or missing (equivalent to all rows)} \item{x}{x coordinate(s)} \item{y}{y coordinate(s)} \item{xy}{matrix of x and y coordinates} } \value{ xFromCol, yFromCol, xFromCell, yFromCell: vector of x or y coordinates xyFromCell: matrix(x,y) with coordinate pairs colFromX, rowFromY, cellFromXY, cellFromRowCol, rowFromCell, colFromCell: vector of row, column, or cell numbers rowColFromCell, rowColCombine: matrix of row and column numbers } \seealso{ \code{\link{crds}} } \examples{ r <- rast() xFromCol(r, c(1, 120, 180)) yFromRow(r, 90) xyFromCell(r, 10000) xyFromCell(r, c(0, 1, 32581, ncell(r), ncell(r)+1)) cellFromRowCol(r, 5, 5) cellFromRowCol(r, 1:2, 1:2) cellFromRowCol(r, 1, 1:3) # all combinations cellFromRowColCombine(r, 1:2, 1:2) colFromX(r, 10) rowFromY(r, 10) xy <- cbind(lon=c(10,5), lat=c(15, 88)) cellFromXY(r, xy) # if no row/col specified all are returned range(xFromCol(r)) length(yFromRow(r)) } \keyword{spatial} terra/man/init.Rd0000644000176200001440000000316214731201234013373 0ustar liggesusers\name{initialize} \alias{init} \alias{init,SpatRaster-method} \title{Initialize a SpatRaster with values} \description{ Create a SpatRaster with values reflecting a cell property: "x", "y", "col", "row", "cell" or "chess". Alternatively, a function can be used. In that case, cell values are initialized without reference to pre-existing values. E.g., initialize with a random number (\code{fun=\link{runif}}). While there are more direct ways of achieving this for small objects (see examples) for which a vector with all values can be created in memory, the \code{init} function will also work for SpatRasters with many cells. } \usage{ \S4method{init}{SpatRaster}(x, fun, ..., filename="", wopt=list()) } \arguments{ \item{x}{SpatRaster} \item{fun}{function to be applied. This must be a either single number, multiple numbers, a function, or one of a set of known character values. A function must take the number of cells as a single argument to return a vector of values with a length equal to the number of cells, such as \code{fun=runif}. Allowed character values are "x", "y", "row", "col", "cell", and "chess" to get the x or y coordinate, row, col or cell number or a chessboard pattern (alternating 0 and 1 values)} \item{...}{additional arguments passed to \code{fun}} \item{filename}{character. Output filename} \item{wopt}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \examples{ r <- rast(ncols=10, nrows=5, xmin=0, xmax=10, ymin=0, ymax=5) x <- init(r, fun="cell") y <- init(r, fun=runif) # initialize with a single value z <- init(r, fun=8) } \keyword{spatial} terra/man/subset_double.Rd0000644000176200001440000000350614624102340015270 0ustar liggesusers\name{subset_double} \alias{[[} \alias{[[,SpatRaster,numeric,missing-method} \alias{[[,SpatRaster,logical,missing-method} \alias{[[,SpatRaster,character,missing-method} \alias{[[,SpatRaster,ANY,missing-method} \alias{[[,SpatRasterDataset,ANY,ANY-method} \alias{[[,SpatVector,numeric,missing-method} \alias{[[,SpatVector,logical,missing-method} \alias{[[,SpatVector,character,missing-method} \alias{[[,SpatVectorCollection,ANY,missing-method} \title{Subset a SpatRaster or a SpatVector} \description{ Select a subset of layers from a SpatRaster or select a subset of records (row) and/or variables (columns) from a SpatVector. } \usage{ \S4method{[[}{SpatRaster,numeric,missing}(x, i, j) \S4method{[[}{SpatRasterDataset,ANY,ANY}(x, i, j, drop=TRUE) \S4method{[[}{SpatVector,numeric,missing}(x, i, j, drop=FALSE) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{i}{ if \code{x} is a \code{SpatRaster}: integer, logical, or character to select layers if \code{x} is a \code{SpatVector}: integer, logical, or character to select variables } \item{j}{missing, or, for SpatRasterDataset only, numeric} \item{drop}{logical. If \code{TRUE}, the geometries will be dropped, and a data.frame is returned} } \value{ if \code{x} is a \code{SpatRaster} or \code{SpatRasterDataset}: SpatRaster if \code{x} is a \code{SpatVector}: a \code{data.frame}. } \seealso{\code{\link{subset}}, \code{\link{$}}, \code{\link{[}}, \code{\link{extract}}} \examples{ ### SpatRaster s <- rast(system.file("ex/logo.tif", package="terra")) s[[ 1:2 ]] s[[c("red", "green")]] # expression based (partial) matching of names with single brackets s["re"] s["^re"] # does not with double brackets # s[["re"]] ### SpatVector v <- vect(system.file("ex/lux.shp", package="terra")) v[[2:3]] # to keep the geometry use v[,2:3] } \keyword{ spatial } terra/man/text.Rd0000644000176200001440000000252114730612452013421 0ustar liggesusers\name{text} \docType{methods} \alias{text} \alias{text,SpatRaster-method} \alias{text,SpatVector-method} \title{Add labels to a map} \description{ Plots labels, that is a textual (rather than color) representation of values, on top an existing plot (map). } \usage{ \S4method{text}{SpatRaster}(x, labels, digits=0, halo=FALSE, hc="white", hw=0.1, ...) \S4method{text}{SpatVector}(x, labels, halo=FALSE, inside=FALSE, hc="white", hw=0.1, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{labels}{character. Optional. Vector of labels with \code{length(x)} or a variable name from \code{names(x)}} \item{digits}{integer. How many digits should be used?} \item{halo}{logical. If \code{TRUE} a "halo" is printed around the text} \item{hc}{character. The halo color} \item{hw}{numeric. The halo width} \item{inside}{logical. Should the text always be placed inside one the sub-geometries?} \item{...}{additional arguments to pass to graphics function \code{\link[graphics]{text}} } } \seealso{ \code{\link[graphics]{text}, \link{plot}, \link{halo}} } \examples{ r <- rast(nrows=4, ncols=4) values(r) <- 1:ncell(r) plot(r) text(r) plot(r) text(r, halo=TRUE, hc="blue", col="white", hw=0.2) plot(r, col=rainbow(16)) text(r, col=c("black", "white"), vfont=c("sans serif", "bold"), cex=2) } \keyword{methods} \keyword{spatial} terra/man/animate.Rd0000644000176200001440000000207414536376240014064 0ustar liggesusers\name{animate} \docType{methods} \alias{animate} \alias{animate,SpatRaster-method} \title{Animate a SpatRaster} \description{ Animate (sequentially plot) the layers of a SpatRaster to create a movie. This does not work with R-Studio. } \usage{ \S4method{animate}{SpatRaster}(x, pause=0.25, main, range, maxcell=50000, n=1, ...) } \arguments{ \item{x}{SpatRaster} \item{pause}{numeric. How long should be the pause be between layers?} \item{main}{title for each layer. If not supplied the z-value is used if available. Otherwise the names are used.} \item{range}{numeric vector of length 2. Range of values to plot} \item{maxcell}{positive integer. Maximum number of cells to use for the plot. If \code{maxcell < ncell(x)}, \code{spatSample(type="regular")} is used before plotting} \item{n}{integer > 0. Number of loops} \item{...}{Additional arguments passed to \code{\link{plot}}} } \value{ None } \seealso{ \code{\link{plot}}} \examples{ s <- rast(system.file("ex/logo.tif", package="terra")) animate(s, n=1) } \keyword{methods} \keyword{spatial} terra/man/SpatVector-class.Rd0000644000176200001440000000113314536376240015636 0ustar liggesusers\name{SpatVector-class} \docType{class} \alias{SpatVector} \alias{SpatVector-class} \alias{SpatVectorCollection} \alias{SpatVectorCollection-class} \alias{SpatVectorProxy} \alias{SpatVectorProxy-class} \alias{Rcpp_SpatVector-class} \alias{PackedSpatVector-class} \alias{show,SpatVector-method} \title{Class "SpatVector" } \description{ \code{SpatVector} can represent points, lines or polygons. \code{SpatVectorCollection} can hold a collection of SpatVectors \code{SpatVectorProxy} is a SpatVector for which the data are on-disk in-stead of in memory. } \keyword{classes} \keyword{spatial} terra/man/align.Rd0000644000176200001440000000203314536376240013533 0ustar liggesusers\name{align} \alias{align} \alias{align,SpatExtent,SpatRaster-method} \alias{align,SpatExtent,numeric-method} \title{Align a SpatExtent} \description{ Align an SpatExtent with a SpatRaster This can be useful to create a new SpatRaster with the same origin and resolution as an existing SpatRaster. Do not use this to force data to match that really does not match (use e.g. \code{\link{resample}} or (dis)aggregate for this). It is also possible to align a SpatExtent to a clean divisor. } \usage{ \S4method{align}{SpatExtent,SpatRaster}(x, y, snap="near") \S4method{align}{SpatExtent,numeric}(x, y) } \arguments{ \item{x}{SpatExtent} \item{y}{SpatRaster or numeric} \item{snap}{Character. One of "near", "in", or "out", to determine in which direction the extent should be aligned. To the nearest border, inwards or outwards} } \value{ SpatExtent } \seealso{ \code{\link{ext}}, \code{\link{draw}} } \examples{ r <- rast() e <- ext(-10.1, 9.9, -20.1, 19.9) ea <- align(e, r) e ext(r) ea align(e, 0.5) } \keyword{spatial} terra/man/metags.Rd0000644000176200001440000000333114732151331013711 0ustar liggesusers\name{metags} \alias{metags} \alias{metags,SpatRaster-method} \alias{metags,SpatRasterDataset-method} \alias{metags,SpatRasterCollection-method} \alias{metags<-} \alias{metags<-,SpatRaster-method} \alias{metags<-,SpatRasterDataset-method} \alias{metags<-,SpatRasterCollection-method} \title{Set or get metadata} \description{ You can set arbitrary metadata to (layers of) a SpatRaster using "name=value" tags. When wring a SpatRaster to a GTiff file, these tags are written to file. } \usage{ \S4method{metags}{SpatRaster}(x, layer=NULL)<-value \S4method{metags}{SpatRaster}(x, layer=NULL, name=NULL) \S4method{metags}{SpatRasterDataset}(x, dataset=NULL)<-value \S4method{metags}{SpatRasterDataset}(x, dataset=NULL, name=NULL) } \arguments{ \item{x}{SpatRaster} \item{layer}{NULL, positive integer or character. If the value is NULL, the tags assigned or returned are for the SpatRaster. Otherwise for the layer number(s) or name(s)} \item{name}{character} \item{value}{character of "name=value" or two-column matrix} \item{dataset}{NULL, positive integer or character. If the value is NULL, the tags assigned or returned are for the SpatRasterDataset/SpatRasterCollection. Otherwise for the datset number(s) or name(s)} } \value{ SpatRaster (\code{metags<-}), or named character (\code{metags}) } \examples{ r <- rast(ncol=5, nrow=5) m <- cbind(c("one", "two", "three"), c("ABC", "123", "hello")) metags(r) <- m metags(r) metags(r) <- c("another_tag=another_value", "one more=this value") metags(r) metags(r) <- c(another_tag="44", `one more`="that value") metags(r) metags(r, name="two") # remove a tag metags(r) <- cbind("one", "") metags(r) <- "two=" metags(r) # remove all tags metags(r) <- NULL metags(r) } \keyword{spatial} terra/man/not.na.Rd0000644000176200001440000000172514731361374013644 0ustar liggesusers\name{not.na} \docType{methods} \alias{not.na} \alias{not.na,SpatRaster-method} \title{is not NA} \description{ Shortcut method to avoid the two-step \code{!is.na(x)} } \usage{ \S4method{not.na}{SpatRaster}(x, falseNA=FALSE, filename="", ...) } \arguments{ \item{x}{SpatRaster} \item{falseNA}{logical. If \code{TRUE}, the output cell values are either \code{TRUE}, for cells that are not \code{NA} in \code{x}, or \code{NA} for the cells that are \code{NA} in \code{x}. Otherwise, the output values are either \code{TRUE} or \code{FALSE}} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{Compare-methods}} } \value{ SpatRaster } \examples{ r <- rast(ncols=5, nrows=5, vals=1, ext=c(0,1,0,1)) r[10:20] <- NA x <- not.na(r) y <- not.na(r, falseNA=TRUE) unique(values(c(x, y))) } \keyword{methods} \keyword{spatial} terra/man/graticule.Rd0000644000176200001440000000165314536376240014427 0ustar liggesusers\name{graticule} \docType{methods} \alias{graticule} \title{ Create a graticule } \description{ Create a graticule. That is, a grid of lon/lat lines that can be used to on a projected map. The object returned, a SpatGraticule, can be plotted with \code{plot} and \code{lines}. There is also a \code{crop} method. } \usage{ graticule(lon=30, lat=30, crs="") } \arguments{ \item{lon}{numeric. Either a single number (the interval between longitudes), or a vector with longitudes} \item{lat}{numeric. Either a single number (the interval between latitudes), or a vector with latitudes} \item{crs}{character. The coordinate reference system to use} } \value{ SpatGraticule } \seealso{ \code{\link[=plot,SpatGraticule,missing-method]{plot}}. } \examples{ g <- graticule(60, 30, crs="+proj=robin") g graticule(90, c(-90, -60, -23.5, 0, 23.5, 60, 90), crs="+proj=robin") } \keyword{methods} \keyword{spatial} terra/man/describe.Rd0000644000176200001440000000350414735571230014222 0ustar liggesusers\name{describe} \alias{describe} \alias{describe,character-method} \alias{describe,SpatRaster-method} \title{describe} \description{ Describe the properties of spatial data in a file as generated with the "GDALinfo" tool. } \usage{ \S4method{describe}{character}(x, sds=FALSE, meta=FALSE, parse=FALSE, options="", print=FALSE, open_opt="") \S4method{describe}{SpatRaster}(x, source, ...) } \arguments{ \item{x}{character. The name of a file with spatial data. Or a fully specified subdataset within a file such as \code{"NETCDF:\"AVHRR.nc\":NDVI"}} \item{sds}{logical. If \code{TRUE} the description or metadata of the subdatasets is returned (if available)} \item{meta}{logical. Get the file level metadata instead} \item{parse}{logical. If \code{TRUE}, metadata for subdatasets is parsed into components (if \code{meta=TRUE})} \item{options}{character. A vector of valid options (if \code{meta=FALSE}) including "json", "mm", "stats", "hist", "nogcp", "nomd", "norat", "noct", "nofl", "checksum", "proj4", "listmdd", "mdd " where specifies a domain or 'all', "wkt_format " where value is one of 'WKT1', 'WKT2', 'WKT2_2015', or 'WKT2_2018', "sd " where is the name or identifier of a sub-dataset. See \url{https://gdal.org/en/latest/programs/gdalinfo.html}. Ignored if \code{sds=TRUE}} \item{print}{logical. If \code{TRUE}, print the results} \item{open_opt}{character. Driver specific open options} \item{source}{positive integer between 1 and \code{nsrc(x)}} \item{...}{additional arguments passed to the \code{describe} method} } \value{ character (invisibly, if \code{print=FALSE}) } \examples{ f <- system.file("ex/elev.tif", package="terra") describe(f) describe(f, meta=TRUE) #g <- describe(f, options=c("json", "nomd", "proj4")) #head(g) } \keyword{spatial} terra/man/mem.Rd0000644000176200001440000000113614744310601013210 0ustar liggesusers\name{mem} \alias{mem_info} \alias{free_RAM} \title{Memory available and needed} \description{ \code{mem_info} prints the amount of RAM that is required and available to process a SpatRaster. \code{free_RAM} returns the amount of RAM that is available } \usage{ mem_info(x, n=1, print=TRUE) free_RAM() } \arguments{ \item{x}{SpatRaster} \item{n}{positive integer. The number of copies of \code{x} that are needed} \item{print}{logical. print memory info?} } \value{ free_RAM returns the amount of available RAM in kilobytes } \examples{ mem_info(rast()) free_RAM() } \keyword{spatial} terra/man/extractAlong.Rd0000644000176200001440000000253214536376240015100 0ustar liggesusers\name{extractAlong} \alias{extractAlong} \title{extract values along lines} \description{ Extract raster values along a line. That is, the returned values are ordered along the line. That is not the case with \code{\link{extract}} } \usage{ extractAlong(x, y, ID=TRUE, cells=FALSE, xy=FALSE, online=FALSE, bilinear=TRUE) } \arguments{ \item{x}{SpatRaster} \item{y}{SpatVector with lines geometry} \item{ID}{logical. Should an ID column be added? If so, the first column returned has the IDs (record numbers) of input SpatVector \code{y}} \item{cells}{logical. If \code{TRUE} the cell numbers are also returned} \item{xy}{logical. If \code{TRUE} the coordinates of the cells traversed by \code{y} are also returned. See \code{\link{xyFromCell}}} \item{online}{logical. If \code{TRUE} the returned coordinates are snapped to \code{y}} \item{bilinear}{logical. If \code{TRUE} the returned raster values computed with bilinear interpolation from the nearest four cells. Only relevant if \code{online=TRUE}} } \value{ data.frame } \seealso{ \code{\link{extract}} } \examples{ r <- rast(ncols=36, nrows=18, vals=1:(18*36)) cds1 <- rbind(c(-50,0), c(0,60), c(40,5), c(15,-45), c(-10,-25)) cds2 <- rbind(c(80,20), c(140,60), c(160,0), c(140,-55)) lines <- vect(list(cds1, cds2), "lines") extractAlong(r, lines) } \keyword{methods} \keyword{spatial} terra/man/deprecated.Rd0000644000176200001440000000050214736275072014543 0ustar liggesusers\name{deprecated} \alias{gridDistance} \alias{gridDistance,SpatRaster-method} \title{deprecated methods} \description{ This method is no longer available. Use \code{\link{gridDist}} instead } \usage{ \S4method{gridDistance}{SpatRaster}(x, ...) } \arguments{ \item{x}{object} \item{...}{additional arguments} } terra/man/impose.Rd0000644000176200001440000000121514536376240013736 0ustar liggesusers\name{impose} \docType{methods} \alias{impose} \alias{impose,SpatRasterCollection-method} \title{ Impose the geometry of a SpatRaster to those in a SpatRasterCollection. } \description{ Warp the members of a SpatRasterCollection to match the geometry of a SpatRaster. } \usage{ \S4method{impose}{SpatRasterCollection}(x, y, filename="", ...) } \arguments{ \item{x}{SpatRasterCollection} \item{y}{SpatRaster} \item{filename}{character. Output filename} \item{...}{list with named options for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{resample}} } \keyword{methods} \keyword{spatial} terra/man/terraOptions.Rd0000644000176200001440000000443614731131407015132 0ustar liggesusers\name{options} \alias{terraOptions} \title{Options} \description{ Get or set general options. } \usage{ terraOptions(..., print=TRUE) } \arguments{ \item{...}{option names and values (see Details). Or missing, to get or show the current options} \item{print}{logical. If \code{TRUE} the option names and values are printed } } \details{ The following options are available. \bold{memfrac} - value between 0 and 0.9 (larger values give a warning). The fraction of RAM that may be used by the program. \bold{memmin} - if memory required is below this threshold (in GB), the memory is assumed to be available. Otherwise, terra checks if it is available. \bold{memmax} - the maximum amount of RAM (in GB) that terra is allowed to use when processing a raster dataset. Should be less than what is detected (see \code{\link{mem_info}}), and higher values are ignored. Set it to a negative number or NA to not set this option. \code{terraOptions} only shows the value of \code{memmax} if it is set. \bold{tempdir} - directory where temporary files are written. The default what is returned by \code{tempdir()}. \bold{datatype} - default data type. See \code{\link{writeRaster}}. \bold{todisk} - logical. If \code{TRUE} write all raster data to disk (temp file if no file name is specified). For debugging. \bold{progress} - non-negative integer. A progress bar is shown if the number of chunks in which the data is processed is larger than this number. No progress bar is shown if the value is zero. \bold{verbose} - logical. If \code{TRUE} debugging info is printed for some functions. \bold{tolerance} - numeric. Difference in raster extent (expressed as the fraction of the raster resolution) that can be ignored when comparing alignment of rasters. } \note{ It is possible to set your own default options in "etc/.Rprofile.site" of your R installation like this \code{options(terra_default=list(tempdir="d:/temp", memfrac=.4))} But that may not be a good practice. It is clearer to set your favorite options at the beginning of each script. } \value{ list. Invisibly if \code{print=TRUE} } \examples{ terraOptions() terraOptions(memfrac=0.5, tempdir = "c:/temp") terraOptions(progress=10) terraOptions() } \keyword{classes} \keyword{spatial} terra/man/as.data.frame.Rd0000644000176200001440000000332214536376240015047 0ustar liggesusers\name{as.data.frame} \alias{as.data.frame} \alias{as.data.frame,SpatRaster-method} \alias{as.data.frame,SpatVector-method} \title{SpatRaster or SpatVector to data.frame} \description{ Coerce a SpatRaster or SpatVector to a data.frame } \usage{ \S4method{as.data.frame}{SpatVector}(x, row.names=NULL, optional=FALSE, geom=NULL, ...) \S4method{as.data.frame}{SpatRaster}(x, row.names=NULL, optional=FALSE, xy=FALSE, cells=FALSE, time=FALSE, na.rm=NA, wide=TRUE, ...) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{geom}{character or NULL. If not NULL, either "WKT" or "HEX", to get the geometry included in Well-Known-Text or hexadecimal notation. If \code{x} has point geometry, it can also be "XY" to add the coordinates of each point} \item{xy}{logical. If \code{TRUE}, the coordinates of each raster cell are included} \item{time}{logical. If \code{TRUE}, the time data is included (if available)} \item{na.rm}{logical. If \code{TRUE}, cells that have a \code{NA} value in at least one layer are removed. If the argument is set to \code{NA} only cells that have \code{NA} values in all layers are removed} \item{cells}{logical. If \code{TRUE}, the cell numbers of each raster cell are included} \item{wide}{logical. If \code{FALSE}, the data.frame returned has a "long" format} \item{...}{Additional arguments passed to the \code{\link{data.frame}}} \item{row.names}{This argument is ignored} \item{optional}{This argument is ignored} } \seealso{\code{\link{as.list}, \link{as.matrix}}. See \code{\link{geom}} to only extract the geometry of a SpatVector} \value{ data.frame } \examples{ f <- system.file("ex/lux.shp", package="terra") v <- vect(f) as.data.frame(v) } \keyword{spatial} \keyword{methods} terra/man/click.Rd0000644000176200001440000000542414732343165013533 0ustar liggesusers\name{click} \alias{click} \alias{click,SpatRaster-method} \alias{click,SpatVector-method} \alias{click,missing-method} \title{Query by clicking on a map} \description{ Click on a map (plot) to get the coordinates or the values of a SpatRaster or SpatVector at that location. For a SpatRaster you can also get the coordinates and cell number of the location. Note that for many installations this does to work well on the default RStudio plotting device. To work around that, you can first run \code{dev.new(noRStudioGD = TRUE)} which will create a separate window for plotting, then use \code{plot()} followed by \code{click()} and click on the map. It may also help to set your RStudio "Tools/Global Options/Appearance/Zoom" to 100% } \usage{ \S4method{click}{SpatRaster}(x, n=10, id=FALSE, xy=FALSE, cell=FALSE, type="p", show=TRUE, ...) \S4method{click}{SpatVector}(x, n=10, id=FALSE, xy=FALSE, type="p", show=TRUE, ...) \S4method{click}{missing}(x, n=10, id=FALSE, type="p", show=TRUE, ...) } \arguments{ \item{x}{SpatRaster or SpatVector, or missing} \item{n}{number of clicks on the plot (map)} \item{id}{logical. If \code{TRUE}, a numeric ID is shown on the map that corresponds to the row number of the output} \item{xy}{logical. If \code{TRUE}, xy coordinates are included in the output} \item{cell}{logical. If \code{TRUE}, cell numbers are included in the output} \item{type}{one of "n", "p", "l" or "o". If "p" or "o" the points are plotted; if "l" or "o" they are joined by lines. See \code{\link[graphics]{locator}}} \item{show}{logical. Print the values after each click?} \item{...}{additional graphics parameters used if type != "n" for plotting the locations. See \code{\link[graphics]{locator}}} } \value{ The value(s) of \code{x} at the point(s) clicked on (or touched by the box drawn). A \code{data.frame} with the value(s) of all layers of SpatRaster \code{x} for the cell(s) clicked on; or with the attributes of the geometries of SpatVector \code{x} that intersect with the box drawn). } \note{ The plot only provides the coordinates for a spatial query, the values are read from the SpatRaster or SpatVector that is passed as an argument. Thus, you can extract values from an object that has not been plotted, as long as it spatially overlaps with the extent of the plot. Unless the process is terminated prematurely values at most \code{n} positions are determined. The identification process can be terminated, depending on how you interact with R, by hitting Esc, or by clicking the right mouse button and selecting "Stop" from the menu, or from the "Stop" menu on the graphics window. } \seealso{\link{draw}} \examples{ \dontrun{ r <-rast(system.file("ex/elev.tif", package="terra")) plot(r) click(r, n=1) ## now click on the plot (map) }} \keyword{ spatial } terra/man/map_extent.Rd0000644000176200001440000000212414646545321014606 0ustar liggesusers\name{map_extent} \alias{map_extent} \title{Get the coordinates of the extent of a map} \description{ Helper function for creating custom map elements that are aligned with the axes of a map (base plot created with a SpatRaster and/or SpatVector). For example, you may need to know the coordinates for the upper-left corner of a map to add some information there. Unlike the standard base plot, terra keeps the axis aligned with the data. For that reason you cannot use \code{par()$usr} to get these coordinates. The coordinates returned by this function are used in, for example, \code{\link{add_legend}} such that a legend can be automatically placed in the a particular corner. This function only returns meaningful results of the active plot (canvas) was create with a call to \code{plot} with a SpatRaster or SpatVector as first argument. } \usage{ map_extent() } \seealso{\code{\link{add_legend}}, \code{\link{add_grid}}, \code{\link{add_box}}} \examples{ r <- rast(xmin=0, xmax=10, ymin=0, ymax=10, res=1, vals=1:100) plot(r) map_extent() par()$usr } \keyword{methods} \keyword{spatial} terra/man/intersect.Rd0000644000176200001440000000534014536376240014445 0ustar liggesusers\name{intersect} \docType{methods} \alias{intersect} \alias{intersect,SpatVector,SpatVector-method} \alias{intersect,SpatVector,SpatExtent-method} \alias{intersect,SpatExtent,SpatVector-method} \alias{intersect,SpatExtent,SpatExtent-method} \alias{intersect,SpatRaster,SpatRaster-method} \alias{intersect,SpatRaster,SpatExtent-method} \alias{intersect,SpatExtent,SpatRaster-method} \title{ Intersection } \description{ You can intersect SpatVectors with each other or with a SpatExtent. Intersecting points with points uses the extent of \code{y} to get the intersection. Intersecting of points and lines is not supported because of numerical inaccuracies with that. You can use \code{\link{buffer}}, to create polygons from lines and use these with intersect. You can also intersect two SpatExtents. When intersecting two SpatRasters these need to be aligned (have the same origin and spatial resolution). The values of the returned SpatRaster are \code{TRUE} where both input rasters have values, \code{FALSE} where one has values, and \code{NA} in all other cells. When intersecting a SpatExtent and a SpatRaster, the SpatExtent is first aligned to the raster cell boundaries. See \code{\link{crop}} for the intersection of a SpatRaster with a SpatExtent (or the extent of a SpatRaster or SpatVector) if you want a SpatRaster (not a SpatExtent) as output. See \code{\link{is.related}(x, y, "intersects")} to find out which geometries of a SpatVector intersect. You can spatially subset a SpatVector with another one with \code{x\link{[}y]}. } \usage{ \S4method{intersect}{SpatVector,SpatVector}(x, y) \S4method{intersect}{SpatVector,SpatExtent}(x, y) \S4method{intersect}{SpatExtent,SpatVector}(x, y) \S4method{intersect}{SpatExtent,SpatExtent}(x, y) \S4method{intersect}{SpatRaster,SpatRaster}(x, y) \S4method{intersect}{SpatRaster,SpatExtent}(x, y) \S4method{intersect}{SpatExtent,SpatRaster}(x, y) } \arguments{ \item{x}{SpatVector, SpatExtent, or SpatRaster} \item{y}{SpatVector, SpatExtent, or SpatRaster} } \value{ Same as \code{x} } \seealso{ \code{\link{union}}, \code{\link{crop}}, \code{\link{relate}}, \code{\link{[}} } \examples{ e1 <- ext(-10, 10, -20, 20) e2 <- ext(0, 20, -40, 5) intersect(e1, e2) f <- system.file("ex/lux.shp", package="terra") v <- vect(f) e <- ext(5.6, 6, 49.55, 49.7) x <- intersect(v, e) p <- vect(c("POLYGON ((5.8 49.8, 6 49.9, 6.15 49.8, 6 49.6, 5.8 49.8))", "POLYGON ((6.3 49.9, 6.2 49.7, 6.3 49.6, 6.5 49.8, 6.3 49.9))"), crs=crs(v)) values(p) <- data.frame(pid=1:2, area=expanse(p)) y <- intersect(v, p) r <- s <- rast(ncol=5, nrow=5, xmin=1, xmax=5, ymin=1, ymax=5) r[5:20] <- 5:20 s[11:20] <- 11:20 rs <- intersect(r, s) u <- shift(r, .8) us <- intersect(u, s) } \keyword{methods} \keyword{spatial} terra/man/sieve.Rd0000644000176200001440000000236014721441243013547 0ustar liggesusers\name{sieve} \alias{sieve} \alias{sieve,SpatRaster-method} \title{Sieve filter} \description{ Apply a sieve filter. That is, remove "noise", by changing small clumps of cells with a value that is different from the surrounding cells, to the value of the largest neighboring clump. Note that the numerical input values are truncated to integers. } \usage{ \S4method{sieve}{SpatRaster}(x, threshold, directions=8, filename="", ...) } \arguments{ \item{x}{SpatRaster, single layer with integer or categorical values } \item{threshold}{positive integer. Only clumps smaller than this threshold will be removed} \item{directions}{numeric to indicate which cells are connected. Either \code{4} to only consider the horizontal and vertical neighbors ("rook"), or \code{8} to consider the vertical, horizontal and diagonal neighbors} \item{filename}{character. Output filename} \item{...}{Options for writing files as in \code{\link{writeRaster}}} } \seealso{\code{\link{focal}}} \examples{ r <- rast(nrows=18, ncols=18, xmin=0, vals=0, crs="local") r[2, 5] <- 1 r[5:8, 2:3] <- 2 r[7:12, 10:15] <- 3 r[15:16, 15:18] <- 4 freq(r, bylayer=FALSE) x <- sieve(r, 8) y <- sieve(r, 9) } \keyword{spatial} terra/man/crop.Rd0000644000176200001440000000671314720654235013413 0ustar liggesusers\name{crop} \docType{methods} \alias{crop} \alias{crop,SpatRaster-method} \alias{crop,SpatRasterDataset-method} \alias{crop,SpatRasterCollection-method} \alias{crop,SpatVector-method} \alias{crop,SpatGraticule-method} \title{Cut out a geographic subset} \description{ Cut out a part of a SpatRaster or SpatVector. You can crop a SpatRaster with a SpatExtent, or with another object from which an extent can be obtained. Note that the SpatRaster returned may not have the exactly the same extent as the SpatExtent supplied because you can only select entire cells (rows and columns), and you cannot add new areas. See methods like \code{\link{resample}} and \code{\link{disagg}} to force SpatRasters to align and \code{\link{extend}} to add rows and/or columns. You can only crop rectangular areas of a SpatRaster, but see argument \code{mask=TRUE} for setting cell values within SpatRaster to \code{NA}; or use the \code{\link{mask}} method after crop for additional masking options. You can crop a SpatVector with another SpatVector. If these are not polygons, the minimum convex hull is used. Unlike with \code{\link{intersect}} the geometries and attributes of \code{y} are not transferred to the output. You can also crop a SpatVector with a rectangle (SpatRaster, SpatExtent). } \usage{ \S4method{crop}{SpatRaster}(x, y, snap="near", mask=FALSE, touches=TRUE, extend=FALSE, filename="", ...) \S4method{crop}{SpatRasterDataset}(x, y, snap="near", extend=FALSE) \S4method{crop}{SpatRasterCollection}(x, y, snap="near", extend=FALSE) \S4method{crop}{SpatVector}(x, y, ext=FALSE) \S4method{crop}{SpatGraticule}(x, y) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{y}{SpatRaster, SpatVector, SpatExtent, or any other object that has a SpatExtent (\code{\link{ext}} returns a \code{SpatExtent})} \item{snap}{character. One of "near", "in", or "out". Used to align \code{y} to the geometry of \code{x}} \item{mask}{logical. Should \code{y} be used to mask? Only used if \code{y} is a SpatVector, SpatRaster or sf} \item{touches}{logical. If \code{TRUE} and \code{mask=TRUE}, all cells touched by lines or polygons will be masked, not just those on the line render path, or whose center point is within the polygon} \item{extend}{logical. Should rows and/or columns be added if \code{y} is beyond the extent of \code{x}? Also see \code{\link{extend}}} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} \item{ext}{logical. Use the extent of \code{y} instead of \code{y}. This also changes the behavior when \code{y} is an extent in two ways: (1) points that are on the extent boundary are removed and (2) lon/lat extents that go beyond -180 or 180 degrees longitude are wrapped around the earth to include areas at the other end of the dateline} } \value{ SpatRaster } \seealso{ \code{\link{intersect}}, \code{\link{extend}} See \code{window} for a virtual and sometimes more efficient way to crop a dataset. } \examples{ r <- rast(xmin=0, xmax=10, ymin=0, ymax=10, nrows=25, ncols=25) values(r) <- 1:ncell(r) e <- ext(-5, 5, -5, 5) rc <- crop(r, e) # crop and mask f <- system.file("ex/elev.tif", package="terra") r <- rast(f) f <- system.file("ex/lux.shp", package="terra") v <- vect(f) cm <- crop(r, v[9:12,], mask=TRUE) plot(cm) lines(v) # crop vector f <- system.file("ex/lux.shp", package="terra") v <- vect(f) e <- ext(6.15, 6.3, 49.7, 49.8) x <- crop(v, e) plot(x, "NAME_1") } \keyword{spatial} terra/man/flip.Rd0000644000176200001440000000221414536376240013374 0ustar liggesusers\name{flip} \docType{methods} \alias{flip} \alias{flip,SpatRaster-method} \alias{flip,SpatVector-method} \alias{rev} \alias{rev,SpatRaster-method} \title{Flip or reverse a raster} \description{ Flip the values of a SpatRaster by inverting the order of the rows (\code{vertical=TRUE}) or the columns (\code{vertical=FALSE}). \code{rev} is the same as a horizontal *and* a vertical flip. } \usage{ \S4method{flip}{SpatRaster}(x, direction="vertical", filename="", ...) \S4method{flip}{SpatVector}(x, direction="vertical") \S4method{rev}{SpatRaster}(x) } \arguments{ \item{x}{SpatRaster or SpatVector} \item{direction}{character. Should (partially) match "vertical" to flip by rows, or "horizontal" to flip by columns} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ SpatRaster } \seealso{ \code{\link{trans}}, \code{\link{rotate}} } \examples{ r <- rast(nrow=18, ncol=36) m <- matrix(1:ncell(r), nrow=18) values(r) <- as.vector(t(m)) rx <- flip(r, direction="h") values(r) <- as.vector(m) ry <- flip(r, direction="v") v <- rev(r) } \keyword{spatial} terra/man/terra-package.Rd0000644000176200001440000011526414745506660015165 0ustar liggesusers\name{terra-package} \alias{terra-package} \alias{terra} \docType{package} \title{Description of the methods in the terra package} \description{ \code{terra} provides methods to manipulate geographic (spatial) data in "raster" and "vector" form. Raster data divide space into rectangular grid cells and they are commonly used to represent spatially continuous phenomena, such as elevation or the weather. Satellite images also have this data structure, and in that context grid cells are often referred to as pixels. In contrast, "vector" spatial data (points, lines, polygons) are typically used to represent discrete spatial entities, such as a road, country, or bus stop. The package implements two main classes (data types): \code{SpatRaster} and \code{SpatVector}. \code{SpatRaster} supports handling large raster files that cannot be loaded into memory; local, focal, zonal, and global raster operations; polygon, line and point to raster conversion; integration with modeling methods to make spatial predictions; and more. \code{SpatVector} supports all types of geometric operations such as intersections. Additional classes include \code{SpatExtent}, which is used to define a spatial extent (bounding box); \code{SpatRasterDataset}, which represents a collection of sub-datasets for the same area. Each sub-dataset is a SpatRaster with possibly many layers, and may, for example, represent different weather variables; and \code{SpatRasterCollection} and \code{SpatVectorCollection} that are equivalent to lists of \code{SpatRaster} or \code{SpatVector} objects. There is also a \code{SpatGraticule} class to assist in adding a longitude/latitude lines and labels to a map with another coordinate reference system. These classes hold a C++ pointer to the data "reference class" and that creates some limitations. They cannot be recovered from a saved R session either or directly passed to nodes on a computer cluster. Generally, you should use \code{\link{writeRaster}} to save \code{SpatRaster} objects to disk (and pass a filename or cell values to cluster nodes). Also see \code{\link{wrap}}. Also, package developers should not directly access this pointer, as its user-interface is not stable. The \code{terra} package is conceived as a replacement of the \code{raster} package. \code{terra} has a very similar, but simpler, interface, and it is faster than \code{raster}. At the bottom of this page there is a table that shows differences in the methods between the two packages. Below is a list of some of the most important methods grouped by theme. --------------------------------------------------------------------------------------------------------------------- } \section{\bold{SpatRaster}}{ ---------------------------------------------------------------------------------------------------------------------} \section{I. Creating, combining and sub-setting}{ \tabular{ll}{ \code{\link{rast}}\tab Create a SpatRaster from scratch, file, or another object\cr \code{\link{c}} \tab Combine SpatRasters (multiple layers)\cr \code{\link{add<-}} \tab Add a SpatRaster to another one\cr \code{\link{subset}} or \code{[[}, or \code{$} \tab Select layers of a SpatRaster\cr \code{\link{selectRange}} \tab Select cell values from different layers using an index layer\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{II. Changing the spatial extent or resolution}{ Also see the methods in section VIII \tabular{ll}{ \code{\link{merge}} \tab Combine SpatRasters with different extents (but same origin and resolution) \cr \code{\link{mosaic}} \tab Combine SpatRasters with different extents using a function for overlapping cells \cr \code{\link{crop}} \tab Select a geographic subset of a SpatRaster \cr \code{\link{extend}} \tab Add rows and/or columns to a SpatRaster \cr \code{\link{trim}} \tab Trim a SpatRaster by removing exterior rows and/or columns that only have NAs\cr \code{\link{aggregate}} \tab Combine cells of a SpatRaster to create larger cells \cr \code{\link{disagg}} \tab Subdivide cells \cr \code{\link{resample}} \tab Resample (warp) values to a SpatRaster with a different origin and/or resolution \cr \code{\link{project}} \tab Project (warp) values to a SpatRaster with a different coordinate reference system \cr \code{\link{shift}} \tab Adjust the location of SpatRaster \cr \code{\link{flip}} \tab Flip values horizontally or vertically \cr \code{\link{rotate}} \tab Rotate values around the date-line (for lon/lat data) \cr \code{\link{t}} \tab Transpose a SpatRaster\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{III. Local (cell based) methods}{ \subsection{Apply-like methods}{ \tabular{ll}{ \code{\link{app}} \tab Apply a function to all cells, across layers, typically to summarize (as in \code{base::apply}) \cr \code{\link{tapp}} \tab Apply a function to groups of layers (as in \code{base::tapply} and \code{stats::aggregate})\cr \code{\link{lapp}} \tab Apply a function to using the layers of a SpatRaster as variables\cr \code{\link{sapp}} \tab Apply a function to each layer\cr \code{\link{rapp}} \tab Apply a function to a spatially variable range of layers\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \subsection{Arithmetic, logical, and standard math methods}{ \tabular{ll}{ \code{\link{Arith-methods}} \tab Standard arithmetic methods (\code{+, -, *, ^, \%\%, \%/\%, /}) \cr \code{\link{Compare-methods}} \tab Comparison methods for SpatRaster (\code{==, !=, >, <, <=, >=m is.na, is.finite}) \cr \code{\link{not.na}} \tab a one-step equivalent to \code{!is.na} \cr \code{\link{Summary-methods}} \tab \code{mean, max, min, median, sum, range, prod,} \cr \tab \code{any, all, stdev, which.min, which.max, anyNA, noNA, allNA}\cr \code{\link{Logic-methods}} \tab Boolean methods (\code{!, &, |}) \cr \code{\link{Math-methods}} \tab \code{abs, sign, sqrt, ceiling, floor, trunc, cummax, cummin, cumprod,} \cr \tab \code{cumsum, log, log10, log2, log1p, acos, acosh, asin, asinh, atan, atanh,} \cr \tab \code{exp, expm1, cos, cosh, sin, sinh, tan, tanh, round, signif}\cr \code{\link{as.bool}}\tab create a Boolean (logical) SpatRaster \cr \code{\link{as.int}}\tab create an integer (whole numbers) SpatRaster \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \subsection{Other methods}{ \tabular{ll}{ \code{\link{approximate}} \tab Compute missing values for cells by interpolation across layers \cr \code{\link{roll}} \tab Rolling functions such as the rolling mean \cr \code{\link{clamp}} \tab Restrict cell values to a minimum and/or maximum value \cr \code{\link{cellSize}} \tab Compute the area of cells \cr \code{\link{classify}} \tab (Re-)classify values \cr \code{\link{subst}} \tab Substitute (replace) cell values \cr \code{\link{cover}} \tab First layer covers second layer except where the first layer is \code{NA} \cr \code{\link{init}} \tab Initialize cells with new values \cr \code{\link{mask}} \tab Replace values in a SpatRaster based on values in another SpatRaster\cr \code{\link{which.lyr}} \tab which is the first layer that is \code{TRUE}?\cr \code{\link{segregate}} \tab Make a 0/1 layer for each unique value \cr \code{\link{rangeFill}} \tab Make a 0/1 SpatRaster for a time series \cr \code{\link{regress}} \tab Cell-based regression models \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } } \section{IV. Zonal and global methods}{ \tabular{ll}{ \code{\link{expanse}} \tab Compute the summed area of cells \cr \code{\link{crosstab}} \tab Cross-tabulate two SpatRasters\cr \code{\link{freq}} \tab Frequency table of SpatRaster cell values \cr \code{\link{global}} \tab Summarize SpatRaster cell values with a function \cr \code{\link{quantile}} \tab Quantiles \cr \code{\link{layerCor}} \tab Correlation between layers \cr \code{\link{stretch}} \tab Stretch values \cr \code{\link{scale}} \tab Scale values \cr \code{\link[terra]{summary}} \tab Summary of the values of a SpatRaster (quartiles and mean) \cr \code{\link{unique}} \tab Get the unique values in a SpatRaster \cr \code{\link{zonal}} \tab Summarize a SpatRaster by zones in another SpatRaster \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{V. Situation (spatial context) based methods}{ \tabular{ll}{ \code{\link{adjacent}} \tab Identify cells that are adjacent to a set of cells of a SpatRaster \cr \code{\link{boundaries}} \tab Detection of boundaries (edges)\cr \code{\link{distance}} \tab Shortest distance to a cell that is not \code{NA} or to or from a vector object\cr \code{\link{gridDist}} \tab Shortest distance through adjacent grid cells\cr \code{\link{costDist}} \tab Shortest distance considering cell-varying friction \cr \code{\link{direction}} \tab Direction (azimuth) to or from cells that are not \code{NA}\cr \code{\link{focal}} \tab Focal (neighborhood; moving window) functions \cr \code{\link{focal3D}} \tab Three dimensional (row, col, lyr) focal functions \cr \code{\link{focalCpp}} \tab Faster focal by using custom C++ functions \cr \code{\link{focalReg}} \tab Regression between layers for focal areas \cr \code{\link{focalPairs}} \tab Apply a function (e.g. a correlation coefficient) to focal values for pairs of layers \cr \code{\link{patches}} \tab Find patches (clumps) \cr \code{\link{sieve}} \tab Sieve filter to remove small patches\cr \code{\link{terrain}} \tab Compute slope, aspect and other terrain characteristics from elevation data \cr \code{\link{viewshed}} \tab Compute viewshed (showing areas that are visible from a particular location \cr \code{\link{shade}} \tab Compute hill shade from slope and aspect layers \cr \code{\link{autocor}} \tab Compute global or local spatial autocorrelation \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{VI. Model predictions}{ \tabular{ll}{ \code{\link{predict}} \tab Predict a non-spatial (regression or classification) model to a SpatRaster \cr \code{\link{interpolate}} \tab Predict a spatial model to a SpatRaster \cr \code{\link{interpIDW}} \tab Inverse-distance-weighted interpolation \cr \code{\link{interpNear}} \tab Nearest neighbor interpolation \cr \code{\link{k_means}} \tab k-means clustering of SpatRaster data \cr \code{\link{princomp} and \link{prcomp}} \tab Principal Component Analysis (PCA) with raster data\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{VII. Accessing cell values}{ Apart from the function listed below, you can also use indexing with \code{[} with cell numbers, and row and/or column numbers \cr \tabular{ll}{ \code{\link{values}} \tab cell values (fails with very large rasters)\cr \code{\link{values<-}} \tab Set new values to the cells of a SpatRaster \cr \code{\link{setValues}} \tab Set new values to the cells of a SpatRaster \cr \code{\link{as.matrix}} \tab Get cell values as a matrix \cr \code{\link{as.array}} \tab Get cell values as an array \cr \code{\link{as.data.frame}} \tab get cell values as a data.frame (including class lables)\cr \code{\link{extract}} \tab Extract cell values from a SpatRaster (with cell numbers, coordinates, points, lines, or polygons)\cr \code{\link{extractAlong}} \tab Extract cell values along a line such that the values are in the right order\cr \code{\link{spatSample}} \tab Regular or random sample \cr \code{\link{minmax}} \tab Get the minimum and maximum value of the cells of a SpatRaster (if known) \cr \code{\link{setMinMax}} \tab Compute the minimum and maximum value of a SpatRaster if these are not known \cr \code{\link{extract}} \tab spatial queries of a SpatRaster with a SpatVector\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{VIII. Getting and setting dimensions }{ Get or set basic parameters of SpatRasters. If there are values associated with a SpatRaster (either in memory or via a link to a file) these are lost when you change the number of columns or rows or the resolution. This is not the case when the extent is changed (as the number of columns and rows will not be affected). Similarly, with \bold{crs} you can set the coordinate reference system, but this does not transform the data (see \link{project} for that). \tabular{ll}{ \code{\link{ncol}}\tab The number of columns \cr \code{\link{nrow}} \tab The number of rows \cr \code{\link{ncell}} \tab The number of cells (can not be set directly, only via ncol or nrow) \cr \code{\link{res}} \tab The resolution (x and y) \cr \code{\link{nlyr}} \tab Get or set the number of layers \cr \code{\link{names}} \tab Get or set the layer names \cr \code{\link{xres}} \tab The x resolution (can be set with res) \cr \code{\link{yres}} \tab The y resolution (can be set with res)\cr \code{\link{xmin}} \tab The minimum x coordinate (or longitude) \cr \code{\link{xmax}} \tab The maximum x coordinate (or longitude) \cr \code{\link{ymin}} \tab The minimum y coordinate (or latitude) \cr \code{\link{ymax}} \tab The maximum y coordinate (or latitude) \cr \code{\link{ext}} \tab Get or set the extent (minimum and maximum x and y coordinates ("bounding box") \cr \code{\link{origin}} \tab The origin of a SpatRaster\cr \code{\link{crs}} \tab The coordinate reference system (map projection) \cr \code{\link{is.lonlat}} \tab Test if an object has (or may have) a longitude/latitude coordinate reference system\cr \code{\link{sources}} \tab Get the filename(s) to which a SpatRaster is linked \cr \code{\link{inMemory}} \tab Are the data sources in memory (or on disk)? \cr \code{\link{toMemory}} \tab Force data sources to memory (not recommended)? \cr \code{\link{compareGeom}} \tab Compare the geometry of SpatRasters \cr \code{\link{NAflag}} \tab Set the \code{NA} value (for reading from a file with insufficient metadata) \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{IX. Computing row, column, cell numbers and coordinates}{ Cell numbers start at 1 in the upper-left corner. They increase within rows, from left to right, and then row by row from top to bottom. Likewise, row numbers start at 1 at the top of the raster, and column numbers start at 1 at the left side of the raster. \tabular{ll}{ \code{\link{xFromCol}} \tab x-coordinates from column numbers \cr \code{\link{yFromRow}} \tab y-coordinates from row numbers \cr \code{\link{xFromCell}} \tab x-coordinates from row numbers \cr \code{\link{yFromCell}} \tab y-coordinates from cell numbers \cr \code{\link{xyFromCell}} \tab x and y coordinates from cell numbers \cr \code{\link{colFromX}} \tab Column numbers from x-coordinates (or longitude) \cr \code{\link{rowFromY}} \tab Row numbers from y-coordinates (or latitude) \cr \code{\link{rowColFromCell}} \tab Row and column numbers from cell numbers\cr \code{\link{cellFromXY}} \tab Cell numbers from x and y coordinates \cr \code{\link{cellFromRowCol}} \tab Cell numbers from row and column numbers \cr \code{\link{cellFromRowColCombine}} \tab Cell numbers from all combinations of row and column numbers \cr \code{\link{cells}}\tab Cell numbers from an SpatVector or SpatExtent\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{X. Time related methods}{ \tabular{ll}{ \code{\link{time}} \tab Get or set time\cr \code{\link{fillTime}} \tab can add empty layers in between existing layers to assure that the time step between layers is constant \cr \code{\link{mergeTime}} \tab combine multiple rasters, perhaps partly overlapping in time, into a single time series\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{XI. Methods for categorical rasters}{ \tabular{ll}{ \code{\link{is.factor}} \tab Are there categorical layers?\cr \code{\link{levels}} \tab Get active categories, or set categories\cr \code{\link{activeCat}} \tab Get or set the active category\cr \code{\link{cats}} \tab Get categories (active and inactive)\cr \code{\link{set.cats}} \tab Set categories in place \cr \code{\link{concats}} \tab Combine SpatRasters with different categories\cr \code{\link{catalyze}} \tab Create a layer for each category \cr \code{\link{as.numeric}} \tab use the active category to create a non-categorical SpatRaster\cr \code{\link{as.factor}} \tab Make the layers of a SpatRaster categorical\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{XII. Writing SpatRaster files}{ \subsection{Basic}{ \tabular{ll}{ \code{\link{writeRaster}} \tab Write all values of SpatRaster to disk. You can set the filetype, datatype, compression. \cr \code{\link{writeCDF}} \tab Write SpatRaster data to a netCDF file\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \subsection{Advanced}{ \tabular{ll}{ \code{\link{readStart}} \tab Open file connections for efficient multi-chunk reading \cr \code{\link{readValues}} \tab Read some values from an opened file \cr \code{\link{readStop}} \tab Close file connections \cr \code{\link{writeStart}} \tab Open a file for writing \cr \code{\link{writeValues}} \tab Write some values to an opened file \cr \code{\link{writeStop}} \tab Close the file after writing \cr \code{\link{blocks}} \tab Get blocksize for reading files (when not writing) \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr \cr } } } \section{XIII. Miscellaneous SpatRaster methods}{ \tabular{ll}{ \code{\link{terraOptions}} \tab Show, set, or get session options, mostly to control memory use and to set write options\cr \code{\link{sources}} \tab Show the data sources of a SpatRaster \cr \code{\link{tmpFiles}} \tab Show or remove temporary files \cr \code{\link{mem_info}} \tab memory needs and availability \cr \code{\link{inMemory}} \tab Are the cell values in memory? \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{XIV. SpatRasterDataset}{ A SpatRasterDataset contains SpatRasters that represent sub-datasets for the same area. They all have the same extent and resolution. \tabular{ll}{ \code{\link{sds}} \tab Create a SpatRasterDataset from a file with subdatasets (ncdf or hdf) or from SpatRasters \cr \code{[} or \code{$} \tab Extract a SpatRaster \cr \code{\link{names}} \tab Get the names of the sub-datasets \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{XV. SpatRasterCollections}{ A SpatRasterCollection is a vector of SpatRaster objects. Unlike for a SpatRasterDataset, there the extent and resolution of the SpatRasters do not need to match each other. \tabular{ll}{ \code{\link{sprc}} \tab create a SpatRasterCollection from (a list of) SpatRasters\cr \code{\link{length}} \tab how many SpatRasters does the SpatRasterCollection have?\cr \code{\link{crop}} \tab crop a SpatRasterCollection\cr \code{\link{impose}} \tab force the members of SpatRasterCollection to the same geometry\cr \code{\link{merge}} \tab merge the members of a SpatRasterCollection\cr \code{\link{mosaic}} \tab mosaic (merge with a function for overlapping areas) the members of a SpatRasterCollection\cr \code{\link{[}} \tab extract a SpatRaster\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{\bold{SpatVector}}{ ---------------------------------------------------------------------------------------------------------------------} \section{XVI. Create SpatVector objects}{ \tabular{ll}{ \code{\link{vect}} \tab Create a SpatVector from a file (for example a "shapefile") or from another object\cr \code{\link{vector_layers}} \tab list or delete layers in a vector database such as GPGK\cr \code{rbind} \tab append SpatVectors of the same geometry type\cr \code{\link{unique}} \tab remove duplicates \cr \code{\link{na.omit}} \tab remove empty geometries and/or fields that are \code{NA} \cr \code{\link{project}} \tab Project a SpatVector to a different coordinate reference system \cr \code{\link{writeVector}} \tab Write SpatVector data to disk \cr \code{\link{centroids}} \tab Get the centroids of a SpatVector\cr \code{\link{voronoi}} \tab Voronoi diagram \cr \code{\link{delaunay}} \tab Delaunay triangles\cr \code{\link{hull}} \tab Compute a convex, circular, or rectangular hull around the (geometries of) a SpatVector \cr \code{\link{fillHoles}}\tab Remove or extract holes from polygons\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{XVII. Properties of SpatVector objects}{ \tabular{ll}{ \code{\link{geom}} \tab returns the geometries as matrix or WKT\cr \code{\link{crds}} \tab returns the coordinates as a matrix\cr \code{\link{linearUnits}} \tab returns the linear units of the crs (in meter)\cr \code{\link{ncol}}\tab The number of columns (of the attributes)\cr \code{\link{nrow}} \tab The number of rows (of the geometries and attributes)\cr \code{\link{names}} \tab Get or set the layer names \cr \code{\link{ext}} \tab Get the extent (minimum and maximum x and y coordinates ("bounding box") \cr \code{\link{crs}} \tab The coordinate reference system (map projection) \cr \code{\link{is.lonlat}} \tab Test if an object has (or may have) a longitude/latitude coordinate reference system\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{XVIII. Geometric queries}{ \tabular{ll}{ \code{\link{adjacent}} \tab find adjacent polygons\cr \code{\link{expanse}} \tab computes the area covered by polygons\cr \code{\link{nearby}} \tab find nearby geometries\cr \code{\link{nearest}} \tab find the nearest geometries\cr \code{\link{relate}} \tab geometric relationships such as "intersects", "overlaps", and "touches"\cr \code{\link{perim}} \tab computes the length of the perimeter of polygons, and the length of lines\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{XIX. Geometric operations}{ \tabular{ll}{ \code{\link{erase}} or "-" \tab erase (parts of) geometries\cr \code{\link{intersect}} or "*" \tab intersect geometries\cr \code{\link{union}} or "+" \tab Merge geometries\cr \code{\link{cover}} \tab update polygons\cr \code{\link{symdif}} \tab symmetrical difference of two polygons \cr \code{\link{aggregate}} \tab dissolve smaller polygons into larger ones \cr \code{\link{buffer}} \tab buffer geometries \cr \code{\link{disagg}} \tab split multi-geometries into separate geometries \cr \code{\link{crop}} \tab clip geometries using a rectangle (SpatExtent) or SpatVector \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{XX. SpatVector attributes}{ We use the term "attributes" for the tabular data (data.frame) associated with vector geometries. \tabular{ll}{ \code{\link{extract}} \tab spatial queries between SpatVector and SpatVector (e.g. point in polygons) \cr \code{\link{sel}} \tab select - interactively select geometries\cr \code{\link{click}} \tab identify attributes by clicking on a map\cr \code{\link{merge}} \tab Join a table with a SpatVector \cr \code{\link{as.data.frame}} \tab get attributes as a data.frame\cr \code{\link{as.list}} \tab get attributes as a list\cr \code{\link{values}} \tab Get the attributes of a SpatVector \cr \code{\link{values<-}} \tab Set new attributes to the geometries of a SpatRaster \cr \code{\link{sort}} \tab sort SpatVector by the values in a field \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{XXI. Change geometries (for display, experimentation)}{ \tabular{ll}{ \code{\link{shift}} \tab change the position geometries by shifting their coordinates in horizontal and/or vertical direction\cr \code{\link{spin}}\tab rotate geometries around an origin\cr \code{\link{rescale}} \tab shrink (or expand) geometries, for example to make an inset map \cr \code{\link{flip}} \tab flip geometries vertically or horizontally\cr \code{\link{t}} \tab transpose geometries (switch x and y)\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{XXII. Geometry properties and topology}{ \tabular{ll}{ \code{\link{width}} \tab the minimum diameter of the geometries \cr \code{\link{clearance}} \tab the minimum clearance of the geometries \cr \code{\link{sharedPaths}} \tab shared paths (arcs) between line or polygon geometries\cr \code{\link{simplifyGeom}} \tab simplify geometries\cr \code{\link{gaps}} \tab find gaps between polygon geometries \cr \code{\link{fillHoles}} \tab get or remove the polygon holes\cr \code{\link{makeNodes}} \tab create nodes on lines \cr \code{\link{mergeLines}} \tab connect lines to form polygons \cr \code{\link{removeDupNodes}} \tab remove duplicate nodes in geometries and optionally rounds the coordinates \cr \code{\link{is.valid}} \tab check if geometries are valid \cr \code{\link{makeValid}} \tab attempt to repair invalid geometries \cr \code{\link{snap}} \tab make boundaries of geometries identical if they are very close to each other \cr \code{\link{erase} (single argument)} \tab remove parts of geometries that overlap \cr \code{\link{union} (single argument)} \tab create new polygons such that there are no overlapping polygons \cr \code{\link{rotate}} \tab rotate to (dis-) connect them across the date-line \cr \code{\link{normalize.longitude}} \tab move geometries that are outside of the -180 to 180 degrees range. \cr \code{\link{elongate}} \tab make lines longer by extending both sides \cr \code{\link{combineGeoms}} \tab combine geometries that overlap, share a border, or are within a minimum distance of each other \cr \code{\link{forceCCW}} \tab force counter-clockwise polygon winding \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{XXIII. SpatVectorCollections}{ A SpatVectorCollection is a vector of SpatVector objects. \tabular{ll}{ \code{\link{svc}} \tab create a SpatVectorCollection from (a list of) SpatVector objects\cr \code{\link{length}} \tab how many SpatRasters does the SpatRasterCollection have?\cr \code{\link{[}} \tab extract a SpatVector\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr }} \section{\bold{Other classes}}{ ---------------------------------------------------------------------------------------------------------------------} \section{XXIV. SpatExtent}{ \tabular{ll}{ \code{\link{ext}} \tab Create a SpatExtent object. For example to \code{\link{crop}} a Spatial dataset\cr \code{\link{intersect}} \tab Intersect two SpatExtent objects, same as \code{-} \cr \code{\link{union}} \tab Combine two SpatExtent objects, same as \code{+} \cr \code{\link{Math-methods}} \tab round/floor/ceiling of a SpatExtent \cr \code{\link{align}} \tab Align a SpatExtent with a SpatRaster \cr \code{\link{draw}} \tab Create a SpatExtent by drawing it on top of a map (plot) \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{XXV. SpatGraticule}{ \tabular{ll}{ \code{\link{graticule}} \tab Create a graticule\cr \code{\link{crop}} \tab crop a graticule\cr \code{\link[=plot,SpatGraticule,missing-method]{plot}} \tab plot a graticule \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{\bold{General methods}}{ ---------------------------------------------------------------------------------------------------------------------} \section{XXVI. Conversion between spatial data objects from different packages}{ You can coerce SpatRasters to Raster* objects, after loading the \code{raster} package, with \code{as(object, "Raster")}, or \code{raster(object)} or \code{brick(object)} or \code{stack(object)} \tabular{ll}{ \code{\link{rast}} \tab SpatRaster from matrix and other objects\cr \code{\link{vect}} \tab SpatVector from \code{sf} or \code{Spatial*} vector data\cr \code{sf::st_as_sf} \tab sf object from SpatVector\cr \code{\link{rasterize}} \tab Rasterizing points, lines or polygons\cr \code{\link{rasterizeWin}} \tab Rasterize points with a moving window\cr \code{\link{rasterizeGeom}} \tab Rasterize attributes of geometries such as "count", "area", or "length"\cr \code{\link{as.points}} \tab Create points from a SpatRaster or SpatVector \cr \code{\link{as.lines}} \tab Create lines from a SpatRaster or SpatVector\cr \code{\link{as.polygons}} \tab Create polygons from a SpatRaster \cr \code{\link{as.contour}} \tab Contour lines from a SpatRaster \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{XXVII. Plotting}{ \subsection{Maps}{ \tabular{ll}{ \code{\link{plot}} \tab Plot a SpatRaster or SpatVector. The main method to create a map \cr \code{\link{panel}} \tab Combine multiple plots \cr \code{\link{points}} \tab Add points to a map\cr \code{\link{lines}} \tab Add lines to a map\cr \code{\link{polys}} \tab Add polygons to a map \cr \code{\link{text}} \tab Add text (such as the values of a SpatRaster or SpatVector) to a map \cr \code{\link{halo}} \tab Add text with a halo to a map \cr \code{\link{map.pal}} \tab Color palettes for mapping \cr \code{\link{image}} \tab Alternative to plot to make a map with a SpatRaster \cr \code{\link{plotRGB}} \tab Combine three layers (red, green, blue channels) into a single "real color" plot \cr \code{\link[=plot,SpatGraticule,missing-method]{plot}} \tab plot a graticule \cr \code{\link{sbar}} \tab Add a scale bar to a map\cr \code{\link{north}} \tab Add a north arrow to a map\cr \code{\link{inset}} \tab Add a small inset (overview) map\cr \code{\link{add_legend}} \tab Add a legend to a map\cr \code{\link{add_box}} \tab Add a bounding box to a map\cr \code{\link{map_extent}} \tab Get the coordinates of a map's axes positions\cr \code{\link{dots}} \tab Make a dot-density map \cr \code{\link{cartogram}} \tab Make a cartogram \cr \code{\link{persp}} \tab Perspective plot of a SpatRaster \cr \code{\link{contour}} \tab Contour plot or filled-contour plot of a SpatRaster \cr \code{\link{colorize}} \tab Combine three layers (red, green, blue channels) into a single layer with a color-table \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \subsection{Interacting with a map}{ \tabular{ll}{ \code{\link{zoom}} \tab Zoom in to a part of a map by drawing a bounding box on it \cr \code{\link{click}} \tab Query values of SpatRaster or SpatVector by clicking on a map \cr \code{\link{sel}} \tab Select a spatial subset of a SpatRaster or SpatVector by drawing on a map\cr \code{\link{draw}} \tab Create a SpatExtent or SpatVector by drawing on a map \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \subsection{Other plots}{ \tabular{ll}{ \code{\link{plot}} \tab x-y scatter plot of the values of (a sample of) the layers of two SpatRaster objects\cr \code{\link{hist}} \tab Histogram of SpatRaster values \cr \code{\link{barplot}} \tab Bar plot of a SpatRaster \cr \code{\link{density}} \tab Density plot of SpatRaster values \cr \code{\link{pairs}} \tab Pairs plot for layers in a SpatRaster \cr \code{\link{boxplot}} \tab Box plot of the values of a SpatRaster\cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } } \section{\bold{Comparison with the raster package}}{ ---------------------------------------------------------------------------------------------------------------------} \section{XXVIII. New method names}{ \code{terra} has a single class \code{SpatRaster} for which \code{raster} has three (\code{RasterLayer, RasterStack, RasterBrick}). Likewise there is a single class for vector data \code{SpatVector} that replaces six \code{Spatial*} classes. Most method names are the same, but note the following important differences in methods names with the \code{raster} package \tabular{ll}{ \bold{raster package} \tab \bold{terra package}\cr \code{raster, brick, stack}\tab\code{\link{rast}}\cr \code{rasterFromXYZ}\tab\code{\link{rast}( , type="xyz")}\cr \code{stack, addLayer}\tab\code{\link{c}}\cr \code{addLayer} \tab\code{\link{add<-}}\cr \code{area} \tab\code{\link{cellSize}} or \code{\link{expanse}}\cr \code{approxNA} \tab\code{\link{approximate}}\cr \code{calc}\tab\code{\link{app}}\cr \code{cellFromLine, cellFromPolygon,}\tab \code{\link{cells}}\cr \code{cellsFromExtent}\tab\code{\link{cells}}\cr \code{cellStats}\tab\code{\link{global}}\cr \code{clump}\tab\code{\link{patches}}\cr \code{compareRaster}\tab\code{\link{compareGeom}}\cr \code{corLocal}\tab\code{\link{focalPairs}}\cr \code{coordinates}\tab\code{\link{crds}}\cr \code{couldBeLonLat}\tab\code{\link{is.lonlat}}\cr \code{disaggregate} \tab\code{\link{disagg}}\cr \code{distanceFromPoints} \tab \code{\link{distance}}\cr \code{drawExtent, drawPoly, drawLine} \tab \code{\link{draw}}\cr \code{dropLayer}\tab\code{\link{subset}}\cr \code{extent}\tab\code{\link{ext}}\cr \code{getValues}\tab\code{\link{values}}\cr \code{isLonLat, isGlobalLonLat}\tab\code{\link{is.lonlat}}\cr \code{layerize}\tab\code{\link{segregate}}\cr \code{layerStats}\tab\code{\link{layerCor}}\cr \code{movingFun}\tab\code{\link{roll}}\cr \code{NAvalue}\tab\code{\link{NAflag}}\cr \code{nlayers}\tab\code{\link{nlyr}}\cr \code{overlay}\tab\code{\link{lapp}}\cr \code{unstack}\tab\code{\link{as.list}}\cr \code{projectRaster}\tab\code{\link{project}}\cr \code{rasterToPoints}\tab\code{\link{as.points}}\cr \code{rasterToPolygons}\tab\code{\link{as.polygons}}\cr \code{readAll}\tab\code{\link{toMemory}}\cr \code{reclassify, subs, cut}\tab\code{\link{classify}}\cr \code{sampleRandom, sampleRegular}\tab\code{\link{spatSample}}\cr \code{shapefile}\tab\code{\link{vect}}\cr \code{stackApply}\tab\code{\link{tapp}}\cr \code{stackSelect}\tab\code{\link{selectRange}}\cr } } \section{XXIX. Changed behavior}{ Also note that even if function names are the same in \code{terra} and \code{raster}, their output can be different. In most cases this was done to get more consistency in the returned values (and thus fewer errors in the downstream code that uses them). In other cases it simply seemed better. Here are some examples: \tabular{ll}{ \code{\link{resample}}\tab Results are not numerically identical when using \code{method="bilinear"}, especially at edges, and when going from a high to a low resolution\cr \code{\link{as.polygons}}\tab By default, \code{terra} returns dissolved polygons\cr \code{\link{quantile}}\tab computes by cell, across layers instead of the other way around\cr \code{\link{extract}}\tab By default, \code{terra} returns a matrix, with the first column the sequential ID of the vectors. \cr \tab \code{raster} returns a list (for lines or polygons) or a matrix (for points, but without the ID\cr \tab column. You can use \code{list=TRUE} to get the results as a list\cr \code{\link{values}}\tab \code{terra} always returns a matrix. \code{raster} returns a vector for a \code{RasterLayer}\cr \code{\link{Summary-methods}}\tab With \code{raster}, \code{mean(x, y)} and \code{mean(stack(x, y)} return the same result, a single\cr \tab layer with the mean of all cell values. This is also what \code{terra} returns with \cr \tab \code{mean(c(x, y))}, but with \code{mean(x, y)} the parallel mean is returned -- that is, the\cr \tab computation is done layer-wise, and the number of layers in the output is the same as\cr \tab that of \code{x} and \code{y} (or the larger of the two if they are not the same). This affects \cr \tab all summary functions (\code{sum}, \code{mean}, \code{median}, \code{which.min}, \code{which.max}, \code{min}, \code{max},\cr \tab \code{prod}, \code{any}, \code{all}, \code{stdev}), except \code{range}, which is not implemented for this case \cr \tab (you can use \code{min} and \code{max} instead) \cr --------------------------- \tab ------------------------------------------------------------------------------------------ \cr } } \section{Authors}{ Except where indicated otherwise, the methods and functions in this package were written by Robert Hijmans. The configuration scripts were written by Roger Bivand. Some of code using the GEOS library was adapted from code by Edzer Pebesma for \code{sf}. Michael Sumner contributed various bits and pieces. } \section{Acknowledgments}{ This package is an attempt to climb on the shoulders of giants (GDAL, PROJ, GEOS, NCDF, GeographicLib, Rcpp, R). Many people have contributed by asking questions or \href{https://github.com/rspatial/terra}{raising issues}. Feedback and suggestions by Márcia Barbosa, Kendon Bell, Andrew Gene Brown, Jean-Luc Dupouey, Krzysztof Dyba, Sarah Endicott, Derek Friend, Alex Ilich, Gerald Nelson, Jakub Nowosad, and Monika Tomaszewska have been especially helpful. } \keyword{ package } \keyword{ spatial } terra/man/writeRaster.Rd0000644000176200001440000001130214677057562014764 0ustar liggesusers\name{writeRaster} \alias{writeRaster,SpatRaster,character-method} \alias{writeRaster} \title{Write raster data to a file} \description{ Write a SpatRaster to a file. } \usage{ \S4method{writeRaster}{SpatRaster,character}(x, filename, overwrite=FALSE, ...) } \arguments{ \item{x}{SpatRaster} \item{filename}{character. Output filename. Can be a single filename, or as many filenames as \code{nlyr(x)} to write a file for each layer} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{...}{additional arguments for for writing files. See Details } } \value{ SpatRaster. This function is used for the side-effect of writing values to a file. } \seealso{ see \code{\link{writeCDF}} for writing NetCDF files. } \details{ In writeRaster, and in other methods that generate SpatRasters, options for writing raster files to disk can be provided as additional arguments or, in a few cases, as the \code{wopt} argument (a named list) if the additional arguments are already used for a different purpose. See \code{\link{terraOptions}} to get or set default values. The following options are available: \tabular{ll}{ \bold{name} \tab \bold{description}\cr \code{datatype}\tab values accepted are "INT1U", "INT2U", "INT2S", "INT4U", "INT4S", "FLT4S", "FLT8S". With GDAL >= 3.5 you can also use "INT8U" and "INT8S". And with GDAL >= 3.7 you can use also use "INT1S". See \code{\link{gdal}} to discover the GDAL version you are using. The first three letters indicate whether the datatype is an integer (whole numbers) of a real number ("float", decimal numbers), the fourth character indicates the number of bytes used for each number. Higher values allow for storing larger numbers and/or more precision; but create larger files. The "S" or "U" indicate whether the values are signed (both negative and positive) or unsigned (zero and positive values only).\cr \code{filetype}\tab file format expresses as \href{https://gdal.org/en/latest/drivers/raster/index.html}{GDAL driver names}. If this argument is not supplied, the driver is derived from the filename. You can use \code{gdal(drivers=TRUE)} to see what drivers are available in your installation\cr \code{gdal}\tab GDAL driver specific datasource creation options. See the GDAL documentation. For example, with the \href{https://gdal.org/en/latest/drivers/raster/gtiff.html}{GeoTiff file format} you can use \code{gdal=c("COMPRESS=DEFLATE", "TFW=YES")}.\cr \code{tempdir}\tab the path where temporary files are to be written to.\cr \code{progress}\tab positive integer. If the number of chunks is larger, a progress bar is shown.\cr \code{memfrac}\tab numeric between 0 and 0.9 (higher values give a warning). The fraction of available RAM that terra is allowed to use.\cr \code{memmax}\tab memmax - the maximum amount of RAM (in GB) that terra can use when processing a raster dataset. Should be less than what is detected (see \code{\link{mem_info}}, and higher values are ignored. Set it to a negative number or NA to ignore this value). \cr \code{names}\tab output layer names.\cr \code{NAflag}\tab numeric. value to represent missing (\code{NA} or \code{NaN}) values. See note\cr \code{scale}\tab numeric. Cell values written to disk are divided by this value (default is 1). See \code{\link{scoff}}\cr \code{offset}\tab numeric. Value that is subtracted from the cell values written to disk (default is 0). See \code{\link{scoff}} \cr \code{verbose}\tab logical. If \code{TRUE} debugging information is printed\cr \code{steps}\tab positive integers. In how many steps (chunks) do you want to process the data (for debugging)\cr \code{todisk}\tab logical. If \code{TRUE} processing operates as if the dataset is very large and needs to be written to a temporary file (for debugging).\cr } } \note{ GeoTiff files are, by default, written with LZW compression. If you do not want compression, use \code{gdal="COMPRESS=NONE"}. When writing integer values the lowest available value (given the datatype) is used to represent \code{NA} for signed types, and the highest value is used for unsigned values. This can be a problem with byte data (between 0 and 255) as the value 255 is reserved for \code{NA}. To keep the value 255, you need to set another value as \code{NAflag}, or do not set a \code{NAflag} (with \code{NAflag=NA}) } \examples{ r <- rast(nrows=5, ncols=5, vals=1:25) # create a temporary filename for the example f <- file.path(tempdir(), "test.tif") writeRaster(r, f, overwrite=TRUE) writeRaster(r, f, overwrite=TRUE, gdal=c("COMPRESS=NONE", "TFW=YES"), datatype='INT1U') ## Or with a wopt argument: writeRaster(r, f, overwrite=TRUE, wopt= list(gdal=c("COMPRESS=NONE"), datatype='INT1U')) ## remove the file unlink(f) } \keyword{ spatial } \keyword{ methods } terra/man/divide.Rd0000644000176200001440000000472114747312400013703 0ustar liggesusers\name{divide} \alias{divide} \alias{divide,SpatRaster-method} \alias{divide,SpatVector-method} \title{ Subdivide a raster or polygons } \description{ Divide a \code{SpatRaster} into \code{n} parts with approximately the same sum of weights (cell values). Divides a \code{SpatVector} of polygons into \code{n} compact and approximately equal area parts. The results are not deterministic so you should use set.seed to be able to reproduce your results. If you get a warning about non-convergence, you can increase the number of iterations used with additional argument iter.max } \usage{ \S4method{divide}{SpatRaster}(x, n=2, start="ns", as.raster=FALSE, na.rm=TRUE) \S4method{divide}{SpatVector}(x, n=5, w=NULL, alpha=1, ...) } \arguments{ \item{x}{SpatRaster or SpatVector of polygons} \item{n}{numeric. Can be a single positive integer to indicate the number of parts (SpatVector) or the number of splits (SpatRaster). If \code{x} is a SpatRaster, it can also be a vector with values -2, -1, 1, or 2. Where 1 means one split and 2 means two splits, and the negative sign indicates an East-West (vertical) split as opposed to a North-South split. If \code{x} is a SpatVector it can be a list with at least one of these elements: \code{horizontal} and \code{vertical} that specify the proportions of the area that splits should cover. This can either be a single fraction such as 1/3, or a sequence of fractions in ascending order such as \code{c(1/4, 1/2, 1)}} \item{start}{character. To indicate the initial direction of splitting the raster. "ns" for North-South (horizontal) or "ew" for East-West (vertical)} \item{as.raster}{logical. If \code{FALSE} a SpatVector is returned. If \code{FALSE}, a SpatRaster is returned. If \code{NA} a list with a SpatRaster and a SpatVector is returned} \item{na.rm}{logical. If \code{TRUE} cells in \code{x} that are \code{NA} are not included in the output} \item{w}{SpatRaster with, for example, environmental data} \item{alpha}{numeric. One or two numbers that act as weights for the x and y coordinates} \item{...}{additional arguments such as \code{iter.max} passed on to \code{\link{kmeans}}} } \seealso{\code{\link{thresh}}} \value{SpatVector or SpatRaster, or a list with both} \examples{ f <- system.file("ex/elev.tif", package="terra") r <- rast(f) x <- divide(r, 3) # plot(r); lines(x) f <- system.file("ex/lux.shp", package="terra") v <- vect(f) d <- divide(v, 3) dv <- divide(v, list(h=.5)) } \keyword{spatial} terra/man/project.Rd0000644000176200001440000001463614745473502014124 0ustar liggesusers\name{project} \alias{project} \alias{project,SpatVector-method} \alias{project,SpatVectorCollection-method} \alias{project,SpatRaster-method} \alias{project,SpatExtent-method} \alias{project,matrix-method} \title{Change the coordinate reference system} \description{ Change the coordinate reference system ("project") of a SpatVector, SpatRaster or a matrix with coordinates. } \usage{ \S4method{project}{SpatVector}(x, y, partial = FALSE) \S4method{project}{SpatRaster}(x, y, method, mask=FALSE, align_only=FALSE, res=NULL, origin=NULL, threads=FALSE, filename="", ..., use_gdal=TRUE, by_util = FALSE) \S4method{project}{SpatExtent}(x, from, to) \S4method{project}{matrix}(x, from, to) } \arguments{ \item{x}{SpatRaster, SpatVector, SpatExtent or matrix (with x and y columns) whose coordinates to project} \item{y}{if \code{x} is a SpatRaster, the preferred approach is for \code{y} to be a SpatRaster as well, serving as a template for the geometry (extent and resolution) of the output SpatRaster. Alternatively, you can provide a coordinate reference system (CRS) description. You can use the following formats to define coordinate reference systems: WKT, PROJ.4 (e.g., \code{+proj=longlat +datum=WGS84}), or an EPSG code (e.g., \code{"epsg:4326"}). But note that the PROJ.4 notation has been deprecated, and you can only use it with the WGS84/NAD83 and NAD27 datums. Other datums are silently ignored. If \code{x} is a SpatVector, you can provide a crs definition as discussed above, or any other object from which such a crs can be extracted with \code{\link{crs}}} \item{partial}{logical. If \code{TRUE}, geometries that can only partially be represented in the output crs are included in the output} \item{method}{character. Method used for estimating the new cell values of a SpatRaster. One of: \code{bilinear}: bilinear interpolation (3x3 cell window). This is used by default if the first layer of \code{x} is not categorical \code{average}: This can be a good choice with continuous variables if the output cells overlap with multiple input cells. \code{near}: nearest neighbor. This is used by default if the first layer of \code{x} is categorical. This method is not a good choice for continuous values. \code{mode}: The modal value. This can be a good choice for categrical rasters, if the output cells overlap with multiple input cells. \code{cubic}: cubic interpolation (5x5 cell window). \code{cubicspline}: cubic B-spline interpolation. (5x5 cell window). \code{lanczos}: Lanczos windowed sinc resampling. (7x7 cell window). \code{sum}: the weighted sum of all non-NA contributing grid cells. \code{min, q1, median, q3, max}: the minimum, first quartile, median, third quartile, or maximum value. \code{rms}: the root-mean-square value of all non-NA contributing grid cells. } \item{mask}{logical. If \code{TRUE}, mask out areas outside the input extent. For example, to avoid data wrapping around the date-line (see example with Robinson projection). To remove cells that are \code{NA} in \code{y} (if \code{y} is a SpatRaster) you can use the \code{\link{mask} method} after calling \code{project} (this function)} \item{align_only}{logical. If \code{TRUE}, and \code{y} is a SpatRaster, the template is used for the spatial resolution and origin, but the extent is set such that all of the extent of \code{x} is included} \item{res}{numeric. Can be used to set the resolution of the output raster if \code{y} is a CRS} \item{origin}{numeric. Can be used to set the origin of the output raster if \code{y} is a CRS} \item{threads}{logical. If \code{TRUE} multiple threads are used (faster for large files)} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} \item{use_gdal}{logical. If \code{TRUE} the GDAL-warp algorithm is used. Otherwise, a slower internal algorithm is used that may be more accurate if there is much variation in the cell sizes of the output raster. Only the \code{near} and \code{bilinear} algorithms are available for the internal algorithm} \item{by_util}{logical. If \code{TRUE} and \code{gdal=TRUE}, the GDAL warp utility is used} \item{from}{character. Coordinate reference system of \code{x}} \item{to}{character. Output coordinate reference system} } \value{ SpatVector or SpatRaster } \seealso{\code{\link{crs}}, \code{\link{resample}}} \note{ The PROJ.4 notation of coordinate reference systems has been partly deprecated in the GDAL/PROJ library that is used by this function. You can still use this notation, but *only* with the WGS84 datum. Other datums are silently ignored. Transforming (projecting) raster data is fundamentally different from transforming vector data. Vector data can be transformed and back-transformed without loss in precision and without changes in the values. This is not the case with raster data. In each transformation the values for the new cells are estimated in some fashion. Therefore, if you need to match raster and vector data for analysis, you should generally transform the vector data. When using this method with a \code{SpatRaster}, the preferable approach is to provide a template \code{SpatRaster} as argument \code{y}. The template is then another raster dataset that you want your data to align with. If you do not have a template to begin with, you can do \code{project(rast(x), crs)} and then manipulate the output to get the template you want. For example, where possible use whole numbers for the extent and resolution so that you do not have to worry about small differences in the future. You can use commands like \code{dim(z) = c(180, 360)} or \code{res(z) <- 100000}. The output resolution should generally be similar to the input resolution, but there is no "correct" resolution in raster transformation. It is not obvious what this resolution is if you are using lon/lat data that spans a large North-South extent. } \examples{ ## SpatRaster a <- rast(ncols=40, nrows=40, xmin=-110, xmax=-90, ymin=40, ymax=60, crs="+proj=longlat +datum=WGS84") values(a) <- 1:ncell(a) newcrs="+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +datum=WGS84" b <- rast(ncols=94, nrows=124, xmin=-944881, xmax=935118, ymin=4664377, ymax=7144377, crs=newcrs) w <- project(a, b) ## SpatVector f <- system.file("ex/lux.shp", package="terra") v <- vect(f) crs(v, proj=TRUE) cat(crs(v), "\n") project(v, "+proj=moll") project(v, "EPSG:2169") } \keyword{spatial} terra/man/rasterize.Rd0000644000176200001440000000675214536376240014465 0ustar liggesusers\name{rasterize} \docType{methods} \alias{rasterize} \alias{rasterize,SpatVector,SpatRaster-method} \alias{rasterize,sf,SpatRaster-method} \alias{rasterize,matrix,SpatRaster-method} \title{Rasterize vector data} \description{ Transfer values associated with the geometries of vector data to a raster } \usage{ \S4method{rasterize}{SpatVector,SpatRaster}(x, y, field="", fun, ..., background=NA, touches=FALSE, update=FALSE, cover=FALSE, by=NULL, filename="", overwrite=FALSE, wopt=list()) \S4method{rasterize}{matrix,SpatRaster}(x, y, values=1, fun, ..., background=NA, update=FALSE, by=NULL, filename="", overwrite=FALSE, wopt=list()) } \arguments{ \item{x}{SpatVector or a two-column matrix (point coordinates)} \item{y}{SpatRaster} \item{field}{character or numeric. If \code{field} is a character, it should a variable name in \code{x}. If \code{field} is numeric it typically is a single number or a vector of length \code{nrow(x)}. The values are recycled to \code{nrow(x)}} \item{values}{typically a numeric vector of length \code{1} or \code{nrow(x)}. If the length is below \code{nrow(x)} the values will be recycled to \code{nrow(x)}. Only used when \code{x} is a matrix. Can also be a matrix or data.frame} \item{fun}{summarizing function for when there are multiple geometries in one cell. For lines and polygons you can only use \code{"min"}, \code{"max"}, \code{"mean"}, \code{"count"} and \code{"sum"} For points you can use any function that returns a single number; for example \code{mean}, \code{length} (to get a count), \code{min} or \code{max}} \item{...}{additional arguments passed to \code{fun}} \item{background}{numeric. Value to put in the cells that are not covered by any of the features of \code{x}. Default is \code{NA}} \item{touches}{logical. If \code{TRUE}, all cells touched by lines or polygons are affected, not just those on the line render path, or whose center point is within the polygon. If \code{touches=TRUE}, \code{add} cannot be \code{TRUE}} \item{update}{logical. If \code{TRUE}, the values of the input SpatRaster are updated} \item{cover}{logical. If \code{TRUE} and the geometry of \code{x} is polygons, the fraction of a cell that is covered by the polygons is returned. This is estimated by determining presence/absence of the polygon in at least 100 sub-cells (more of there are very few cells)} \item{by}{character or numeric value(s) to split \code{x} into multiple groups. There will be a separate layer for each group returned. If \code{x} is a SpatVector, \code{by} can be a column number or name. If \code{x} is a matrix, \code{by} should be a vector that identifies group membership for each row in \code{x}} \item{filename}{character. Output filename} \item{overwrite}{logical. If \code{TRUE}, \code{filename} is overwritten} \item{wopt}{list with additional arguments for writing files as in \code{\link{writeRaster}}} } \seealso{ \code{\link{rasterizeGeom}}, \code{\link{rasterizeWin}}, \code{\link{mask}} } \value{ SpatRaster } \examples{ r <- rast(xmin=0, ncols=18, nrows=18) # generate points set.seed(1) p <- spatSample(r, 1000, xy=TRUE, replace=TRUE) # rasterize points as a matrix x <- rasterize(p, r, fun=sum) y <- rasterize(p, r, value=1:nrow(p), fun=max) # rasterize points as a SpatVector pv <- vect(p) xv <- rasterize(pv, r, fun=sum) # Polygons f <- system.file("ex/lux.shp", package="terra") v <- vect(f) r <- rast(v, ncols=75, nrows=100) z <- rasterize(v, r, "NAME_2") plot(z) lines(v) } \keyword{spatial} terra/man/pitfinder.Rd0000644000176200001440000000257414633631501014427 0ustar liggesusers\docType{methods} \name{pitfinder} \alias{pitfinder} \alias{pitfinder,SpatRaster-method} \title{Pit Finder in a Flow Dir SpatRaster for Watershed Extraction} \description{ find pits (depressions with no outlet ) } \usage{ \S4method{pitfinder}{SpatRaster}(x,filename="",...) } \arguments{ \item{x}{SpatRaster wih flow-direcion. See \code{\link{terrain}}} \item{filename}{character. Output filename} \item{...}{additional arguments for writing files as in \code{\link{writeRaster}}} } \value{ A \code{\link{SpatRaster-class}} (raster) map containing value 1 for the pits and value 0 elsewhere. } \author{ Emanuele Cordano } \seealso{\code{\link{terrain}},\code{\link{watershed}},\code{\link{flowAccumulation}},\code{\link{NIDP}}} \examples{ ## Creation of a Digital Elevation Model elev <- array(NA,c(9,9)) dx <- 1 dy <- 1 for (r in 1:nrow(elev)) { x <- (r-5)*dx for (c in 1:ncol(elev)) { y <- (c-5)*dy elev[r,c] <- 10+5*(x^2+y^2) } } elev <- cbind(elev,elev,elev,elev) elev <- rbind(elev,elev,elev,elev) elev <- rast(elev) ## Flow Directions flowdir<- terrain(elev,v="flowdir") t(array(flowdir[],rev(dim(flowdir)[1:2]))) ## Pit Detect pits <- pitfinder(flowdir) ## Application wth example DEM elev <- rast(system.file('ex/elev.tif',package="terra")) flowdir <- terrain(elev,"flowdir") pits <- pitfinder(flowdir) } \keyword{spatial} terra/DESCRIPTION0000644000176200001440000000501014757546132013107 0ustar liggesusersPackage: terra Type: Package Title: Spatial Data Analysis Version: 1.8-29 Date: 2025-02-25 Depends: R (>= 3.5.0) Suggests: parallel, tinytest, ncdf4, sf (>= 0.9-8), deldir, XML, leaflet (>= 2.2.1), htmlwidgets LinkingTo: Rcpp Imports: methods, Rcpp (>= 1.0-10) SystemRequirements: C++17, GDAL (>= 2.2.3), GEOS (>= 3.4.0), PROJ (>= 4.9.3), sqlite3 Encoding: UTF-8 Language: en-US Maintainer: Robert J. Hijmans Description: Methods for spatial data analysis with vector (points, lines, polygons) and raster (grid) data. Methods for vector data include geometric operations such as intersect and buffer. Raster methods include local, focal, global, zonal and geometric operations. The predict and interpolate methods facilitate the use of regression type (interpolation, machine learning) models for spatial prediction, including with satellite remote sensing data. Processing of very large files is supported. See the manual and tutorials on to get started. 'terra' replaces the 'raster' package ('terra' can do more, and it is faster and easier to use). License: GPL (>= 3) URL: https://rspatial.org/, https://rspatial.github.io/terra/ BugReports: https://github.com/rspatial/terra/issues/ LazyLoad: yes Authors@R: c( person("Robert J.", "Hijmans", role=c("cre", "aut"), email="r.hijmans@gmail.com", comment=c(ORCID="0000-0001-5872-2872")), person("Márcia", "Barbosa", role="ctb"), person("Roger", "Bivand", role="ctb", comment=c(ORCID="0000-0003-2392-6140")), person("Andrew", "Brown", role="ctb"), person("Michael", "Chirico", role="ctb"), person("Emanuele", "Cordano", role="ctb",comment=c(ORCID="0000-0002-3508-5898")), person("Krzysztof", "Dyba", role="ctb", comment=c(ORCID="0000-0002-8614-3816")), person("Edzer", "Pebesma", role="ctb", comment=c(ORCID="0000-0001-8049-7069")), person("Barry", "Rowlingson", role="ctb"), person("Michael D.", "Sumner", role="ctb")) NeedsCompilation: yes Packaged: 2025-02-26 01:29:49 UTC; rhijm Author: Robert J. Hijmans [cre, aut] (), Márcia Barbosa [ctb], Roger Bivand [ctb] (), Andrew Brown [ctb], Michael Chirico [ctb], Emanuele Cordano [ctb] (), Krzysztof Dyba [ctb] (), Edzer Pebesma [ctb] (), Barry Rowlingson [ctb], Michael D. Sumner [ctb] Repository: CRAN Date/Publication: 2025-02-26 08:10:02 UTC