2014/05/25(日)Perl Data Language 基礎編 #02 「行列の演算とバッド値」

PDLの関数を見る前に行列の演算です。

ドキュメントは以下の通り。

  • PDL::Core(メソッド、型変換のための関数、PDLの生成、型変換、スレッドなど)
  • PDL::BadValues(PDLにおけるバッド値サポートの議論)

バッド値は欠損値に使うのが良さそう。バッド値があるとバッドフラグがついて、さらにバッドフラグがついたピドル(PDLの変数のこと)で演算したりするとバッドフラグが伝染するみたい。ちなみに他の文字列(nyan)はバッド値がつくのか疑問に思ったので試したけど、ちゃんと'bad'や'BAD'と区別してバッドフラグはつかないようになっている模様。

他の注意点は行列同士の積は「x」を使うことぐらい。

統計についてまとめていく前にコア関数をまとめて、主要なドキュメントをまとめて、グラフ描画についてまとめます。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use PDL;
use DDP filters => { -external => [ 'PDL' ] };

my $a = pdl [
    [ 1, 2 ],
    [ 3, 4 ]
];

my $b = pdl [
    [ 5 ],
    [ 6 ]
];

say "$a: $a";
say "$b: $b";

say "$a x $b";
say $a x $b; # 行列の積は*でなくてxを使う

my $d = $a;
$d = $d ** 3; # 3乗

say "$d($a^3): $d";
say "$a: $a"; # $a には影響しない

my $e = pdl [
    [ 'inf',    2    ],
    [ 'nan', ' -inf' ]
];

my $f = pdl [
    [ '-inf',  'bad'   ],
    [  3    ,  'nyan' ]
];

say "$e: $e";
say "$f: $f";

say "$e + $f:";
say $e + $f;

say "バッドフラグ";
say PDL->new(3)->badflag;
say PDL->new('bad')->badflag;
eval { PDL->new('nyan')->badflag; };
print $@ if $@;
my $g = pdl [ 'nyan' ];
say $g->badflag;
say p $g;

実行結果↓

$a: 
[
 [1 2]
 [3 4]
]

$b: 
[
 [5]
 [6]
]

$a x $b

[
 [17]
 [39]
]

$d($a^3): 
[
 [ 1  8]
 [27 64]
]

$a: 
[
 [1 2]
 [3 4]
]

$e: 
[
 [ inf    2]
 [ nan -inf]
]

$f: 
[
 [-inf    0]
 [   3    0]
]

$e + $f:

[
 [-nan    2]
 [ nan -inf]
]

バッドフラグ
0
1
PDL::Core::new_pdl_from_string: found disallowed character(s) 'nyan' in nyan at core.pl line 50.
0
PDL {
    Data     : [0]
    Type     : double
    Shape    : [1]
    Nelem    : 1
    Min      : 0
    Max      : 0
    Badflag  : No
    Has Bads : No
}

2014/05/25(日)Perl Data Language 基礎編 #01 「PDLのインストール」

統計検定に向けて「Perlで統計」をまとめていきます。(の予定でしたが、思いのほかPDLが大きいライブラリだったのでまずはPDLをまとめていきます)

PDL(Perl Data Language)は、科学技術計算とその結果の描画のためのPerl拡張です。PDLは速くて、IDL(科学技術計算でよく使われるデータ分析用プログラミング言語)やMATLABと匹敵するか、それらより速い(often outperforming)です。PDLによって、画像などの多次元データも効率よく格納できて素早く操作できます。$a = $b + $c で $b と $c が大きいデータ集合 (たとえば 2048x2048 画像) でもほんの一瞬で結果を得られます。PDL変数(piddleと呼ばれる)は基本的なデータ型の広範囲をサポートし、たとえば $x は何次元のデータでも入ります(おそらくメモリが許す限り)。@x に格納しない理由は、「メモリ」と「スピード」のためです。(ドキュメントより)

インストールは以下の通り。

cpanm Data::Printer
cpanm Data::Printer::Filter::PDL

今回はとりあえず動かすところま'で。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use PDL;
use DDP filters => { -external => [ 'PDL' ] };

my $piddle = pdl [1,0,0,1];
say $piddle;

say "Data::Printer::Filter::PDL で表示:";
p $piddle;
print "\n";

print "要素数:" . $piddle->nelem . "\n";
say $piddle->info("メモリ消費量:%M");

print "\n";


my $piddle2 = pdl [ [ 1 .. 3 ], [ 3 .. 5 ] ];
say $piddle2;

say "Data::Printer::Filter::PDL で表示:";
p $piddle2;
print "\n";

print "要素数:" . $piddle2->nelem . "\n";
say $piddle2->info("メモリ消費量:%M");

実行結果:
pdl

次回はPDLの関数を見て、次々回でモジュールまとめていく感じでいこうかな。

追記!割りとガチで使う場合は GSL(GNU Scientific Library)をインストールしておきましょう。パッケージ管理システムがAPTの場合は「sudo apt-get install libgsl0-dev」でOK!GSLのインストールより先にPDLをインストールしてしまった場合は、「cpanm PDL --reinstall」でPDLを再インストールしましょう。

2014/03/21(金)Lingua::JA::KanjiTable - Perlで常用漢字表と人名用漢字表を扱う

https://metacpan.org/pod/Lingua::JA::KanjiTable

常用漢字表だけでも個人的には嬉しいのですが、人名用漢字表も用意してあるので妥当な名かのチェックもできます。戸籍法 第50条と戸籍法施行規則 第60条によると、子の名には常用漢字表の漢字と人名用漢字表の漢字と片仮名と平仮名が使えるようなので、以下のコードで名の妥当性をチェックできます。(名は Mock::Person::JP で出力)

#!/usr/bin/env perl
 
use strict;
use warnings;
use utf8;
use Lingua::JA::KanjiTable;
 
my @name_list = qw/希砂妃 みのる 菜奈世
勇凪 ソラ 未佑 茶流 怜実 紫翠 夢里/;
 
for my $name (@name_list)
{
    $name =~ /^p{InMei}+$/
        ? print "validn"
        : print "invalidn"
        ;
}
 
sub InMei
{
    return <<"END";
+Lingua::JA::KanjiTable::InJoyoKanji
+Lingua::JA::KanjiTable::InJinmeiyoKanji
3005
3041t3096
309D
309E
30A1t30FA
30FCt30FE
END
}

2014/03/08(土)PerlでServer-Sent Events

サーバからPUSHされたイベントを受け取るやつ。(http://www.w3.org/TR/eventsource/

Server-sent Event

最初リアルタイムで反映されなくて試行錯誤していたのですが、nginxの設定を変えたらリアルタイムで反映されるようになりました。(http://stackoverflow.com/questions/13672743/eventsource-server-sent-events-through-nginx

コードは下の通りで「plackup」とかで立ち上げられます。

#!/usr/bin/env perl

use strict;
use warnings;
use AnyEvent;
use Time::Piece;
use HTTP::ServerEvent;

my $AFTER    = 1;
my $INTERVAL = 1;
my $DURATION = 60 * 30; # 秒

my $html = do { local $/; <DATA> };

my $app = sub {
    my $env = shift;

    if ($env->{PATH_INFO} ne '/sse/events')
    {
        return [ 200, ['Content-Type', 'text/html'], [$html] ];
    }

    if ( ! $env->{"psgi.streaming"} )
    {
        my $err= "Server does not support streaming responses";
        return [ 500, ['Content-Type', 'text/plain'], [$err] ];
    }

    return sub {
        my $responder = shift;
        my $writer    = $responder->([ 200, [ 'Content-Type' => 'text/event-stream; charset=UTF-8' ] ]);

        my $cnt = 0;

        my $t; $t = AnyEvent->timer(
            after    => $AFTER,
            interval => $INTERVAL,
            cb       => sub {
                my $now = localtime->strftime('%Y-%m-%d %H:%M:%S');

                my $event = HTTP::ServerEvent->as_string(
                    id   => ++$cnt,
                    data => $now,
                );

                $writer->write($event);

                undef $t if $cnt > $DURATION;
            }
        );
    };
};

__DATA__
<!DOCTYPE html>
<html lang="ja">
<head>
  <meta charset="UTF-8">
  <title>Server-Sent Events</title>
  <script src="http://ajax.googleapis.com/ajax/libs/jquery/2.1.0/jquery.min.js"></script>
</head>

<body>
  <h1>Server-Sent Events</h1>
  <div id="msg"></div>
  <script>
    var eventSource = new EventSource('/sse/events');
    var msg = $("#msg");

    eventSource.onmessage = function(e)
    {
        console.log("message");
        console.log(e.data);

        msg.prepend("<p>" + e.data + "</p>");
    };

    eventSource.onopen = function(e)
    {
        console.log("open");
    };

    eventSource.onerror = function(e)
    {
        console.log("error");
    };
  </script>
</body>

2014/02/07(金)PerlでのMalformed UTF-8文字を含む文字列の処理とutf-8-strictについて

深く理解できていないように感じたのでコードにまとめた。

準備:

perl -e 'print "ax{FFFF_FFFF}b"' > malformed_utf8.txt
perl -e 'print "x{FFFE}"' > FFFE.txt

コード:

#!/usr/bin/env perl

use strict;
use warnings;
use Encode qw/decode_utf8/;

my $IN_FILE  = 'malformed_utf8.txt';
my $IN_FILE2 = 'FFFE.txt';

{
  open(my $fh, '<', $IN_FILE) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  # malformed が来たら代替文字で置換
  print "Encode::DEFAULT\n";
  printf( "U+%04Xn", ord decode_utf8($_, Encode::FB_DEFAULT) ) for split(//, $text);

  # malformed が来たら即死
  print "Encode::FB_CROAK\n";
  eval { printf( "U+%04X\n", ord decode_utf8($_, Encode::FB_CROAK) ) for split(//, $text) };
  print "Encode::FB_CROAK: $@" if $@;

  # malformed が来たらこれまで処理したデータの一部を返す
  print "Encode::FB_QUIET\n";
  printf( "U+%04X\n", ord decode_utf8($_, Encode::FB_QUIET) ) for split(//, $text);

  # FB_QUIET + 警告(デバッグ時に便利)
  print "Encode::FB_WARN\n";
  printf( "U+%04X\n", ord decode_utf8($_, Encode::FB_WARN) )  for split(//, $text);

  print "\n";
}

## utf8 と utf-8-strict の区別
# utf と 8 の間にハイフン(またはアンダーライン '_')があるかどうか(大文字小文字は関係なし)

## utf-8-strict ってなに?
# 以下の制約がある
# U+FDD0 .. U+FDEF の non-character code points を許さない
# Unicodeの各面の最後の2文字のnon-character code points を許さない(U+XXFFFE, U+XXFFFF. XX = 0 - 10)
# non-shortest エンコーディングを許さない
# ↑を許すと例えば非最短形式のスラッシュとかがバリデーションをすり抜けて脆弱性になりうる
# てなわけで外からの信頼できない入力には常に utf-8-strict を使うべき

{
  open(my $fh, '<:encoding(utf-8)', $IN_FILE) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "$text\n";
  print "\n";
}

{
  open(my $fh, '<:utf8', $IN_FILE) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "\n";
}

# ここから U+FFFE

{
  open(my $fh, '<:encoding(utf-8)', $IN_FILE2) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "$text\n";
  print "\n";
}

{
  open(my $fh, '<:utf8', $IN_FILE2) or die $!;
  chomp(my $text = <$fh>);
  close($fh);

  printf("U+%04X\n", ord) for split(//, $text);
  print "\n";
}

出力:

Encode::DEFAULT
U+0061
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+FFFD
U+0062
Encode::FB_CROAK
U+0061
Encode::FB_CROAK: utf8 "xFE" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
Encode::FB_QUIET
U+0061
U+0000
U+0000
U+0000
U+0000
U+0000
U+0000
U+0000
U+0062
Encode::FB_WARN
U+0061
utf8 "xFE" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "x83" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
utf8 "xBF" does not map to Unicode at /home/***/.plenv/versions/5.18.2/lib/perl5/site_perl/5.18.2/x86_64-linux/Encode.pm line 215.
U+0000
U+0062

utf8 "xFFFFFFFF" does not map to Unicode at read_malformed_utf8.pl line 48.
U+0061
U+005C
U+0078
U+007B
U+0046
U+0046
U+0046
U+0046
U+0046
U+0046
U+0046
U+0046
U+007D
U+0062
ax{FFFFFFFF}b

U+0061
U+FFFFFFFF
U+0062

utf8 "xFFFE" does not map to Unicode at read_malformed_utf8.pl line 69.
U+005C
U+0078
U+007B
U+0046
U+0046
U+0046
U+0045
U+007D
x{FFFE}

U+FFFE