Simulating CMYK mis-registration printing

I recently came across a poster advertising a children's production of Shakespeare's The Tempest where they purposely used an effect to mimic a mis-registration in CMYK printing. You have probably seen this before as a slight offset in one of the 4 colors (cyan, magenta, yellow, and black).
     The CMYK color model is "subtractive" in that you end up with a white color (when the paper color is white) when no colors are printed. The opposite is an "additive" color model, such as RGB (red, green, blue), which results in black when none of these three color channels are added. This is more typically used in imaging on lit screens (e.g. color creation in R using the rgb() function).
     I wanted to try simulating this type of mis-registration in R and came up with the following function. For images with white backgrounds, the "subtractive" shift will look best while an "additive" shift works best for black backgrounds. The results are essentially the same, but you can eliminate some color channel striping on the image borders by choosing one or the other.
     This is probably much easier to do in a photo editting program, but I had fun with it nonetheless. I used the excellent package biOps for some of its image reading and manipulation functions.

...the function

###band.shift.R
band.shift<-function(x, type="additive", r.shift=c(0.075,0.075), g.shift=c(0.05,0.05), b.shift=c(0.025,0.025)){
 require(biOps)
 x<-imagedata(x)
 d=dim(x)
 
 if(type=="subtractive"){x<-imgNegative(x)}
 
 x.r<-x[,,1]
 x.g<-x[,,2]
 x.b<-x[,,3]
 
 ######################
 #build red channel
 r.channel=matrix(0, d[1], d[2])
 take.put=rep(c(1, 1,  d[1], d[2]),2); dim(take.put)<-c(2,2,2)
 if(r.shift[1]>0){
  rows=round(d[1]*r.shift[1])
  take.put[1,,1]<-c(1,(d[1]-rows))
  take.put[1,,2]<-c((1+rows),d[1])
 }
 if(r.shift[1]<0){
  rows=round(d[1]*r.shift[1])
  take.put[1,,1]<-c((-rows+1),d[1])
  take.put[1,,2]<-c(1,(d[1]+rows))
 }
 if(r.shift[2]>0){
  cols=round(d[2]*r.shift[2])
  take.put[2,,1]<-c(1,(d[2]-cols))
  take.put[2,,2]<-c((1+cols),d[2])
 }
 if(r.shift[2]<0){
  cols=round(d[2]*r.shift[2])
  take.put[2,,1]<-c((-cols+1),d[2])
  take.put[2,,2]<-c(1,(d[2]+cols))
 }
 r.channel[(take.put[1,1,2]:take.put[1,2,2]),(take.put[2,1,2]:take.put[2,2,2])]=x.r[(take.put[1,1,1]:take.put[1,2,1]),(take.put[2,1,1]:take.put[2,2,1])]
 
 ######################
 #build green channel
 g.channel=matrix(0, d[1], d[2])
 take.put=rep(c(1, 1,  d[1], d[2]),2); dim(take.put)<-c(2,2,2)
 if(g.shift[1]>0){
  rows=round(d[1]*g.shift[1])
  take.put[1,,1]<-c(1,(d[1]-rows))
  take.put[1,,2]<-c((1+rows),d[1])
 }
 if(g.shift[1]<0){
  rows=round(d[1]*g.shift[1])
  take.put[1,,1]<-c((-rows+1),d[1])
  take.put[1,,2]<-c(1,(d[1]+rows))
 }
 if(g.shift[2]>0){
  cols=round(d[2]*g.shift[2])
  take.put[2,,1]<-c(1,(d[2]-cols))
  take.put[2,,2]<-c((1+cols),d[2])
 }
 if(g.shift[2]<0){
  cols=round(d[2]*g.shift[2])
  take.put[2,,1]<-c((-cols+1),d[2])
  take.put[2,,2]<-c(1,(d[2]+cols))
 }
 g.channel[(take.put[1,1,2]:take.put[1,2,2]),(take.put[2,1,2]:take.put[2,2,2])]=x.g[(take.put[1,1,1]:take.put[1,2,1]),(take.put[2,1,1]:take.put[2,2,1])]
 
 
 ######################
 #build blue channel
 b.channel=matrix(0, d[1], d[2])
 take.put=rep(c(1, 1,  d[1], d[2]),2); dim(take.put)<-c(2,2,2)
 if(b.shift[1]>0){
  rows=round(d[1]*b.shift[1])
  take.put[1,,1]<-c(1,(d[1]-rows))
  take.put[1,,2]<-c((1+rows),d[1])
 }
 if(b.shift[1]<0){
  rows=round(d[1]*b.shift[1])
  take.put[1,,1]<-c((-rows+1),d[1])
  take.put[1,,2]<-c(1,(d[1]+rows))
 }
 if(b.shift[2]>0){
  cols=round(d[2]*b.shift[2])
  take.put[2,,1]<-c(1,(d[2]-cols))
  take.put[2,,2]<-c((1+cols),d[2])
 }
 if(b.shift[2]<0){
  cols=round(d[2]*b.shift[2])
  take.put[2,,1]<-c((-cols+1),d[2])
  take.put[2,,2]<-c(1,(d[2]+cols))
 }
 b.channel[(take.put[1,1,2]:take.put[1,2,2]),(take.put[2,1,2]:take.put[2,2,2])]=x.b[(take.put[1,1,1]:take.put[1,2,1]),(take.put[2,1,1]:take.put[2,2,1])]
 
 
 
 result=0*x
 #build red channel
 result[,,1] <- r.channel
 
 #build green channel
 result[,,2] <- g.channel
 
 #build blue channel
 result[,,3] <- b.channel
 
 if(type=="subtractive"){result<-imgNegative(result)}
 
 result
}

Created by Pretty R at inside-R.org



...and an example of how the function was used to create the above image

require(biOps)
x <- readJpeg("rubber_duck.jpeg")
y <- band.shift(x, type="subtractive", r.shift=c(0.075,0.075), g.shift=c(0.05,0.05), b.shift=c(0.025,0.025))
jpeg("rubber_duck_band.shift.jpeg", quality=100)
plot(y)
dev.off()

Created by Pretty R at inside-R.org