How to create a cone polygon to sample SpatRaster to represent a cameras field of view

46 Views Asked by At

I am working with a wildlife camera grid. I would like to extract values from SpatRaster's over the camera points, but from the field of view. To simulate a cameras field of view, I would like to create a cone polygon that is pointed in the listed bearings of the cameras in the grid.

Minimal working example:

library(terra)
f <-system.file("ex/elev.tif", package="terra")
r <-rast(f)

WildCams <- spatSample(r,10, "regular", as.points=TRUE)
bearings <- sample.int(180,10)
WildCams$bearings <- bearings    
WildCams_buf <- buffer(WildCams,5000)
WildCams_sf <- sf::st_as_sf(WildCams)

The following answer provides an example of the type of result I would like to create in R for multiple points. This answer provides an example for creating a cone polygon for a single point to a portion of sphere.

I started working from the example to create a cone around a single point but do not know how to extend this to a grid of points. The following does not work but builds on this example:

# Attempt 1: Create a cone polygon
theta <- 120 # my angle of interest
radius <- 500 # my radius length of interest (in meters)

WildCams_buf_sf <- sf::st_as_sf(WildCams_buf)
theta = pi*theta/180
cone1 <- vect(WildCams_buf_sf)
conegrid = rast(cone1, nrow=nrow(r), ncol=ncol(r))
conegrid2 = rasterize(cone, conegrid, field="bearings")
conegrid3 <- project(conegrid2, crs(r), res=res(r))

plot(conegrid3)
xy = crds(conegrid3)
xy[,1] = xy[,1] - st_coordinates(WildCams_sf)[1]
xy[,2] = xy[,2] - st_coordinates(WildCams_sf)[2]

v = (atan2(xy[,1], xy[,2]) + theta)

conegrid3[] = (1+sin(v))/2
conegrid4 = mask(conegrid3, vect(WildCams_sfbuf ))
plot(conegrid4 >0.05)

Is there a function in terra or another package that creates a field of view cone from a set of points that can individually be set to sample in the orientation of the camera's bearing? I would like to extract SpatRaster values from the field of view cones.

1

There are 1 best solutions below

2
Wimpel On BEST ANSWER

sample data

assuming we have a data.frame of camera's with ther lon/lat position, camera bearing, camera angle width and camera distance.

# sample data with camera coordinates, viewing angle (from north) and viewing distance
cameras <- data.frame(id = 1:2,
                      lat = c(52.0807722,52.0825922), 
                      lon = c(5.8374241, 5.8393871),
                      angle = c(10, 180),
                      width = c(30, 60),
                      dist = c(250, 150))

code

library(sf)
library(tidyverse)
library(geosphere)
library(sfheaders)
library(mapview)  # for viewing purposes only
cameras.sf <- cameras %>%
  sf::st_as_sf(coords = c("lon", "lat"), crs = 4326)
# view/verify camera location
# mapview::mapview(cameras.sf)
wedge.func <- function(coordinates, distance, angle, width, id) {
  coordinates.m <- matrix(unlist(coordinates), ncol = 2, byrow = TRUE, dimnames = NULL)
  angles <- angle - width/2 + seq(0, width, by = 0.5)
  angle.point <- lapply(angles, function(x) geosphere::destPoint(unlist(coordinates), b = x, d = distance))
  m <- matrix(unlist(angle.point), ncol = 2, byrow = TRUE)
  allpoints <- rbind(coordinates.m, m, coordinates.m)
  wedge <- sfheaders::sf_linestring(allpoints) %>% 
    st_set_crs(4326) %>%
    st_cast("POLYGON")
  return(wedge)
}
# get points of the camera's
point_coords <- split(st_coordinates(cameras.sf), row(st_coordinates(cameras.sf)))
# create wedges
wedges <- dplyr::bind_rows(
  mapply(wedge.func, 
         point_coords, cameras.sf$dist, cameras.sf$angle, cameras.sf$width, cameras.sf$id, 
         SIMPLIFY = FALSE)) %>%
  mutate(id = cameras.sf$id)

# view
mapview(list(cameras.sf, wedges))

enter image description here