R/pixelShift.r

In jmt2080ad/pixelShift:

##' Functions for shifting pixels
##'
##' These functions are intended to shift pixels by row in sets by a certian pixel count. The pixels that fall out side are added back to head or tail of the rows that they orginated from. If pixels shift off the tail, they are added to the head and if pixel fall off the tail they are added back to the head.
##' @title Pixel Shifter
##' @param rowS A starting row to shift pixels
##' @param rowE An ending row to shift pixels. Start and end are a band of pixels that shift together
##' @param rowMove The amound to shift the pixels.
##' @param pm A matrix of pixels vales from a single band of and image.
##' @return A band of pixels defined by rowS and rowE.
##' @author jmt2080ad
rowShift <- function(rowS, rowE, rowMove, pm){
    if(rowMove == 0) return(pm[rowS:rowE,])
    np <- nrow(pic)
    if(rowMove >= 0){
        remain <- pm[rowS:rowE, (np - rowMove + 1):np]
        after  <- pm[rowS:rowE, 1:(np - rowMove)]
        return(cbind(remain, after))
    }
    rowMove <- abs(rowMove)
    remain  <- pm[rowS:rowE, 1:rowMove]
    after   <- pm[rowS:rowE, (rowMove + 1):np]
    return(cbind(after, remain))
}

##' A calling function that maps row indices and pixel movement to rowShift().
##'
##' This function takes a qRows data.frame type object and a matrix of pixel values to shift and mapplys the qRows data.frame object on the pixel matrix with rowShift. It rbinds the results of rowShift and output a complete matrix of pixels.
##' @title rowShiftBind
##' @param pm A matrix of pixel values
##' @param qRows A data.frame of rowS, rowE, and rowMove.
##' @return A matrix of pixel values
##' @author jmt2080ad
rowShiftBind <- function(pm, qRows){
    do.call(rbind, mapply(rowShift,
                          qRows$rowS,
                          qRows$rowE,
                          qRows$rowMove,
                          MoreArgs = list(pm),
                          SIMPLIFY = F))
}

##' A function for shifting rows of pixels in an image.
##'
##' This function takes a series of pixels row start and end pixels and shifts those defined rows by a vector of a given number of pixels. 
##' @title pixelShift
##' @param pic An input image object from `imager::load.image()`.
##' @param outputPicPath A path to output a single image that has been shifted.
##' @param rowS A vector of row start pixels to shift the image at.
##' @param rowE A vector of row end pixels that correspond to the `rowS` argument.
##' @param rowMove A vector of pixel to shift each rowS/rowE combination.
##' @return Will write out a new image to the file system or plot depending if outputPixPath is NA or not.
##' @author jmt2080ad
##' @export
pixelShift <- function(pic, outputPicPath=NA, rowS, rowE, rowMove){
    qRows <- data.frame(rowS=rowS, rowE=rowE, rowMove=rowMove)
    picX <- lapply(channels(pic), function(pm) t(as.matrix(pm)))
    picX <- lapply(picX, rowShiftBind, qRows = qRows)
    col <- rgb(picX[[1]], picX[[2]], picX[[3]])
    dim(col) <- dim(picX[[1]])
    if(!is.na(outputPicPath)) jpeg(outputPicPath,
                                   width = dim(pic)[1],
                                   height = dim(pic)[2])
    grid.raster(col, interpolate=FALSE)
    if(!is.na(outputPicPath)) dev.off()
}