non_monotone.r

#library(raster)
#b <- brick("Clipboard01.png")
#plotRGB(b)
#x <- locator()
x <- do.call(cbind, lapply(structure(list(x = c(18.2570281124498, 143.859437751004, 238.759036144578, 
                          280.068273092369, 204.706827309237, 259.413654618474, 183.493975903614, 
                          186.285140562249, 110.923694779116, 278.951807228916, 201.915662650602, 
                          85.2449799196787, 27.1887550200803, 64.0321285140562, 141.068273092369
), y = c(285.815261044177, 375.132530120482, 400.81124497992, 
         322.100401606426, 287.489959839357, 213.244979919679, 170.261044176707, 
         249.530120481928, 142.907630522088, 67.5461847389558, 14.5140562248996, 
         107.738955823293, 168.028112449799, 231.666666666667, 309.819277108434
)), .Names = c("x", "y")), round, digits = 4))
x <- x[c(1:nrow(x), 1), ]


buffer <- function(x) {
  x + c(-1, 1) * diff(range(x))/10
}

mkline <- function(xlim) {
  function(y) {
    st_linestring(cbind(xlim, rep(y, 2L)))
  }
}
line <- mkline(xlim)
#line(2)


is_primitive <- function(x) {
  stopifnot(st_geometry_type(x) == "LINESTRING")
  nrow(as.matrix(x)) == 2L
}
detect <- function(x) {
  switch(as.character(st_geometry_type(x)), 
         POINT = FALSE, 
         GEOMETRYCOLLECTION = TRUE, 
         MULTILINESTRING = TRUE,
         LINESTRING = !is_primitive(x))
         
}
aplot <- function(x, ...) {
  op <-  options(warn = -1)
  on.exit(options(op))
  if (inherits(x, "POINT")) {
    points(matrix(x, nrow = 1), ...)
    return(invisible(NULL))
  }
  if (inherits(x, "GEOMETRYCOLLECTION")) {
    lapply(x, aplot, ...)
    return(invisible(NULL))
  }
  plot(x, ...)
}
  
library(sf)

## Linking to GEOS 3.5.1, GDAL 2.1.2, proj.4 4.9.3

sfx <- st_polygon(list(x))
bb <- st_bbox(sfx)
xlim <- buffer(bb[c("xmin", "xmax")])
idx <- order(x[, 2])
plot(sfx)
cols <- viridis::viridis(length(idx))

abline(h = x[idx, 2], col = viridis::viridis(length(idx)))

detected <- logical(length(idx))

## loop over the sorted y-coordinates and holler if 
## non-monotonicity is detected
plot(sfx)
for (i in seq_along(idx)) {
  hline <- line(x[idx[i] , 2, drop = TRUE])
  int <- st_intersection(hline, sfx)
  #print(int)
  
  if (detect(int)) {
    #print("woah")
    detected[i] <- TRUE
    aplot(int, add = TRUE, col = cols[i])
  }
  #scan("", 1L)
}

library(maptools)

## Loading required package: sp

## Checking rgeos availability: TRUE

data(wrld_simpl)
w <- st_as_sf(disaggregate(subset(wrld_simpl, NAME == "Australia")))
sfx <- st_geometry(w[1, ])[[1]]
plot(sfx)

x <- as.matrix(sfx)
bb <- st_bbox(sfx)
xlim <- buffer(bb[c("xmin", "xmax")])
idx <- order(x[, 2])
cols <- viridis::viridis(length(idx))
abline(h = x[idx, 2], col = cols)

plot(sfx)
detected <- logical(length(idx))

## loop over the sorted y-coordinates and holler if 
## non-monotonicity is detected
for (i in seq_along(idx)) {
  hline <- line(x[idx[i] , 2, drop = TRUE])
  int <- st_intersection(hline, sfx)
  #print(int)

  if (detect(int)) {
    #print("woah")
    detected[i] <- TRUE
    aplot(int, add = TRUE, col = cols[i])
  }
  #scan("", 1L)
}