如何通过R中的少量旋转位图

Question

The Question:

This is in relation to the MNIST presentation of image data. I would like to do fine rotations of the images. The set of all images is represented as a data.frame where each row (each image) is a 785 character vector; the first character is the value of the digit; the remaining 784 are a flattened 28x28 pixel matrix.

I would like to efficiently rotate the 784 characters to generate a number of additional rotated images; ie I would like to engineer some new data!

I have already done this with the following code, but what I would like to do now is make it more efficient. It currently takes hours to run on 42,000 images, using 6 threads on a 2.7GHz i7 machine.

####################################################################################################
# rotateImage() -- generates new images rotated from -angleDegree tp +angleDegree
#                  images will be returned as a data.frame
####################################################################################################
xOffset = 14
yOffset = 14
rotateImage <- function(imgData,angleDegree) {
  for (t in -angleDegree:angleDegree) {
    newImgData <- t(as.data.frame(rep(0,785)))
    newImgData[1,1]=imgData[1,1] # set the actual digit value to imgData value
    for (j in 1:28) {
      for (i in 1:28) {
        newI = round(xOffset + (((i-xOffset)*cos(t*pi/180)) + ((j-yOffset)*sin(t*pi/180))))
        newJ = round(yOffset + (((xOffset-i)*sin(t*pi/180)) + ((j-yOffset)*cos(t*pi/180))))
        if ((newI %in% 1:28) && (newJ %in% 1:28)) {
          newImgData[1,1 + newI + ((newJ-1)*28)] = imgData[1,1+i+((j-1)*28)]
        }
      }
    }
    if (exists("retImages")) {
      retImages <- rbind(retImages,newImgData)
    } else {
      retImages = newImgData
    }
  }
  retImages
}
####################################################################################################
# various globals
degreesToRotate = 5
# one sample image
sampleData = t(as.data.frame(c(8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,34,34,0,0,0,57,136,162,245,203,19,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,47,147,249,253,224,232,232,6,81,21,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3,91,254,253,242,128,17,97,240,149,254,115,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,57,253,254,151,38,0,0,47,253,253,228,40,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,13,221,254,160,0,0,0,0,164,254,228,102,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,47,253,253,9,0,0,17,130,251,223,73,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,47,253,253,17,0,19,199,254,223,42,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,13,186,253,235,101,199,253,195,40,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,17,210,255,254,254,228,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,254,253,253,211,17,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,11,149,254,215,232,253,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,125,253,228,15,107,253,184,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,106,254,228,0,0,17,235,229,15,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,130,243,164,15,0,0,13,222,241,19,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,119,254,206,9,0,0,0,141,253,142,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,17,234,228,40,0,0,0,102,240,219,25,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,141,254,102,0,0,0,128,245,188,25,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,207,168,0,9,89,172,254,160,21,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,207,169,83,174,242,230,80,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,140,253,228,143,38,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)))
# image rotated from -5 to 5 degrees:
rotations <- rotateImage(sampleData,degreesToRotate)
# plot the images to verify correctness
library(raster)
bw=grey.colors(2,start=0,end=1)
for (i in 1:nrow(rotations)) {
  pixData <- rotations[i,2:785]
  dim(pixData) <- c(28,28)
  image(pixData, col=bw)
}

Basically this starts with all pixels off (so sheering isn't a bother - I'm doing fine rotations, not 45 degree stuff), and in the two loops, any "on" pixels will be moved to their new locations for the rotated image. (This is, by the way, a simple way to do fine-angle image rotation in R, within the same "frame" of the original image.)

I would like to eliminate the i and j loops with some kind of fancy one-liner transformation that runs faster. Any tips along those lines, or other novel ideas, would be much appreciated.

A Solution:

One accepted answer (see @42- below), utilizes TsparseMatrix; and has been slightly modified into a function here:

####################################################################################################
xOffsetM = 13
yOffsetM = 13
rotateImageM <- function(imgData,angleDegree) {
  for (t in -angleDegree:angleDegree) {
    rotMat <- matrix( c( cos(t*pi/180), sin(t*pi/180), -sin(t*pi/180), cos(t*pi/180)), 2, 2)
    M <- as(matrix(imgData[,2:785], 28, 28), "TsparseMatrix")
    idxs <- round(cbind(M@i - xOffsetM, M@j - yOffsetM) %*%  rotMat)
    M@i <- as.integer(idxs[,1]+xOffsetM)  # back shift to right and ..
    M@j <- as.integer(idxs[,2]+yOffsetM)  # back "up"
    newImgData <- imgData
    newImgData[,2:785] <- t(as.data.frame(as.vector(M)))
    if (exists("retImages")) {
      retImages <- rbind(retImages,newImgData)
    } else {
      retImages <- newImgData
    }
  }
  retImages
}

For others curious about this same sort of question, you can probably see that the image dimensions (28x28) are arbitrary - specific to the examples I'm working on; and these also govern the choice of "offsets" as either 14 or 13 in the solutions. Therefore this should be easily extended to images of any size.

At the end of the day...

The proposed solutions all work, but for a large number of images were still a bit slow or memory inefficient. I ended up writing a simple app in VB.Net (which I know well, no other reason for that vs. anything else), and it processed 42,000 images coming in, generating 11 times that going out based on 10 rotations using the original rotateImage approach... aand it finished in under 6 minutes, including all the reading/writing to a non-SSD disk. I'm still not sure why I couldn't get R to flip through everything with roughly that same efficiency.

Answer 1

This demonstrates a strategy of working on the sparseMatrix representation:

M <-  as( matrix( sampleData[-1], 28), "TsparseMatrix")
 idxs <- floor( cbind( M@i-13, M@j-13) %*%   
      # This implicitly shifts the rows down and columns left by 14 since sparse i-j's are 0-based
             matrix( c(cos(5*2*pi/360), sin(5*2*pi/360), 
                       -sin(15*2*pi/360), cos(5*2*pi/360)), 2,2) ) # 5 degrees
 M@i <- as.integer( idxs[,1]+14)  # back shift to right and ..
 M@j=as.integer( idxs[,2]+14)     # back "up"
 image( matrix(sampleData[-1], 28) )

 image( as.matrix(M) )

Answer 2

A different approach would be to use the functionality provided by the Bioconductor package EBImage , an image processing and analysis toolbox for R . To install the package use:

source("http://bioconductor.org/biocLite.R")
biocLite("EBImage")

You can then represent your image data as an Image object, and use the rotate function to transform it. This is illustrated by the following code.

If your original pixel data is stored in a data frame, you first need to convert it to an array-based format used by EBImage .

library("EBImage")

# sample data.frame containg 3 copies of sampleData
df = rbind(sampleData, sampleData, sampleData)

# convert rows to 28x28 matrices and combine them into a single image stack
img = combine(lapply(1:nrow(df), function(i) Image(df[i, -1], c(28, 28))))

# set frame names to digit values
dimnames(img) = list(NULL, NULL, df[, 1])

# img contains an array of 3 grayscale 28x28 frames 
img
## Image 
## colorMode    : Grayscale 
##   storage.mode : double 
##   dim          : 28 28 3 
##   frames.total : 3 
##   frames.render: 3 
##
## imageData(object)[1:5,1:6,1]
##      [,1] [,2] [,3] [,4] [,5] [,6]
## [1,]    0    0    0    0    0    0
## [2,]    0    0    0    0    0    0
## [3,]    0    0    0    0    0    0
## [4,]    0    0    0    0    0    0
## [5,]    0    0    0    0    0    0

# display the first frame
display(getFrame(img, 1)/255, method = "raster", interpolate = FALSE)

Note the scaling by 1/255, which is due to the fact that EBImage uses intensities in the [0:1] range to plot image data.

Once your data is in the correct format, all frames can be rotated at once with the function rotate .

# rotate of the whole image stack
imgr = rotate(img, angle = 5, output.dim = dim(img)[1:2])

display(getFrame(imgr, 1)/255, method = "raster", interpolate = FALSE)

To retain the original image dimensions we need to set output.dim , otherwise the resulting image would be expanded so that the rotated image fits into it.

The pixel array can be flattend back to a data.frame with the help of the function getFrames which returns a list of image frames. These can be expanded to vectors and combined row-wise. The original digit names are prepended as the first column of the resulting data frame.

dfr = as.data.frame(cbind(as.numeric(dimnames(imgr)[[3]]), 
                          do.call(rbind, lapply(getFrames(imgr), as.vector))))

The rotation is performed using the general affine transformation which is efficiently implemented in C. It uses bilinear filtering, which can be switched off by setting filter = "none" . According to my microbenchmark measurements, the rotate function is around 18x faster than the rotateImageM function (and 200x faster compared to your original rotateImage function).