R/editLattice.R

In latticeDensity: Density Estimation and Nonparametric Regression on Irregular Regions

#' Add or remove links in the lattice
#' 
#' editLattice is an interactive editor 
#' based on the function edit.nb from the 
#' package spdep. A formLatticeOutput object 
#' includes an automatically generated 
#' neighborhood structure. Occasionally 
#' this will either leave two nodes disconnected 
#' that should be connected or vice versa. 
#' editLattice allows the user to directly edit 
#' the plot of the lattice using mouseclicks to 
#' add or remove neighbor links between nodes.
#' @param formLatticeOutput An object from formLattice or editLattice.
#' @return a formLatticeOutput object, which contains
#' \itemize{
#'   \item EWlocs EW coordinates for use in contour.
#'   \item NSlocs NS coordinates for use in contour.
#'   \item nodes Matrix of node locations.
#'   \item poly Matrix of vertices of the boundary polygon.
#'   \item latt Lattice object as generated by dnearneigh of package spdep.
#'   }
#' @author Ronald P. Barry
#' @seealso formLattice
#' @examples 
#' \dontrun{
#' plot.new()
#' data(polygon1)
#' nodeFillingOutput = nodeFilling(poly=polygon1, node_spacing=0.03)
#' plot(nodeFillingOutput)
#' formLatticeOutput = formLattice(nodeFillingOutput)
#' plot(formLatticeOutput)
#' formLatticeOutput = editLattice(formLatticeOutput)
#' #
#' #  Paste the code above into R, then do the editing before
#' #  pasting the code below into R.
#' #
#' Pointdata = splancs::csr(polygon1,20)
#' densityOut = createDensity(formLatticeOutput,PointPattern=Pointdata,
#'                   k=150,intensity=FALSE, sparse = TRUE)
#' plot(densityOut)
#' }
#' @import utils
#' @import graphics
#' @import stats
#' @importFrom spdep card
#' @import grDevices
#' @export
editLattice <-
function (formLatticeOutput){
  #
  #  This function is a highly modified version of 'edit.nb' in 
  #  package 'spdep' originally by Roger Bivand.
  #
    latt <- formLatticeOutput$latt
    nodes <- formLatticeOutput$nodes
    polys <- formLatticeOutput$poly
    hole_list <- formLatticeOutput$hole_list
    nbr_numbers <- spdep::card(latt)
    old_plt <- par()$plt
    on.exit(par(plt=old_plt))
    par(plt=c(0,1,0,1))
    if (!inherits(latt, "nb")) 
        stop("not a neighbours list")
    #  inher_cl is a list of classes inherited by latt, not "nb"
    cl <- class(latt)
    if (length(cl) > 1) 
        inher_cl <- cl[-match("nb", cl)]
    else inher_cl <- NULL
    x <- nodes[, 1]
    y <- nodes[, 2]
    n <- length(latt)
    row.names <- as.character(1:n)
    xlim <- range(x)
    ylim <- range(y)
    plot.new()
    plot.window(xlim = xlim, ylim = ylim, "", asp = 1)
    lines(polys,col=6,lwd=0.5)
    n_holes <- length(hole_list)
    for(i in 1:n_holes){
      lines(rbind(hole_list[[i]],hole_list[[i]][1,]),col=6,lwd=0.5)
    }
    #  draw the neighbor links
    for (i in 1:n) {
        if (nbr_numbers[i] > 0) 
            segments(x[i], y[i], x[latt[[i]]], y[latt[[i]]])
    }
    if(min(spdep::card(latt))==0){
      points(nodes[spdep::card(latt)==0,], col=2, cex=1,pch=19)}
    finished <- "n"
   erase.col <- par()$bg
    while (finished == "n") {
        cat("Identifying contiguity for deletion ...\n")
        cand <- identify(x, y, n = 2,plot=FALSE)
        lines(x[cand], y[cand], col = "red",lwd=2)
        if (.Platform$OS.type == "windows") 
            bringToTop(-1)
        if ((cand[2] %in% latt[[cand[1]]]) && (cand[1] %in%     
          latt[[cand[2]]])) {
            delete <- readline("Delete this line (y/n) ")
            if (delete != "y") 
                delete <- "n"
            else {
                          latt[[cand[1]]] <- latt[[cand[1]]][latt[[cand[1]]] != cand[2]]
                          if (length(latt[[cand[1]]]) == 0) {
                            latt[[cand[1]]] <- as.integer(0)
                            cat(cand[1], "is now an island\n")
                          }
                          latt[[cand[2]]] <- latt[[cand[2]]][latt[[cand[2]]] != 
                            cand[1]]
                          if (length(latt[[cand[2]]]) == 0) {
                            latt[[cand[2]]] <- as.integer(0)
                            cat(cand[2], "is now an island\n")
                          }
                          lines(x[cand], y[cand], col = erase.col)
                cat("deleted contiguity between point", cand[1], 
                  "and", cand[2], "\n")
    plot.new()
    plot.window(xlim = xlim, ylim = ylim, "", asp = 1)
    lines(polys,col=6,lwd=0.5)
    for (i in 1:n) {
        if (nbr_numbers[i] > 0) 
            segments(x[i], y[i], x[latt[[i]]], y[latt[[i]]])
    }
    if(min(spdep::card(latt))==0){
      points(nodes[spdep::card(latt)==0,], col=2, cex=1,pch=19)}
            }
        }
        else {
            if (length(cand == 2)) {
                cat("No contiguity between chosen points\n")
                addcont <- readline("Add contiguity? (y/n) ")
                if (addcont != "y") 
                  addcont <- "n"
                if (addcont == "y") {
                  latt[[cand[1]]] <- sort(unique(c(latt[[cand[1]]], 
                    cand[2])))
                  latt[[cand[2]]] <- sort(unique(c(latt[[cand[2]]], 
                    cand[1])))
                  cat("added contiguity between point", cand[1], 
                    "and", cand[2], "\n")
                  lines(x[cand], y[cand], col = "black")
                  latt[[cand[2]]] <- latt[[cand[2]]][ latt[[cand[2]]]>0]
                  latt[[cand[1]]] <- latt[[cand[1]]][ latt[[cand[1]]]>0]
                }
            }
        }
        finished <- readline("Options: quit[q] continue[c] ")
        if (finished != "q") 
            finished <- "n"
    }
    attr(latt, "region.id") <- row.names
    if (is.null(inher_cl)) 
        class(latt) <- "nb"
    else class(latt) <- c("nb", inher_cl)
    formLatticeOutput$latt <- latt
    return(formLatticeOutput)
}