2011年12月19日月曜日

Rで年賀状

R Advent Calendar の参加記事です。 季節ものということで、そろそろ年賀状の作成というプレッシャーに圧されている方もいらっしゃるかと思います。 でも、年賀状作成ソフトの使い方を覚えるのって面倒ですよね!いつも使い慣れているRで年賀状が作れたらいいな、、、という方への記事です。 まずは、来年は辰年ですから、龍のイラストを用意しちゃいましょう。Rで龍のアウトラインをプロットすればよさそうですが、丁度良いものがありました。 The stanford 3D scanning library , 3Dスキャナーで実際のオブジェをスキャンした結果の座標データを集めて公開しているものです。データフォーマットはPLY というもので、何かパッケージもあるかもしれませんが、非常に単純なテキストファイルなので、細かいことを気にしなければ, scan()関数 で読み込めました。 上記サイトの龍の写真のあたりから、dragon_recon.tar.gz をダウンロードし、解凍します。dragon_vrip_res2.plyというファイルから、座標データの行だけをgrepで抽出して、適当なファイルに格納します。
(以下はシェルコマンド。Macならそのまま動きますが、Windowsの人は何とかしてください。)
egrep '^[0-9.\-][0-9.\-]* [0-9.\-][0-9.\-]* [0-9.\-][0-9.\-]* $' dragon_vrip_res2.ply > ~/Desktop/test.txt
プロットするには、onionパッケージのp3d()関数を使うので、ここでonionパッケージをインストールしておいてください。その後、scan()で読み込んだ座標値をmatrix()で行列に変換したものが使用するデータとなります。これをp3d()関数で3次元プロットします。3Dモデルの回転には、ヘルプを見るとrotate()関数を使っている例がありますが、どういうパラメータを与えるとよいのか、なかなか難しくてわからなかったので、カメラ視点そのものをpersp()関数に渡される theta, phiの各パラメータで調整しています。
library(onion)
dragon <-matrix(scan(file="~/Desktop/test.txt"),ncol=3,byrow=T)
p3d(dragon,theta=3,phi=104,box=T)
これで出来たのが下図、ちゃんとドラゴンに見えますよね?
さて、次は、年賀状作成のハイライト、宛名印刷に入ります。郵便番号の記載など、mm単位での位置合わせが必要ですから、gridパッケージを使用してみましょう。 まず、出力はPDFファイルに出し。。。たかったんですが、R 2.14.0 on MacOS X では、PDFデバイスにUTF-8を出そうとすると、mbcsToSbcsが失敗して日本語がうまく出ない、という問題があるので、PNGファイルに出すことにします。ハガキサイズ(10cmx14.8cm)のPNGファイルを出力デバイスとして指定しますから、png()関数のunits引数に"cm"を指定して、res引数で解像度を150dpiぐらいにしておきましょう。日本語をうまく出すために(Mac限定ですが…)type="quartz"もしておきます。
png(width= 10, height= 14.8, units="cm", file="~/Desktop/Hagaki.png", res=150, type="quartz")
mm単位で位置指定ができるようにするために、用紙サイズと同サイズのビューポートを最上位に作成します。grid graphicsでは、unit関数を使うことでmmやcmなどの単位を座標指定に用いることができます。
library(grid)
vp_hagaki <- viewport(x=0, y=0, width=unit(10,"cm"), height=unit(14.8,"cm"), just = c("left","bottom"))
pushViewport(vp_hagaki)
次に、郵便番号用のビューポートを作成します。最も左側の枠の左端は、紙の右端から47.7+8mm左に行ったところ(参考:郵便番号・バーコードマニュアル)だそうです。下端は、紙の上端から12+8mm下に行ったところのようです。紙の右端はx座標で100mm, 紙の上端はy座標で148mmですから、最も左側の郵便番号枠の左下端の点と、用紙の右上端の点でつくられる長方形のビューポートを作成してみましょう。
vp_yubinnum <- viewport(unit(100-47.7-8,"mm"),unit(148-12-8,"mm"),width=unit(47.7+8.0,"mm"),height=unit(12.0+8.0,"mm"),just=c("left","bottom"))
少々面倒ですが、このビューポートを作っておけば、郵便番号の赤色の枠を書くのは非常に楽にできます。 さらに、住所表記用のビューポートと、宛名用のビューポートを作っておきましょう。こちらはとくに規定はないので、フィーリングで決めてみました。
vp_address <- viewport(unit(75,"mm"), unit(74, "mm"), just="centre", width=unit(3, "cm"), height=unit(7, "cm"))
vp_name <- viewport(unit(50,"mm"), unit(74, "mm"), just="centre", width=unit(2, "cm"), height=unit(6, "cm"))
さて、これでビューポートがすべて出そろったので、最初のハガキビューポートの下に郵便番号と名前と住所のビューポートが入る、というツリー構造を定義して、pushViewport()関数で一気にグラフィックデバイスに送ります。
vpTree(vp_hagaki, vpList(vp_name,vp_address, vp_yubinnum))
pushViewport(vp_hagaki)
ここからは実際の描画です。まず郵便番号の枠を赤色で書きましょう。
grid.rect(unit(c(21.6,28.4,35.2,42.0),"mm"),0,unit(5.7,"mm"),unit(8,"mm"),gp=gpar(col="red"),vp=vp_yubinnum,just=c("left","bottom"))
grid.rect(unit(c(0,7,14),"mm"),0,unit(5.7,"mm"),unit(8,"mm"),gp=gpar(col="red"),vp=vp_yubinnum,just=c("left","bottom"))
ビューポート内の座標系を用いて座標を指定できるので、y座標指定はすべてゼロになっていますね。 次は文字を書くところですが、位置合わせが面倒なので関数を作ってしまいます。関数定義はのちほど。yubinnum()とatenagaki()という2つの関数を使っています。PNGデバイスで日本語をうまく出すために、quartzFonts()関数でフォントファミリー"HKaku"を定義しています(Mac限定)。
yubinnum("3058575",vp_yubinnum)
quartzFonts(HKaku=quartzFont(rep("HiraKakuPro-W3", 4))) 
atenagaki("つくば市天王台1の1の1",vp_address,font=gpar(fontsize=16,fontfamily="HKaku"))
atenagaki("筑波大学 御中",vp_name,font=gpar(fontsize=16,fontfamily="HKaku"))
以上で完了です。dev.off()すれば、宛名が書けています。
dev.off()
仕上がりはこんな感じ。
さきほど使った2つの関数の定義はこんな感じです。
atenagaki <- function(str, viewport, font=gpar(fontsize=16)) {
 yunit<- 1/(nchar(str)+1)
 yseq<-1-seq(yunit, 1.0, yunit)[1:nchar(str)]
 grid.text(strsplit(str,"")[[1]],x=0.5,y=yseq,rot=0,gp=font,vp=viewport)
}

yubinnum <- function(numstr,viewport, font=gpar(fontsize=12)) {
 xl <- c(rep(5.7/2,3)+(0:2)*7.0 , rep(21.6+5.7/2,4)+(0:3)*6.8)
 grid.text(strsplit(numstr,"")[[1]],x=unit(xl,"mm"), y=unit(4.0,"mm"), gp=font, vp=viewport) 
}
gridを使っているのでしくみは単純で、atenagaki関数は与えられた文字列をビューポート内に均等割付をしています。gridグラフィックスは、幅全体を1.0とした相対位置指定ができるので、それを使っています。座標指定にunit関数を使用しないデフォルト状態では、この相対位置指定になります。 yubinnum関数は、正確な位置に書くためにmm単位で座標指定をしています。xl変数に何か複雑な数値を入れているように見えますが、単に各郵便番号文字の中心点のx座標として来るべき場所を入れているだけですね。 まだ、差出人住所欄がないじゃないか!とか、「迎春」とかも入れたい、とか、「年賀」スタンプが宛名面にない、とか、やっぱりお年玉付き年賀はがきにしたい、とか、いろいろツッコミどころがあると思いますが、とりあえず「Rで年賀状」も現実的ですよ、というお話でした。

0 件のコメント:

コメントを投稿