bonar note

京都のエンジニア bonar の技術的なことや技術的でない日常のブログです。

MySQLのおまとめINSERTはどれくらい速いか

MySQLで大量のINSERT処理等をする場合、VALUES で長いクエリを作って一気に突っ込むとかなり高速になることはよく知られています。何となく10倍くらいっていう体感だったのですが、計ってみることにしました。

以下と同じスキーマのテーブル foo1, foo2 foo3 を用意します。

CREATE TABLE `foo1` (
  `field1` int(10) unsigned NOT NULL DEFAULT '0',
  `field2` varchar(255) NOT NULL DEFAULT '',
  PRIMARY KEY (`field1`)
) ENGINE=InnoDB DEFAULT CHARSET=latin1

テスト環境は以下のような感じです。

Server version: 5.1.44 MySQL Community Server (GPL)
2.13 GHz Intel Core 2 Duo
2GB Mem

DBI 1.609
DBD::mysql 4.012

ベンチマークスクリプト

#!/usr/bin/perl

use strict;
use warnings;

use DBI;
use Benchmark qw/cmpthese/;

use constant {
    DSN => 'DBI:mysql:database=bonardb;host=localhost;port=3306',
    TEST_INSERT_RANGE => [1..100000],
    TEST_TABLES => [qw/foo1 foo2 foo3/],
};

sub connect_db {
    return DBI->connect(DSN, 'root', '');
}

sub cleanup_db {
    my $dbh = connect_db();
    $dbh->prepare('TRUNCATE TABLE ' . $_)->execute()
       for @{ TEST_TABLES() };
    $dbh->disconnect();
}

sub insert_normal {
    my $dbh = connect_db();
    my $sth = $dbh->prepare(
        'INSERT INTO foo1 VALUES (?,?)');
    foreach (@{ TEST_INSERT_RANGE() }) {
        $sth->execute($_, 'foo');
    }
    $dbh->disconnect();
}

sub insert_bulk {
    my ($unit, $table) = @_;
    my $dbh = connect_db();

    my $sql_prefix = 'INSERT INTO ' . $table . ' VALUES ';
    my $sql = $sql_prefix;
    my @value = ();

    foreach (@{ TEST_INSERT_RANGE() }) {
        push @value, ($_, 'foo');
        $sql .= '(?,?),';

        # 指定された件数たまったら INSERT
        if ((scalar @value) >= ($unit * 2)) {
            chop($sql);
            my $sth = $dbh->prepare($sql);
            $sth->execute(@value);

            @value = ();
            $sql = $sql_prefix;
        }
    }
    # 残りがあれば挿入
    if (@value) {
        chop($sql);
        my $sth = $dbh->prepare($sql);
        $sth->execute(@value);
    }
    $dbh->disconnect();
}

cleanup_db();

cmpthese(1, {
    'normal'    => sub { insert_normal();          },
    'bulk(10)'  => sub { insert_bulk(10, 'foo2');  },
    'bulk(100)' => sub { insert_bulk(100, 'foo3'); },
});

# rows check
print "--------- rows -------------\n";
my $dbh = connect_db();
foreach my $table (@{ TEST_TABLES() }) {
    my $sth = $dbh->prepare('SELECT count(field1) FROM ' . $table);
    $sth->execute();
    my $rows = $sth->fetchrow_array();
    printf "%10s %5d\n", $table, $rows;
}

insert_normal() は普通に一行ずつ入れて、insert_bulk() の方は 10, 100 の両方でまとめて入れています。insert_bulk() の方がコード的にはちょっと混みいった感じになりますね。

too few iteration なのですが、以下のような結果になりました。

          s/iter    normal  bulk(10) bulk(100)
normal      6.00        --      -81%      -95%
bulk(10)    1.16      417%        --      -76%
bulk(100)  0.280     2043%      314%        --
--------- rows -------------
      foo1 100000
      foo2 100000
      foo3 100000

1件ずつ入れるのに対して、100件同時に入れる方が 20倍 程度高速なことがわかります。更新が同時であることの優位性と、接続が少なくてすむことの優位性の両方があると思いますが、どちらの影響が大きいのかは調べる必要がありそうです。

みんなが体感的に知っていたことですが、改めて見てみると結構な違いですね。数パーセントの違いなまだしも、20倍違うとなると無視出来ません。同じことをするなら速い方を使わない手は無いです。ただこの方法にはデメリットもあって、書き方が煩雑になるのと(これは工夫出来そうですが)、クエリサイズの上限値に気をつけないと、SQL が途中で切られてエラーになります。

予めデータ長が分かっているような場合にはすごくいいですね。

Class::Accessor::Fast から Mouse へ

Class::Accessor::Fast(以下 C::A::F)を使っているクラスで、例えば Role っぽいものを表現したくなったりして、Mouse::Role 使いたい!Mouseに移行しようかな、みたいなことがあったりします。

この2つは機能的にもだいぶ違うものでもちろん簡単には比較できません。Mouse の場合には 単純にアクセサを追加するだけじゃなくて、読み書き権限の制御や方を用いたvalidation等よりきめ細かい制約を持つクラスを作ることが可能になります。

なので、その機能の代償として単純なクラスでも当然遅くなります。ある程度はしょうが ないし、 そのコストを払う価値があれば問題ないのですが、どれくらいのインパクトなのかは知っ ておく 必要があると思います。とても小さなクラスで簡単なベンチマークを取ってみました。

以下の環境で行ないました。

Mac OS X 10.6 
CPU: 2.8 GHz Intel Core 2 Duo 
4 GB 800 MHz DDR2 SDRAM 

This is perl, v5.8.9 built for darwin-2level

Class::Accessor::Fast is up to date (0.33).
Mouse is up to date (0.28).

perl のバージョンが低いので、5.10 だとまた違う結果が出るかもです。
count という値を内部に持ち、increment() というメソッドでその内部カウントを増加させるだけのクラスを作成します。以下は C::A::F の場合。

package CountupCAF; 
use strict; 
use warnings; 

use base 'Class::Accessor::Fast'; 
__PACKAGE__->mk_accessors('count'); 

sub increment { 
    my ($self) = shift; 
    my $count = $self->count; 
    $self->count(++$count); 
} 
1; 

同じものを Mouse で書きます。

package CountupMouse; 
use Mouse; 

has count => (is => 'rw', isa => 'Int'); 

__PACKAGE__->meta->make_immutable; 

sub increment { 
    my ($self) = shift; 
    my $count = $self->count; 
    $self->count(++$count); 
} 
1; 

実際には同じではなく、count には数字しか入れられないという制約が付いているなど、こちらの方が機能的です。見た目にもスッキリですね。

さらに、isa の型指定を無くしたもの。

package CountupMouseNoType; 

use Mouse; 

has count => (is => 'rw'); 

__PACKAGE__->meta->make_immutable; 

sub increment { 
    my ($self) = shift; 
    my $count = $self->count; 
    $self->count(++$count); 
} 
1; 

id:tom_lpsd 先生の指摘によると、Mouse::Meta::Method::Accessor::generate_accessor_method_inline() では

27     if ($attribute->_is_metadata eq 'rw') { 
28         $accessor .= 
29             '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . 
30             'if (scalar(@_) >= 2) {' . "\n"; 
31 
32         my $value = '$_[1]'; 
33 
34         if ($constraint) { 
35             if ($should_coerce) { 
36                 $accessor .= 

といった感じで type_constraint の有無で作られるメソッドの内容が変わるのでこれで速度に違いが出るはず、ということでisaが無いバージョンもバリエーションに入れて見ました。

あと、意味があるかわからないですが、Role を付けたバージョン。

package CountupMouseRole; 
use Mouse; 
use Incrementable; 

has count => (is => 'rw', isa => 'Int'); 
with 'Incrementable'; 

__PACKAGE__->meta->make_immutable; 

sub increment { 
    my ($self) = shift; 
    my $count = $self->count; 
    $self->count(++$count); 
} 
1; 

Incrementable.pm

package Incrementable; 
use Mouse::Role; 
requires 'increment'; 
1; 

スピード

まずはひたすら new だけをした場合

#!/usr/bin/perl 

use strict; 
use warnings; 

use CountupCAF; 
use CountupMouse; 
use CountupMouseNoType; 
use CountupMouseRole; 
use Benchmark qw/cmpthese/; 

cmpthese(1000000, { 
    'new(CAF)'    => sub { new CountupCAF();   }, 
    'new(Mouse)'  => sub { new CountupMouse(); }, 
    'new(NoType)' => sub { new CountupMouseNoType(); }, 
    'new(Role)'   => sub { new CountupMouseRole(); }, 
}); 

結果

                Rate   new(Role) new(NoType)  new(Mouse)    new(CAF)
new(Role)   373134/s          --         -1%         -2%        -29%
new(NoType) 375940/s          1%          --         -2%        -29%
new(Mouse)  381679/s          2%          2%          --        -28%
new(CAF)    529101/s         42%         41%         39%          --

C::A::F の方が 39% 程高速ですね。思った程の違いじゃないかなという印象。余談ですが、make_immutable をしないと僕の環境では15倍くらいスピードが違うので、これは必須ですね。

5.10.1

同じスクリプトを perl 5.10.1 で実行するとまったく違う結果に

                Rate new(NoType)   new(Role)  new(Mouse)    new(CAF)
new(NoType) 369004/s          --         -1%         -2%         -4%
new(Role)   374532/s          1%          --         -0%         -3%
new(Mouse)  375940/s          2%          0%          --         -2%
new(CAF)    384615/s          4%          3%          2%          --

ほとんど差がなくなりました。。実行回数だけみると、C::A::F が遅くなってるように見えるのですがこれはなんなんだろう。。

次に、new してひたすらincrementする場合。

#!/usr/bin/perl 

use strict; 
use warnings; 

use CountupCAF; 
use CountupMouse; 
use CountupMouseNoType; 
use CountupMouseRole; 
use Benchmark qw/cmpthese/; 

my $caf    = new CountupCAF(); 
my $mouse  = new CountupMouse(); 
my $notype = new CountupMouseNoType(); 
my $role   = new CountupMouseRole(); 

cmpthese(1000000, { 
    'incre(CAF)'    => sub { $caf->increment();   }, 
    'incre(Mouse)'  => sub { $mouse->increment(); }, 
    'incre(NoType)' => sub { $notype->increment(); }, 
    'incre(Role)'   => sub { $role->increment(); }, 
}); 

printf("caf:%d\nmouse:%d\nnotype:%d\nrole:%d\n" 
    , $caf->count 
    , $mouse->count 
    , $notype->count 
    , $role->count); 

結果

                  Rate  incre(Mouse)   incre(Role)    incre(CAF) incre(NoType)
incre(Mouse)  298507/s            --           -1%          -46%          -51%
incre(Role)   302115/s            1%            --          -45%          -50%
incre(CAF)    549451/s           84%           82%            --          -10%
incre(NoType) 609756/s          104%          102%           11%            --
caf:1000000
mouse:1000000
notype:1000000
role:1000000

Mouse よりも C::A::F の方が 84% 高速。まあそうですよねという感じですね。この辺りは人によって感じかたが違うかもしれません。特筆すべきは、type_constraints の無い Mouse の方がC::A::F よりもわずかに高速だという部分です。このチェックがあるか無いかで大分速度が変わりますね。

5.10.1

微妙に差が開いた印象

                  Rate  incre(Mouse)   incre(Role)    incre(CAF) incre(NoType)
incre(Mouse)  260417/s            --           -2%          -54%          -56%
incre(Role)   264550/s            2%            --          -54%          -55%
incre(CAF)    571429/s          119%          116%            --           -3%
incre(NoType) 591716/s          127%          124%            4%            --
caf:1000000
mouse:1000000
notype:1000000
role:1000000

caf.pl

と、ここまでやったところで、Mouseのpackageの中に author/benchmarks/caf.pl というベンチマークスクリプトが入っている事が発覚。完全に徒労だった予感。。実行してみるとこんな感じです。

perl 5.8.9

bash-3.2$ perl author/benchmarks/caf.pl 
-- new
          Rate mouse   caf
mouse 371158/s    --  -27%
caf   508970/s   37%    --
-- setter
           Rate   caf mouse
caf   1747627/s    --  -11%
mouse 1960478/s   12%    --
-- getter
           Rate mouse   caf
mouse 2123852/s    --  -11%
caf   2383127/s   12%    --

perl 5.10.1

-- new
          Rate   caf mouse
caf   367589/s    --   -1%
mouse 371359/s    1%    --
-- setter
           Rate   caf mouse
caf   1818773/s    --   -7%
mouse 1946613/s    7%    --
-- getter
           Rate mouse   caf
mouse 2123852/s    --   -9%
caf   2338582/s   10%    --

ここでも Class::Accessor::Fast の new が遅くなって差が縮まっている印象。
このスクリプト中の mouse は type の無いもの(上の例で言うと CountupMouseNoType)です。

{
    package Bench::Mouse;
    use Mouse;
    has 'a' => ( is => 'rw' );
    no Mouse;
    __PACKAGE__->meta->make_immutable;
}

メモリ使用量

new して 1000000回 内部変数をincrementするだけの動作で、メモリの消費量を計ってみました。以下が計測スクリプト。

#!/usr/bin/perl 

use strict; 
use warnings; 

use GTop; 
use UNIVERSAL::require; 

my $gtop = GTop->new(); 
my $base_mem = $gtop->proc_mem($$)->size(); 

my $package = shift; 
$package->require 
    or die "cannot import package:$package"; 

my $incrementer = $package->new(); 
for (1..1000000) { 
    $incrementer->increment(); 
    if (0 == ($_ % 300000)) { 
        my $procmem = $gtop->proc_mem($$)->size() - $base_mem; 
        printf "mem:%s (%d)\n" 
            , GTop::size_string($procmem), $procmem; 
    } 
} 
printf("%d\n", $incrementer->count()); 

結果

$ perl gtop.pl CountupCAF 
mem: 264k (270336) 
mem: 264k (270336) 
mem: 264k (270336) 
1000000 
$ perl gtop.pl CountupMouse 
mem: 3.4M (3604480) 
mem: 3.4M (3604480) 
mem: 3.4M (3604480) 
1000000 
$ perl gtop.pl CountupMouseNoType 
mem: 3.4M (3604480) 
mem: 3.4M (3604480) 
mem: 3.4M (3604480) 
$ perl gtop.pl CountupMouseRole 
mem: 3.8M (4009984) 
mem: 3.8M (4009984) 
mem: 3.8M (4009984) 
1000000 

C::A::F の圧勝ですが、Mouse もそんなにめちゃくちゃメモリ食ってるって感じでも無いですね。もうちょっと複雑なケースでの検証が必要かもしれません。

まとめ

やってるうちに、これ比べること自体が無駄なんじゃないかと思えて来ました。。違うものですしね。今回の様に単純なものであれば C::A::F の方が有利なのは間違いないし、複雑なものだとC::A::F でそもそも出来なかったり。

ただし、Mouse でも型指定を行なわず C::A::F と同じ様な使い方をするのであれば、メモリ使用量はさておき少なくとも実行速度に関しては負けてないことがわかりました。実行時間やメモリ使用量に関しては、使う人の環境によって感じ方違うかと思いますが、個人的には Mouse(or Moose)の簡素な書式と型/Role等の強力なパワーを得る代償としては受け入れられる範疇かなと思いました。

本題とは関係ないですが、Class::Accessor::Fast が 5.8.9 と 5.10.1 でパフォーマンスが違うっぽい件が気になる。

vim server 入門

vim server mode

あまり知られてないのですが、vim には server として動作し、外部から入力を受けるモードが存在します。純粋なエディタとしてだけではなく、外部からの指示で特定のファイルを開いたり、用意してる関数を実行したりってことが出来るのです。

僕も今までまったく使った事がなくて、vimscriptを単体のファイルとして実行したいなと漠然と調べていた際に見つけました。有効活用してる例ってあるのかな。。

下ごしらえ

vim server を使用するためには、そのバイナリが +clientserver というフラグ付きでconfigureされている必要があります。そして多くの場合この機能はデフォルトではありません。コンパイルオプションを調べるにはvimの起動後に

:version

でずらっと表示されます。

:version
VIM - Vi IMproved 7.2 (2008 Aug 9, compiled Nov 11 2008 17:20:43)
Included patches: 1-22
Compiled by _www@b77.apple.com
Normal version without GUI.  Features included (+) or not (-):
-arabic +autocmd -balloon_eval -browse +builtin_terms +byte_offset +cindent -clientserver -clipboard +cmdline_compl +cmdline_hist +cmdline_info +comments 
+cryptv +cscope +cursorshape +dialog_con +diff +digraphs -dnd -ebcdic -emacs_tags +eval +ex_extra +extra_search -farsi +file_in_path +find_in_path +float 
+folding -footer +fork() -gettext -hangul_input +iconv +insert_expand +jumplist -keymap -langmap +libcall +linebreak +lispindent +listcmds +localmap +menu
 +mksession +modify_fname +mouse -mouseshape -mouse_dec -mouse_gpm -mouse_jsbterm -mouse_netterm -mouse_sysmouse +mouse_xterm +multi_byte +multi_lang 
-mzscheme -netbeans_intg -osfiletype +path_extra -perl +postscript +printer -profile -python +quickfix +reltime -rightleft -ruby +scrollbind -signs 
+smartindent -sniff +statusline -sun_workshop +syntax +tag_binary +tag_old_static -tag_any_white -tcl +terminfo +termresponse +textobjects +title -toolbar
 +user_commands +vertsplit +virtualedit +visual +visualextra +viminfo +vreplace +wildignore +wildmenu +windows +writebackup -X11 -xfontset -xim -xsmp 
-xterm_clipboard -xterm_save 
   system vimrc file: "$VIM/vimrc"
     user vimrc file: "$HOME/.vimrc"
      user exrc file: "$HOME/.exrc"
  fall-back for $VIM: "/usr/share/vim"
Compilation: 
gcc -c -I. -D_FORTIFY_SOURCE=0 -Iproto -DHAVE_CONFIG_H     -arch i386 -arch ppc -g -Os -pipe -mdynamic-no-pic -arch i386 -arch ppc -pipe        
Linking: gcc   -arch i386 -arch ppc             -o vim       -lm -lncurses  -liconv        

このように -clientserver と出た場合には vim server 関連の機能が組み込まれていないので、コンパイルし直す必要があります。最新版のソースを取ってきてconfigure にはお好みのもの(--enable-multibyteとか)を入れつつ、+clientserver を付けます。

$ wget ftp://ftp.vim.org/pub/vim/unix/vim-7.2.tar.bz2
$ tar jxvf vim-7.2.tar.bz2 
$ cd vim72/
$ ./configure +clientserver
$ make
$ make install

基本的な使い方

起動

まずはサーバを立ち上げます。方法は簡単で、そのサーバを識別する文字列を付けてvimを起動するだけです。

$ vim --servername FOO

これで FOO という名前で認識されるサーバが立ち上がります。とはいえ見た目には普通にvimが立ち上がったように見えますが、

:ecoh v:servername

とするとFOOと表示され、servernameとして設定されていることがわかります。

このservernameはちょっと注意が必要な点があり、与えた名前が upper case に変換される(foo, Foo, FoO のどれでもFOOになる)という点と、同じ名前で2個立ち上げようとすると、2個めはFOO2となる点です。特に後者は結構直感に反する動きな気もしなくはないですね。

以下のコマンドで起動中のサーバ一覧を得る事が出来ます。

$ vim --serverlist
FOO
--remote

このFOOサーバに何か仕事をさせるにはいくつかの方法があり、例えば特定のファイルを開かせる場合には --remote を使用します。

$ perl -v > /tmp/perl.txt
$ vim --servername FOO --remote /tmp/perl.txt 

こうすると、すでに起動中のvim(FOO)の中にいきなり/tmp/perl.txtが開かれます。なかなかテキストだと伝わりにくいのですが、特定のttyに開かれたvimの内部状態を外側から変更するっていうのは見た目にキャッチーです。

ここで --remote の代わりに --remote-wait を使用すると、開いたファイルが展開されているバッファがなくなるまで(:q とか :bd とか)クライアント側は待つようになります。

--remote-expr

また、ファイルを開くだけでなく、--remote-expr を使うと特定の式を送り込んで、その評価結果をstdoutから受け取ることが出来ます。

たとえばさっきファイルを送り込んだサーバから特定の行を取り出したりする場合は以下のような感じです。

$ vim --servername FOO --remote-expr 'getline(6,9)'
Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.

Complete documentation for Perl, including FAQ lists, should be found on

計算も出来ちゃいます。

$ vim --servername FOO --remote-expr '60 * 60 * 24'
86400
--remote-send

vim の通常コマンドやvimscript関数の実行等を行う事も出来ます。--remote-send でコマンドをそのまま送りつけます。
例えば立ち上げたFOOサーバを終了させる時は以下のようにします。

$ vim --servername FOO --remote-send '<C-\><C-N>:q!<CR>'

というのがちょっと奇妙ですが、これは vim の normal mode に移行するコマンドです。現在のサーバ側の状態がわからないので、exコマンドの実行等をする場合にはこれを先頭に付けてnormal mode であることを保証する必要があります。

ただしこの場合実行結果の出力を受け取る事はできません。vimscript内でechoしたとしてもそれはstdoutに出る訳ではないのです。

VimRemote::Agent

というわけで、これを使って色々な事をやってみようと思っていて、--remote-* みたいなコマンドをつらつら書くのも大変なので、Perlのコマンドwrapperを書いてみました。
こんな感じで使えます。

    use VimRemote::Agent;

    my $agent = VimRemote::Agent->new();

    # check compile option
    if (!$agent->has('clientserver')) {
        die "configure vim with +clientserver flag";
    }

    # get running server list
    my @server_name = $agent->serverlist();

    # start new server
    my $server_name = 'NEWSVR';
    if (!$agent->start_server($server_name)) {
        die "starting server $server_name failed.";
    }

    # calc on remote server
    my $result = $agent->remote_expr($server_name, '1 + 1');
    print $result; # 2

    # send ex command to remote server
    $agent->remote_send('e /tmp/hoge.txt');

    # shutdown server
    $agent->shutdown_server($server_name);

git repo:
http://github.com/bonar/vimremote-agent/tree/master

中身はvimコマンドを叩きまくっているのをそれっぽく見せてるだけなので、無理矢理感が隠しきれてない感じになっています。
注意点

  • 実装されていないコマンド(*-wait, *-tab 系)がたくさんあります
  • -t な環境で make test すると gvim が一杯立ち上がります
  • mac os x 以外の環境でtestしてないので多分通らないです

本当はXSでかっこ良く操作したかったのですが、if_xcmdsrv.c とかを観た感じちょっと僕の実力では難しそうですね。。OS毎に実装も違うだろうし。。

まとめ

エラそうに書きましたが、基本 :help remote に全部書いてあります。どういう局面で役に立つのか、それが一番悩ましいのですが、

  • IRCサーバとかが作れる
  • システムログとかをvim server に送るようにして、みんなでそれを共有できる
  • vnewして右側がlogtailになっている的なものとか
  • 頑張れば遠隔操作とかが出来るようになって、外科手術をみんなで観る的な公開コーディングが出来るかも

みたいな夢が広がります。なんでそれをvimで、っていうのは、言わない約束じゃないですか。

モダンPerl入門でMooseに入門してみた

Perl界隈の期待の新刊「モダンPerl入門」。読んじゃいました。

モダンPerl入門 (CodeZine BOOKS)

モダンPerl入門 (CodeZine BOOKS)

Perl基礎の表層を一通りなめたものの、初心者からなかなか抜け出せない僕のような人のためにかかれた本ですね。感動しました。読んで満足してこのまま終わってしまいそうだったので、書いてある内容を実践してみてようと思います。

注意

  • 調べながら書きながらなので間違っている箇所もあるかもです。ツッコミお待ちしております。
  • Moose と Class::MOP の機能をおそらく混同してます。すいません。

Mooooooose

モダンPerl入門は "Class::Accessor::Fast と Moose" という話題から始まります。Moose に関してはこのまえのYAPCで初めてして、「へー何か良くわからないけどすごいんだろうな」程度にしか思っていなかったので、こんな風に書けるんだっていうのがわかって勉強になりました。

今書いている Music::AutoPhrase という自動作曲ライブラリをbranch切って修正してみました。元々 Class::Accessor::Fast を使って書かれていて、設計や実装に関しても甘いところが多く、題材としては微妙かもですがご容赦を。

例えば以下は Music::AutoPhrase::Code というコード(例:Cm7, F, C7)を表現するクラスはこんな風に変えました。

使用前
http://coderepos.org/share/browser/lang/perl/Music-AutoPhrase/trunk/lib/Music/AutoPhrase/Code.pm

使用後
http://coderepos.org/share/browser/lang/perl/Music-AutoPhrase/branches/moose/lib/Music/AutoPhrase/Code.pm

Exportやめたりとかの関係ない修正も入っているのでちょっと比べずらいかもです。。

has

Class::Accessor とくらべて見た目の一番の違いはhasでしょうか。そのattributeは一体どんなものでどんなデータが入るのかっていうのが細かく指定できて、且つそれがソースの先頭に列挙されるので、かなり見通しが良くなる気がしますね。

has string_value => (
    is       => 'ro',
    isa      => 'Str',
    required => 1,
);

値が必須かどうかや、読み書き制限等便利なフラグが盛りだくさんですが(perldoc Moose をみるとhasはすごい数の設定項目が)、特に値の型を指定できる isa が便利だと思いました。Str, Int, ArrayRef みたいな単純なものだけでなく、ArrayRef[Int] のように組み合わせて使う事もでき、この[Int]の部分は自分で作ったpackageを入れることも出来ます(これが最高に便利)。

has candidate => (
    is       => 'ro',
    isa      => 'ArrayRef[Int]',
    required => 1,
);

型の種類については perldoc Moose::Util::TypeConstraints を参照。

subtype

isa では上記のような既存の型以外に自分で作った制約を当てることもできます。例えば、Cm7 というコードを C(Note Main) + m7(Note Sub) に分けて保持する場合、それぞれの
パーツで許容できる文字列に制限をかけたかったりします

  5 use Moose::Util::TypeConstraints;
  6 
  7 subtype 'NoteMain'                                                                                                                                
  8     => as 'Str'
  9     => where { defined $_ && $_ =~ /^(C|D|E|F|G|A|B|X)(#|\-)?$/ }
 10     ;
 11 subtype 'NoteSub'
 12     => as 'Str'
 13     => where { !defined $_ || $_ =~ /^(m|m7|M7|7|X)$/ }
 14     ;

 21 has note_main => (
 22     is       => 'ro',
 23     isa      => 'NoteMain',
 24     required => 1,                                                                                                                                
 25 );
 26 has note_sub => (
 27     is       => 'ro',
 28     isa      => 'NoteSub',
 29     required => 1,
 30 );
new() and BUILDARGS()

Moose なクラスでは自分でnew()を書く事は無く、Moose::Object のnew() が使われます。上記の Music::AutoPhrase::Code の場合だと以下のようにhasで作った属性にhashで値を渡します。

my $code = Music::AutoPhrase::Code->new(
    string_value => 'Cm7',
    note_main    => 'C',
    note_sub     => 'm7',
);

ただ、実際にはこれでは不便で、string_value を文字列で指定して、渡した文字列を勝手に切り分けて欲しいかったりする時もあります。こんな感じで

my $code = Music::AutoPhrase::Code->new('Cm7');

そんな時にnew()が書けないのが不便だなと思ったのですが、その辺は考えられていて、BUILDARGS() という関数を定義すると、それをnew()に渡すhashの整形処理として使ってくれます。

new()の引数を受け取って、Moose::Object->new() に渡すhashのリファレンスを返すだけです。今回の例だとこんな感じになりました。
#_parse_code() が文字列を切り分ける関数

sub BUILDARGS {
    my ($class, $string_value) = @_;
    return if !defined $string_value;

    my @parsed = _parse_code($string_value);
    return if !@parsed;
    my ($candidate, $note_main, $note_sub) = @parsed;

    return {
        note_main    => $note_main,
        note_sub     => $note_sub,
        candidate    => $candidate,
        string_value => $string_value,
    };

さらにオブジェクトを作成したあとの初期化処理もBUILD()という関数を定義することで作成できます。Moose::Object の BUILDALL() という関数が継承ツリーの全てのBUILD()を実行します。

coercing

coerce もMooseの特徴的な機能ですね。僕が知らないだけで特に特徴的で無かったらすいません。

Mooseなクラスでは属性値の型を定義できて、違う型が与えられた場合、元の型が変換可能なものであれば自動で変換するという機能です。

今回の例でいうと、Music::AutoPhrase::Channel というクラスがあり、これは一つの楽曲内のそれぞれの楽器チャンネルを表現しています。その中に octav という属性があります。これはそのチャンネルのオクターブ(音の高さ)のレンジを規定しています。

has octav => (
    is       => 'rw',
    isa      => 'OctavList',
    default  => sub { [qw/4 5 6/] },
    required => 1,
    coerce   => 1,
);

これで、

my $channel = Music::AutoPhrase::Channel->new(%arg);
$channel->octav([qw/3 4 5 6/]);

みたいにして書くわけですが、与えるarrayrefの要素数が1個だった場合に、$channel->octav([4]); ではなく $channel->octav(4) という書き方も許容したくなります。そういった場合には、coerce で特定のsubtype に対する変換処理をあらかじめ書いておく事が出来ます。
#coerce を有効にするには has で coerce => 1 を指定

subtype 'OctavList'
    => as 'ArrayRef'
    => where { is_valid_octav($_) or return for @$_; 1; };
coerce 'OctavList'
    => from 'Int' => via { [$_] };

これで「Intが渡された時にはその値1つだけを要素としてもつarrayrefに変換」というルールを教えることが出来ます。こうしておくと、以下のような全く関係ない値を与えると、

my $channel = Music::AutoPhrase::Channel->new();
$channel->octav('a');

不正な値としてエラーになりますが、

Attribute (octav) does not pass the type constraint because: Validation failed for 'OctavList' failed with value a at foo.pl line 6

数値を与えるとちゃんと変換してくれます。

use Data::Dumper;

my $channel = Music::AutoPhrase::Channel->new();
$channel->octav(4);
warn Dumper $channel->octav;
$VAR1 = [
          4
        ];

非常に面白い仕組みで便利なのですね。あと、coerce をなんと発音するのか実はわからないので(こあーす?)誰か教えてください。

MooseX::AttributeHelpers

モダンPerl入門ではデザインパターンの章で紹介される MooseX::AttributeHelpers ですが、個人的にはこれはかなり衝撃的でした。このモジュールを使うと、hasでその属性のmetaclassを指定した際に、その属性に関する操作を自動生成することが出来ます。

例えば先ほどの Music::AutoPhrase::Channel では、beats という属性があります。

has beats => (
    is         => 'rw',
    isa        => 'ArrayRef[Music::AutoPhrase::BeatPattern]',
    default    => sub { [] },
    required   => 1,
    }
);

これはちょっと説明しづらいのですが、、そのチャンネルにおける音符配置情報で、どういうタイミングで音が鳴るのかという情報の配列になっています。データとしては isa で表現されている様に Music::AutoPhrase::BeatPatternオブジェクトの配列(のリファレンス)になります。

こういう属性があると以下のようなアクセサを書きたくなります。内部で持っている arrayref に push したり、中身を全部消したり、といった操作です。

sub push_beat { 
    my ($self, $new_beat) = @_;
    my $beats = $self->beats;
    push @$beats, $new_beat;
    $self->beats($beats);
}

sub clear_beat {
    my ($self) = @_;
    $self->beats([]);
}

こういったものも、metaclass と providers(メソッドマッピング)を指定することで簡単に作成できます。

use MooseX::AttributeHelpers;

has beats => (
    is         => 'rw',
    isa        => 'ArrayRef[Music::AutoPhrase::BeatPattern]',
    default    => sub { [] },
    required   => 1,
    metaclass => 'Collection::Array',
    provides  => {
        push  => 'push_beat',
        clear => 'clear_beat',
    }
);

これで、$channel->push_beat($beat) みたいに使えるようになります。すばらしいですね。どういったメソッドが使えるかについては

perldoc MooseX::AttributeHelpers::MethodProvider::Array
perldoc MooseX::AttributeHelpers::MethodProvider::List
perldoc MooseX::AttributeHelpers::MethodProvider::Hash
perldoc MooseX::AttributeHelpers::Number
perldoc MooseX::AttributeHelpers::Counter
perldoc MooseX::AttributeHelpers::Bool

に書いてあります。

Role

Music::AutoPhrase::Channel には selector という属性があります。これは、自動作曲する際にどういう基準で音を選ぶのかというロジックを入れる場所です。内部状態の遷移によって出力がかわる可能性があるので関数リファレンスではなくオブジェクトをセットする必要があり、且つそのオブジェクトは select_note() という音を選び出すメソッドを持っている必要があります。
#すいません、意味不明ですよね。。

いままでは以下のようなコードで該当するメソッドがあるかを確認していました。

    # set custom selector
    if (defined $arg{selector}) {
        my $fullns = SELECTOR_NS_PREFIX . $arg{selector};
        if ($fullns->require() && $fullns->can('select_note')) {
            $self->selector($fullns->new());
        }
    }

Moose では with 'ロール名' という宣言で、あるクラスがあるメソッドを持っていることを保証できます。まずは、

lib/Music/AutoPhrase/NoteSelector.pm

package Music::AutoPhrase::Role::NoteSelector;
use Moose::Role;

requires 'select_note';

1;

ロールの制約を受ける側ではwithで上記のロールを指定するだけです。

lib/Music/AutoPhrase/NoteSelector/Simple.pm

package Music::AutoPhrase::NoteSelector::Simple;

use Moose;
use Music::AutoPhrase::Note;
use Music::AutoPhrase::NoteSelector;
use List::Util qw/shuffle/;

extends 'Music::AutoPhrase::NoteSelector';    # 継承
with 'Music::AutoPhrase::Role::NoteSelector'; # ロール

__PACKAGE__->meta->make_immutable;
no Moose;

この後に実際は select_note() の定義があるのですが、この指定したメソッドが無いと use した時点でエラーが出るようになります。

'Music::AutoPhrase::Role::NoteSelector' requires the method 'select_note' to be implemented by 'Music::AutoPhrase::NoteSelector::Simple' at /Library/Perl/5.8.8/Moose/Meta/Role/Application.pm line 59

その後この NoteSelector を継承した NoteSelector::Simple のオブジェクトを格納する Music::AutoPhrase::Channel 側では、has のオプション "does" を使って、格納されるオブジェクトが上記のロールを持っていなくてはならないという制約を追加します。

has selector => (
    is      => 'rw',
    does    => 'Music::AutoPhrase::Role::NoteSelector',
    default => sub { Music::AutoPhrase::NoteSelector::Simple->new(); },
);

なんというか、こうちゃんととやってる感じが出ますね。new() のなかで can() で調べるとかよりはずっと見やすいなと思いました。

まとめ

そんなこんなで本を読み進めながら branches/moose を修正していったのですが、Moose化だけにして差分を奇麗に見せたいなと思っていたのですが、やりだしたら次から次へとバグが見つかってしまって、こらえきれずに色々直してしまいました。
branch:http://coderepos.org/share/browser/lang/perl/Music-AutoPhrase/branches/moose

Mooseの機能の1%も使えてないですが、その前提で感想を述べさせていただきますと、「書いた人の意図がわかりやすい、それがいい」って感じなのかなと思いました。何かのモデルクラスの場合、ソースの先頭で属性の一覧があり、そこに何が入るのか、デフォルトは何か、必須項目か、みたいな全体像が一気に見えるので、把握しやすくなりますね。

また、subtype/isa による値チェックやcoerce、provides によって、ほかの部分に散らばっていた雑多な処理がまとまってすっきりする気がします。属性値の設定とそのチェックロジックが近くにあるっていうのもいいですね。書き方の問題ですが。

モダンPerl入門は、これらのトピック以外にも テスト/ベンチマーク/XS など盛りだくさんの内容でどれもとても実践的です。ほかのトピックに関しても色々やってみたいですね。
なんかあんまり本の紹介になってないですが、全てのPerlプログラマにオススメできる良書です。まだの方は是非。

Music::AutoPhrase - code-base music composition library

Music::AutoPhrase というモジュールを coderepos に上げました。以下のコマンドでチェックアウトできます。

svn checkout http://svn.coderepos.org/share/lang/perl/Music-AutoPhrase

まだ完成度が低くて、「なんとか動く」っていうレベルではありますが。。

以前 Music::Phrase::MMLGenerator というモジュールを上げていて、基本的なコンセプトそれと同じです。音楽的な教養の無い僕のような人が簡単に音楽を作成できるように、ベースとなるコード進行と音がなるタイミングだけを指示すれば音楽が(いまのところはMIDIファイルが)出きるような仕組みになっています。以前のモジュールから以下のような改善を行っています。

  • 全体的にクラス構造を見直してコードを書き直した
    • 実際に音をどう選択するかのアルゴリズムを後から追加できるようにした
  • pmml という外部アプリケーションへの依存を無くした(MIDI::SImpleに移行)
  • マルチトラックに対応

特定のコマンドラインスクリプトにオプションを与えてファイルを生成するスタイルから、perlスクリプトそのものが1つの楽曲になるような感じに方向転換しています。具体的には以下のようなコードになります。

demo/sample2.pl

#!/usr/bin/perl

use strict;
use warnings;

use Music::AutoPhrase;

my $track = new_track();
$track->set_tempo(120);
$track->set_base_code(qw/
    F G E A
    F G E A
/);
my (@channel);
$channel[0] = new_channel(
    inst  => 2,
    vol   => 60,
    octav => [qw/4 5/],
)->push(
    '2-------2-------2-------2-------',
    '2-------2-------2-------2-------',
);

$channel[1] = new_channel(
    inst     => 69,
    vol      => 90,
    octav    => [qw/5 6/],
    selector => 'Loose',
)->push(
    '111-1-11-1-11-1-111-1-11-11-1-1-',
    '111-1-11-1-11-1-111-1-11-11-1-1-',
);

$track->push_channel(@channel);
save_as_midi($track, $0 . '.mid');

このplを実行するとMIDIファイルが作成されます。

$track が Music::AutoPhrase::Track オブジェクトで、1つの楽曲を表現しています。new_channel() で Music::AutoPhrase::Channel オブジェクトを作成し、それを$trackにpushしてくことで曲が出来る、っていうのが全体像です。

各チャンネルにpushされている32文字の文字列は Music::AutoPhrase::BeatPattern オブジェクトに変換されて保持されます。これはどういうタイミングで音がなるかを表していて、1なら単音、3なら3和音を $track に設定された base_code にしたがって選び出します。

このコードにしたがって音を選び出す仕組みが Music::AutoPhrase::NoteSelector::* に入っていて、channelオブジェクトのselectorアクセサにセットされたインスタンスが使用されます。デフォルトは Music::AutoPhrase::NoteSelector::Simple で、単純にそのコードを構成する和音の中からランダムに指定された個数の音を選び出します。

package Music::AutoPhrase::NoteSelector::Simple;

use strict;
use warnings;

use Music::AutoPhrase::Note qw/note_uniq/;

use base 'Music::AutoPhrase::NoteSelector';
use List::Util qw/shuffle/;

sub select_note {
    my ($self, $code, $octav_range, $dur, $count) = @_;

    my (@notes);
    for (1..$count) {
        push @notes, Music::AutoPhrase::Note->new(
            octav    => (shuffle @{$octav_range})[0],
            note_num => (shuffle @{$code->candidate()})[0],
            duration => $dur,
        );
    }
    return note_uniq(@notes);
}

$channel[1] で指定しているLoose(Music::AutoPhrase::NoteSelector::Loose)は、そのコードを構成する和音の各音を7度ずらした音を選択時の候補に入れる、というモジュールでこうするとなぜか旋律が不安定で且つ外れすぎない感じになります。

ざっくりとはこんな感じです。かなり作りかけなのでいけてないところが沢山あるのですが、興味のある方はぜひ改善をcommitしていただければと思います。今後は以下の点をもうちょっと改善していきたいなとおもっています。

  • 対応していないMIDI命令への対応
    • 左右のパン
  • DSLチックな書き方が出きるように
  • リズムパートをどうするか考える

まだこれだけではあまり本格的な音楽は作れないかもですが、これで生成したMIDIファイルをGarageBandを組み合わせて編集してeffectをかけたりすると結構おもしろいかなと思っています。
#しかし家のmacbookが死んでGarageBnadが使えない。。。

Business::ISRC 0.01

Business::ISRC というモジュールをcodereposにあげました。

changeset:
http://coderepos.org/share/changeset/16900

本体:
http://coderepos.org/share/browser/lang/perl/Business-ISRC/trunk/lib/Business/ISRC.pm?rev=16900

SYNOPSYS

  use Business::ISRC;

  # create object (validate string)
  my $isrc = Business::ISRC->new("usl4q0702458");
  if (!defined $isrc) {
      die "invalid isrc format";
  }

  $isrc->country_code;    # US
  $isrc->country_name;    # Unites States
  $isrc->registrant_code; # L4Q
  $isrc->year; # 07
  $isrc->designation_code; # 02458

  # get normalized string
  print $isrc; # US-L4Q-07-02458

  # or this is the same as above
  print $isrc->as_string();

これはISRCをparseして文字列表現を正規化するためのモジュールです。やっていることは単に正規表現で与えられた文字列分割して名前で引けるようにしているだけです。Locale::Country で国コードのチェックをしているので、その副産物として国名の英語表記が取れるようになります。

恥ずかしながら Test::Perl::Critic を初めて使ったのですが、すごく簡単でいいですね。

ISRC とは

ISRC とは主に海外よく使われている(国内でも使われている)楽曲の(厳密には「録音の」)ユニークなコードです。市場に流通しているCD等の音源にこのISRCというコードが振られていて、裏側の楽曲管理に利用されています。例えば僕の「Saitama Life」という楽曲の場合以下のようなISRCが割り振られています。

US-L4Q-07-02458

本当は ISRC-US-L4Q-07-02458 のように ISRC- というprefixが付くのですが、省略されることが多いようです。上記のISRCは以下のような成分に分解出来ます。

US    : アメリカの楽曲
L4Q   : 事業者コードが L4Q (これは CDBaby のコードかな?)
07    : 2007年の楽曲
02458 : 年内と押し番号が02458

非常にシンプルですね。ISRC の組成や使用方法については以下のサイトが詳しいです。

RESOURCES - ISRC - Handbook (incorporating the ISRC Practical Guide)
http://www.ifpi.org/content/section_resources/isrc_handbook.html

この事業者コードや通し番号(実際は通しじゃないかもですが)の部分を誰が発行しているかというと、それぞれの国のしかるべき団体がコードを発行しているようです。日本の場合だとレコード協会になります。

日本レコード協会-ISRC
http://isrcdb.jmd.ne.jp/index.html

Busines::UPC

また、ISRCとは別に UPC というコードがあり、アルバム(シングル/アルバムの区分ではなく、楽曲のコンテナ/製品パッケージとしての単位)のユニークなコードとして広く使われてします。上記の「Saitama Life」は「Saitama Life - EP」というアルバムに収録されていて、そのUPCは 634479662768 になります。UPCに関しては既にそれを扱うモジュールがCPANに上がっているようです。
#あまりメンテナンスされてないようですが。。

Business::UPC
http://search.cpan.org/~robf/Business-UPC-0.04/UPC.pm

今回のISRCのモジュールも一応上記とそろえて Business::ISRC としてみました。

まとめ

プロ/アマ問わず世界中の楽曲がこのISRCUPCで管理されていれば色々すっきりすることも多いと思うのですが、ISRCUPCの取得に管理団体への申請手続きがあったり、AMG等の他のidも使われていたりして現実にはなかなか統一はされていないようです。

また、楽曲のアーティストを識別するコードが(僕の知る限り)無いようなんですよね。あったらすごく便利だと思うのですが、実際やるとなるとレコードレーベルを跨いだコード運用が必要になったりとか、その辺が難しいのかもしれません。憶測ですが。

この辺りの歴史的な背景とかコード体系の勢力図とかは結構面白そうだなと思いました。

List::TableMark 0.01 を coderepos に入れました

前から少しずつ考えていた、リストをテーブル風に扱うモジュールのプロトタイプをcodereposに入れました。

http://coderepos.org/share/changeset/13035

なんでこんなものを作ったかといいますと、テーブル的なレイアウトを扱う局面ってすごくあって、HTMLのtableタグとかもそうですが、ul, li の構造でliの要素数が固定の場合とか、カレンダーの表示とか、「特定の要素数で折り返して且つ行の最後まで行く」という仕組みが欲しいなと思っていました。
# あと Class::InsideOut を使ってみたかった

SYNOPSIS 丸コピーですが、使い方的には以下のような感じです。

    my $list = List::TableMark−>new(col => 7);
    $list−>push(undef(), undef());
    $list−>push(1..31);
    $list−>finish();

    my $bar = "−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−\n";
    my $output = "";
    foreach my $num (@$list) {
        $output .= $bar if $num−>is_table_start;
        $output .= sprintf("week %d | ", $num−>row)
            if $num−>is_row_start;

        $output .= $num−>is_empty
            ? ’−−|’
            : sprintf("%2d|", ($num−>value || 0))
            ;
        $output .= "\n" if $num−>is_row_end;
        $output .= $bar if $num−>is_table_end;
    }
    print $output;

    # output
    # −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
    # week 1 | −−|−−| 1| 2| 3| 4| 5|
    # week 2 |  6| 7| 8| 9|10|11|12|
    # week 3 | 13|14|15|16|17|18|19|
    # week 4 | 20|21|22|23|24|25|26|
    # week 5 | 27|28|29|30|31|−−|−−|
    # −−−−−−−−−−−−−−−−−−−−−−−−−−−−−−

    # you can also push reference to the list
    my $fruit = List::TableMark−>new(col => 3);
    $fruit−>push(
        { name => ’banana’ color => ’yellow’ },
        { name => ’applecolor => ’red’    },
        { name => ’lemmon’ color => ’yellow’ },
        { name => ’grape’  color => ’purple’ },
    );
    $fruit−>finish(); # push undef value to rest of the table
    foreach my $data (@$list) {
        my $ref = $data−>value; # get pushed refernce
        if (!$ref−>is_empty) {
            print $ref−>{name} . ’ ’;
        }
        else {
            print "−−− ";
        }
        print "\n" if $ref−>is_line_end;
    }
    # output:
    # banana apple lemmon
    # grape −−− −−−

横幅を指定してlistを作成してそこにデータをpushしていくと、特定の区切りでマークが付く、って感じです。配列のリファレンスを bless しているので、@$list で中身(List::TableMark−::Element の配列)が取れます。

データを取り出した後に、$data->value とかやらなくてもスカラーコンテキストで評価された時点で元の値として評価される、っていうのがかっこいいかなと思ったのですが、元のオブジェクトを取り出しづらくなりそうだし、豪快なoverloadは僕の手に負えない可能性大なので見送りました。

$list->push されたデータは List::TableMark−::Element にマークとともに入れられて保存されます。取り出したあとは is_* 系のメソッドでフラグの確認ができるのですが、hashで一気にとれるようにもなっています(markhash())。これはテンプレートエンジンに渡す際に簡単に書けるようにそうしてみました。

    my (@loop);
    foreach my $data (@$list) {
        my %temp = $data->markhash();
        $temp{value} = $data->value;
        push @loop, \%temp;
    }
    $template->param(loop => \@loop);

結構探して確認したのですが、似たようなモジュールが既にあったら誰かツッコミお願いします!

今日一日他の方のコードを結構見ていたのですが、すごい勉強になりますね。特にテストの書き方とか僕はすごく未熟だなと、Test::More 全然使いこなせてないなと、いやむしろテスト書いてないなと反省しました>< perlcritic が入っていればそのチェックもするっていうのは素敵ですね、真似しよう。