Myブログ軍師
http://catfrog.net/PHP/gunshi.php

yto「今日はブログを書かない」
諸葛亮曰く「天下を狙わんとするものが無為に過ごすのですか･･･」

週末に SUFARY.pm や SUFARY.xs のソースを見てたら(ref.[2006-04-23-2])、
あまり使ってない（忘れてる）メソッドがいろいろありました。
suffix array をトライとして使うためのメソッド(range_search)や、
開始・終了文字列を指定してリージョンを取得するメソッド(get_region)
なんかもあります。SUFARY 自体、なんか途中で投げ出してしまった感が
ありありなので、この際ちょっとサンプルプログラムを作ってみます。
SUFARY Hacks としてシリーズ化していきます！
（なお SUFARY.pm のオフィシャルなドキュメントは、
sufary-2.3.8/doc/ReferenceP.txt にあります。）

必要なもの：
- SUFARY http://nais.to/~yto/tools/sufary/ および、
  その Perl モジュール。


今回使用するメソッドは以下の二つ：

■ get_position(INT)
suffix array（配列）の添字を index point（文字列のoffset）に
変換します。

■ get_string(OFFSET, LEN)
検索対象テキストの OFFSET バイト目から LEN バイト取り出して文字列
として返します。

これらを用い、「2回以上現れる部分文字列のうち最長のもの」つまり
「最長の繰り返し文字列を探す」を取り出すサンプルプログラム
longest_repetition.pl を作りました。

#!/usr/bin/perl
use strict;
use warnings;
use SUFARY;

my $fn = shift @ARGV;
my $suf = SUFARY->new($fn);

my $asz = $suf->{'arraysize'};  # 配列の大きさ
my $tsz = $suf->{'textsize'};   # テキストの長さ

my %longest = (len => 0, posi => -1); # 結果が入る
my $pre_posi = -1;
for (my $i = 0; $i < $asz; $i++) {
   my $posi = $suf->get_position($i);
   if ($pre_posi != -1) {
       my $common = compare_suffixies($suf, $pre_posi, $posi);
       if ($common > $longest{len}) {
           $longest{len} = $common;
           $longest{posi} = $pre_posi;
       }
   }
   $pre_posi = $posi;
}

printf "%s (%d)\n",
   $suf->get_string($longest{posi}, $longest{len}),
   $longest{len};

# 二つのsuffixを比較し先頭から何文字共通かを返す
sub compare_suffixes {
   my ($suf, $p1, $p2) = @_;
   my $len = 0;
   for (; $len + $p1 < $tsz and $len + $p2 < $tsz; $len++) {
       if ($suf->get_string($p1 + $len, 1) ne
           $suf->get_string($p2 + $len, 1)) {
           last;
       }
   }
   return $len;
}

ソートされた文字列を上から順番に取り出し、直前の文字列とつきあわせ
て、先頭からの共通文字列数を計算します。最長の文字列数を持つものを
$longest で保持しています。

準備と実行結果：

% cat aaa
ACGTTTCGACACAGCTCTAGACAGCTCCCCCCTAGACACCCAAAAAGAGAGAGATTTTGGGAGAGAG
% mkary -q aaa
% longest_repetition.pl aaa
ACAGCTC (7)

最長の繰り返し文字列は「ACAGCTC」で、7文字でした。

日本語でやるときは EUC-JP に変換してから mkary すると良いです。


■参考

- [を] 自分マイニング！ - Blogでよく使うフレーズは？[2005-01-18-3]
- [を] Suffix Array の解説文書のリンク集[2006-04-10-3]
- [を] SUFARY のパッケージに付属のドキュメント[2006-04-25-2]

■読者への挑戦

サンプルプログラム中の関数 compare_suffixes は、一文字ずつちまちま
取り出して比較しているので、ちょっと効率が悪いです。一文字ではなく
一気に何文字か get_string で取り出して比較するのが良いですね。
さて、ここで問題です！
そのときの文字数ってどうやって決めたら良いでしょうか？
このタスクに特化した方法がありますよ。

ヒント：最初は何文字かまとめて比較し、その後は一文字ずつ。

WEB+DB PRESS Vol.32 の id:naoya さんの書いた Catalyst 入門記事の
インストラクションに従って実行してみたメモ。

■WEB+DB PRESS Vol.32


記事では Catalyst 5.65 だそうだが、インストールしてみたら、
Catalyst 5.67 であった。すでに記事の内容と異なる箇所もあり、
開発の速さを感じた。

そのまま書いてある通りにやれば簡単に追体験できるかと思いきや、
かなり時間がかかった。なかなか手ごわいな、Catalyst。


■インストール

本文にも書いてあったが、すごく時間がかかる。ほんとに。

% sudo perl -MCPAN -e 'install Task::Catalyst'

■動かしてみる

% catalyst.pl MyApp
% cd MyApp
% script/myapp_server.pl -r

ブラウザで「http://localhost:3000/」にアクセスしてみる。ktkr!!!

% emacs lib/MyApp.pm （追加）

sub hello : Local {
   my ($self, $c) = @_;
   $c->response->output('Hello, World!');
}

ブラウザで「http://localhost:3000/hello」にアクセスし、
「Hello, World!」の表示を確認。嬉しい！

※なお、p.161のリスト1(MyApp.pm)は、v5.67 では default メソッドが
lib/MyApp/Controller/Root.pm に移っており、だいぶ様相が異なっている。


■コントローラの作成

% script/myapp_create.pl controller Foo
% emacs lib/MyApp/Controller/Foo.pm （追加）

sub default : Private {
   my ( $self, $c ) = @_;
   $c->response->body('hello! /foo');
}
sub bar : Local {
   my ( $self, $c ) = @_;
   $c->response->body('hello! /foo/bar');
}
sub baz : Local {
   my ( $self, $c ) = @_;
   $c->response->body('hello! /foo/baz');
}

ブラウザで「http://localhost:3000/foo」
「http://localhost:3000/foo/bar」
「http://localhost:3000/foo/baz」を確認。


■Template Toolkit でビュー

% sudo perl -MCPAN -e 'install Catalyst::Helper'
% sudo perl -MCPAN -e 'install Time::Piece'

% emacs myapp.yml （追加）

View::TT:
 INCLUDE_PATH:
   - 'root/templates'
 TEMPLATE_EXTENSION: '.tt'

% script/myapp_create.pl view TT TT
% emacs lib/MyApp.pm （修正）

use Time::Piece;
sub hello : Local {
   my ($self, $c) = @_;
   $c->stash(now => Time::Piece->new);
   $c->forward($c->view('TT'));
}

（※p.164のソースでは「use Time::Piece;」がない。）

% mkdir root/templates
% root/templates/hello.tt

<html>
<head><title>[% c.config.name %]</title></head>
<body>
<h1>[% c.config.name %]</h1>
<p>Hello! [% now.year %]</p>
</body>
</html>

（※p.164のリスト4はheadタグが閉じられていない。）

ブラウザで「http://localhost:3000/hello」を確認。


■モデルを作る

準備。

% sudo perl -MCPAN -e 'install Catalyst::Helper::Model::CDBI'
% sudo perl -MCPAN -e 'install Class::DBI'
% sudo perl -MCPAN -e 'install Class::DBI::mysql'
% sudo perl -MCPAN -e 'install DBD::mysql'

（※test通らなくても強引にインストールした。）

MySQLのデータ作成。

% mysql
create database myapp;
use myapp;
create table entry (
 id int unsigned auto_increment primary key,
 title varchar(255),
 body text,
 timestamp timestamp
);
insert into entry values (NULL, 'Hello','This is a pen.', NOW());
insert into entry values (NULL, 'Bye','Sayonara!', NOW());
insert into entry values (NULL, 'Oreore','Ore dayo ore!', NOW());

% script/myapp_create.pl model CDBI CDBI dbi:mysql:myapp root
% emacs myapp.yml （追加）

Model::CDBI:
 dsn: 'dbi:mysql:dbname=myapp'
 password: ''
 user: 'root'

% emacs lib/MyApp.pm （書き換え）

sub hello : Local {
   my ($self, $c) = @_;
   my $entries = MyApp::Model::CDBI::Entry->retrieve_all;
   $c->stash(entries => $entries);
   $c->stash(now => Time::Piece->new);
   $c->forward($c->view('TT'));
}

（※タイポ：p.165のソースの「my $entres」→「my $entries」。
行末のセミコロンも抜けてた。）

% root/templates/hello.tt （追加）

<dl>
[% WHILE (entry = entries.next) %]
<dt>[% entry.title %]</dt>
<dd>[% entry.body %]</dd>
[% END %]
</dl>

ブラウザで「http://localhost:3000/hello」にアクセスする。
ちょっと感動！

はまりメモ：
Catalyst の Catalyst::Helper::Model::CDBI でいつもハマる・・・orz
http://www.drk7.jp/MT/archives/001032.html

その２）Can't locate object method "set_sql" とエラーがでる

同じ現象が起こったので drk7 さんのように、
/usr/lib/perl5/site_perl/5.8.8/Class/DBI/Loader.pm
に「require Class::DBI;」を追加した。……。

雑感：
この記事、id:naoya さん以外に事前に通して実行した人いないのかな。
こういう記事って、モニターさん（詳しくない人ね）がたくさん必要かも。

- WEB+DB PRESS一覧