ぱわふる

検索条件

タグで絞り込み Web技術(4) プログラミング::JavaScript(2) プログラミング::Perl(37) プログラミング::Python(5) プログラミング::自然言語処理(6) 勉強(12) 勉強::心理学(1) 勉強::統計学(11)

日付で絞り込み 2012年(2) 2013年(5) 2014年(27) 2015年(5) 2016年(1) 2019年(1) 2022年(1) 2023年(1)

全43件 (7/9ページ) 一覧表示に切り替え記事本文を表示

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

プログラミング::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 &lt;&lt;"END";
+Lingua::JA::KanjiTable::InJoyoKanji
+Lingua::JA::KanjiTable::InJinmeiyoKanji
3005
3041t3096
309D
309E
30A1t30FA
30FCt30FE
END
}

コメント（0件）

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

プログラミング::PerlWeb技術

サーバから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>

コメント（0件）

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

プログラミング::Perl

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

準備：

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

コメント（0件）

2014/02/05(水)Web Speech API でツイート

プログラミング::JavaScriptプログラミング::PerlWeb技術

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} $_;
        };
    }
}

コメント（4件）

2014/01/11(土)Directional Formatting Characters に関するメモ

プログラミング::Perlプログラミング::自然言語処理

大部分の言語ではテキストを左から右へ表示するけど、アラビア語やヘブライ語は右から左に表示するらしいです。しかしながら、それらの言語のテキスト中に数字や英語などの左から右へ表示されるテキストが含まれると、テキストが「左から右」と「右から左」の双方向性を持つことになってしまいます。そのため、双方向性を持つテキストをどう表示したら良いか曖昧性が生じます。（恐らくレンダリングエンジンが）よしなに表示してくれることもあるけど、それだけでは十分でないケースがあるため、方向性を制御できるように「Directional Formatting Characters」が必要になるっちゅうこっちゃ。

「Directional Formatting Characters」の一覧は以下の通り。

U+061C  ARABIC LETTER MARK
U+2066  LEFT-TO-RIGHT ISOLATE
U+2067  RIGHT-TO-LEFT ISOLATE
U+2068  FIRST STRONG ISOLATE
U+2069  POP DIRECTIONAL ISOLATE
U+200E  LEFT-TO-RIGHT MARK
U+200F  RIGHT-TO-LEFT MARK
U+202A  LEFT-TO-RIGHT EMBEDDING
U+202B  RIGHT-TO-LEFT EMBEDDING
U+202C  POP DIRECTIONAL FORMATTING
U+202D  LEFT-TO-RIGHT OVERRIDE
U+202E  RIGHT-TO-LEFT OVERRIDE

恐らく、99.9%ぐらいの日本語がメインのテキストではこれらのフォーマット文字は不要であると考えられるので、拙作のPerlモジュール「Lingua::JA::NormalizeText」ではこれらの文字を削除するオプションを用意しています。（Webアプリケーションでこられの文字を埋め込んでイタズラされちゃうおそれがあるため）

さらに詳しい情報は↓を参照されたし。 Unicode Standard Annex #9

コメント（0件）