Premise
I was recently asked to print out a fabric pattern that could be used to cover a sphere, about the size of a ping pong ball, for the purposes of re-creating a favorite cat toy (quite important). Thinking this over, I realized that this was basically a map projection problem-- and could probably be solved by scaling an interrupted sinusoidal projection to match the geometry of a ping pong ball. Below are some R functions, and examples of how this endeavor evolved. Thanks to Greg Snow for this helpful post on the R-mailing list, describing how to preserve linear measurement when composing a figure in R. So far the pattern doesn't quite fit.
Update
It looks like it was not the printer's fault-- I had used the wrong radius for a ping pong ball: 16mm instead of 19mm or 20mm (there are 38mm and 40mm diameter ping pong balls). Updated files are attached.
Figure: Sinusoidal Projection
Function Defs
# scale to C of ping pong ball:# r = 16mm# C = 2 * pi * 19 = 119.3805 mm (for a 38mm diameter ball)# A = 4 * pi * r^2 = 4536.46 sq. mm# n: number of slices# circ: target circumference# d: number of degrees per incrementsphere.slice <- function(n=4, circ, d=10){# define sinusoidal projection function, fully vectorized# http://en.wikipedia.org/wiki/Sinusoidal_projectionf <- function(lon, lat, lon_0=0, x_0=0){x <- x_0 + ( (lon - lon_0) * cos((lat*pi/180)) )y <- latd <- data.frame(x, y)return(d)}# temp lists used to store intermediate resultsl <- list()l.sin <- list()# sequences that define longitudinal slices:# slice edgess <- seq(from=-180, to=180, by=360/n)# slice centerss_lon_0 <- seq(from=-180, to=180, by=360/n) + (360/n)/2# slice false eastingss_x_0 <- seq(from=0, to=360, by=360/n)# generate slicesfor(i in 1:n){l[[i]] <- rbind(data.frame(lon=s[i], lat=seq(-90, 90, by=d)), data.frame(lon=s[i+1], lat=seq(90, -90, by=-d)))}# project slicesfor(i in 1:n){l.sin[[i]] <- data.frame(f(l[[i]]$lon, l[[i]]$lat, lon_0=s_lon_0[i], x_0=s_x_0[i]), lon_0=s_lon_0[i])}# combine into DFg <- ldply(l.sin)# scale to user-supplied circumferenceg.scaled <- with(g, data.frame(x=x * circ/360, y=y * circ/360, lon_0=lon_0))# done!return(g.scaled)}
Try With Ping Pong Ball Geometry
# need theselibrary(lattice)library(plyr)library(sp)# try it outg.scaled <- sphere.slice(n=4, circ=2*pi*19, d=5)#check visually: aspect is scaled properlyxyplot(y ~ x, data=g.scaled, groups=lon_0, pch=4, cex=0.5, aspect='iso', type=c('p','g'))## check circ: OKsum(abs(range(g.scaled$x)))sum(abs(range(g.scaled$y))) * 2# check area, by converting to polygonsp.list <- by(g.scaled, g.scaled$lon_0, function(p) {Polygon(round(p[,1:2], 4))})# compute total area of leavessum(sapply(p.list, function(i) i@area))# this is only 3 sq.mm off4533.58
Generate PDF Output at 1:1 Scale
## plot at 1:1 resolution for printing# http://n4.nabble.com/plot-scale-td906260.html#a906260# convert to inchesg.scaled.in <- with(g.scaled, data.frame(x=x * 0.03937008, y=y * 0.03937008, lon_0=lon_0))dev.new()tmp <- par('plt')scale <- 1dx <- diff(range(g.scaled.in$x))*1.08wx <- grconvertX(dx/scale, from='inches', to='ndc')dy <- diff(range(g.scaled.in$y))*1.08wy <- grconvertY(dy/scale, from='inches', to='ndc')par(plt = c(tmp[1], tmp[1]+wx, tmp[3], tmp[3]+wy) )# setup plot, but don't actually plot anythingplot(g.scaled.in$x,g.scaled.in$y, type='n')# add a gridgrid()# add each slice, as linesby(g.scaled.in, g.scaled.in$lon_0, function(i){lines(i$x, i$y)})
Attachment: sphere.pdf
