R: Georeference single drone image from metadata file - r

In my example, I have a single dji image in *JPG:
library(terra)
single.image <-stack("https://github.com/Leprechault/trash/raw/main/DJI_0274.JPG")
plotRGB(single.image, r = 3, g = 2, b = 1, stretch = "lin")
# class : RasterStack
# dimensions : 3648, 4864, 17743872, 3 (nrow, ncol, ncell, nlayers)
# resolution : 1, 1 (x, y)
# extent : 0, 4864, 0, 3648 (xmin, xmax, ymin, ymax)
# crs : NA
# names : DJI_0274_1, DJI_0274_2, DJI_0274_3
and the correspond Metadata in *jgw file:
single.image.mtd <- read.table("https://github.com/Leprechault/trash/raw/main/DJI_0274.jgw", header = FALSE, skip=1)
single.image.mtd
# V1
# 1 -3.532000e-07
# 2 2.600000e-09
# 3 3.100000e-09
# 4 2.976000e-07
# 5 -5.170865e+01
# 6 -1.973617e+01
This values are:
# X-cell size
# rotation (usually 0)
# rotation (usually 0)
# Y-cell size (always negative)
# Upper left X
# Upper left Y
I'd like to know if is possible to use the metadata in order to have a georeferenced image and save it in geoTIFF format?
Thanks in advance!
Alexandre

From my point of view, reading your jpg file works on-the-fly if you used {terra} for importing instead of {raster}. Meta data present in *.jgw seems to be utilized automatically if the files are placed in the same directory.
However, it seems like you have to change the leading signs of your lines 1 and 4 of the *.jgw file (y is "always negative") to respect compliance with ESRI World File format. So proceeding with the following *.jgw file leads to following results:
0.0000003532
0.0000000026
0.0000000031
-0.0000002976
-51.7086484997
-19.7361691253
library(terra)
#> terra 1.6.49
# load data without *.jgw --> res, extent, crs missing
r1 <- rast("DJI_0274.JPG")
#> Warning: [rast] unknown extent
r1
#> class : SpatRaster
#> dimensions : 3648, 4864, 3 (nrow, ncol, nlyr)
#> resolution : 1, 1 (x, y)
#> extent : 0, 4864, 0, 3648 (xmin, xmax, ymin, ymax)
#> coord. ref. :
#> source : DJI_0274.JPG
#> colors RGB : 1, 2, 3
#> names : DJI_0274_1, DJI_0274_2, DJI_0274_3
# copy DJI_0274.jgw to same directory as DJI_0274.JPG
# load data with *.jgw copied to same directory --> looks better
r2 <- rast("DJI_0274.JPG")
#> Warning: [rast] the data in this file are rotated. Use 'rectify' to fix that
r2
#> class : SpatRaster
#> dimensions : 3648, 4864, 3 (nrow, ncol, nlyr)
#> resolution : 3.532e-07, 2.976e-07 (x, y)
#> extent : -51.70865, -51.70693, -19.73725, -19.73617 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> source : DJI_0274.JPG
#> colors RGB : 1, 2, 3
#> names : DJI_0274_1, DJI_0274_2, DJI_0274_3
r_rect <- rectify(r2)
r_rect
#> class : SpatRaster
#> dimensions : 3648, 4864, 3 (nrow, ncol, nlyr)
#> resolution : 3.555963e-07, 3.011079e-07 (x, y)
#> extent : -51.70865, -51.70692, -19.73725, -19.73616 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> source(s) : memory
#> names : DJI_0274_1, DJI_0274_2, DJI_0274_3
#> min values : 0, 0, 0
#> max values : 255, 255, 255
# write to disk as geoTIFF
writeRaster(r_rect, "DJI_0274.tif")
Note that it was necessary to execute rectify() to adjust the rotated SpatRaster into a non-rotated object - otherwise R crashed when executing writeRaster().

Related

How to index individual layers from a SpatRaster object by time?

I found out the other day, more or less by chance, that it is possible to query layers from SpatRaster objects based on the time attribute in general (c.f. here), e.g based on years (r["2017"]) and yearmonths (r["2017-10"]).
Now I wanted to deep-dive a little bit into this because of the great flexibility you receive when working with spatio-temporal data. Unfortunately, I seem to be failing from the beginning and can't reproduce the behaviour from before because of the following error: [subset] no (valid) layer selected
library(terra)
#> terra 1.6.3
r <- rast(ncols = 10, nrows = 10, nlyr = 365)
time(r) <- seq(from = as.POSIXlt("2001-01-01", tz = "UTC"),
to = as.POSIXlt("2001-12-31", tz = "UTC"),
by = "day")
r
#> class : SpatRaster
#> dimensions : 10, 10, 365 (nrow, ncol, nlyr)
#> resolution : 36, 18 (x, y)
#> extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> time : 2001-01-01 to 2001-12-31 UTC
time(r) |> class()
#> [1] "POSIXct" "POSIXt"
r["2001"]
#> Error: [subset] no (valid) layer selected
time(r) <- as.Date("2002-01-01") + 0:364
r
#> class : SpatRaster
#> dimensions : 10, 10, 365 (nrow, ncol, nlyr)
#> resolution : 36, 18 (x, y)
#> extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> time (days) : 2002-01-01 to 2002-12-31
time(r) |> class()
#> [1] "Date"
r["2002"]
#> Error: [subset] no (valid) layer selected
I had a look at ?time as well as at the docs at rspatial.org but was not able to find relevant documentation related to indexing.
What am I missing here?
You are mixing up layer names (that may look like a time-stamp) with an actual time-stamp.
Here is how you can use time-stamps (using Date here, as it is a bit less verbose)
library(terra)
r <- rast(ncols = 10, nrows = 10, nlyr = 365)
time(r) <- as.Date("2001-01-01") + 0:364
head(names(r))
# "lyr.1" "lyr.2" "lyr.3" "lyr.4" "lyr.5" "lyr.6"
You can subset layers by name like this
r[["lyr.1"]]
Note the double brackets for sub-setting layers, although you can use single brackets when using a name as opposed to a numerical index.
To subset by time, you can do
r[[time(r) == as.Date("2001-06-01")]]
#class : SpatRaster
#dimensions : 10, 10, 1 (nrow, ncol, nlyr)
#resolution : 36, 18 (x, y)
#extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#coord. ref. : lon/lat WGS 84
#time (days) : 2001-06-01
With dates, you do not even need to use "as.Date"
r[[time(r) >= "2001-12-01"]]
#class : SpatRaster
#dimensions : 10, 10, 31 (nrow, ncol, nlyr)
#resolution : 36, 18 (x, y)
#extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#coord. ref. : lon/lat WGS 84
#time (days) : 2001-12-01 to 2001-12-31

R language, unreasonable (?) raster resolutions

Sorry for the very stupid question, but I'm really stuck here... I need to create a Digital Elevation Model for my study area. For this, I downloaded an SRTM (1 arc-seg resolution, freely available from the net) image, which comprises a region wider than my area of interest. The original raster has these characteristics:
class : RasterLayer
dimensions : 3601, 3601, 12967201 (nrow, ncol, ncell)
resolution : 0.0002777778, 0.0002777778 (x, y)
extent : -45.00014, -43.99986, -22.00014, -20.99986 (xmin, xmax, ymin, ymax)
crs : +proj=longlat +datum=WGS84 +no_defs
source : s22_w045_1arc_v3.tif
names : s22_w045_1arc_v3
values : -32768, 32767 (min, max)
I need to (1) increase the resolution (initially of 30.75662 * 28.68392 m) to 1 * 1 m (that is, I really do not care about the exactitude of the elevations) and (2) crop a squared area of 2000 * 2000 m centered at a given coordinate. So, the first step I'm following is to re-project to UTM:
projection(r) <- "+proj=utm +zone=23 +datum=WGS84"
But the resolution units do not change after that:
class : RasterLayer
dimensions : 3601, 3601, 12967201 (nrow, ncol, ncell)
resolution : 0.0002777778, 0.0002777778 (x, y)
extent : -45.00014, -43.99986, -22.00014, -20.99986 (xmin, xmax, ymin, ymax)
crs : +proj=utm +zone=23 +datum=WGS84 +units=m +no_defs
source : s22_w045_1arc_v3.tif
names : s22_w045_1arc_v3
values : -32768, 32767 (min, max)
If I try to set the resolutions in meters manually, then generates an empty raster. Can anybody be so kind as to throw some light on me here?
You are changing (i.e. overwriting) the CRS, not projecting the raster. Usually, it is recommended to create a template raster with the CRS and the resolution you need and reproject the raster using this template.
See here an example, I am switching to terra for the analysis since it is a newer and faster package, but I would show also how to convert it back to raster format:
library(raster)
#> Loading required package: sp
# Faking your data
r <- raster(
nrows = 3601, ncols = 3601,
ext = extent(c(-45.00014, -43.99986, -22.00014, -20.99986))
)
values(r) <- seq(-32768, 32767, length.out = ncell(r))
r
#> class : RasterLayer
#> dimensions : 3601, 3601, 12967201 (nrow, ncol, ncell)
#> resolution : 0.0002777784, 0.0002777784 (x, y)
#> extent : -45.00014, -43.99986, -22.00014, -20.99986 (xmin, xmax, ymin, ymax)
#> crs : +proj=longlat +datum=WGS84 +no_defs
#> source : memory
#> names : layer
#> values : -32768, 32767 (min, max)
plot(r)
# End of faking data
# Change to terra, much faster
library(terra)
#> terra 1.5.21
r_terra <- terra::rast(r)
template <- terra::project(r_terra, "+proj=utm +zone=23 +datum=WGS84")
# Change to the desired res
res(template) <- c(2000, 2000)
# Reproject
r_terra_reproj <- terra::project(r_terra, template)
r_terra_reproj
#> class : SpatRaster
#> dimensions : 56, 52, 1 (nrow, ncol, nlyr)
#> resolution : 2000, 2000 (x, y)
#> extent : 499985.4, 603985.4, -2433195, -2321195 (xmin, xmax, ymin, ymax)
#> coord. ref. : +proj=utm +zone=23 +datum=WGS84 +units=m +no_defs
#> source : memory
#> name : layer
#> min value : -32371.95
#> max value : 32182.81
terra::plot(r_terra_reproj)
# Back to RasterLayer
r_reproj <- raster(r_terra_reproj)
r_reproj
#> class : RasterLayer
#> dimensions : 56, 52, 2912 (nrow, ncol, ncell)
#> resolution : 2000, 2000 (x, y)
#> extent : 499985.4, 603985.4, -2433195, -2321195 (xmin, xmax, ymin, ymax)
#> crs : +proj=utm +zone=23 +datum=WGS84 +units=m +no_defs
#> source : memory
#> names : layer
#> values : -32371.95, 32182.81 (min, max)
Created on 2022-06-10 by the reprex package (v2.0.1)

Terra Spatial Correlation between two raster

I am trying to calculate the spatial correlation between two rasters. I have two large rasters with the same extent, resolution, etc
class : RasterLayer
dimensions : 45598, 53241, 2427683118 (nrow, ncol, ncell)
resolution : 30, 30 (x, y)
extent : 273366.8, 1870597, 367780.7, 1735721 (xmin, xmax, ymin, ymax)```
These layers have massive NAs cells
I tried to use terra::focalCor with the stack of those layers.
corr=focalCor(layerstack, w=9, cor)
But I have this issue
Error in v[[j - 1]] <- t(sapply(1:nrow(Y), function(i, ...) fun(X[i, ], :
more elements supplied than there are to replace
Any ideas or suggestions?
Cheers
It would have been easier to provide a specific answer with actual data provided to be able to reproduce your issue, but in this case it seems like you imported your gridded data using raster::raster() creating a RasterLayer object, but according to ?focalCor, x has clearly to be a SpatRaster with at least two layers.
So, try terra::rast(c("grid_1.tif", "grid_2.tif")) |> terra::focalCor(w = 9, cor) instead.
Edit:
Thanks for your reprex. I dared to reduce dimensions and modify the extent a little bit in order to reduce processing time:
library(terra)
r <- rast(ncols = 100, nrows = 100,
xmin = 0, xmax = 25, ymin = 0, ymax = 25,
crs = "epsg:4326")
r1 <- init(r, fun = runif)
r2 <- init(r, fun = runif)
r_stack <- c(r1, r2)
r_stack_cor_5 <- focalCor(r_stack, w = 5, cor)
r_stack_cor_5
#> class : SpatRaster
#> dimensions : 100, 100, 1 (nrow, ncol, nlyr)
#> resolution : 0.25, 0.25 (x, y)
#> extent : 0, 25, 0, 25 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source : memory
#> name : lyr1
#> min value : -0.6476946
#> max value : 0.6948594
r_stack_cor_25 <- focalCor(r_stack, w = 25, cor)
r_stack_cor_25
#> class : SpatRaster
#> dimensions : 100, 100, 1 (nrow, ncol, nlyr)
#> resolution : 0.25, 0.25 (x, y)
#> extent : 0, 25, 0, 25 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84 (EPSG:4326)
#> source : memory
#> name : lyr1
#> min value : -0.1020998
#> max value : 0.1045798
I used fun = cor instead of function(x, y) cor(x, y) but the result is the same according to all.equal(). However, your example seems to work - and I'm failing to recognize the issue at the moment.

Calculating long-term mean monthly rainfall from interpolated rasters using TERRA package?

I have a SpatRaster object in R called IDW3, estimated using IDW interpolation method. I have nlyr = 240, containing 12 months x 20 years. I need to calculate the long-term mean monthly rainfall from the layers, so that I get nlyr = 12 at the end, in which each layer represents one calendar month (Jan - Dec).
I have tried using the code below, following this thread calculating long term daily means from a RASTER in R, but I want to verify the code I used.
Any thoughts and comments please?
idw3
#> class : SpatRaster
#> dimensions : 723, 449, 240 (nrow, ncol, nlyr)
#> resolution : 100, 100 (x, y)
#> extent : 624698.7, 669598.7, 640507.8, 712807.8 (xmin, xmax, ymin, ymax)
#> coord. ref. :
#> sources : May 1998_masked_idw3.asc
#> May 1999_masked_idw3.asc
#> May 2000_masked_idw3.asc
#> ... and 237 more source(s)
#> names : Jan 1998, Jan 1999, Jan 2000, Jan 2001, #> Jan 2002, Jan 2003, ...
#> min values : ? , ? , ? , ? , ? , ? , ...
#> max values : ? , ? , ? , ? , ? , ? , ...
## CALCULATE THE LONGTERM MONTHLY MEANS
# get the months substring
month.ltm <- substr(my, 1,3)
# calculate the ltm using tapp funtion in terra
idw3.ltm <- tapp(idw3, month.ltm, mean)
names(idw3.ltm)
#> [1] "May" "Apr" "Aug" "Jan" "Sep" "Jul" "Jun" "Feb" "Dec"
#> [10] "Nov" "Oct" "Mar"
You can use tapp for that. Here are some example data
library(terra)
r <- rast(ncols=10, nrows=10, nlyr=24)
values(r) <- 1:size(r)
If the data are ordered by year, and then by month, you can now do
x <- tapp(r, 1:12, mean)
In other cases you may have to create another index to match the layers that need to be combined. If your data has a time-stamp, there are some shortcuts. In this case you can use index="months"
time(r) <- as.Date("2000-01-15") + 0:23 * 30.5
y <- tapp(r, "months", mean)
It's been some time since you posted this, but I'd try to solve this for the next one asking. Since your example does not seem to be fully reproducible, let my use my own data for this purpose.
I used GPCC v2022 data - the last two decades of monthly data at 0.5° resolution to be precise - from German Weather Service.
library(terra)
#> terra 1.5.21
# define filenames
files <- c("full_data_monthly_v2022_2001_2010_05.nc",
"full_data_monthly_v2022_2011_2020_05.nc")
# create SpatRaster object
nc_data <- rast(files)
# get variable names
varnames(nc_data)
#> [1] "precip" "numgauge"
#> [3] "infilled_numgauges" "interpolation_error"
#> [5] "interpolation_error_infilled" "diff_new_old_method"
#> [7] "precip" "numgauge"
#> [9] "infilled_numgauges" "interpolation_error"
#> [11] "interpolation_error_infilled" "diff_new_old_method"
# subset dataset to precipitation only
nc_precip <- nc_data["precip"]
# sneak peek
nc_precip
#> class : SpatRaster
#> dimensions : 360, 720, 240 (nrow, ncol, nlyr)
#> resolution : 0.5, 0.5 (x, y)
#> extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> sources : full_data_monthly_v2022_2001_2010_05.nc:precip (120 layers)
#> full_data_monthly_v2022_2011_2020_05.nc:precip (120 layers)
#> varnames : precip (gpcc full data monthly product version 2022, precipitation per grid)
#> precip (gpcc full data monthly product version 2022, precipitation per grid)
#> names : precip_1, precip_2, precip_3, precip_4, precip_5, precip_6, ...
#> unit : mm/month, mm/month, mm/month, mm/month, mm/month, mm/month, ...
#> time : 2001-01-01 to 2020-12-01
As you can see, this dataset is quite similar to yours in terms of information at least (except for crs, extent and resolution). A stack of SpatRaster objects with nlyr = 240 containing monthly precipitation data. What differs most notably is the time attribute ranging from 2001-01-01 to 2020-12-01.
However, basically I approached your issue constructing an appropriate time-based index vector as input to tapp using fun = mean:
# get timestamps from your SpatRaster object
tst <- terra::time(nc_precip)
# calculate monthly means
lta <- tapp(nc_precip, index = 1:12, fun = mean)
# tidy your names a little bit
names(lta) <- format(tst, "%B") |> unique()
# inspect result
lta
#> class : SpatRaster
#> dimensions : 360, 720, 12 (nrow, ncol, nlyr)
#> resolution : 0.5, 0.5 (x, y)
#> extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> sources : memory
#> memory
#> memory
#> ... and 9 more source(s)
#> names : January, February, March, April, May, June, ...
#> min values : 0, 0, 0, 0, 0, 0, ...
#> max values : 979.1880, 852.0020, 720.6245, 739.8225, 884.2455, 1590.6805, ...
The result seems plausible from my point of view, but since this is the first time I used tapp, I want to make sure the function behaves as expected by re-calculating manually:
# init an empty list for temporary storage purposes
lta <- list()
# loop monthly and calculate the long-term mean
for (i in 1:12) {
idx <- seq(from = i, by = 12, length.out = n_years)
lta[[i]] <- nc_precip[[idx]] |> terra::mean()
}
# create a SpatRast object with nlyr = 12
lta <- terra::rast(lta)
lta
#> class : SpatRaster
#> dimensions : 360, 720, 12 (nrow, ncol, nlyr)
#> resolution : 0.5, 0.5 (x, y)
#> extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> sources : memory
#> memory
#> memory
#> ... and 9 more source(s)
#> names : mean, mean, mean, mean, mean, mean, ...
#> min values : 0, 0, 0, 0, 0, 0, ...
#> max values : 979.1880, 852.0020, 720.6245, 739.8225, 884.2455, 1590.6805, ...
Same results, phew.
Edit:
After some weird behaviour yesterday which cannot be reproduced today I can confirm that using index = months.abb gives you the same results as using index = "months" (as suggested by Robert below in the comments):
tapp(nc_precip, index = month.abb, fun = mean)
#> class : SpatRaster
#> dimensions : 360, 720, 12 (nrow, ncol, nlyr)
#> resolution : 0.5, 0.5 (x, y)
#> extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> source : memory
#> names : Jan, Feb, Mar, Apr, May, Jun, ...
#> min values : 0, 0, 0, 0, 0, 0, ...
#> max values : 979.1880, 852.0020, 720.6245, 739.8225, 884.2455, 1590.6805, ...
tapp(nc_precip, index = "months", fun = mean)
#> class : SpatRaster
#> dimensions : 360, 720, 12 (nrow, ncol, nlyr)
#> resolution : 0.5, 0.5 (x, y)
#> extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
#> coord. ref. : lon/lat WGS 84
#> source : memory
#> names : X1, X2, X3, X4, X5, X6, ...
#> min values : 0, 0, 0, 0, 0, 0, ...
#> max values : 979.1880, 852.0020, 720.6245, 739.8225, 884.2455, 1590.6805, ...

How to create weekly composite from 5-consecutive day

I have a NetCDF file of salinity in Indonesia water with 4 dimensions (lon, lat, depth and time). How to create create weekly composite from my data
download data here: https://onedrive.live.com/redir?resid=6FFDD661570C7D0A%21177
output map here: https://onedrive.live.com/redir?resid=6FFDD661570C7D0A%21176
I would like to convert the raster into vector and the use apply to get the mean, but I have problem to plot the vector data using rasterVis
With your example, nor really complicated:
# load needed librairies
library(rasterVis)
# open the data
salinity <- brick("data.nc", varname = "salinity")
salinity
# class : RasterBrick
# dimensions : 61, 61, 3721, 5 (nrow, ncol, ncell, nlayers)
# resolution : 0.08333333, 0.08333333 (x, y)
# extent : 104.9583, 110.0417, -5.041667, 0.04166667 (xmin, xmax, ymin, ymax)
# coord. ref. : +proj=longlat +datum=WGS84
# data source : data.nc
# names : X252331200, X252417600, X252504000, X252590400, X252676800
# z-value : 252331200, 252417600, 252504000, 252590400, 252676800
# varname : salinity
# level : 1
# Calculate the mean
m.salinity <- mean(salinity)
m.salinity
# class : RasterLayer
# dimensions : 61, 61, 3721 (nrow, ncol, ncell)
# resolution : 0.08333333, 0.08333333 (x, y)
# extent : 104.9583, 110.0417, -5.041667, 0.04166667 (xmin, xmax, ymin, ymax)
# coord. ref. : +proj=longlat +datum=WGS84
# data source : in memory
# names : layer
# values : 18.85652, 31.84299 (min, max)

Resources