#' Extract metadata info from UAS images
#'
#' Extracts info from geotagged images taken from a drone
#'
#' @param img_dirs Directory(s) where the image files reside
#' @param ext File name extension(s)
#' @param pattern A regex expression for files
#' @param alt_agl The elevation above ground level in meters (optional for images with the relevative altitude saved)
#' @param fp Compute image foot prints, T/F
#' @param fwd_overlap Whether or not to compute the amount of overlap between one image and the next, T/F
#' @param cameras Location of the cameras.csv file. Is NULL the package csv file will be used.
#' @param metadata A filename pattern for a metadata file, or a metadata list object (see Details)
#' @param path2name_fun A function to generate the default short name (see Details)
#' @param use_exiftoolr Whether to use the exiftoolr package, logical
#' @param exiftool The path to the exiftool command line tool (omit if on the OS path). Ignored if use_exiftoolr = TRUE.
#' @param exif_csv The file name of a new csv file where the exif data will be saved (omit to make a temp one)
#' @param cache Logical or a directory where EXIF data should be cached (see Details)
#' @param update_cache Whether to update the cache
#' @param quiet Don't show messages
#'
#' @details This will read the EXIF data from one or more directory(s) of image files and return a list of
#' Image Collection Metadata' object(s) for each directory. The metadata objects will include the centroids of each image,
#' and auto-generated flight metadata. Depending on the arguments used, the metadata objects may also include the
#' estimated ground-footprints of individual images, and custom flight metadata fields (such as the name of the pilot).
#' Extracting image locations requires that the images have embedded coordinates, also called geostamps. This is common
#' with drone images, but some drone platforms require an extra processing step to geostamp the images.
#'
#' An Image Collection Metadata object requires that all images be from the same sensor (camera).
#' It is ok to have collections with different sensors in a single 'uas_info' object, but each individual collection
#' should be from the same sensor. If you have a directory with mixed images from multiple sensors, there are two arguments
#' you can use to specify which ones to include in the
#' Metadata object. \code{ext} should be used to specify the image filename extensions (e.g., 'jpg' or 'tiff'). This will also
#' prevent non-image files, such as text files or videos, from being read. \code{pattern} can be used
#' to specify a regex expression that image filenames must match as an \emph{additional} requirement. Neither \code{ext}
#' nor \code{pattern} are case sensitive.
#'
#' To include estimated footprints in the metadata object, pass \code{fp = TRUE}. This further requires that 1) the camera
#' parameters are known (see below), and 2) the flight altitude above ground level is either recorded in the EXIF info or provided by
#' \code{alt_agl} (in meters). If \code{alt_agl} is passed, it will override any altitude data
#' in the EXIF info. Ground-footprints are estimates only. The modeled footprints assume the camera was at nadir (common in
#' mapping work but there are exceptions), and that the above ground altitude is the same as the above launch point altitude
#' (generally true in flat areas, but not hilly areas). Estimated footprints are also only as accurate as the above-launch point altitude
#' recorded in the EXIF data (which is typically the least accurate of the xyz coordinates).
#'
#' Camera parameters are saved in a csv file called \emph{cameras.csv}. The package ships with a CSV file containing
#' the parameters for many popular drone cameras. If your drone camera is not in the database, you can create your own
#' \emph{cameras.csv} file (see \code{\link{uas_cameras}} for details) and pass the file name as the
#' \code{cameras} argument. Or \href{https://github.com/ucanr-igis/uasimg/issues}{contact} the package author
#' to add your camera to the database.
#'
#' \code{uas_info} uses a free command line tool called EXIFtool to read the EXIF data. You can install this by
#' running \code{\link[exiftoolr]{install_exiftool}}. Alternately you can download exiftool
#' from \url{http://www.sno.phy.queensu.ca/~phil/exiftool/}. If you're on Windows, after you download it you should rename the executable file
#' from \emph{exiftool(-k).exe} to \emph{exiftool.exe}, and save it somewhere on your system's PATH (e.g., c:\\Windows).
#'
#' If you installed EXIFtool using the exiftoolr package on Windows, and the output includes strange
#' \code{-- press ENTER --} statements, you can ignore them. These messages are generated by the exiftool executable.
#' To get rid of them, find the exiftool executable (try \code{tools::R_user_dir("exiftoolr")}) and rename the
#' exiftool(-k).exe' file to 'exiftool.exe' (if you don't see the '.exe.' extensions in File Explorer, you probably
#' have file extensions hidden).
#'
#' \code{metadata} is an optional argument to pass supplemental flight metadata that can not be extracted from the
#' images (e.g., location name, pilot). For details, see the Vignette on Flight Metadata
#' \code{vignette("flight_metadata", package = "uasimg")}.
#'
#' \code{metadata} can also be a named list containing metadata fields / values. For supported field names,
#' see \code{vignette("flight_metadata", package = "uasimg")}.
#'
#' \code{metadata} can also be a filename regular expression (pattern) for a metadata text file saved in the same directory
#' (for details on how to write a pattern expression, see \code{\link{list.files}}). This is the recommended
#' way to enter metadata, because the little metadata text files move with the images.
#'
#' If multiple metadata text files match the pattern expression, they will all be read. This allows you for example to have a
#' boilerplate file called \emph{metadata_org.txt} with organizational info (such as a contact person), and another
#' called \emph{metadata.txt} with info about that specific flight (e.g., the pilot or wind conditions).
#' Metadata text files should be plain text in YAML format (the easiest way to create new metadata text files
#' is using \code{\link{uas_metadata_make}}.) Each line should contain a key:value pair (with no quotes or delimiters).
#' Lines starting with a hash or forward slash will be ignored. Example:
#'
#' \preformatted{
#' name_short: hrec_wtrshd2_flt03
#'
#' name_long: Hopland Research and Extension Center, Watershed II Flight 3
#'
#' data_url: https://ucdavis.box.com/s/dp0sdfssxxxxxsdf
#'
#' pilot: Andy Lyons
#'
#' description: These data were collected as part of a restoration monitoring program.
#'
#' notes: We had to pause the mission about half way through as a hawk was getting close, hence there is a time lapse
#' of about 45 seconds. Pix4Dcapture was used as the mission planning software with an overlap of 75%.
#' }
#'
#' \code{path2name_fun} can be a function to generate a default short name for the flight. The function should
#' be written to accept one and only one argument - a directory path. This can be useful if the default
#' short names should be constructed from pieces of the image directory path. See also \code{\link{uas_path2name_fun}}.
#'
#' \code{cache} can be a logical value or the name of a directory where EXIF data gets cached.
#' If \code{cache = TRUE}, the default cache directory will be used (\code{~/.R/uasimg}). The only information
#' that gets cached is image metadata. Flight metadata is never cached (see the Vignette on Flight Metadata
#' for a discussion of image and flight metadata). Cached EXIF data is linked
#' to a directory of images based on the directory name and total size of all image files.
#' So if images are added or removed from the directory, the cache will be automatically rebuilt
#' the next time the function is run. \code{update_cache} is a logical value
#' which forces an update of cached data when TRUE.
#'
#' @return An Image Collection Metadata object. This is a named list with elements for
#' image centroids (as a sf data frame), footprints, total area, minimum convex polygon,
#' total directory size, the data flown, and flight metadata.
#'
#' @seealso \code{\link{uas_getcache}}, \code{\link{uas_report}}, \code{\link{uas_path2name_fun}}
#'
#' @import dplyr
#' @import sf
#' @importFrom grDevices chull
#' @importFrom digest digest
#' @importFrom tidyr replace_na
#' @importFrom dplyr filter select left_join mutate
#' @importFrom magrittr extract2 %>%
#' @importFrom utils read.csv
#' @importFrom sf st_as_sf st_coordinates st_polygon st_drop_geometry st_sf st_sfc
#' @importFrom crayon yellow green red magenta bold
#' @importFrom exiftoolr configure_exiftoolr
#' @export
uas_info <- function(img_dirs, ext = c("jpg", "jpeg", "tif", "tiff", "raw", "dng")[1:4], pattern = NULL, alt_agl = NULL,
fp = FALSE, fwd_overlap = fp,
cameras = NULL, metadata = "metadata.*\\.txt", path2name_fun = NULL,
use_exiftoolr = TRUE, exiftool = NULL, exif_csv = NULL,
cache = TRUE, update_cache = FALSE, quiet = FALSE) {
## Define the date for a cache to be considered valid (due to updates in the package that modify what gets saved)
cache_valid_date <- ISOdatetime(2023, 8, 10, 0, 0, 0)
## See if all directory(s) exist
for (img_dir in img_dirs) {
if (!file.exists(img_dir)) stop(paste0("Can't find ", img_dir))
}
if (is.null(cameras)) {
cameras_fn <- system.file("cameras/cameras.csv", package="uasimg")
} else {
cameras_fn <- cameras
}
if (!file.exists(cameras_fn)) stop(paste0("Can't find cameras.csv file: ", cameras_fn))
## Create a list that we'll use later to shorten field names
short_names <- as.list(c("sourcefile" = "img_fn",
"filename" = "file_name",
"gpslatitude" = "gps_lat",
"gpslongitude" = "gps_long",
"datetimeoriginal" = "date_time",
"gpsdatestamp" = "gps_date",
"gpstimestamp" = "gps_time",
"gpsaltitude" = "gps_alt",
"make" = "make",
"model" = "model",
"focallength" = "focal_len",
"imagewidth" = "img_width",
"imageheight" = "img_height",
"relativealtitude" = "alt_agl",
"sensor_width" = "sens_wdth",
"sensor_height" = "sens_hght",
"gsd" = "gsd",
"foot_w" = "fp_width",
"foot_h" = "fp_height",
"fwd_overlap" = "fwd_ovrlap"))
## nomap will (eventually) be a vector of images that should be excluded
## from the flight summary map, mcp computation, area computation, etc.
## This is for things like calibration images
nomap <- NA
## Look for the exiftool executable
if (use_exiftoolr) {
## Note: system2() doesn't require you to quote an executable (only arguments if they include spaces)
## I can't suppress printing the version number, even sink() doesn''t work.
## Will have to live with it.
exiftool_exec <- configure_exiftoolr(quiet = TRUE)
} else {
## Not using exiftoolr. Look on the path for the correct filename.
if (is.null(exiftool)) {
if (.Platform$OS.type == "windows") {
exiftool <- "exiftool.exe"
} else {
exiftool <- "exiftool"
}
}
exiftool_exec <- findonpath(exiftool, status = FALSE)
if (is.null(exiftool_exec)) {
stop("Can't find exiftool. Please make sure this file is downloaded and saved either in the working directory or a directory on the PATH environment variable (e.g., c:/windows). Windows users may download it from http://www.sno.phy.queensu.ca/~phil/exiftool/, then rename 'exiftool(-k).exe' to 'exiftool.exe'. Or run exiftoolr::install_exiftool().")
} else {
exiftool_exec <- exiftool_exec
}
}
## Process the ext argument
if (is.null(ext)) {
ext_cmdarg <- ""
ext_regex_chr <- ""
ext_msg <- " (all image files)"
} else {
ext_cmdarg <- paste0("-ext ", ext, " ", collapse = "")
ext_regex_chr <- paste0(".", ext, "$", collapse = "|")
ext_msg <- paste0(" (", paste(ext, collapse = ", "), " files)")
}
res <- list()
## Loop through the directories passed to the function
for (img_dir in img_dirs) {
if (!quiet) message(magenta$bold(img_dir))
save_to_cache <- FALSE
cache_loaded <- FALSE
if (!is.null(cache)) {
## Get the cache directory
cache_dir_use <- NA
if (is.logical(cache)) {
## Cache is T/F
if (cache) {
cache_dir_use <- uas_getcache(quiet=TRUE, default=TRUE)
if (!is.na(cache_dir_use)) save_to_cache <- TRUE
} else {
## cache = FALSE. Take no action because
## cache_dir_use is already NA.
}
} else {
## String was passed for cache, we presume this is a directory
if (dir.exists(cache)) {
cache_dir_use <- cache
save_to_cache <- TRUE
} else {
stop(paste0(cache, " does not exist. Please create and try again, or omit."))
}
}
## If a cache directory exists, look for a cached file for this folder
if (!is.na(cache_dir_use)) {
## Construct the cache file name based on the image dir and total size of the image files
## First, we get a list of files that have the right extension
dir_files <- list.files(img_dir, all.files = FALSE, full.names = TRUE, pattern = ext_regex_chr, ignore.case = TRUE)
## If the pattern arg was passed, apply that also
if (!is.null(pattern)) dir_files <- dir_files[grepl(pattern, basename(dir_files), ignore.case = TRUE)]
dir_size <- as.character(sum(file.size(dir_files)))
cache_fn <- paste0("uas_", digest(paste0(img_dir, dir_size),
algo='md5', serialize = FALSE), ".RData")
## If we're not doing auto-update, look for a file and load it if found
if (!update_cache) {
## Look for a cache file
cache_pathfn <- file.path(cache_dir_use, cache_fn)
if (file.exists(cache_pathfn)) {
## Make sure its newer than the release of version 1.7.0
if (file.mtime(cache_pathfn) > cache_valid_date) {
load(cache_pathfn)
if (identical(fp_utm_sf, NA) && fp) {
cache_loaded <- FALSE
if (!quiet) message(yellow(" - Found cached data (but no footprints)"))
if (!quiet) message(yellow(" - Updating cached data"))
} else {
cache_loaded <- TRUE
if (!quiet) message(yellow(" - Using cached data"))
}
} else {
if (!quiet) message(yellow(" - Updating cached data"))
}
}
}
}
}
if (!cache_loaded) {
### Run EXIF tool on the first image only to get the camera make and model
### (We assume all image files imported will be of the same sensor. We don't check that here,
### but check that further down)
if (!quiet) message(yellow(paste0(" - Looking for image files", ext_msg)))
## Initially we just need to get the make and model of the first image
## Get a list of files that meet the extension regex
rightext_fn <- list.files(path = img_dir, full.names = TRUE, pattern = ext_regex_chr, ignore.case = TRUE)
## If pattern was passed, apply it also
if (!is.null(pattern)) {
rightext_fn <- rightext_fn[grepl(pattern, basename(rightext_fn), ignore.case = TRUE)]
}
## Get the first image only
first_fn <- rightext_fn[1]
if (is.na(first_fn)) stop(paste0("Couldn't find any image files with the passed extension ",
ifelse(is.null(pattern), "", "and pattern "),
"in ", img_dir))
## Create a temporary csv filename to store the EXIF data of the first image file
csv_first_fn <- tempfile(pattern="~map_uas_", fileext = ".csv")
system2(exiftool_exec, args=paste("-Make -Model -FileType -n -csv", shQuote(first_fn), sep=" "),
stdout=csv_first_fn, stderr=FALSE)
exif_first_df <- read.csv(csv_first_fn, stringsAsFactors = FALSE)
file.remove(csv_first_fn)
if (nrow(exif_first_df) == 0) stop("Couldn't find EXIF info in the first image file")
camera_make <- exif_first_df[1, "Make"]
if (is.na(null2na(camera_make))) camera_make <- ""
camera_model <- exif_first_df[1, "Model"]
if (is.na(null2na(camera_model))) camera_model <- ""
camera_filetype <- exif_first_df[1, "FileType"]
## Import database of known sensors
sensors_df <- uas_readcameras(cameras_fn)
## Search for this sensor
sensor_this_df <- sensors_df %>%
filter(model == camera_model & filetype == camera_filetype) %>%
as.data.frame()
if (nrow(sensor_this_df)==0) {
## UNKNOWN SENSOR!!!!
## right here I need to get **all** the fields, so I can see which one is the date time
# system2(exiftool_exec, args=paste("-Make -Model -FileType -n -csv", shQuote(first_fn), sep=" "),
# stdout=csv_first_fn, stderr=FALSE)
if (!quiet) message(yellow(paste0(" - unknown sensor: ", camera_make, " ", camera_model)))
if (!quiet) message(yellow(" - to add this camera to the database, please contact the package author via email, or create an issue on GitHub"))
if (!quiet) message(yellow(" - using generic camera settings"))
camera_name <- "unknown camera"
camera_tag_yaw <- "none"
camera_tag_dt <- "DateTimeOriginal" ## this could cause an error
short_names[["none"]] <- "yaw"
camera_agl_tag <- "none"
camera_has_agl <- FALSE
agl_avail <- FALSE
} else {
## Get the human-friendly camera name from the sensor database
camera_name <- sensor_this_df[1, "camera_name", drop = TRUE]
## TODO NOT SURE WHY ITS PUTTING A BLANK LINE AFTER THE FOLLOWING MESSAGE
## I'VE TRIED A LOT OF DIFFERENT THINGS!!
if (!quiet) message(yellow(paste(" - Found", camera_name)))
## Get the tag for camera yaw
camera_tag_yaw <- sensor_this_df[1, "tag_yaw"]
## Add elements to short_names to standardize the column names for camera and flight yaw
short_names[[tolower(camera_tag_yaw)]] <- "yaw"
short_names[[tolower(sensor_this_df[1, "tag_flt_yaw"])]] <- "flt_yaw"
## Get the date_time field(s) for this camera. Usually this will be "DateTimeOriginal" but there are
## some cameras that don't have this EXIF tag, in which case we can use GPSDateStamp|GPSTimeStamp
camera_tag_dt <- sensor_this_df[1, "date_time"] %>% strsplit("\\|") %>% extract2(1)
## See if this camera stores elevation above ground level
camera_agl_tag <- sensor_this_df[1, "tag_elev_agl"]
camera_has_agl <- (tolower(camera_agl_tag) != "none")
if (is.null(alt_agl) && !camera_has_agl) {
agl_avail <- FALSE
if (fp || fwd_overlap) {
warning_msg <- "Can not estimate footprints - above ground altitude was not saved in the images, and no value for alt_agl was passed."
if (quiet) {
warning(warning_msg)
} else {
message(red(" -", warning_msg))
}
}
# stop("alt_agl argument required (relative altitude not saved in image files)")
} else {
agl_avail <- TRUE
}
}
######################################
## TODO Still to come - incorporate non-nadir GimbalPitchDegree
# Construct exif_csv file name
if (is.null(exif_csv)) {
exif_csv_fn <- tempfile(pattern = "uasimg_exifdata_", fileext = ".csv")
} else {
exif_csv_fn <- exif_csv
}
# Identify EXIF tags to extract. These are generic for all / most cameras.
## The # in "FileSize#" tells EXIFTOOL to return the value in bytes (as opposed to a human readable text)
exif_tags <- c("FileName", "FileType", "FileSize#", "GPSLatitude", "GPSLongitude",
"GPSAltitude", "Make", "Model", "FocalLength", "ImageWidth", "ImageHeight",
camera_tag_dt, camera_tag_yaw)
if (camera_has_agl) exif_tags <- c(exif_tags, camera_agl_tag)
if (!is.na(sensor_this_df[1, "tag_flt_yaw", drop = TRUE])) {
exif_tags <- c(exif_tags, sensor_this_df[1, "tag_flt_yaw", drop = TRUE])
}
## Construct args for exiftool.exe
str_args <- paste("-", paste(exif_tags, collapse=" -"), " -n -csv ", ext_cmdarg, shQuote(img_dir), sep="")
# Run exiftool command
if (!quiet) message(yellow(" - Running exiftool (this can take a while)..."), appendLF = FALSE)
suppressWarnings(system2(exiftool_exec, args = str_args, stdout = exif_csv_fn, stderr = FALSE))
if (!quiet) message(yellow("Done."))
if (!file.exists(exif_csv_fn)) {
stop("exiftool could not create the csv file")
}
# Import EXIF CSV
exif_df <- read.csv(exif_csv_fn, stringsAsFactors=FALSE)
## Delete the csv file (we're done with it)
if (is.null(exif_csv)) file.remove(exif_csv_fn)
names(exif_df) <- tolower(names(exif_df))
## If there's an additional pattern regex, apply it now
if (!is.null(pattern)) {
exif_df <- exif_df[grepl(pattern, exif_df$filename, ignore.case = TRUE), ]
}
## Check for required fields
flds_req <- c("gpslongitude", "gpslatitude")
if (FALSE %in% (flds_req %in% names(exif_df))) stop("Can't find coordinates in the EXIF data.")
flds_req <- c("make", "model")
if (FALSE %in% (flds_req %in% names(exif_df))) stop("Can't find the camera make and model in the EXIF data")
if (fp) {
if (length(unique(exif_df$make)) > 1 || length(unique(exif_df$model)) > 1) {
stop("Multiple sensors found. This is currently not supported if you want to compute footprints. Either set fp = FALSE, move some of them out of the folder, or use the 'ext' argument if they have different extensions.")
}
}
## TODO Right here we need to do some checks for tags
## See if focallength is undef (see D:\Data\DroneData\autel-evo2\samples-max-2\orig-missing-make-model)
## FILTER OUT IMAGES (ROWS) FROM EXIF_DF
## TODO: Filter out (quietly) images from exif_df that do not meet pattern_regex (when I add that argument to the function)
## Filter out images with incomplete EXIF info
## We already verified above the data frame includes these columns
idx_incomplete <- which(na2val(exif_df$gpslongitude, 0) == 0 |
na2val(exif_df$gpslatitude, 0) == 0 |
is.na(exif_df$make) |
exif_df$make == "" |
is.na(exif_df$model) |
exif_df$model == "" |
is.na(exif_df$filetype))
if (length(idx_incomplete) > 0) {
bad_files <- paste(exif_df[idx_incomplete, "filename", drop = TRUE], collapse = ", ")
warning_msg <- paste0(length(idx_incomplete),
" image(s) had one or more required EXIF tags missing, and will be ignored: ",
bad_files)
exif_df <- exif_df[-idx_incomplete, ]
warning_msg <- paste0(length(idx_incomplete), " image(s) had one or more required EXIF tags missing, and will be excluded from the result")
if (quiet) {
warning(warning_msg)
} else {
message(red(" -", warning_msg))
}
}
## Filter out images with 0 elevation
if (agl_avail) {
if (is.null(alt_agl)) {
idx_onground <- which(exif_df[[tolower(camera_agl_tag)]] <= 0)
if (length(idx_onground) > 0) exif_df <- exif_df[-idx_onground, ]
}
}
if (nrow(exif_df) == 0) {
warning_msg <- "No valid images found. Skipping this directory."
if (quiet) {
warning(warning_msg)
} else {
message(red(" -", warning_msg))
}
## Skip to next directory
next
}
## DONE WITH FILTERING
## Get the total file size of all images (will be part of the object returned)
total_size_mb <- round(sum(exif_df$filesize) / 1048576)
if (!quiet) message(yellow(paste0(" - Total file size: ", total_size_mb, " MB")))
## If datetimeoriginal doesn't exist, try to create it by concatenating the two columns in camera_tag_dt
if (!"datetimeoriginal" %in% names(exif_df)) {
exif_df[["datetimeoriginal"]] <- apply(exif_df[, tolower(camera_tag_dt), drop = FALSE], 1, paste, collapse = " ")
## See if the concatenation produced a valid date-time string
test_dt <- as.POSIXct(exif_df[1, "datetimeoriginal", drop=TRUE], format = "%Y:%m:%d %H:%M:%S")
if (!inherits(test_dt, "POSIXct")) {
warning_msg <- "Can't construct the timestamps"
if (quiet) {
warning(warning_msg)
} else {
message(red(" -", warning_msg))
}
exif_df[["datetimeoriginal"]] <- "1970-01-01 12:00:00"
}
}
## We can assume now that datetimeoriginal (a character column) exists.
## Next we sort the rows by datetimeoriginal for the odd case where the original sort order
## (presumably alphabetically by filenames) was not sequential (which we need of course
## for accurately computing percent overlap).
exif_df <- exif_df[order(exif_df$datetimeoriginal), ]
## Get the date flown from the first image (will be part of the object returned)
flight_date_dt <- as.Date(exif_df[1, "datetimeoriginal", drop=TRUE], format = "%Y:%m:%d %H:%M:%S")
flight_date_str <- format(flight_date_dt, "%Y-%m-%d")
## Add sensor dimensions columns to exif_df
if (camera_name == "unknown camera") {
exif_df <- exif_df %>%
mutate(camera_name = camera_name, camera_abbrev = "unknown", sensor_width = 0, sensor_height = 0)
} else {
sensor_info_df <- sensors_df %>%
select(model, camera_name, camera_abbrev, filetype, sensor_width, sensor_height)
exif_df <- exif_df %>% left_join(sensor_info_df, by=c("model" = "model", "filetype" = "filetype"))
}
## Compute image footprints, gsd, and dimensions
## Based on Pix4D GSD calculator. Assumptions:
## input units: sensor_width and height - mm; focal length - mm, RelativeAltitude (flight height) - meters
## output units: gsd - cm/pixel, Dw, Dh - meters
## See https://support.pix4d.com/hc/en-us/articles/202560249-TOOLS-GSD-Calculator#gsc.tab=0
## Create the expression object for the gsd calculation
if (agl_avail) {
if (is.null(alt_agl)) {
gsd_exprsn <- parse(text=paste("(sensor_width * ", tolower(camera_agl_tag),
" * 100) / (as.numeric(focallength) * imagewidth)", sep=""))
} else {
gsd_exprsn <- parse(text=paste("(sensor_width * ", alt_agl,
" * 100) / (as.numeric(focallength) * imagewidth)", sep=""))
}
exif_df <- mutate(exif_df,
gsd = eval(gsd_exprsn),
foot_w = (gsd * imagewidth) / 100,
foot_h = (gsd * imageheight) / 100)
}
#################################################################
## CREATE SPATIAL OBJECTS
if (!("gpslongitude" %in% names(exif_df) && "gpslatitude" %in% names(exif_df))) {
warning_msg <- paste0("gpslongitude and/or gpslatitude not found in the EXIF data for ",
img_dir, ". Skipping centroids and footprints.")
if (quiet) {
warning(warning_msg)
} else {
message(red(" -", warning_msg))
}
imgs_ctr_utm_sf <- NA
fp_utm_sf <- NA
area_m2 <- NA
mcp_sf <- NA
} else {
## Create a sf dataframe for the image centroids
imgs_ctr_ll_sf <- st_as_sf(exif_df, coords = c("gpslongitude","gpslatitude"), remove = FALSE, crs = 4326)
## Convert to UTM
utm_epsg <- geo2utm(exif_df[1,"gpslongitude"], exif_df[1,"gpslatitude"])
imgs_ctr_utm_sf <- imgs_ctr_ll_sf %>% st_transform(utm_epsg)
## Compute footprints
if (!fp || !agl_avail || tolower(camera_tag_yaw) == "none" || sum(exif_df$sensor_width, na.rm = TRUE) == 0) {
## Going to skip footprints
fp_utm_sf <- NA
## This is where a user was getting an error
## https://github.com/UCANR-IGIS/uasimg/issues/12
if (!quiet && sum(exif_df$sensor_width, na.rm = TRUE) == 0) message(yellow(" - Sensor size not available for this camera"))
if (!quiet) message(yellow(" - Skipping footprints"))
nodes_all_mat <- st_coordinates(imgs_ctr_utm_sf)
} else {
if (!quiet) message(yellow(" - Creating footprints..."), appendLF = FALSE)
corners_sign_mat <- matrix(data=c(-1,1,1,1,1,-1,-1,-1,-1,1), byrow=TRUE, ncol=2, nrow=5)
ctr_utm <- st_coordinates(imgs_ctr_utm_sf)
## Create an empty list to hold the individual st_polygons
polys_sf_lst <- vector("list", nrow(imgs_ctr_utm_sf))
## Create an empty 2-column matrix to store the corners for all the footprints
## (in order to make the MCP)
nodes_all_mat <- matrix(ncol=2, nrow=0)
## Loop through the centroids
for (i in 1:nrow(imgs_ctr_utm_sf)) {
dx <- imgs_ctr_utm_sf[i, "foot_w", drop = TRUE]
dy <- imgs_ctr_utm_sf[i, "foot_h", drop = TRUE]
if (is.na(dx) || is.na(dy)) {
if (!quiet)message(red("uh ooh."))
stop(paste0("Can not compute footprint for ", exif_df[i, "filename", drop = TRUE],
". Please make sure this image is taken from a drone, and the camera parameters are in cameras.csv."))
}
if (dx > 0 && dy > 0) {
## Compute the nodes of the corners (centered around 0,0)
corners_mat <- corners_sign_mat * matrix(data=c(dx/2, dy/2), byrow=TRUE, ncol=2, nrow=5)
# Convert the gimbal yaw degree to radians, the rotate the rectangle to
# align with the gimbal direction
# DJI Gimbal directions
# 0 = north (no rotation needed)
# 90 = east (rotate 90 degrees clockwise)
# -90 = west (rotate 90 degress counter-clockwise)
# -179, + 179 = south (rotate 180 degrees)
# check if the Sequoia 'Yaw' has the same alignment
theta <- - pi * imgs_ctr_utm_sf[i, tolower(camera_tag_yaw), drop = TRUE] / 180
rot_mat <- matrix(data=c(cos(theta), -sin(theta), sin(theta), cos(theta)),
nrow=2, byrow=TRUE)
corners_mat <- t(rot_mat %*% t(corners_mat))
## Grab the coordinates of this image centroid
img_ctr_mat <- matrix(ctr_utm[i,], byrow=TRUE, ncol=2, nrow=5)
fp_nodes_mat <- img_ctr_mat + corners_mat
## Create a polygon for this footprint and add it to the list
polys_sf_lst[[i]] <- st_polygon(list(fp_nodes_mat), dim = "XY")
## Add the nodes to the master matrix (for the purposes of computing the overall area)
nodes_all_mat <- rbind(nodes_all_mat, fp_nodes_mat[1:4,])
}
} ## for (i in 1:nrow(imgs_ctr_utm_sf)) {
## Create a sf data frame for the footprints, using the attributes from the centroids
fp_utm_sf <- st_sf(imgs_ctr_utm_sf %>% st_drop_geometry(),
geometry = st_sfc(polys_sf_lst, crs = utm_epsg))
if (!quiet) message(yellow("Done."))
## Compute the forward overlap
if (fwd_overlap) {
if (nrow(fp_utm_sf) == 1) {
if (!quiet) message(yellow(" - Only 1 image, skipping forward overlap."))
} else {
if (!quiet) message(yellow(" - Computing forward overlap..."), appendLF = FALSE)
idx_minus_one <- 1:(nrow(fp_utm_sf)-1)
## Compute areas of each footprint
area_polys <- fp_utm_sf %>% slice(idx_minus_one) %>% st_area() %>% as.numeric()
## Compute the area of intersection of each footprint with the next one
area_intersection_with_next <- sapply(idx_minus_one, function(i)
st_intersection(fp_utm_sf[i, "geometry"], fp_utm_sf[i+1, "geometry"]) %>%
st_area()) %>% as.numeric() %>% replace_na(0)
## Add the percent overlap to the sf dataframe
fp_utm_sf$fwd_overlap <- c(area_intersection_with_next / area_polys, NA)
if (!quiet)message(yellow("Done."))
}
}
## Shorten field names in fp_utm_sf
all_flds <- names(fp_utm_sf)
for (i in 1:length(all_flds)) {
fldname <- all_flds[i]
if (fldname %in% names(short_names)) {
names(fp_utm_sf)[i] <- short_names[[fldname]]
}
}
}
## Create the MCP
## Compute area based on the convex hull around all the corners of all the footprints or centroids
## Find the indices of the combined set of corners that comprise the MCP nodes
if (nrow(nodes_all_mat) < 3) {
mcp_sf <- NA
area_m2 <- NA
} else {
chull_idx <- chull(nodes_all_mat)
chull_idx <- c(chull_idx, chull_idx[1])
## Turn this into a sf polygon
mcp_polygon <- st_polygon(list(nodes_all_mat[chull_idx,]), dim = "XY")
mcp_sfc <- st_sfc(mcp_polygon, crs = utm_epsg)
## Compute the area
area_m2 <- mcp_sfc %>% st_area() %>% as.numeric()
## Generate a sf data frame for the MCP
mcp_sf <- st_sf(data.frame(img_dir=img_dir, area_m2=area_m2), geometry = mcp_sfc)
}
## Shorten field names in imgs_ctr_utm_sf
all_flds <- names(imgs_ctr_utm_sf)
for (i in 1:length(all_flds)) {
fldname <- all_flds[i]
if (fldname %in% names(short_names)) {
names(imgs_ctr_utm_sf)[i] <- short_names[[fldname]]
}
}
} #if (!("gpslongitude" %in% names(exif_df) && "gpslatitude" %in% names(exif_df)))
## CREATE AN ID STRING (WHICH WILL BE USED AS THE DEFAULT SHORT_NAME ALSO)
if (is.null(path2name_fun)) {
## THIS BLOCK WAS CAUSING AN ERROR WHEN imgs_ctr_utm_sf WAS NULL
## BECAUSE gpslongitude WAS NOT FOUND ABOVE
# if ("date_time" %in% names(imgs_ctr_utm_sf)) {
# dt_str <- paste0(gsub(" ", "_", gsub(":", "-", sort(imgs_ctr_utm_sf$date_time)[1])), "_")
# } else {
# dt_str <- ""
# }
if ("datetimeoriginal" %in% names(exif_df)) {
dt_str <- paste0(gsub(" ", "_", gsub(":", "-", sort(exif_df$datetimeoriginal)[1])), "_")
} else {
dt_str <- ""
}
# type_count <- imgs_ctr_utm_sf %>% ## THIS WAS CAUSING AN ERROR WHEN imgs_ctr_utm_sf WAS NULL
# st_drop_geometry() %>% ## BECAUSE gpslongitude WAS NOT FOUND ABOVE
# group_by(filetype) %>%
# count() %>%
# mutate(type_count = paste0(n, filetype, "s")) %>%
# pull(type_count) %>%
# paste(collapse = "_")
type_count <- exif_df %>%
group_by(filetype) %>%
count() %>%
mutate(type_count = paste0(n, filetype, "s")) %>%
pull(type_count) %>%
paste(collapse = "_")
id_str <- paste0(dt_str, type_count)
} else {
## path2name_fun is NOT NULL (presume it's a function)
id_str <- path2name_fun(img_dir)
}
} # if !cache_loaded
## Cache results (if not already cached)
if (save_to_cache) {
if (update_cache || !cache_loaded) {
## Store the image folder name in case the cache data is used on its own
img_folder <- img_dir
save(img_folder, imgs_ctr_utm_sf, fp_utm_sf, area_m2, mcp_sf, total_size_mb,
flight_date_str, camera_name, id_str, file = file.path(cache_dir_use, cache_fn))
if (!quiet) message(yellow(" - Cache saved"))
}
}
########################################################################################################
## Load the additional flight metadata (which is never cached!)
## Get the extra metadata either by an argument or finding an metadata.txt file
if (is.null(metadata)) {
## Create a blank metadata list using the default fields
flds_md <- uas_getflds()
metadata_use <- as.list(rep(as.character(NA), length(flds_md)))
names(metadata_use) <- flds_md
if (!quiet) message(yellow(paste0(" - Metadata fields set to NA: ", paste(flds_md, collapse = ", "))))
} else if (is.list(metadata)) {
metadata_use <- metadata
} else if (is.character(metadata)) {
## Presume this is a file name pattern
## metadata_fn <- file.path(img_dir, "metadata.txt")
metadata_fn <- list.files(path = img_dir,
pattern = metadata,
full.names = TRUE)
if (length(metadata_fn) == 0) {
if (!quiet) message(yellow(" - Flight metadata file not found, using defaults"))
flds_md <- uas_getflds()
metadata_use <- as.list(rep(as.character(NA), length(flds_md)))
names(metadata_use) <- flds_md
} else {
metadata_use <- list()
for (md_fn in metadata_fn) {
if (!quiet) message(yellow(" - Reading", basename(md_fn)))
fcon <- file(md_fn, open = "r")
while ( TRUE ) {
one_line <- readLines(fcon, n = 1, warn = FALSE)
if ( length(one_line) == 0 ) {
## You've gotten to the end
break
}
first_char <- trimws(substr(one_line, 1, 1))
if (first_char != "#" && first_char != "/") {
colon_pos <- regexpr(":", one_line)
if (colon_pos > 0) {
## Key (before colon)
ln_key <- trimws(substring(one_line, 1, colon_pos - 1)[1])
##if (ln_key %in% names(metadata_use)) { }
metadata_use[[ln_key]] <- gsub("\"", "'",
trimws(substring(one_line, colon_pos + 1)[1]))
}
}
} ## while TRUE
close(fcon)
} ## for (md_fn in metadata_fn)
}
} else {
warning("Unknown object for metadata")
flds_md <- uas_getflds()
metadata_use <- as.list(rep(as.character(NA), length(flds_md)))
names(metadata_use) <- flds_md
}
## Create a default name_short if needed
if (is.null(metadata_use$name_short)) {
metadata_use$name_short <- id_str
} else {
if (is.na(metadata_use$name_short)) {
metadata_use$name_short <- id_str
} else if (metadata_use$name_short == "") {
metadata_use$name_short <- id_str
}
}
## If there's a value for collection_name (a field which is now deprecated but still exists in some
## older metadata.txt files), rename it name_long
if (is.null(metadata_use$name_long) && !is.null(metadata_use$collection_name)) {
names(metadata_use)[names(metadata_use) == "collection_name"] <- "name_short"
warning(yellow("Metadata field `collection_name` has been deprecated. Moving forward please use `name_long`."))
}
## Add to the result list
res[[img_dir]] <- list(pts = imgs_ctr_utm_sf,
fp = fp_utm_sf,
nomap = nomap,
area_m2 = area_m2,
mcp = mcp_sf,
size_mb = total_size_mb,
date_flown = flight_date_str,
# camera_name = camera_name,
id = id_str,
metadata = metadata_use)
}
if (!quiet) message(green("All done"))
## Return the results
class(res) <- c("list", "uas_info")
res
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.