Javaで暗号化したデータをPerlで復号化しようとしたら大変だった件
JavaでRijndael(AES)で暗号化されたデータをPerlで復号化しようと思います。
「暗号方式と秘密鍵だけ聞いておけば簡単にデコードできるっしょ、余裕っしょ」とタカをくくっていたら、思いっきり天罰がくだりました。久しぶりにハマったのであります。
ちゃんと確認しておくべきだった情報
まずは暗号方式と秘密鍵だけでなく、以下の情報をしっかりと確認しておく必要アリでした。
暗号のことちゃんと勉強した事がないので、なんだかよくわからんけど、必要らしい。
せめて事前にここらへんを読んで勉強しておけばよかった。
ぱせらんメモ
http://d.hatena.ne.jp/pasela/20100612/crypto
DESに代わる次世代暗号「AES」の最終候補が「Rijndael」に決定
http://itpro.nikkeibp.co.jp/members/ITPro/ITARTICLE/20001003/1/
ブロック暗号化モード
http://www.triplefalcon.com/Lexicon/Encryption-Block-Mode-1.htm
今回はこれらの情報を全然把握せず、よその開発チームからJavaのソースコード（ドキュメントなし）と断片的な情報（「暗号鍵はたぶんこれ」といった感じの不確かな情報）だけを入手して、「まぁ適当に復号化できるだろう」とナメた態度で臨んだら、思いのほかハマってしまったわけです。
結局、いろいろ調べるのにJavaのソースを読んだり書いたりして、えらい手間がかかりました。。。
Javaで暗号化
Javaでの暗号化／復号化の簡単なサンプルです。
条件は以下のとおり。
- 暗号アルゴリズム => AES（Rijndael）
- 秘密鍵 => 0123456789ABCDEF
- 秘密鍵の長さ => 128bit
- ブロック暗号化モード => CBC
- IV => 0000000000000000
- padding方式 => PKCS5Padding
「Hello World!」という文字列を暗号化してみます。
以下おソースです。
import java.security.*; import javax.crypto.*; import javax.crypto.spec.IvParameterSpec; import javax.crypto.spec.SecretKeySpec; public class Encrypt { public static void main(String[] args) { try { // 元データはHello World! String plainText = "Hello World!"; System.out.println( "PLAIN TEXT: " + plainText ); // 秘密鍵とIV byte[] key = "0123456789ABCDEF".getBytes(); byte[] iv = "0000000000000000".getBytes(); SecretKey cipherKey = new SecretKeySpec(key, "AES"); IvParameterSpec ivSpec = new IvParameterSpec(iv); // 条件を指定してCipherを暗号モードで初期化 Cipher cipher = Cipher.getInstance("AES/CBC/PKCS5Padding"); cipher.init(Cipher.ENCRYPT_MODE, cipherKey, ivSpec); // 暗号化してみる。結果のバイト配列を16進文字列で表示 byte[] cipherText = cipher.doFinal(plainText.getBytes()); System.out.println( "ENCRYPTED : " + asHex(cipherText) ); // 今度は複合化。 cipher.init(Cipher.DECRYPT_MODE, cipherKey, ivSpec); byte[] output = cipher.doFinal(cipherText); System.out.println("DECRYPTED : " + new String(output)); } catch(Exception e) { e.printStackTrace(); } } // byte配列を16進で返す関数。 private static String asHex(byte bytes[]) { StringBuffer strbuf = new StringBuffer(bytes.length * 2); for (int index = 0; index < bytes.length; index++) { int bt = bytes[index] & 0xff; if (bt < 0x10) { strbuf.append("0"); } strbuf.append(Integer.toHexString(bt)); } return strbuf.toString(); } }
実行すると以下のようになります。
PLAIN TEXT: Hello World!
ENCRYPTED : d481e7bc55b0ef8b74221d497d6bc259
DECRYPTED : Hello World!
「Hello World!」という文字列を暗号化して16進にした文字が「d481e7bc55b0ef8b74221d497d6bc259」として取得できました。
そいつをさらに復号すると元の「Hello World!」になるのも確認できました。
Perlで復号化
さて、こいつをPerlで復号化します。Crypt::CBCを使います。
use strict; use warnings; use Crypt::CBC; # Javaで暗号化した文字列 my $encrypted = "d481e7bc55b0ef8b74221d497d6bc259"; # Crypt::CBCのコンストラクタ。パラメータが重要。 my $cipher = Crypt::CBC->new( -key => '0123456789ABCDEF', -keysize => 16, -literal_key => 1, -cipher => "Crypt::Rijndael", -iv => '0000000000000000', -header => 'none', ); # 16進文字列をバイトに変換 $encrypted = pack( "H*", $encrypted ); # 復号化して表示 my $decrypted = $cipher->decrypt($encrypted); print "decrypted: ", $decrypted, "\n";
このスクリプトによってPerl側で「Hello World!」と復元できました。それにしてもここに至るまで長かった。。。
Crypt::CBCのコンストラクタに渡す全てのパラメータが重要で、少しでも組み合わせが違うとまともにデコードできません。
さらに言うとこの中で「-literarl_key => 1」がかなり盲点です。
当初このパラメータの存在に気づかずだいぶ悩んでいたら、ようやくこんな書き込みを発見。
Java Solution会議室 > perl java暗号化復号化ロジックに関して
http://ap.atmarkit.co.jp/bbs/core/fjava/22485
言い忘れましたが、javaで暗号化しても、perlで暗号化しても、こちらでは同じ暗号文が出力されました。ただしliteral_key => trueを指定した場合です。
これを指定しないと、Crypt::CBCのほうは、デフォルトでは指定したキーをパスワードとみなし、
その文字列を複数回ハッシュした結果からキーを生成するようです（標準的なPBEではなく、おそらく独自方式ではないかと思います）。
OH! そんなの知らないってば。
これがわかるまで１日かかってしまったあるyo！
遺伝的アルゴリズムを楽しく理解できるサイトをまとめてみた
女優の菊川怜さんが学生時代に研究テーマにしていたという事で有名な「遺伝的アルゴリズム」ですが、名前の仰々しさとは裏腹に、意外と直感的に理解できる取っ付きやすいアルゴリズムだったりします。
それにしても菊川怜さん、美人ですねー。こんな先生にイロイロと教えてもらいたかったなぁ。。。
という願望はおいといて、「遺伝的アルゴリズム」を目で見て＆手で触って、直感的に「理解したつもり」になれそうなサイトをまとめてみました！
学術的なことはガン無視でいきます。
動画で見て雰囲気を知る
まずは動画で見て楽しみましょう。ニコ動から何本か動画を紹介します。
【人工知能】物理エンジンで人工生命つくって学習させた
http://www.nicovideo.jp/watch/sm6392515
いきなりですが、強烈なインパクトをはなつ動画です。
人工生命がうにょうにょ動きながら、勝手に「歩き方」を学んでいきます。超キモイですが、スゴイ作品だと思います。物理エンジンと遺伝的アルゴリズムを駆使してるらしいです。
これも同じ作者の人のものなのかな？ちょっと定かではありませんが、人工生命を育成するゲームのようなシミュレータです。
ちなみに、だいぶ脱線になりますが、ニコニコ動画で「anlife」で検索すると、人工生命が増殖する動画がたくさん出てきます。尺の長い動画ですが、我慢して見ていくと、2分30秒過ぎあたりから人口爆発的に増殖していって、寒気がするほど気持ち悪いです。
次もニコ動から。
ミクが出てこないと何も理解できない、という人にはおすすめ。
【MMD】遺伝的アルゴリズムをやってみた
http://www.nicovideo.jp/watch/sm10944345
一応、局所最適解のこととか説明していて、それなりにしっかりした内容かと思います。
デモを触って雰囲気で知る
続いて、実際のデモプログラムなどを見たり触ったりして雰囲気をつかめるサイトを紹介します。
遺伝的アルゴリズムで進化していく車
http://www.wreck.devisland.net/ga/
ここで紹介されてた→ http://sasapong.s41.xrea.com/diary/archives/003503.php
海外ネタですが、車がどんどん進化してでこぼこ道を走れるように進化していくデモです。
赤い車輪を地面に接触させないで進んでいけるようになることが目的のようです。
4つの車輪の大きさ，初期位置，8つのバネの長さとバネ定数，ダンピング係数といったパラメータを変えていくようです。
最初のうちは全くのダメダメくんですが、しばらく我慢してみていてると結構走れるようになってきます。やや面白いです。
Image evolution
http://alteredqualia.com/visualization/evolve/
http://rogeralsing.com/2008/12/07/genetic-programming-evolution-of-mona-lisa/
ここで紹介されてた→ http://sasapong.s41.xrea.com/diary/archives/003503.php
こちらも海外ネタです。
ランダムにポリゴンを配置していって、徐々に進化を重ねて、モナリザの顔に近づいていきます。
実際にデモプログラムを動かすと長時間かかりますが、これはちょっとスゴイかも。。。
続いて３本、国内のデモアプリを紹介。大学の教材的なものもあるので、基本からちゃんと勉強したい人にはオススメです。
Web教材 Chapter.1 遺伝的アルゴリズム
http://carnation.is.konan-u.ac.jp/xoops/CJcontents/chapter01/chapter1.html
甲南大学の研究室のサイト。
全体的に丁寧に解説された教材ですが、特にページの下部にある「GAシミュレータ」が、きれいでわかりやすい。パラメータを色々いじって何度か試してみてください。
遺伝的アルゴリズム
http://www.sist.ac.jp/~suganuma/kougi/other_lecture/SE/opt/GA/GA.htm
静岡理工科大学 の研究室のサイトです。いかにも大学のサイトって感じですが、
ページの真ん中らへんにjava appletによるデモがあります。あまり面白くはありませんが、遺伝アルゴリズムの仕組みを実感的に理解するにはとてもよいデモかと思います。
遺伝的アルゴリズムを用いたTSPデモ
http://orfeon.blog80.fc2.com/blog-entry-68.html
巡回セールスマン問題というやつです。
適当に配置された複数の点を、どういう順番で回ったら一番効率的に巡回できるか、というのを解く問題です。flashで実際に操作できるので一度やってみるとよくわかります。
実ビジネスでの利用事例
ちょっと嗜好を変えて、ネット広告での活用事例の紹介です。
http://www.mm-lab.jp/news/110/
広告文の最適化 〜リスティング広告のタイトル＆説明文が自動進化
ADエビスで有名なロックオンのサイトから。
Googleリスティング広告の広告文を題材に、どのクリエイティブが最も効果が高くなるかシミュレーション的にわかるエクセルファイルがダウンロードできます。エクセルで触れるってところが、なんとなくうれしいですね。
これもネット広告で実際に遺伝アルゴリズムを使っている実例になります。
最近話題の「クリエイティブ最適化」を商用化したサービスです。
自動的に生成した複数の広告バナーのうち、徐々にクリック率の高かったものが生き残っていき、最終的にはCTRが何倍にもなるよ、という仕組みです。興味深いシステムですね。
読み物の紹介
新型新幹線「N700系」の“顔”を生んだ「遺伝的アルゴリズム」の秘密【その１】
http://trendy.nikkeibp.co.jp/article/column/20070620/1001047/
新幹線のデザインにも遺伝アルゴリズムが使われたよ、というお話。
自分は鉄っちゃんではないので、ふーんとしか思いませんでしたが、その筋の人にはどうなんでしょう？垂涎ものなんでしょうか？ちなみにこのデザイン変更で東京〜新大阪間の所要時間を５分短縮したとか。へぇー。
ほぼ日刊イトイ新聞 - がんばれ森川くんの遺伝子くん
http://www.1101.com/morikawa/index_AI.html
最後におまけ。昔から人気のある有名サイトですね。
遺伝アルゴリズムのことだけなく、人工知能のこと全般をわかりやすく面白く紹介したコンテンツです。
全くの初学者の人でも安心してよめるわかりやすい記事なので、AIに興味はあるけど、どこから入ったらいいかわからない、という人に超オススメです。
以上、遺伝的アルゴリズムとそれに関係ありそうな面白サイトを紹介してみました。
表面を撫でただけの記事になってしまいましたが、まずは興味を持ってもらえればいいかなーと思ってます。
perlでテトリス！
偶然おもしろいモノを発見しました。コンソールで遊べるperlテトリスです。
スクリーンショットとってみました。
なんと、macbookのターミナル上でカラフルなテトリスが元気よく動いてます！
それにしても、俺テトリス下手だな。。。
ってのはおいといて、ソースを見てみましょう。難読化されてます。
#!/usr/bin/perl $_='A=15; B=30; select(stdin); $|=1; select(stdout);$|=1; system "stty -echo -icanon eol \001"; for C(split(/\s/,"010.010.010.010 77.77 022.020.020 330.030.030 440.044.000 055.550.000 666.060.". "000")){D=0;for E(split(/\./,C)){F=0;for G(split("",E)){C[P][F++ ][D]=G} D++}J[P]=F; I[P++] =D}%L=split(/ /,"m _".chr(72)." c 2". chr(74)." a _m");sub a{for K(split(/ /,shift)){(K,L)=split(/=/,K );K=L{K};K=~s/_/L/; printf "%c[K",27}}sub u{a("a=40");for D(0..B -1){for F(0..A-1){M=G[F][D];if(R[F][D]!=M) {R[F][D]=M;a("m"."=". (5+D).";".(F*2+5)); a("a=".(40+M).";" .(30+M));print " "x2}}}a( "m=0;0 a=37;40")}sub r{(N)=@_;while(N--) {Q=W;W=O=H;H=Q;for F( 0 ..Q-1){for D(0..O-1) {Q[F][D]=K[F][D]}}for F(0..O-1){for D(0..Q- 1){K[F][D]= Q[Q-D-1][F]}}}}sub l{for F(0..W-1){for D(0..H-1){(K[ F][D]&& ((G[X+F][Y+D])|| (X+F<0)||(X+F>=A)|| (Y+D>=B)))&& return 0}}1}sub p{for F(0..W-1){for D(0..H-1){(K[F][D]>0)&&(G[X+F][Y+D] =K[F][D]) }}1}sub o{for F(0..W-1){for D(0..H-1){(K[F][D]>0)&&(G[ X+F][ Y+D]=0)}}}sub n{C=int(rand(P)) ;W=J[C];H=I[C];X=int(A/2)-1 ;Y=0;for F(0..W-1){for D(0..H-1){K[F][D]= C[C][F][D]}}r(int(rand (4)));l&&p}sub c{d:for(D=B;D>=0;D--){for F(0..A-1){G[F][D]||next d}for(D2=D;D2>=0; D2--){for F(0..A-1){G[F][D2]= (D2>1)?G[F][D2-1 ]:0; }}u;}}a ("m=0;0 a=0;37;40 c");print "\n\n".4x" "." "x(A-4). "perltris\n".(" "x4)."--"xA."\n".((" "x3)."|"." "x(A*2)."|\n")xB .(" "x4). "--"xA."\n";n;for(;;) {u;R=chr(1); (S,T)=select(R,U,V, 0.01);if(S) {Z=getc;}else {if($e++>20){Z=" ";$e=0;}else{next;} } if(Z eq "k"){o;r(1);l||r(3);p}; if(Z eq "j"){o;X--;l||X++;p}; if (Z eq "l"){o;X++;l||X--;p};if(Z eq " "){o;Y++;(E=l)||Y--;p;E|| c |c|c|c|c|n||goto g;};if(Z eq "q"){last;}}g: a("a=0 m=".(B+8).";0 " ); system "stty sane"; '; s/([A-Z])/\$$1/g; s/\%\$/\%/g; eval;
きゃー 変態！
と叫びたくなりますね。
でもぐっとこらえて、こいつをコピペしてlinuxの上で走らせてみてください。
どうですか？テトリスできましたか！？
ちなみに操作はj,kで左右移動、lでアイテムを回転。それだけです。
ちょっと整形してみる
さて、この難読コード、ちょっと面白そうだから、分解＆整形してみます。
最後のevalの部分をprint $_に変更して実行結果をファイルに出力。それでもってperltidyで整形。
・・・なんと、整形してもなお十分に意味不明なコードでした。読み下すにはだいぶ根性が必要です。
$A = 15; $B = 30; select(stdin); $| = 1; select(stdout); $| = 1; system "stty -echo -icanon eol \001"; for $C ( split( /\s/, "010.010.010.010 77.77 022.020.020 330.030.030 440.044.000 055.550.000 666.060." . "000" ) ) { $D = 0; for $E ( split( /\./, $C ) ) { $F = 0; for $G ( split( "", $E ) ) { $C[$P][ $F++ ][$D] = $G; } $D++; } $J[$P] = $F; $I[ $P++ ] = $D; } %L = split( / /, "m _" . chr(72) . " c 2" . chr(74) . " a _m" ); sub a { for $K ( split( / /, shift ) ) { ( $K, $L ) = split( /=/, $K ); $K = $L{$K}; $K =~ s/_/$L/; printf "%c[$K", 27; } } sub u { a("a=40"); for $D ( 0 .. $B - 1 ) { for $F ( 0 .. $A - 1 ) { $M = $G[$F][$D]; if ( $R[$F][$D] != $M ) { $R[$F][$D] = $M; a( "m" . "=" . ( 5 + $D ) . ";" . ( $F * 2 + 5 ) ); a( "a=" . ( 40 + $M ) . ";" . ( 30 + $M ) ); print " " x 2; } } } a("m=0;0 a=37;40"); } sub r { ($N) = @_; while ( $N-- ) { $Q = $W; $W = $O = $H; $H = $Q; for $F ( 0 .. $Q - 1 ) { for $D ( 0 .. $O - 1 ) { $Q[$F][$D] = $K[$F][$D] } } for $F ( 0 .. $O - 1 ) { for $D ( 0 .. $Q - 1 ) { $K[$F][$D] = $Q[ $Q - $D - 1 ][$F] } } } } sub l { for $F ( 0 .. $W - 1 ) { for $D ( 0 .. $H - 1 ) { ( $K[$F][$D] && ( ( $G[ $X + $F ][ $Y + $D ] ) || ( $X + $F < 0 ) || ( $X + $F >= $A ) || ( $Y + $D >= $B ) ) ) && return 0; } } 1; } sub p { for $F ( 0 .. $W - 1 ) { for $D ( 0 .. $H - 1 ) { ( $K[$F][$D] > 0 ) && ( $G[ $X + $F ][ $Y + $D ] = $K[$F][$D] ); } } 1; } sub o { for $F ( 0 .. $W - 1 ) { for $D ( 0 .. $H - 1 ) { ( $K[$F][$D] > 0 ) && ( $G[ $X + $F ][ $Y + $D ] = 0 ); } } } sub n { $C = int( rand($P) ); $W = $J[$C]; $H = $I[$C]; $X = int( $A / 2 ) - 1; $Y = 0; for $F ( 0 .. $W - 1 ) { for $D ( 0 .. $H - 1 ) { $K[$F][$D] = $C[$C][$F][$D] } } r( int( rand(4) ) ); l && p; } sub c { d: for ( $D = $B; $D >= 0; $D-- ) { for $F ( 0 .. $A - 1 ) { $G[$F][$D] || next d; } for ( $D2 = $D; $D2 >= 0; $D2-- ) { for $F ( 0 .. $A - 1 ) { $G[$F][$D2] = ( $D2 > 1 ) ? $G[$F][ $D2 - 1 ] : 0; } } u; } } a("m=0;0 a=0;37;40 c"); print "\n\n" . 4 x " " . " " x ( $A - 4 ) . "perltris\n" . ( " " x 4 ) . "--" x $A . "\n" . ( ( " " x 3 ) . "|" . " " x ( $A * 2 ) . "|\n" ) x $B . ( " " x 4 ) . "--" x $A . "\n"; n; for ( ;; ) { u; $R = chr(1); ( $S, $T ) = select( $R, $U, $V, 0.01 ); if ($S) { $Z = getc; } else { if ( $e++ > 20 ) { $Z = " "; $e = 0; } else { next; } } if ( $Z eq "k" ) { o; r(1); l || r(3); p } if ( $Z eq "j" ) { o; $X--; l || $X++; p } if ( $Z eq "l" ) { o; $X++; l || $X--; p } if ( $Z eq " " ) { o; $Y++; ( $E = l ) || $Y--; p; $E || c | c | c | c | c | n || goto g; } if ( $Z eq "q" ) { last; } } g: a( "a=0 m=" . ( $B + 8 ) . ";0 " ); system "stty sane";
やばいです。血圧があがりそう。
全面的にグローバル変数まみれ。変数名も故意にわかりづらくしてあります。
また時折まったく意味のない関数や変数がトラップのようにちりばめれていて、まさに難読コードここにありって感じです。
しかし頑張って読んでみると、なんとも味わい深いテクニックが何カ所か発見できます。
注目すべきテクニック
なんともレガシー感あふれるコードですが、以下のポイントが気になりました。
- sttyでコンソールの挙動変更
- printf("\e[0;0H");やprintf("\e[0;37;40m"); でカーソル操作や色設定
- 座標の回転
- selectを使ったループ内でのスピード制御
いいですねぇ。古き良き日の「スクリプト」って感じがします。
時間がある時にでもじっくり追ってみたいコードです。
ちなみに元ソースはココ↓
http://www.colinfahey.com/tetris/tetris_ja.html
テトリスのなにか。なんだかよくわからん。日本語が激しくでたらめ。たぶんまともな日本人には読めません。
なにはともあれ、コンソールの上でテトリスで遊べるようになってヨカッタです。
さぁ、仕事してるフリして Let'sテトリス！
１枚のスクリプトに全てをまとめてくれるApp::FatPacker
App::FatPackerとは、依存モジュールを全て１つのファイルに押し込んでパックしてくれるライブラリです。CPANにあります。
pack your dependencies onto your script file
http://search.cpan.org/~mstrout/App-FatPacker-0.009001/
依存モジュールを解決して１枚のスクリプトにまとめてくれるようです。
perl使いの間で大人気の「cpanm」でもこれが使われています。
どっかでcpanmの紹介として「１枚岩のスクリプト」みたいな表現を目にしましたが、要するにこれのことを指していたようです。
ちなみに作者はlocal::libの人。
「ファット」って響きが心に刺さりますが、id:miyagawaさんも使ってることだし、きっと良質モジュールなんだろうなーと思って触ってみました。
使ってみて
まずいきなりですが、SYNOPSISが間違えています。
fatpack tree fatlib `cat packlists`
と書いてあるところ、素直にそのまま実行するとエラーになります。
ソースをざっと見た感じ、第２引き数と第３引き数あたりが、とても怪しい感じ。
それからSYNOPSISで次の行に書いてある
(fatpack file; cat myscript.pl) >myscript.packed.pl
も、なんだか意味がわかりません。
で、いろいろと苦労していたら以下のページを発見。
http://twitter.com/uasi/statuses/13145562851
App::FatPacker でちょいハマったのでメモ。man には fatpack tree fatlib `cat packlists` とあるが fatlib はいらない。fatpack file するときは lib ディレクトリがないと死ぬ。空でいいので作っておく。
なーんだ、やっぱりそうだったか。
さらに以下のページを発見。
http://friendfeed.com/tyru/1f1473b6/uasi-app-fatpacker-pack
uasi: App::FatPacker 使うのわりとめんどくさいんで一発で pack できるスクリプト書いた http://gist.github.com/385661
おお、たしかにこのステップは面倒だよね。自動化してくれると助かります！
ということで、http://gist.github.com/385661 に置いてあるシェルを使ってみたところ、無事にfatpackに成功しました。やったね！
今後の課題？
fatpack.shのお陰で楽々パッキングだぜ！と思ったいたら、いきなりHTML::TreeBuilder::XPathを使っているスクリプトのパッキングでこけました。
「HTML::TreeBuilder::XPath::Nodeが見あたらねぇよ」と言われます。
調べてみたらHTML::TreeBuilder::XPathにはNode.pmというファイルは存在していませんでした。
実際にはXpath.pmの中でpackage HTML::TreeBuilder::XPath::Nodeが定義されています。
つまり、パッケージとしては存在しても、実際にpmファイルが存在していないというケースだとエラーになります。むむ、こういうケースって結構多い気がするんですよね。
他にもUNIVERSAL::requireで動的にモジュールをロードする場合とかも問題ありそう（ためしてないけど）。
ということで、App::FatPacker、色々と課題はありそうですが、cpanmのように使いどころがうまくはまっていれば便利かもしれません。
知ってそうで意外と知られていないperlの小技 10選
意外と知られていないperlテクってのが、意外とあるもんですね。
最近身の回りでいくつか話題に上がったものがあったので、ちょっと書いてみます。
どれも最新のモダパ的なモノではないけども、知っておくと地味に便利かもしれないノウハウです。
中級レベル以上のperlユーザの人たちでも「お、こんなの知らなかった」というのもあるかもね。
複数項目でのソート
よくエクセルなんかで「A列を降順、B列を昇順にして並び替え」みたいなことしますよね？
perlで複数項目のsortではどうすればできるでしょうか？
じつはとっても簡単。sortの次に続くブロックの中でorするだけです。
例えば以下のような４人の子供たちのデータを年齢順、体重順でソートしてみます。
use strict; my @data = ( { name => '太郎', age => 10, weight => 25, }, { name => '花子', age => 9, weight => 23, }, { name => '次郎', age => 10, weight => 27, }, { name => 'よし子', age => 9, weight => 21, }, ); my @sorted = sort { $b->{age} <=> $a->{age} || $b->{weight} <=> $a->{weight} } @data; for (@sorted) { print $_->{name}, "\t", $_->{age}, "歳\t", $_->{weight}, "キロ\n"; }
次郎 10歳 27キロ
太郎 10歳 25キロ
花子 9歳 23キロ
よし子 9歳 21キロ
おお、簡単ですね。
これを知らないとうっかり自分で関数を書いてしまいそうになります。ひゃー。
ランダムシャッフル
続いてこれもソートねた。
配列をランダムにシャッフルします。
use Data::Dumper; my @data = qw( 0 1 2 3 4 5 6 7 8 9 ); my @shuffle = sort { rand() <=> 0.5 } @data; print Dumper \@shuffle; #結果はランダムにシャッフルされている
え、これだけ？なんで？って思うかもしれませんが、よーく考えてみてください。
ふーむ。よく考えたもんだ！
GUIアプリをつくる
がらっと志向を変えてみます。
実はperlでwindowsアプリを作れるって知ってましたか？
Win32::GUIとWin32::GUI::Loftを使えば簡単にGUIアプリケーションを作れてしまいます。
もしくはGtkとGtk2::GladeXMLを使えばwindowsだけでなくmacやlinuxな環境でも動作するGUIアプリを作れれます。
これらのツールで書いたスクリプトをPARで実行可能なバイナリ形式にパックすれば、perlインタプリタが入っていない環境にも配布できるよ！
具体的に書いているとすごい量になってしまうので参考サイトを書いておきます。
http://blog.remora.cx/2010/03/gui-programming-with-win32-gui-loft.html
http://perl-mongers.org/2008/06/perl-and-gtk.html
あとついでにWin32::GuiTestを紹介しておきます。
これのSendKeysという関数をうまく使えば、フォームなどへのデータの流し込みとかができて面白いです。
周りの人に見せると、たぶんびっくりされます。
http://perldoc.jp/docs/modules/Win32-GuiTest-1.3/GuiTest.pod
ハッシュと配列の相互変換
perlの中級者ぐらいの人でも以外と知らない事実。
実はハッシュをアレイコンテキストで評価すると配列になります。
逆もしかりです。
my %hash = ( 'ブレンド' => 540, 'アメリカン' => 540, 'カフェオーレ' => 650 ); my @array = %hash; # @arrayの中身は qw( 'ブレンド' 540 'アメリカン' 540 'カフェオーレ' 650 ) my %hash2 = @array; #%hash2の中身はは%hashと同じ
この性質はクラスのコンストラクタでよく使われているテクだったりします。
sub new { my $class = shift; my %args = @_; return bless \%args, $class; }
デフォルト引数を設定する場合なんか、こういう風に書かれたりもします。
sub new { my $class = shift; my %args = ( foo => 'bar', hoge => 'fuga', @_ ); return bless \%args, $class; }
なるほどね。って感じではないでしょうか。
evalのあぶない使い方
evalと言えば例外処理、という固定観念はありませんか？
evalはもっとエキサイティングな用途でも使えます。
evalは渡されブロックをperlスクリプトとして実行します。
なので動的に文字列としてプログラムコードを生成して、それを実行させることができるわけです。
わざとらしい例を１つあげます。
ログを集計する場合に「店舗別の月別の商品別の販売個数を集計したい」というようなタスクがあったとします。
でもこの「○別の△別の〜」といった集計項目が何個あるか、プログラムを実行するまでわからないような条件であったとしましょう。
（現実的にはそんな条件ってないと思うけど）
use strict; use Data::Dumper; my $data; while (<DATA>) { chomp $_; # 一番最後のカラムに数値が入っているつもり # それ以外のカラムは集計軸として使うという前提 my @f = split( "\t", $_ ); my $value = pop @f; # 動的にデータ構造を作る my $string = '$data'; for (@f) { $string .= '->{\'' . $_ . '\'}'; } $string .= '+=' . $value . ';'; # エバる eval $string; } print Dumper $data; __DATA__ 横浜店 2010年05月 商品A 割引なし 2 横浜店 2010年06月 商品A 割引あり 7 田町店 2010年06月 商品A 割引なし 2 田町店 2010年05月 商品B 割引なし 4 横浜店 2010年06月 商品C 割引なし 8 横浜店 2010年06月 商品C 割引あり 12
なんと、事前に定義することなく動的に多段のハッシュなデータ構造ができてしまいました。
でも、ある意味でこれはとても危険な行為です。ログの文字列にへんなコードが混入してたらアウト。１行ごとのevalするので実行速度も遅いしね。
くわしくはこちらを見てください。
http://blog.livedoor.jp/dankogai/archives/51175261.html
しかしリスクを十分わかった上で、使いどころを間違えなければ、evalは十分に便利な道具です。私はevalが以外とすきです。
perltidy
どんなにいいコードを書いてもインデントの幅がまちまちだったり、きたなーい感じのソースだとイマイチですよね。
そんなときはPerl::Tidyでソースコードを整形してあげましょう。一発でプロっぽい見栄えに変身します。
さぁ、今すぐ cpan -i Perl::Tidy しましょう。perltidyというコマンドが使えるようになります。
use strict; use warnings; for(1.. 10){ print $_; print "\n"; }
こんな悲しくなるほどきたないコードが
use strict; use warnings; for ( 1 .. 10 ) { print $_; print "\n"; }
おお、まっとうな見栄えになりました。
vimつかってるならば :%!perltidy とするだけどOK！
とても便利です。
perlとだけ叩いたら
perlはコードを書いてファイルに保存して実行させるか、-e オプションでワンライナーとして実行させるか、どちらかで動かすものと考えていませんか？
そんなあなたは、まずコンソールに向かって「perl」とだけ打ってリターンしてみてください。
続いて print "hello world\n"; と叩いてみてください。
最後にCtrl-D。
おお！こんな動かしたもあったのか！
って知ってましたか？常識だったかな？
モジュールの格納場所をしる
@INCはとても有名。perlユーザならだれもが知ってる特殊変数ですね。
インクルードパスが格納されています。
一方、なぜか %INC は知名度が低いようです。
%INCにはそのプログラムでロードしているモジュールのパスがハッシュとして格納されています。
use LWP::Simple; while ( my ( $key, $value ) = each %INC ) { print $key, "\t", $value, "\n"; }
これをじっこするとこうなります。
Godzilla:Hacks miki$ perl test.pl
warnings.pm /System/Library/Perl/5.10.0/warnings.pm
warnings/register.pm /System/Library/Perl/5.10.0/warnings/register.pm
LWP/Simple.pm /System/Library/Perl/Extras/5.10.0/LWP/Simple.pm
Exporter/Heavy.pm /System/Library/Perl/5.10.0/Exporter/Heavy.pm
Exporter.pm /System/Library/Perl/5.10.0/Exporter.pm
HTTP/Status.pm /System/Library/Perl/Extras/5.10.0/HTTP/Status.pm
vars.pm /System/Library/Perl/5.10.0/vars.pm
strict.pm /System/Library/Perl/5.10.0/strict.pm
モジュールを書いていて、そのモジュール自身がインストールされている場所を知りたい、なんて時にはこのハッシュから自分自身のパッケージ名を探せばパスがわかります。
知っておくとちょっと便利です。
モジュールのメソッドを上書きする
CPANモジュールを使っていて、「ここのメソッドのこの処理、どうしてもちょっとだけ変えたいんだよなぁ」というようなケースってありますよね？
わざわざ継承するのも大げさっていうような場合は思い切ってそのクラスの当該メソッドを再定義してしまいましょう！
use strict; use warnings; package Foo; sub do_something { print "なにか処理します", "\n"; } package main; # オリジナルのメソッドのコードリファレンスを保持しておく my $origin = Foo->can('do_something'); # 型グロブで上書き no warnings 'redefine'; *Foo::do_something = sub { print "このメソッドはノットッタゼ！", "\n"; }; # 実行してみる Foo->do_something(); #ノットタレタゼ！ # もとに戻す no warnings 'redefine'; *Foo::do_something = sub { $origin->(); }; # もう１回実行してみる Foo->do_something(); # なにか処理します
実行結果はこうなります。
このメソッドはノットッタゼ！
なにか処理します
ちょっとお行儀わるいかもしれませんが、知っておくと便利なテクですね。
perldocをもう少し
perldocって便利ですよね。わざわざブラウザでCPANサイトに行かなくてもPODのドキュメントをコンソールで閲覧できるわけです。
そんな便利なperldocをもう少しだけ便利に使うオプションです。
モジュールの格納されているパスを知るためには -l オプションをつけます。
perldoc -l
Godzilla:Hacks miki$ perldoc -l JSON
/Library/Perl/5.10.0/JSON.pm
さらにソースを直接みたい場合は -m オプションでソースを開くことができます。
perldocは便利だなぁ。
以上、なんの脈絡もなく１０個の「意外と知られていないテクニック」を紹介してみました。
enjoy!
perlXSでSTLのstd::mapを使ってみる
ここのところC++でコードを書いているんですが、やっぱりそいつをperlから使いたい。
ということでXSについてお勉強中です。
ごく簡単なものなら書けるようになってきましたが「perlから渡したハッシュをC++側でstd::mapとして受け取りたい」といった特殊なケースではまってしまったのでメモっておきます。
いろいろ悩みはしましたが、結論から言うと「hollyなblog」さんのところでまさにドンピシャな記事を書いてくれていたので、これを参考に頑張ってみました。
以下、サンプルコードと実践手順です。
C++コード
hashを渡してstd::mapを返すというケースを想定しているので、以下のようなクラスを準備しました。コサイン類似度を計算するコードです。
vector_tool.hとして以下を用意します。
#include <iostream> #include <map> #include <string> #include <cmath> typedef std::map<std::string, double> vec; typedef vec::iterator VecIt; class VectorTool { public: VectorTool() { } ~VectorTool() { } double cosine_similarity( vec &vector_1, vec &vector_2){ double inner_product = 0.0; for(vec::iterator itr = vector_1.begin(); itr != vector_1.end(); ++itr){ if(double value_2 = vector_2[itr->first]){ inner_product += itr->second * value_2; } } double norm_1 = 0.0; for(vec::iterator itr = vector_1.begin(); itr != vector_1.end(); ++itr){ norm_1 += pow(itr->second, 2); } norm_1 = sqrt(norm_1); double norm_2 = 0.0; for(vec::iterator itr = vector_2.begin(); itr != vector_2.end(); ++itr){ norm_2 += pow(itr->second, 2); } norm_2 = sqrt(norm_2); if(norm_1 && norm_2){ return inner_product / (norm_1 * norm_2); } else{ return 0.0; } } vec unit_length(vec &vector) { double norm = VectorTool::norm(vector); for(vec::iterator itr = vector.begin(); itr != vector.end(); ++itr){ vector[itr->first] = itr->second / norm; } return vector; } double norm(vec &vector){ double norm; for (vec::iterator itr = vector.begin(); itr != vector.end(); ++itr) { norm += pow(itr->second, 2); } norm = sqrt(norm); return norm; } private: };
コサイン類似度を計算するメソッド以外にもちょろちょろとメソッドがありますが、正直ここら辺はどうでもいいです。
ポイントとしては、このコードではベクトルをstd::mapのデータ構造で取り扱っているというところになります。
perlからの呼び出しイメージ
test.plとして以下を用意します。
use strict; use warnings; use VectorTool::XS; my $vec_1 = { abc => 123.45, bcd => 234.56, cde => 345.67 }; my $vec_2 = { abc => 123.45, bcd => 234.56, cde => 345.67 }; my $tool = VectorTool::XS->new; #--コサイン類似度 my $ret = $tool->cosine_similarity( $vec_1, $vec_2 ); print "SIM : ", $ret, "\n"; #-- ノルム（正規化前） print "NORM: ", $tool->norm($vec_1), "\n"; #-- 単位長による正規化 $vec_1 = $tool->unit_length($vec_1); #-- ノルム（正規化後） print "NORM: ", $tool->norm($vec_1), "\n";
VectorTool::XSというのが今回つくるパッケージのつもりです。
ベクトルは単純なハッシュリファレンスとしています。
ベクトルの中身の値は、実験的にはどうでもよかったので、$vec_1と$vec_2で同じものにしています。
スクリプト叩くと結果はこんな風になります。（記事の内容的にはこの結果自体はどうでもいいです）
godzilla:VectorTool-XS miki$ perl -Mblib test.pl SIM : 1 NORM: 435.59849058508 NORM: 1
typemap
typemapとはperlのデータ型とC/C++のデータ型を変換するためのルール記述です。
デフォルトで用意されているもの以外にも自分で定義できるので、イケてるXS使いはみな自前でtypemapを書くみたいです。
ちなみにこのtypemapは全面的にhollyなblogさんからのコピペです。
T_VEC
sv_setref_pv($arg, CLASS, (void *)$var);
TYPEMAP
vec T_STRING_MAP
INPUT
T_STRING_MAP
{
HV *hv;
HE *he;
vec t_sm;
if(SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVHV) {
hv = (HV *)SvRV($arg);
if(hv_iterinit(hv) == 0) {
warn(\"${Package}::$func_name() -- $var is empty hash reference\");
XSRETURN_UNDEF;
}
} else {
warn(\"${Package}::$func_name() -- $var is not a hash reference\");
XSRETURN_UNDEF;
}
while((he = hv_iternext(hv)) != NULL) {
SV *svkey = HeSVKEY_force(he);
SV *svval = HeVAL(he);
//SV *svkey = hv_iterkeysv(he);
//SV *svval = hv_iterval(hv, he);
t_sm.insert(vec::value_type(std::string(SvPV_nolen(svkey)), SvNV(svval)));
}
$var = t_sm;
}
OUTPUT
T_STRING_MAP
{
if($var.empty()){
warn(\"${Package}::$func_name() -- map is empty\");
XSRETURN_UNDEF;
}
HV *hv = (HV *)sv_2mortal((SV *)newHV());
for(VecIt it = $var.begin(); it != $var.end(); it++) {
hv_store(hv, (it->first).c_str(), (it->first).size(), newSVnv(it->second), 0);
}
SvSetSV($arg, newRV_noinc((SV *)hv));
}いろいろと呪文のようなコードがつらなっておりますが、
前半部分はオブジェクトを作る部分（コンストラクタ）のデータ構造の変換についての記述です。
これは以下の記事のまんまです。
perlxs入門その3 http://blog.livedoor.jp/kurt0027/archives/51850105.html
後半部分はperlのハッシュとSTLのstd::mapを変換する記述です。これもhollyさんの記事から拝借しました。
perlxs入門その5 http://blog.livedoor.jp/kurt0027/archives/51855521.html
ただしhollyさんの例だとstd::map
それにしてもtypemap、まさに呪文ですね。。まぁ読んでいけばなんとなく想像はつきますが、こんなの素で書けっていわれてもちょっと無理ですね。口から泡が出そうです。
XSコード
さてさて、ようやくXSです。
typemapがんばったおかげでXS部分はとてもシンプルです。
#include "vector_tool.h" #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" MODULE = VectorTool::XS PACKAGE = VectorTool::XS VectorTool * VectorTool::new() double VectorTool::cosine_similarity(vec vector_1, vec vector_2) vec VectorTool::unit_length(vec vector) double VectorTool::norm(vec vector)
Makefile.PL
おっと忘れてはいけないMakefile.PLです。
use 5.010000; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'VectorTool::XS', VERSION_FROM => 'lib/VectorTool/XS.pm', # finds $VERSION PREREQ_PM => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/VectorTool/XS.pm', # retrieve abstract from module AUTHOR => 'miki <miki@apple.com>') : ()), LIBS => [''], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' INC => '-I.', # e.g., '-I. -I/usr/include/other' # Un-comment this if you add C files to link with later: OBJECT => '$(O_FILES)', # link all the C files too CC => "g++", LD => "g++", XSOPT => '-C++' );
ほぼh2xsで生成されたままですが、下のほうにあるCC,LD,XSOPTは後から追記しています。
あとCやC＋＋のファイルを別にいくつか用意してオブジェクトファイルを生成するような場合はOBJECT => '$(O_FILES)'は必要になります。これで勝手にオブジェクトファイルをリンクしてくれるようになります。
ベンチマーク
さて、こいつをmakeすると、一応期待通りに動作するモジュールが生成されたました。やったぜ！
ですが、速度の方はあまり速くありません。
同じようなことをするperlコードを別モジュールとして書いておいて、それとのベンチマークをとってみました。
use strict; use warnings; use VectorTool::XS; use VectorTool::PurePerl; use Benchmark qw(timethese cmpthese); # ベクトルは適当 my $vec_1 = { abc => 123.45, bcd => 234.56, cde => 345.67 }; my $vec_2 = { abc => 123.45, bcd => 234.56, cde => 345.67 }; # XS版とPurePerl版 my $tool_xs = VectorTool::XS->new; my $tool_pp = VectorTool::PurePerl->new; my $loop = 1000000; my $r = timethese( $loop, { pp => \&pp, xs => \&xs, } ); cmpthese $r; sub pp { my $ret = $tool_pp->cosine_similarity( $vec_1, $vec_2 ); } sub xs { my $ret = $tool_xs->cosine_similarity( $vec_1, $vec_2 ); }
結果はこうです。
godzilla:VectorTool-XS miki$ perl -Mblib bench.pl
Benchmark: timing 1000000 iterations of pp, xs...
pp: 7 wallclock secs ( 6.89 usr + 0.00 sys = 6.89 CPU) @ 145137.88/s (n=1000000)
xs: 9 wallclock secs (10.16 usr + 0.00 sys = 10.16 CPU) @ 98425.20/s (n=1000000)
Rate xs pp
xs 98425/s -- -32%
pp 145138/s 47% --「XSにしたのにpure perlより遅いとはなにごとだ！」としばし怒ってみましたが、よく考えれば当然かもしれません。
コサイン類似度の計算のようにシンプルな処理の場合、その部分での言語間でのパフォーマンス差よりも、むしろtypemapのような複雑な型変換処理の方がコストが高くついてるのではないでしょうか。
つまり、もっと演算に時間がかかるような処理であればはっきりとXSが強いはず。
なのでC++とperlのモジュール側で各々100万回ループするようにしてみて、ベンチマークスクリプトからは１回だけ呼び出すように構成を変えてみました。
まったく馬鹿らしい変更ですが、わざと明示的にXSを勝たせるための変更です。
その結果がこれ。
godzilla:VectorTool-XS miki$ perl -Mblib bench.pl
Benchmark: timing 1 iterations of pp, xs...
pp: 5 wallclock secs ( 4.98 usr + 0.01 sys = 4.99 CPU) @ 0.20/s (n=1)
(warning: too few iterations for a reliable count)
xs: 0 wallclock secs ( 0.22 usr + 0.00 sys = 0.22 CPU) @ 4.55/s (n=1)
(warning: too few iterations for a reliable count)
s/iter pp xs
pp 4.99 -- -96%
xs 0.220 2168% --おお、C++強し！強すぎる！
わざとらしいベンチではありますが、100万ループをC++側に持ってくることで圧倒的なパフォーマンスの差となりました。
多次元尺度法で遊んでみる（オレ流 R入門）
多次元データをクラスタリングする際に、それらのデータを2次元データに落とし込んで可視化させたいことがあります。そんな時に便利なのが「多次元尺度法」という手法です。
個々のデータ間の距離／類似度が分かっている場合に、それらのデータの座標を求めて、データ構造を復元するようなものです。
詳しい説明は割愛します。知りたい人はwikipediaと金先生の連載を読んで下さい。
体で覚えるタイプなので、とにかく何かデータを処理してみます。
「山手線」の地図を再現
さっそく試してみます。
山手線の各駅同士の直線距離を測っておいて、そのデータから実際の位置関係を復元できるか実験してみます。
山手線全駅の距離を測るのはめんどいので、適当に抜粋してしらべました。
以下のような表になりました。単位はメートルです。
さてさて、この距離表からどのようなデータ構造が再現されるでしょうか？
このデータを統計解析ソフトRで読み込めるようなデータにします。ファイル名はyamanote.txtとしておきます。
渋谷 新宿 池袋 巣鴨 上野 東京 品川 五反田
0 3609 7880 9026 9217 6385 4742 4092
3609 0 4328 5911 7410 6046 7679 7477
7880 4328 0 2666 6275 7305 11326 11469
9026 5911 2666 0 4069 6284 11504 12003
9217 7410 6275 4069 0 3744 9886 10871
6385 6046 7305 6284 3744 0 6157 7230
4742 7679 11326 11504 9886 6157 0 1592
4092 7477 11469 12003 10871 7230 1592 0
一行目がラベルで、2行目以降はデータが並んでいます。区切り文字はスペースだと思ってみて下さい。
それではこのファイルをRで読み込んで多次元尺度法で処理してみます。
多次元尺度を求めるにはcmdscaleという関数を叩きます。
X <- read.table("c:\\yamanote.txt", header=T) loc <- cmdscale(X)
続いてこれを描画してみます。
plot(loc) text(loc, names(X), col="red")
そうするとこのようなグラフが描画されます。
ん？？角度と向きが変ですね。。。
というのも、多次元尺度法ではあくまでも距離関係だけでデータ構造を再現するので、
今回のような実際の地理情報を扱う場合にはちょっと手直ししてあげる必要があります。
手直しといっても簡単です。裏表が逆なのでひっくり返して、時計回りに90度動かしてみます。
ぬぬ！これは・・・東京在住の人はすでに興奮して鳥肌ものですね！？
関東以外の方は山手線の駅名に馴染みがないかもしれないので、参考までに実際の山手線の駅画像を貼付けてみましょう。
この駅画像の上に、先ほど描画したファイルをちょっと角度をずらして、幅を調整しながら重ねてみると・・・。
おおおおおお！ぴったりだぁぁぁ！
感動したぁ！！
「ガンダム」でモビルスーツを分析
お次は実際の距離ではなく、適当な特徴ベクトルを作ってマップしてみようと思います。
世の中にはガンダムおたく、通称ガンヲタの方が多いようで、インターネット上にはモビルスーツのスペック表を公開しているサイトもあったりします。
http://www.interq.or.jp/jupiter/mcmurd/FG.htm
今回はこのスペック表から特徴ベクトルを作って、個々のモビルスーツ／モビルアーマーの類似度を測定してみます。それでもって多次元尺度法で２次元に「見える化」してみようという実験です。
なお素性として使うデータは「頭頂高」「本体重量」「ジェネレータ出力」「スラスター推力」の４項目とします。
データを作る部分はperlでかきました。
たぶんRだけでも出来るんだと思いますが、Rは初心者なので、細かい処理をどう書けばいいのかわからないのでperlに逃げました。
use strict; use warnings; #-- データ読み込み my $vectors; my @names; while(<DATA>){ chomp $_; my @f = split("\t", $_); my $id = $f[0]; my $name = $f[1]; my $height = $f[2]; $height =~ s/m//g; my $weight = $f[3]; $weight =~ s/t//g; my $kwat = $f[4]; $kwat =~ s/kw//g; my $gain = $f[5]; $gain =~ s/kg//g; my $weapon = $f[6]; $vectors->{$name} = { height => $height, weight => $weight, kwat => $kwat, gain => $gain, }; } #-- 単位ベクトルに正規化 while ( my ( $label, $vec ) = each %$vectors ) { unit_length($vec); $vectors->{$label} = $vec; } #-- 個々の距離（１−類似度）を量ってマトリックス化 my $matrix; my @labels; for my $label (keys %$vectors){ my $vec = $vectors->{$label}; for my $target_label( keys %$vectors){ my $target_vec = $vectors->{$target_label}; my $sim = cosine_similarity($vec, $target_vec); my $dis = 1 - $sim; $matrix->{$label}->{$target_label} = $dis; } push(@labels, $label); } #-- 出力 print join(" ", @labels),"\n"; for my $row(@labels){ my @array; for my $col(@labels){ my $item = $matrix->{$row}->{$col}; push @array, $item; } print join(" ", @array), "\n"; } #---- 以下サブルーチン sub unit_length { my $vec = shift; my $norm = norm($vec); while ( my ( $key, $value ) = each %$vec ) { $vec->{$key} = $value / $norm; } } sub norm { my $vec = shift; my $norm; for ( values %$vec ) { $norm += $_**2; } sqrt($norm); } sub cosine_similarity { my ( $vector_1, $vector_2 ) = @_; my $inner_product = 0.0; map { if ( $vector_2->{$_} ) { $inner_product += $vector_1->{$_} * $vector_2->{$_}; } } keys %{$vector_1}; my $norm_1 = 0.0; map { $norm_1 += $_**2 } values %{$vector_1}; $norm_1 = sqrt($norm_1); my $norm_2 = 0.0; map { $norm_2 += $_**2 } values %{$vector_2}; $norm_2 = sqrt($norm_2); return ( $norm_1 && $norm_2 ) ? $inner_product / ( $norm_1 * $norm_2 ) : 0.0; } __DATA__ MS-05 ザクI 17.5m 50.3ｔ 899kw 40700kg 105mm マシンガン、240mmバズーカ、ヒートホーク MS-06F ザクII 17.5m 58.1ｔ 976kw 43300kg 120mm マシンガン、240mmバズーカ、ヒートホーク、他 MS-06S ザクII 17.5m 56.2ｔ 976kw 51600kg 120mm マシンガン、240mmバズーカ、ヒートホーク、他 MS-07B グフ 18.2m 58.5ｔ 1034kw 40700kg ５連装75mmマシンガン、ヒートロッド、ヒートサーベル MS-09 ドム 18.6m 62.6ｔ 1269kw 58200kg 360mm バズーカ、拡散ビーム砲、ヒートサーベル MS-09R リックドム 18.6m 43.8ｔ 1199kw 53000kg ジャイアントバズーカ、拡散ビーム砲、ヒートサーベル MS-14A ゲルググ 19.2m 42.1ｔ 1440kw 61500kg ビームライフル、ビームナギナタ MSM-03 ゴッグ 18.3m 82.4ｔ 1740kw 121000kg メガ粒子砲×２、魚雷発射管×２ MSM-04 アッガイ 19.2m 91.6ｔ 1870kw 109600kg 105mm バルカン×４、ロケット弾ランチャー×６ MSM-07 ズゴック 18.4m 65.1ｔ 2480kw 83000kg 240mm ロケット弾×８、メガ粒子砲×８ MSM-10 ゾック 23.9m 167.6ｔ 3849kw 253000kg フォノンメーザー砲、メガ粒子砲×８ MA-05 ビグロ 45.5m 125.5ｔ 17800kw 136100kg 大型メガ粒子砲、４連装ミサイルランチャー×２ MA-08 ビグ・ザム 59.6m 1021.2ｔ 140000kw 580000kg 大型メガ粒子砲、対空メガ粒子砲×２８、105mmバルカン×２ MAN-02 ジオング 17.3m 151.2ｔ 9400kw 187000kg 有線制御式メガ粒子砲×２、メガ粒子砲×３ MAN-03 ブラウ・ブロ 60.2m 1735.3ｔ 74000kw 1760000kg 有線制御式メガ粒子砲×４ MAN-08 エルメス 85.4m 163.7ｔ 14200kw 645200kg メガ粒子砲×２、ビット×１０ RX-75 ガンタンク 15.0m 56.0ｔ 878kw 88000kg 120mm 低反動キャノン砲×２、４連装ガンランチャー×２ RX-77-2 ガンキャノン 17.5m 51.0ｔ 1380kw 51800kg 240mm キャノン、ビームライフル、60mmバルカン砲×２、他 RX-78-2 ガンダム 18.0m 43.4ｔ 1380kw 55500kg ビームライフル、ビームサーベル、60mmバルカン砲×２、ハイパーバズーカ、他 RGM-79 ジム 18.0m 41.2ｔ 1250kw 55500kg ビームスプレーガン、ビームサーベル、60mmバルカン砲×２、ハイパーバズーカ
こうして出力した結果をテキストファイルに保存してRで処理します。
X <- read.table("c:\\gandum.txt", header=T) loc <- cmdscale(X) plot(loc, type="n") text(loc, names(X), col="red")
結果はこう。
扱ったデータが重量とか大きさ、馬力のような類いのものなので、そのことを念頭に入れてみてみると、なんとなくこの距離感はうなずけるかな、と思います。
ビグザム、ビグロ、エルメス、ジオング、ブラウブロあたりの重量級が程よく散らばってますね。
またさりげなくガンタンクも個性的なポジショニングなのが笑えます。
本当は個々の素性を標準化しないといけないような気がしますが、まぁ雰囲気でてるんで良しとします。
それにしても、これだとなんだかイマイチなんで、画像をプロットしてみましょう。
おお！なんだか猛烈にガンプラ作りたくなってきた！
というわけで、Rと多次元尺度法、結構あそべますyo。
