R/prepare-points.R

In Laboratorio-de-Pedometria/spsann-package: Optimization of Spatial Samples via Simulated Annealing

# Generated by autofun (0.0.0.9000): do not edit by hand!!!
# Please edit source code in spsann-package/R-autofun/prepare-points.R
.prepare_points<-function(...){
expression(if (!missing(candi)) {
  n_candi <- nrow(candi)
  candi <- as.matrix(cbind(id = 1:n_candi, candi))
}, if (is(points, "list") && length(points) == 2) {
  fixed_pts <- points$fixed
  points <- points$free
  if (is(fixed_pts, "OptimizedSampleConfiguration")) { # Optimized sample configuration
    fixed_pts <- fixed_pts$points
  }
  if (is.matrix(fixed_pts) || is.data.frame(fixed_pts)) { # Data frame or matrix
    fixed_pts <- as.matrix(fixed_pts)
  } else {
    if (is.integer(fixed_pts) || pedometrics::isNumint(fixed_pts)) {
      if (length(fixed_pts) > 1) { # Integer vector
        fixed_pts <- candi[fixed_pts, ]
      }
      if (length(fixed_pts) == 1) { # Integer value
        stop("invalid value passed to argument 'points$fixed': integer value")
      }
    }
  }
  # Check if 'fixed_pts' has a column "id" with the row indexes of 'candi' that correspond to each
  # point (THE REQUIREMENT FOR PROVIDING AN ID COLUMN WAS DROPPED ON 2022-04-17)
  if (ncol(fixed_pts) != 3 || colnames(fixed_pts)[1] != "id") {
    # stop ("missing 'id' column in object 'points$fixed'")
    fixed_pts_id <- SpatialTools::dist2(candi[, 2:3], fixed_pts)
    fixed_pts <- as.matrix(cbind(id = apply(fixed_pts_id, 2, which.min), fixed_pts))
  }
}, if (is(points, "OptimizedSampleConfiguration")) {
  points <- points$points
}, if (is.matrix(points) || is.data.frame(points)) { # Data frame or matrix
  points <- as.matrix(points)
} else {
  if (is.integer(points) || pedometrics::isNumint(points)) {
    if (length(points) > 1) { # Integer vector
      points <- candi[points, ]
    }
    if (length(points) == 1) { # Integer value
      points <- sample(1:n_candi, points)
      points <- candi[points, ]
    }
  }
}, n_pts <- nrow(points), conf0 <- points, if (exists("fixed_pts")) {
  n_fixed_pts <- nrow(fixed_pts)
  points <- rbind(points, fixed_pts)
} else {
  n_fixed_pts <- 0
}, old_conf <- points)
}