検索条件
全27件
(5/6ページ)
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の関数を見て、次々回でモジュールまとめていく感じでいこうかな。
追記！割りとガチで使う場合は 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/）
最初リアルタイムで反映されなくて試行錯誤していたのですが、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の各面の最後の２文字の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
2014/02/05(水)Web Speech API でツイート
Web Speech APIのためにマイク買ったので、音声でツイートできるAjaxなCGIを適当に書いてみました。（CGIモジュールなんて使うのもクソ久しぶり）
よく使うような単語やフレーズの認識精度はすげーです。
Web Speech APIの仕様は、「Web Speech API Specification」を参照。
完成したやつ↓（隣の部屋の人に聞こえないようマイクに近づいて小声でしゃべっています）
「index.html」
<!DOCTYPE html>
<html lang="ja">
<head>
<meta charset="UTF-8">
<title>こえでついーと！</title>
<link rel="stylesheet" href="voice_tweet.css">
<script src="http://ajax.googleapis.com/ajax/libs/jquery/2.1.0/jquery.min.js"></script>
<script src="voice_tweet.js"></script>
</head>
<body>
<h1>こえでついーと！</h1>
<div id="status">状態：<span id="desc"></span></div>
<div id="recog_result"></div>
<button>音声認識開始</button>
</body>
</html>
「voice_tweet.css」
@charset "UTF-8";
#recog_result
{
width: 600px;
height: 100px;
border: 1px solid #666;
padding: 10px;
margin-top: 20px;
}
button
{
margin-top: 10px;
}
「voice_tweet.js」
"use strict";
$(function()
{
var script_url = "voice_tweet.cgi";
var api_recog = $("#recog_result");
var api_status = $("#status #desc");
var api_button = $("button");
var is_recognizing = false; // 音声認識中か否か
var interim_result = "";
var error_en2ja = { "no-speech": "何か話して" };
var recognition = new webkitSpeechRecognition();
recognition.continuous = true; // 複数の連続した認識を有効にする
recognition.interimResults = true; // 途中結果を返す
recognition.lang = 'ja'; // 指定しない場合はドキュメントルートのlangが使われる（BCP 47 を参照）
recognition.start();
recognition.onresult = function(event)
{
for (var i = 0; i < event.results.length; i++)
{
api_recog.text(interim_result + " " + event.results[i][0].transcript);
}
var result = event.results[event.results.length - 1];
if (result.isFinal)
{
var last_spoken = result[0].transcript.trim();
console.log("音声認識結果：" + last_spoken);
if (last_spoken === "ストップ" || last_spoken === "stop")
{
recognition.stop();
}
else if (last_spoken === "クリア")
{
api_recog.text("");
}
else if (last_spoken === "削除")
{
api_recog.text( remove_trailing_word( remove_trailing_word( api_recog.text() ) ) );
}
else if (last_spoken === "ツイート" || last_spoken === "ツイード")
{
$.ajax
({
dataType: "text",
data:
{
"tweet_text": remove_trailing_word( api_recog.text() ),
},
url: script_url,
timeout: 10000, // 10秒
type: "POST",
success: function(res)
{
console.log(res);
},
error: function(XMLHttpRequest, textStatus, errorThrown)
{
console.log("ツイート失敗");
//console.log(XMLHttpRequest);
//console.log(XMLHttpRequest.status);
//console.log(textStatus);
//console.log(errorThrown);
}
});
api_recog.text("");
}
interim_result = api_recog.text();
}
};
recognition.onstart = function()
{
is_recognizing = true;
interim_result = "";
api_button.text("音声認識停止");
console.log("音声認識スタート！");
api_status.text("音声入力待ち");
};
recognition.onerror = function(event)
{
var error = error_en2ja[event.error] || event.error;
console.log("音声認識エラー：" + error);
api_status.text(error);
};
recognition.onend = function()
{
is_recognizing = false;
api_button.text("音声認識再開");
console.log("音声認識が終了しました");
api_status.text("音声認識が終了しました");
};
api_button.click(function()
{
is_recognizing ? recognition.stop() : recognition.start();
});
function remove_trailing_word(text)
{
var splited_text = text.split(/s+/);
splited_text.pop();
return splited_text.join(" ");
}
});
「voice_tweet.cgi」
#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use open OUT => qw/:utf8 :std/;
use Encode qw/decode_utf8/;
use CGI;
#use CGI::Carp qw/fatalsToBrowser/;
use Net::Twitter::Lite::WithAPIv1_1;
use Text::Truncate;
use Try::Tiny;
my $MAX_TWEET_LEN = 140;
my @IP_WHITE_LIST = qw/150.65.110.57/;
my %WHITE_IP;
@WHITE_IP{ @IP_WHITE_LIST } = ();
my $q = CGI->new;
open(my $fh, '>', 'log.txt') or die $!; # 直前のリクエスト分のログを取る
if ($q->request_method eq 'POST')
{
my $ip = $q->remote_addr;
my $tweet_text = decode_utf8( $q->param('tweet_text') );
if (exists $WHITE_IP{$ip} && length $tweet_text)
{
print {$fh} "$tweet_text\n";
my $nt = Net::Twitter::Lite::WithAPIv1_1->new(
consumer_key => '***',
consumer_secret => '***',
access_token => '***',
access_token_secret => '***',
ssl => 1,
);
my $appendix = " （音声認識ツイート）";
$tweet_text = truncstr($tweet_text, $MAX_TWEET_LEN - length $appendix);
print "Content-Type: text/plain; charset=UTF-8\n\n";
try {
$nt->update("$tweet_text$appendix");
print "ツイート成功！[$ip]";
}
catch {
print "ツイート失敗！[$ip]";
print {$fh} $_;
};
}
}