R measuring distance from a coastline

Question

I have a set of coordinates:

d1 <- data_frame(
title = c(\"base1\", \"base2\", \"base3\", \"base4\"),
lat = c(57.3, 58.8, 47.2, 57.8, 65.4, 56.7, 53.3),
long          


        

Answer 1

For a faster implementation of geosphere:::dist2Line that uses purrr for efficient looping and progress for a progress bar, thus retaining the accuracy of Chris' first answer, see below:

library(geosphere)
library(purr)
library(progress)

spDistPoint2Line <- function (p, line, distfun)
{ 
  ## rewrite of internal function from geosphere
  test <- !sp::is.projected(line)
  if (!isTRUE(test)) {
    if (is.na(test)) {
      warning("Coordinate reference system of SpatialPolygons object is not set. Assuming it is degrees (longitude/latitude)!")
    }
    else {
      stop("Points are projected. They should be in degrees (longitude/latitude)")
    }
  }

  x <- line@lines
  n <- length(x)
  res <- matrix(nrow = nrow(p), ncol = 3)
  colnames(res) <- c("distance", "lon", "lat")

  line_coords <- map(x, ~(map(.@Lines, ~(.@coords)))) #basically an unlist
  pb <- progress_bar$new(
    total = length(line_coords),
    format = "(:spin) :current of :total, :percent, eta: :eta"
  )

  res[] <- Inf
  result <- reduce(
    .x = line_coords,
    .init = res,
    .f = function(res, crd){
      pb$tick()
      crd <- crd[[1]]
      r <- dist2Line(p, crd, distfun) # have to live without ID
      k <- r[, 1] < res[, 1]
      res[k, ] <- r[k, ]
      return(res)
    }
  )
  return(result)
}

dist2Line <- function (p, line, distfun = distGeo) 
{
  p <- geosphere:::.pointsToMatrix(p)
  if (inherits(line, "SpatialPolygons")) {
    line <- methods::as(line, "SpatialLines")
  }
  if (inherits(line, "SpatialLines")) {
    return(spDistPoint2Line(p, line, distfun))
  }

  line <- geosphere:::.pointsToMatrix(line)
  line1 <- line[-nrow(line), , drop = FALSE]
  line2 <- line[-1, , drop = FALSE]
  seglength <- distfun(line1, line2)

  res <-
    p %>%
      array_branch(1) %>%
      map(
        function(xy){
          crossdist <- abs(dist2gc(line1, line2, xy))
          trackdist1 <- alongTrackDistance(line1, line2, xy)
          trackdist2 <- alongTrackDistance(line2, line1, xy)
          mintrackdist <- pmin(trackdist1, trackdist2)
          maxtrackdist <- pmax(trackdist1, trackdist2)
          crossdist[maxtrackdist >= seglength] <- NA
          nodedist <- distfun(xy, line)
          warnopt = getOption("warn")
          options(warn = -1)
          distmin1 <- min(nodedist, na.rm = TRUE)
          distmin2 <- min(crossdist, na.rm = TRUE)
          options(warn = warnopt)
          if (distmin1 <= distmin2) {
            j <- which.min(nodedist)
            return(c(distmin1, line[j, ]))
          }
          else {
            j <- which.min(crossdist)
            if (trackdist1[j] < trackdist2[j]) {
              bear <- bearing(line1[j, ], line2[j, ])
              pt <- destPoint(line1[j, ], bear, mintrackdist[j])
              return(c(crossdist[j], pt))
            }
            else {
              bear <- bearing(line2[j, ], line1[j, ])
              pt <- destPoint(line2[j, ], bear, mintrackdist[j])
              return(c(crossdist[j], pt))
            }
          }
        }
      ) %>%
      simplify %>%
      matrix(ncol = 3, byrow = TRUE)

  colnames(res) <- c("distance", "lon", "lat")
  return(res)
}