UCANR-IGIS/uasimg
Drone Image Utilities

Package index
Search the UCANR-IGIS/uasimg package
Vignettes
Functions
73
Source code
26
Man pages
26
Home
/
GitHub
/
UCANR-IGIS/uasimg
/

In UCANR-IGIS/uasimg: Drone Image Utilities

```{js echo = FALSE} function set_src(elmnt) { elmnt.parentNode.parentNode.lastElementChild.src = "./tb/" + elmnt.getAttribute("data-tbfn"); elmnt.parentNode.parentNode.getElementsByClassName("fn3")[0].textContent = elmnt.textContent; elmnt.parentNode.parentNode.getElementsByClassName("dt3")[0].textContent = elmnt.getAttribute("data-dt"); elmnt.parentNode.parentNode.getElementsByClassName("gps3")[0].textContent = elmnt.getAttribute("data-gps"); }

```{css echo = FALSE}
h1.title {
  color: #305230;
  font-size:18px;
}
tr {
  vertical-align:top;
}
span.btext {
  background-color: #F1F1F1;
  padding: 2px 5px;
  border-radius: 3px;
  color: navy;
  margin: 2px;
  cursor: pointer; 
  line-height: 180%; 
}
table.fn_dt {
  width: 100%;
}
td.dt {
  font-size: 90%;
  font-style: italic;
  text-align: right;
}
td.gps {
  margin-left:0;
  padding-left:0;
  font-size: 90%;
  font-style: italic;
}
td.gps3 {
  margin-left:0;
  padding:0.3em 0;
  font-size: 90%;
  font-style: italic;
  width:25%;
  border:none;
}
td.fn3 {
  padding:0.3em 0;
  width: 50%;
  font-size:90%;
  font-style:italic;
  font-weight:bold;
  text-align:center;
  border:none;
  color:green;
}
td.dt3 {
  padding:0.3em 0;
  width:25%;
  font-size: 90%;
  font-style: italic;
  text-align: right;
  border:none;
}
img.bln_img {
  border:1px solid dimgray;
  max-width: 440px;
  max-height: 360px;
  margin: 0.5em auto;
  display: block;
}

## Setup
knitr::opts_chunk$set(echo = TRUE)
library(htmltools)
library(leaflet)
library(leaflet.extras)
library(base64enc)
library(dplyr)

## Get the image dimensions
img_pixels <- paste0(params$pts[1, "img_width", drop = TRUE], " x ", params$pts[1, "img_height", drop = TRUE])

## Get the start and end time formatted
dt_posix <- as.POSIXct(params$pts$date_time, format="%Y:%m:%d %H:%M:%S")
dt_range <- format(range(dt_posix), "%b %d %Y, %I:%M:%S %p")

convert_me <- list(
  alt_agl = list(imperial = list(fun = m2ft, lbl = "feet"),
                 metric = list(fun = I, lbl = "m")),
  gsd = list(imperial = list(fun = cm2in, lbl = "inches"),
                 metric = list(fun = I, lbl = "cm")),
  flight_area = list(imperial = list(fun = msq2acres, lbl = "acres"),
                     metric = list(fun = msq2ha, lbl = "hectacres"))
)

## Insert meta tags. These will not be visible but will be harvested by uas_toc()
cat("<meta name='map_fn' content='", params$map_fn, "'>\n", sep = "")
cat("<meta name='date_flown' content='", params$date_flown, "'>\n", sep = "")
cat("<meta name='area_m2' content='", round(params$area_m2), "'>\n", sep = "")
cat("<meta name='kml_mcp_fn' content='", params$kml_mcp_fn, "'>\n", sep = "")
cat("<meta name='kml_ctr_fn' content='", params$kml_ctr_fn, "'>\n", sep = "")

## Encode the MCP simple feature polygon to Base64 (text), and save it in a meta tag
#mcp_raw <- serialize(params$mcp, connection = NULL)
mcp_b64 <- serialize(params$mcp, connection = NULL) |> base64encode()
cat("<meta name='mcp_b64' content='", mcp_b64, "'>\n", sep = "")

## Come up with a name to use as the title. First, try name_long:
if (!is.na(params$metadata$name_long |> null2na())) {
  name_use <- params$metadata$name_long
} else {
  ## Next, try name_short
  if (!is.na(params$metadata$name_short |> null2na())) {
    name_use <- params$metadata$name_short
  } else {
    ## Last resort - use the id
    name_use <- params$id  
  }
}

cat("<h2><span id='name_use'>", name_use, "</span></h2>\n", sep = "")

cat("<table>")

if (!is.na(params$metadata$description |> null2na())) cat("<tr><td>__Description__:</td><td><span id='description'>",  params$metadata$description, "</span></td></tr>", sep = "")

if (!is.na(params$metadata$pilot |> null2na())) cat("<tr><td>__Pilot__:</td><td><span id='pilot'>",  params$metadata$pilot, "</span></td></tr>", sep = "")

if (!is.na(params$metadata$contact |> null2na())) cat("<tr><td>__Contact__:</td><td><span id='contact'>",  params$metadata$contact, "</span></td></tr>", sep = "")

if (params$show_local_dir) cat("<tr><td>__Local dir__:</td><td>", gsub("\\\\", "/", params$img_dir), "</td></tr>", sep = "")

if (!is.na(params$metadata$data_url |> null2na())) cat("<tr><td>__Data URL__:</td><td>",  params$metadata$data_url, "</td></tr>", sep = "")

## Report the number of images
cameras_lst <- as.list(table(params$pts$camera_name))

cat("<tr><td>__Camera__:</td><td><span id='camera_name'>", paste(names(cameras_lst), collapse = ", "), "</span></td></tr>", sep = "")

cat("<tr><td>__Num&nbsp;images__:</td><td><span id='num_img'>", paste(unlist(cameras_lst), collapse = ", "), "</span></td></tr>", sep = "")

cat("<tr><td>__Total&nbsp;file&nbsp;size__:</td><td><span id='size_mb'>", params$size_mb, "</span> MB</td></tr>", sep = "")

cat("<tr><td>__Area__:</td><td><span id='area_acres'>", round(convert_me$flight_area[[params$units]]$fun(params$area_m2),2), " ", convert_me$flight_area[[params$units]]$lbl, "</span></td></tr>", sep = "")

cat("<tr><td>__Start__:</td><td><span id='dt_start'>", dt_range[1], "</span></td></tr>", sep = "")

cat("<tr><td>__End__:</td><td><span id='dt_end'>", dt_range[2], "</span></td></tr>", sep = "")

cat("<tr><td>__Image&nbsp;dimensions__:</td><td><span id='img_dim'>", img_pixels, "</span></td></tr>", sep = "")

if (!is.na(params$metadata$notes |> null2na())) cat("<tr><td>__Notes__:</td><td><span id='notes'>",  params$metadata$notes, "</span></td></tr>", sep = "")

cat("</table>")

Maps {.tabset}

Centers

## Add tiles properties
tiles_esri_url <- "http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}"

tiles_esri_attr <- "Tiles &copy; Esri &mdash; Source: Esri, i-cubed, USDA, USGS, AEX, GeoEye, Getmapping, Aerogrid, IGN, IGP, UPR-EGP, and the GIS User Community"

## Initiate a new leaflet object
m <- leaflet(width="800px", height="600px",
             options = leafletOptions(maxZoom = 23)) |> 
  addTiles(tiles_esri_url, group="Satellite", attribution=tiles_esri_attr) |> 
  addTiles(group="Open Street Map") |> 
  addLayersControl(baseGroups = c("Satellite", "Open Street Map"), options = layersControlOptions(collapsed = FALSE)) |> 
  addFullscreenControl()

## Create a leaflet object for the points
lng_rng <- range(params$pts$gps_long)
lat_rng <- range(params$pts$gps_lat)
m_pts <- m |> fitBounds(lng_rng[1], lat_rng[1], lng_rng[2], lat_rng[2])

## Create the popup options
if (params$thumbnails) {
  pup_opts <- popupOptions(maxWidth = 450, minWidth = 450, closeOnClick = TRUE, keepInView = TRUE)
} else {
  pup_opts <- NULL
}

if (group_img) {

  ## Group points to the 5th decimal place (approx 1m on the ground)
  ## There will be one point for each group. The popup window will show info for all the images
  ## at that location
  leaf_pts_tbl <- params$pts |> st_drop_geometry() |> 
    mutate(gps_long_rnd = round(gps_long, 5), 
         gps_lat_rnd = round(gps_lat, 5),
         pts_dt = as.POSIXct(date_time, format="%Y:%m:%d %H:%M:%S")) |> 
    select(gps_long, gps_long_rnd, gps_lat, gps_lat_rnd, file_name, pts_dt, tb_fn) |> 
    group_by(gps_long_rnd, gps_lat_rnd) 

  if (params$thumbnails) {
    leaf_pts_tbl <- leaf_pts_tbl |> 
      summarise(count = n(), first_dt = first(pts_dt),
                balloon_html = paste0("<div><p>",
                                      paste("<span onclick='set_src(this)' data-tbfn='", tb_fn,
                                            "' data-dt='",
                                            format(pts_dt, "%Y-%m-%d %H:%M:%S"), 
                                            "' data-gps='", gps_long_rnd, ",", gps_lat_rnd, "' class='btext'>",
                                            file_name, "</span>", sep = "", collapse = " "),
                                      "</p>",
                                      "<table class='fn_dt'><tr><td class='gps3'>",
                                      first(gps_long_rnd), ",", first(gps_lat_rnd),
                                      "</td><td class='fn3'>", first(file_name),
                                      "</td><td class='dt3'>",
                                      format(first(pts_dt), "%Y-%m-%d %H:%M:%S"), "</td></tr></table>",
                                      "<img src='./tb/",
                                      first(tb_fn), 
                                      "' class='bln_img'/></div>")) |>    ## removed height='300' width='440' 
      arrange(first_dt)

  } else {
    ## Grouping but no thumnbails
    leaf_pts_tbl <- leaf_pts_tbl |> 
      summarise(count = n(), first_dt = first(pts_dt),
                balloon_html = paste(file_name, "<br/><em>", format(pts_dt, "%Y-%m-%d, %H:%M:%S"), "</em><br/>", sep = "", collapse = "<br/>")) |> 
    arrange(first_dt)
  }

  ## Compute colors for the pts and fp. THESE WERE COMPUTED IN uas_report.R and passed as params$col
  # if (is.na(params$col)) {
  #   col_use <- rainbow(nrow(leaf_pts_tbl), end=5/6)
  # } else {
  #   col_use <- params$col
  # }
  # col_use <- params$col

  ## Add circle markers
  m_pts <- m_pts |> addCircleMarkers(data = leaf_pts_tbl,
                   lng = ~gps_long_rnd, lat = ~gps_lat_rnd, 
                   radius = 5, fillColor = params$col, fillOpacity = 1,  
                   stroke = (max(leaf_pts_tbl$count) > 1), 
                   color = "black", weight = 2,
                   popup = ~balloon_html,
                   popupOptions = pup_opts)

} else {

  ## NOT GROUPING

  ## Create the balloons
  pts_dt <- as.POSIXct(params$pts$date_time, format="%Y:%m:%d %H:%M:%S")

  if (params$thumbnails) {
    ## Create the IMG tag
    thumbnail_html <- paste0("<img src='tb/", params$pts$tb_fn, "' class='bln_img'/>")

    balloons_html <- paste0("<div><p><b>", params$pts$file_name, "</b></p>",
                          "<table class='fn_dt'><tr><td class='gps'>", 
                          paste0(round(params$pt$gps_long, 5), ", ",  round(params$pt$gps_lat, 5)),
                          "</td><td class='dt'>",
                          format(pts_dt, "%Y-%m-%d %H:%M:%S"), "</td></tr></table>",
                          thumbnail_html, "</div>")
  } else {
    ## No grouping, no thumbnails
    balloons_html <- paste0("<p>", params$pts$file_name, "<br/>",
                            "<em>", format(pts_dt, "%Y-%m-%d, %H:%M:%S"), "</em></p>")
  }

  ## Compute colors. THESE WERE COMPUTED IN uas_report.R and passed as params$col
  # if (is.na(params$col)) {
  #   col_use <- rainbow(nrow(params$pts), end=5/6)
  # } else {
  #   col_use <- params$col
  # }

  ## Add the circle markers
  m_pts <- m_pts |> addCircleMarkers(lng = params$pts$gps_long, lat = params$pts$gps_lat, 
                                   radius = 4, fillColor = params$col, fillOpacity = 1, 
                                   stroke = FALSE, popup = balloons_html,
                                   popupOptions = pup_opts)

}

## Display HTML Widget
m_pts

if (!identical(params$fp, NA)) {
  cat("### Footprints \n")
}

# if (!identical(params$fp, NA)) {
#   ## No fp, because fp=F in uas_info, or yaw or AGL altitude was not saved in the EXIF
#   ## div(p("Image footprints not computed."), hr())
#   cat("<p>Hi there</p>\n")
# 
# } else {  

if (!identical(params$fp, NA)) {
  cat("### Footprints \n")

  ## Reproject footprints to lat-long (required by leaflet)
  fp_ll_sf <- params$fp |> st_geometry() |>  st_transform(crs = 4326)

  ## Compute colors. THESE WERE COMPUTED IN uas_report.R and passed as params$col
  # if (is.na(params$col)) {
  #   col_use <- rainbow(nrow(params$fp), end=5/6)
  # } else {
  #   col_use <- params$col
  # }

  m_fp <- m |> addPolygons(data = fp_ll_sf, fill = FALSE, stroke = TRUE, color = params$col, weight = 2, dashArray = "1,2")

  ## Display HTML Widget
  m_fp
}

## If needed, add links to the KML file(s)

if (!is.na(params$kml_mcp_fn) || !is.na(params$kml_ctr_fn)) {
  cat("## KMLs\n")  

  ## Alternately I can clear the tab set with:
  ## cat("## {-}\n")
  if (!is.na(params$kml_ctr_fn)) {
    cat("<ul><li><a href=\"", kml_ctr_fn, "\">Camera points</a></li></ul>\n", sep = "")  
  } 
  if (!is.na(params$kml_mcp_fn)) {
    cat("<ul><li><a href=\"", kml_mcp_fn, "\">Flight Area (MCP)</a></li></ul>\n", sep = "")  
  } 

}

EXIF Data Analysis

if (!"gsd" %in% names(params$pts) && (!"alt_agl" %in% names(params$pts)) && (identical(params$fp, NA))) {
  htmltools::p("Estimates of ground sampling distance, above ground elevation, and footprints not available")
}

if ("gsd" %in% names(params$pts)) {
  hist(convert_me$gsd[[params$units]]$fun(params$pts$gsd), col="grey50", breaks=20, main="Ground Sampling Distance", 
       xlab = paste0("estimated GSD (", convert_me$gsd[[params$units]]$lbl, ")"), 
       ylab = "freq")

  #hist(cm2in(params$pts$gsd), col="grey50", breaks=20, main="Ground Sampling Distance", xlab="estimated GSD (inches)", ylab="freq")
}

if ("alt_agl" %in% names(params$pts)) {

  hist(convert_me$alt_agl[[params$units]]$fun(params$pts$alt_agl), col="grey50", breaks = 20, main = "Altitude", 
       xlab = paste0("recorded altitude above launch (", convert_me$alt_agl[[params$units]]$lbl, ")"), 
       ylab = "freq")
}

if (!identical(params$fp, NA)) {
  if (!is.null(params$fp$fwd_ovrlap)) {
    hist(params$fp$fwd_ovrlap, col="grey50", breaks=20, main="Forward Overlap", 
         xlab="estimated overlap (%)", ylab="freq")    
  }
}

Created with:
Drone Image Utilities for R

 



UCANR-IGIS/uasimg documentation built on Jan. 16, 2025, 10:29 p.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close