R/getpath.R

Defines functions get_path next_move_tidy get_zigzag_turns move

Documented in get_path get_zigzag_turns move next_move_tidy

## Move/turns/path tools for zenplot()


##' @title Determine the new position when moving from the current position
##'        in a given direction
##' @param curpos current position (i, j) in the occupancy matrix
##' @param dir direction in which we move ("d", "u", "r" or "l")
##' @param method choice of method ("in.occupancy" means the (current/new)
##'        position is given in terms of (row, column) indices in the
##'        occupancy matrix; "in.plane" means the directions are
##'        interpreted as in the (x,y)-plane).
##' @return new position in the occupancy matrix
##' @author Marius Hofert and Wayne Oldford
move <- function(curpos, dir, method = c("in.occupancy", "in.plane"))
{
    method <- match.arg(method)
    curpos +
        if (method == "in.plane") {
            switch(dir,
                   "d" = { c( 0, -1) },
                   "u" = { c( 0,  1) },
                   "r" = { c( 1,  0) },
                   "l" = { c(-1,  0) },
                   stop("Wrong 'dir'"))

        } else {
            switch(dir,
                   "d" = { c( 1,  0) },
                   "u" = { c(-1,  0) },
                   "r" = { c( 0,  1) },
                   "l" = { c( 0, -1) },
                   stop("Wrong 'dir'"))
        }
}

##' @title Compute turns for zigzag
##' @param nPlots total number of plots
##' @param n2dcols number of columns of 2d plots (>= 1)
##' @param method character string indicating which zigzag method to use
##' @return turns
##' @author Marius Hofert and Wayne Oldford
get_zigzag_turns <- function(nPlots, n2dcols,
                             method = c("tidy", "double.zigzag", "single.zigzag"))
{
    ## Main idea: Determine the pattern which repeats rowblock-wise
    ##            (after going to the right and then back to the left)
    stopifnot(nPlots >= 4, # smaller nPlots relate to special cases dealt with in get_path()
              n2dcols >= 2)
    method <- match.arg(method)
    ## 1) Define the horizontal 2d pattern of turns
    h2dpattern <- rep(c("r", "l"), each = 2*(n2dcols-1)) # r,r,..., l,l,... for 2d plots
    ## 2) Define the vertical 2d subpattern
    v2dsubpattern <- if(method == "single.zigzag") rep("d", n2dcols-1) else {
        if(n2dcols <= 2) "d" else c(rep_len(c("d", "u" ), n2dcols-3), "d", "d") # up/down for 2d plots for one row (length = n2dcols - 1; so, e.g. only from right to left)
    }
    ## 3) Define the vertical 2d pattern
    v2dpattern <- rep(v2dsubpattern, times = 2) # up/down for 2d plots for one block of rows (r,r,..., l,l,...)
    ## 4) Merge the vertical 2d pattern into the horizontal 2d pattern
    h2dpattern[2*seq_along(v2dpattern)] <- v2dpattern # merge the ups/downs into h2dpattern
    ## 5) Repeat the merged 2d pattern to account for 1d plots
    overallpattern <- rep(h2dpattern, each = 2) # bring in 1d plots (by repeating each direction twice)
    ## 6) Repeat the overall pattern according to the total number of (1d or 2d) plots
    c("d", rep_len(overallpattern, nPlots-1)) # attach the first 1d plot separately and repeat the repeat pattern as often as required
}

##' @title Determine the next position to move to and the turn out of there
##' @param plotNo current plot number
##' @param nPlots total number of plots
##' @param curpath the current path
##' @return a list containing the next position to move to (nextpos) and the turn
##'         out of there (nextout); Interpretation:
##'         nextpos: position of plot number plotNo+1 in the (non-trimmed) occupancy matrix
##'         nextout: turn out of nextpos
##' @author Marius Hofert and Wayne Oldford
##' @note - This assumes that the last plot is a 1d plot!
##'       - It also assumes that first1d = TRUE; will be adapted later in get_path()
##'         in case first1d = FALSE.
##'       - We start in (1, 2) and also have an additional last column in the occupancy
##'         matrix to have the first and last column left in case we end up there with
##'         the last 1d plot; this cannot happen for 'zigzag' but for 'tidy'.
next_move_tidy <- function(plotNo, nPlots, curpath)
{
    stopifnot(plotNo >= 1, nPlots >= 4, # smaller nPlots relate to special cases dealt with in get_path()
              is.list(curpath))
    nPlotsLeft <- nPlots - plotNo # number of plots left
    if(nPlotsLeft <= 0)
        stop("Wrong number of plots left.") # next_move_tidy() should not be called in this case

    ## 1) Deal with special cases first
    if(plotNo==1) return(list(nextpos=c(2, 2), nextout="r")) # 1st plot (1d); next move/turn is "r"
    if(plotNo==2) return(list(nextpos=c(2, 3), nextout="r")) # 2nd plot (2d); next move/turn is "r"
    if(plotNo==3) # 3rd plot (1d); next move/turn is either up (only if there's only 1 1d plot left) or down
        return(list(nextpos=c(2, 4), nextout=if(nPlotsLeft <= 2) "u" else "d"))

    ## 2) Now plotNo >= 4 and there are >= 1 plots left
    curpos <- curpath$positions[plotNo,] # current position
    curin  <- curpath$turns[plotNo-1] # turn into the current position
    curout <- curpath$turns[plotNo] # turn out of the current position
    nextpos <- move(curpos, curout) # next position to move to

    ## 3) If plotNo is even (2d plot)
    ##    Note: This case also applies if nPlotsLeft==1
    if(plotNo %%2 == 0)
        return(list(nextpos=nextpos, nextout=curout))

    ## Now we are in the case plotNo is >= 5, odd (1d plot) and there are >= 2 plots left

    ## 4) Determine the current horizontal moving direction.
    ##    If the current 1d plot is vertical (or: horizontal), the horizontal direction is the
    ##    turn into the current (or: last) position.
    ##    => We simply consider the turn into the current position and the
    ##       one before to determine the horizontal moving direction.
    rinlast2 <- "r" %in% curpath$turns[(plotNo-2):(plotNo-1)]
    linlast2 <- "l" %in% curpath$turns[(plotNo-2):(plotNo-1)]
    if((rinlast2 + linlast2) != 1) # defensive programming
        stop("Algorithm to determine horizontal moving direction is wrong. This should not happen.")
    horizdir <- if(rinlast2) "r" else "l" # current horizontal moving direction

    ##    Determine the distance to the margin of the occupancy matrix in the horizontal moving direction
    ncolOcc <- ncol(curpath$occupancy)
    dist <- if(horizdir=="r") ncolOcc-curpos[2] else curpos[2]-1
    stopifnot(dist >= 0) # defensive programming

    ## 5) We are sitting at a 1d plot and have to determine how to leave
    ##    the next 2d plot
    posExists <- function(pos, occupancy) # aux function for checking the existence of a position in the occupancy matrix
        (1 <= pos[1] && pos[1] <= nrow(occupancy)) &&
            (1 <= pos[2] && pos[2] <= ncol(occupancy))
    nextout <- if(curout %in% c("d", "u")) { # 5.1)

        ## 5.1) The 1d plot is horizontal (curout "u" or "d")
        if(dist == 0) stop("dist == 0. This should not happen.")
        ##      If we have at most 2 plots left, decide where to put the last 1d plot
        if(nPlotsLeft <= 2) { # 5.1.1)
            ## Check the location of the 2d plot which comes after the next 2d plot
            ## in opposite horizontal moving direction.
            pos2check <- c(curpos[1] + if(curout=="u") -1 else 1, curpos[2] + if(horizdir=="r") -2 else 2)
            exists <- posExists(pos2check, occupancy = curpath$occupancy)
            ## If it does not exist (can only happen if curout="d" in which case
            ## the occupancy matrix is missing a new row), then put the
            ## last 1d plot in opposite horizontal moving direction if we are near
            ## the margin (otherwise we would occupy an additional column) and put it
            ## in the horizontal moving direction otherwise (if we are 'inside' the
            ## occupancy matrix)
            if(!exists) { # we will be in a new row (curout must be "d" in this case)
                stopifnot(curout=="d") # defensive programming
                if(dist <= 2) {
                    if(horizdir == "r") "l" else "r"
                } else {
                    horizdir
                }
            } else { # exists
                ## If this position exists, then change the horizontal moving direction
                ## if and only if it is not occupied (otherwise we can't go there)
                if(curpath$occupancy[pos2check[1], pos2check[2]] == "") { # not occupied
                    if(horizdir == "r") "l" else "r"
                } else {
                    horizdir
                }
            }
        } else { # 5.1.2) nPlotsLeft >= 3 (=> at least two more 2d plots)
            ## Change the horizontal moving direction if and only if we are at
            ## the boundary (clear).
            if(dist <= 2) {
                if(horizdir == "r") "l" else "r"
            } else {
                horizdir
            }
        }

    } else { # 5.2) curout "l" or "r"

        ## 5.2) The 1d plot is vertical (curout "l" or "r")
        if(curpath$turns[plotNo-2] %in% c("l", "r")) # defensive programming; how we entered last 2d plot must be l or r
            stop("Last 2d plot was entered in the wrong direction. This should not happen.")
        if(dist <= 1) {
            stop("dist <= 1. This should not happen.") # ... as we don't call next_move_tidy() for the last 1d plot
        } else { # dist >= 2; note that dist==2 and dist==3 are possible

            ## 5.2.1) Auxiliary function to determine how many plots fit in the next U-turn
            UturnLength <- function(curpos, horizdir, occupancy) {
                ## Check whether 1 or 2 plot(s) fit in
                pos2check <- c(curpos[1]-2, curpos[2] + if(horizdir=="r") 1 else -1)
                exists <- posExists(pos2check, occupancy=occupancy)
                if(exists && (occupancy[pos2check[1], pos2check[2]] != "")) return(1)
                if(!exists) return(2) # ... we can't put in more plots
                ## Check whether 4 plots fit in
                pos2check <- pos2check + c(0, if(horizdir=="r") 2 else -2)
                exists <- posExists(pos2check, occupancy=occupancy)
                if(!exists || (exists && (occupancy[pos2check[1], pos2check[2]] != "")))
                    return(4) # ... we can't put in more plots
                ## Check whether 6 plots fit in
                pos2check <- pos2check + c(2, 0)
                exists <- posExists(pos2check, occupancy=occupancy)
                if(!exists || (exists && (occupancy[pos2check[1], pos2check[2]] != "")))
                    return(6) # ... we can't put in more plots
                ## Check whether 8 or >= 10 plots fit in
                pos2check <- pos2check + c(0, if(horizdir=="r") 2 else -2)
                exists <- posExists(pos2check, occupancy=occupancy)
                if(!exists || (exists && (occupancy[pos2check[1], pos2check[2]] != "")))
                    return(8) else return(10) # here means "at least 10"
            }
            ## Determine the number of plots along the U-turn starting from the current position
            Ulen <- UturnLength(curpos, horizdir = horizdir, occupancy = curpath$occupancy)

            ## 5.2.2) If we are in the second row or there are more plots left than
            ##        can fit into a U-turn, go down, else go up.
            ##        Note: if Ulen >= 10, we can always take the U-turn, so we can always go up
            if(curpos[1] <= 2 || (Ulen < 10 && nPlotsLeft > Ulen)) "d" else "u"

        }

    }

    ## 6) Return
    list(nextpos = nextpos, nextout = nextout) # nextout = turn out of next position
}

##' @title Computing the path according to the provided method
##' @param turns The turns
##' @param n2dcols The number of columns of 2d plots (>= 1) or one of "letter", "square",
##'        "A4", "golden", "legal". Note that n2dcols is ignored if turns is not NULL.
##' @param n2dplots The number of 2d plots to be laid out
##' @param method A character string indicating the method according to which the
##'        path is built
##' @param first1d A logical indicating whether the first 1d plot should be plotted
##' @param last1d A logical indicating whether the last 1d plot should be plotted
##' @return the path, a list containing the turns, the positions (indices in the
##'         occupancy matrix) and the the occupancy matrix
##' @author Marius Hofert and Wayne Oldford
get_path <- function(turns = NULL, n2dcols = c("letter", "square", "A4", "golden", "legal"),
                     n2dplots, method = c("tidy", "double.zigzag", "single.zigzag", "rectangular"),
                     first1d = TRUE, last1d = TRUE)
{
    ## 1) Deal with the case that turns have been given (we need to construct
    ##    the positions in the occupancy matrix and the occupancy matrix itself)
    if(!is.null(turns)) {

        ## 1.1) Initialization
        hlim <- c(0, 0) # horizontal limits covered so far
        vlim <- c(0, 0) # vertical limits covered so far
        positions <- matrix(0, nrow=length(turns), ncol=2,
                            dimnames=list(NULL, c("x", "y"))) # matrix of positions
        loc <- c(0, 0) # where we are at the moment (start)
        ## 1.2) Loop
        if(length(turns) > 1) { # if length(turns)==1, we only have one 1d plot (nothing to do as positions is already initialized with 0)
            for(i in 2:length(turns)) { # loop over all turns
                loc <- move(loc, dir=turns[i-1]) # move to the next location according to turns
                positions[i,] <- loc # update positions
                if(loc[1] < hlim[1]) {
                    hlim[1] <- loc[1] # extend the lower bound of hlim if necessary
                } else if(loc[1] > hlim[2]) {
                    hlim[2] <- loc[1] # extend the upper bound of hlim if necessary
                }
                if(loc[2] < vlim[1]) {
                    vlim[1] <- loc[2] # extend the lower bound of vlim if necessary
                } else if(loc[2] > vlim[2]) {
                    vlim[2] <- loc[2] # extend the upper bound of vlim if necessary
                }
            }
        }
        ## 1.3) Shift
        min.pos <- apply(positions, 2, min) # get minimal visited row/column position
        positions <- sweep(positions, 2, min.pos) + 1 # substract these and add (1,1)

        ## 1.4) Compute the occupancy matrix
        occupancy <- matrix("", nrow=max(positions[,"x"]), ncol=max(positions[,"y"])) # occupancy matrix; note: already trimmed by construction
        for(i in 1:nrow(positions)) # loop over positions and fill occupancy matrix accordingly
            occupancy[positions[i,1], positions[i,2]] <- switch(turns[i],
                                                                "l" = { "l" },
                                                                "r" = { "r" },
                                                                "d" = { "d" },
                                                                "u" = { "u" },
                                                                stop("Wrong 'turns'"))

        ## (Early) return
        return(list(turns = turns, positions = positions, occupancy = occupancy)) # return here; avoids huge 'else' below

    }

    ## 2) Now consider the case where turns has not been given => construct the path

    ## Checking
    stopifnot(n2dplots >= 0)
    if(is.character(n2dcols)) n2dcols <- n2dcols_aux(n2dplots, method = n2dcols)
    stopifnot(length(n2dcols) == 1, n2dcols >= 1)
    if(n2dplots >= 2 && n2dcols < 2)
        stop("If n2dplots >= 2, n2dcols must be >= 2.")
    method <- match.arg(method)

    ## 2.1) Deal with method = "rectangular" first
    if(method == "rectangular") {
        nPlots <- 2 * n2dplots + 1 - !first1d - !last1d
        ## Determine the number or rows required
        n2drows <- ceiling(n2dplots/n2dcols)
        ## Determine 'turns'
        turns <- unlist(lapply(rep(c("r", "l"), length.out = n2drows),
                               function(t) c("d", rep(t, 2*(n2dcols-1)), "d"))) # correct for a *full last* row if first1d == TRUE and last1d == FALSE
        if(!first1d) turns <- turns[-1] # remove first element
        if(last1d) turns <- c(turns, "d") # append last element
        turns <- turns[seq_len(nPlots)] # grab out those we need
        ## Determine 'positions'
        positions <- matrix(, nrow = nPlots, ncol = 2, dimnames = list(NULL, c("x", "y"))) # positions
        if(nPlots >= 1) positions[1,] <- c(1, 1) # first plot
        if(nPlots >= 2) {
            for(plotNo in 2:nPlots) {
                turnOOcur <- turns[plotNo-1] # turn out of last position
                if(turnOOcur == "r") {
                    positions[plotNo,] <- positions[plotNo-1,] + c(0,1)
                } else if(turnOOcur == "l") {
                    positions[plotNo,] <- positions[plotNo-1,] + c(0,-1)
                } else if(turnOOcur == "d") {
                    positions[plotNo,] <- positions[plotNo-1,] + c(1,0)
                } else stop("Wrong turn in 'rectangular' method. This should not happen.")
            }
        }
        ## Determine occupancy matrix
        occupancy <- matrix(0, nrow = positions[nPlots,1], ncol = min(max(positions[,2]), 2*n2dcols-1)) # positions
        for(i in 1:nPlots) {
            occupancy[positions[i,1], positions[i,2]] <- switch(turns[i],
                                                                "l" = { "l" },
                                                                "r" = { "r" },
                                                                "d" = { "d" },
                                                                "u" = { "u" }, # should not happen here
                                                                stop("Wrong 'turns'"))
        }
        ## Return
        return(list(turns = turns, positions = positions, occupancy = occupancy))
    }

    ## 2.2) We start by dealing with three special cases (the same for all methods)
    nPlots <- 2 * n2dplots + 1 # total number of plots (1d and 2d; assumes first1d = TRUE; last1d = TRUE (will be trimmed off below if necessary))
    path <- if(nPlots <= 3) {
        switch(nPlots,
           { # nPlots = 1
               turns <- "d"
               positions <- matrix(c(1,1), ncol=2, dimnames=list(NULL, c("x", "y")))
               occupancy <- matrix("d", nrow=1, ncol=1)
               list(turns=turns, positions=positions, occupancy=occupancy)
           },
           { # nPlots = 2
               turns <- c("d", "r")
               positions <- matrix(c(1,1, 2,1), ncol=2, byrow=TRUE,
                                   dimnames=list(NULL, c("x", "y")))
               occupancy <- matrix(c("d", "r"), nrow=2, ncol=1)
               list(turns=turns, positions=positions, occupancy=occupancy)
           },
           { # nPlots = 3
               turns <- c("d", "r", "r")
               positions <- matrix(c(1,1, 2,1, 2,2), ncol=2, byrow=TRUE,
                                   dimnames=list(NULL, c("x", "y")))
               occupancy <- matrix(c("d","", "r","r"), nrow=2, ncol=2, byrow=TRUE)
               list(turns=turns, positions=positions, occupancy=occupancy)
           },
               stop("Wrong 'nPlots'"))
    } else {

        ## nPlots >= 4 (repeating order depends on n2dcols)
        turns <- character(nPlots) # how we leave every plot (1d or 2d)
        switch(method,
               "double.zigzag" =, "single.zigzag" = { # 2.2.1)

                   ## Main idea: Determine all turns right away, then build positions and
                   ##            occupancy matrix all from the turns
                   turns <- get_zigzag_turns(nPlots, n2dcols=n2dcols, method=method)

                   ## Build positions and occupancy matrix

                   ## Setup
                   ncolOcc <- 2*n2dcols-1 # number of columns in the occupancy matrix
                   occupancy <- matrix("", nrow=1, ncol=ncolOcc) # occupancy matrix
                   positions <- matrix(0, nrow=nPlots, ncol=2, dimnames=list(NULL, c("x", "y"))) # positions

                   ## Init
                   curpos <- c(1, 1) # current position
                   positions[1,] <- curpos # occupy (row, col)
                   occupancy[curpos[1], curpos[2]] <- turns[1]

                   ## Loop over all remaining plots
                   maxrowOcc <- 1
                   for(plotNo in 2:nPlots) {
                       ## Update position
                       nextpos <- move(curpos, dir=turns[plotNo-1])
                       positions[plotNo,] <- nextpos # occupy location (row, col)
                       curpos <- nextpos
                       if(curpos[1] > maxrowOcc) { # expand occupancy matrix by one row
                           occupancy <- rbind(occupancy, rep("", ncolOcc))
                           maxrowOcc <- maxrowOcc + 1
                       }
                       ## Update occupancy matrix
                       occupancy[nextpos[1], nextpos[2]] <- turns[plotNo]
                   }

                   ## Trim last columns of "" from occupancy matrix
                   occupancy <- occupancy[,seq_len(max(positions[,2])), drop=FALSE]

                   ## Build path
                   list(turns=turns, positions=positions, occupancy=occupancy)

               },
               "tidy" = { # 2.2.2)

                   ## Main idea: Build turns, positions and occupancy as we go along

                   ## Setup
                   turns <- character(nPlots) # vector of turns out of current position
                   ncolOcc <- 2*n2dcols+1 # number of columns in the occupancy matrix (2*n2dcols-1 + left/right one more)
                   occupancy <- matrix("", nrow=1, ncol=ncolOcc) # occupancy matrix
                   positions <- matrix(0, nrow=nPlots, ncol=2, dimnames=list(NULL, c("x", "y"))) # positions

                   ## Init
                   turns[1] <- "d" # turn out of current position
                   positions[1,] <- c(1, 2) # occupy (row, col)
                   occupancy[1, 2] <- "d" # initialize occupancy matrix there

                   ## Loop over all remaining plots
                   maxrowOcc <- 1
                   for(plotNo in 2:nPlots) {
                       ## Next move
                       nextmove <- next_move_tidy(plotNo-1, nPlots=nPlots,
                                                  curpath=list(turns=turns,
                                                               positions=positions,
                                                               occupancy=occupancy))
                       ## Update turn
                       turns[plotNo] <- nextmove$nextout # nextout = turn out of next position
                       ## Update position
                       nextpos  <- nextmove$nextpos
                       positions[plotNo,] <- nextpos # occupy location (row, col)
                       if(nextpos[1] > maxrowOcc) { # expand occupancy matrix by one row
                           occupancy <- rbind(occupancy, rep("", ncolOcc))
                           maxrowOcc <- maxrowOcc + 1
                       }
                       ## Update occupancy matrix
                       occupancy[nextpos[1], nextpos[2]] <-
                           switch(turns[plotNo], # update occupancy matrix
                                  "l" = { "l" },
                                  "r" = { "r" },
                                  "d" = { "d" },
                                  "u" = { "u" },
                                  stop("Wrong 'turns' at plotNo ", plotNo))
                   }

                   ## Trim last columns of 0s from occupancy matrix if necessary
                   occupancy <- occupancy[,seq_len(max(positions[,2])), drop=FALSE]
                   ## Trim first column of 0s and adjust positions if necessary
                   if(all(occupancy[,1]=="")) { # first column
                       occupancy <- occupancy[,-1]
                       positions[,2] <- positions[,2] - 1
                   }

                   ## Build path
                   list(turns=turns, positions=positions, occupancy=occupancy)

               },
               stop("Wrong 'method'"))

    }

    ## Trim path if necessary
    ## Idea: Take corresponding (first/last) turn to determine where to trim the
    ##       occupancy matrix and the positions.
    if(!first1d) {
        ## Trim turns
        first1d.turn.out <- path$turns[1] # get turn out of first 1d plot
        turns <- path$turns[-1] # trim

        ## Trim occupancy matrix
        occupancy <- path$occupancy
        rm <- positions[1,] # position to be removed (= replaced by 0)
        occupancy[rm[1], rm[2]] <- "" # remove position
        switch(first1d.turn.out,
        "l" = { # check whether we can trim last column
            jj <- ncol(occupancy)
            if(all(occupancy[,jj] == ""))
                occupancy <- occupancy[,-jj, drop = FALSE] # trim; no shift in positions necessary!
        },
        "r" = { # check whether we can trim first column
            if(all(occupancy[,1] == "")) {
                occupancy <- occupancy[,-1, drop = FALSE] # trim
                path$positions[,2] <- path$positions[,2] - 1 # shift all positions
            }
        },
        "d" = { # check whether we can trim first row
            if(all(occupancy[1,] == "")) {
                occupancy <- occupancy[-1,, drop = FALSE] # trim
                path$positions[,1] <- path$positions[,1] - 1 # shift all positions
            }
        },
        "u" = { # check whether we can trim last row
            ii <- nrow(occupancy)
            if(all(occupancy[ii,] == ""))
                occupancy <- occupancy[-ii,, drop = FALSE] # trim; no shift in positions necessary!
        }, stop("Wrong 'first1d.turn.out'."))

        ## Trim positions
        positions <- path$positions[-1,, drop = FALSE] # trim

        ## Define (trimmed) path
        path <- list(turns = turns, positions = positions, occupancy = occupancy)
    }
    if(!last1d) {
        ## Trim turns
        n <- length(path$turns)
        last1d.turn.out <- path$turns[n] # get turn out of last 1d plot
        turns <- path$turns[-n] # trim

        ## Trim occupancy matrix
        occupancy <- path$occupancy
        rm <- positions[n,] # position to be removed (= replaced by 0)
        occupancy[rm[1], rm[2]] <- "" # remove position
        switch(last1d.turn.out,
        "l" = { # check whether we can trim first column
            if(all(occupancy[,1] == "")) {
                occupancy <- occupancy[,-1, drop = FALSE] # trim
                path$positions[,2] <- path$positions[,2] - 1 # shift all positions
            }
        },
        "r" = { # check whether we can trim last column
            jj <- ncol(occupancy)
            if(all(occupancy[,jj] == ""))
                occupancy <- occupancy[,-jj, drop = FALSE] # trim; no shift in positions necessary!
        },
        "d" = { # check whether we can trim last row
            ii <- nrow(occupancy)
            if(all(occupancy[ii,] == ""))
                occupancy <- occupancy[-ii,, drop = FALSE] # trim; no shift in positions necessary!
        },
        "u" = { # check whether we can trim first row
            if(all(occupancy[1,] == "")) {
                occupancy <- occupancy[-1,, drop = FALSE] # trim
                path$positions[,1] <- path$positions[,1] - 1 # shift all positions
            }
        }, stop("Wrong 'last1d.turn.out'."))

        ## Trim positions
        positions <- path$positions[-n,, drop = FALSE] # trim

        ## Define (trimmed) path
        path <- list(turns = turns, positions = positions, occupancy = occupancy)
    }

    ## Return the path
    path
}

Try the zenplots package in your browser

Any scripts or data that you put into this service are public.

zenplots documentation built on Nov. 8, 2023, 1:10 a.m.