  |
はてなキーワード: subとは
perl でバカ正直に書いたらこうなった。%seen で過去の登場分をメモって枝刈りしてみたけど、効果を発揮できてるんだかどうだか分からん。
use strict;
my $found = 0;
my %seen = ();
for my $m (2 .. 7110) {
for my $n (1 .. $m / 2) {
if (find_7110($n, $m - $n)) {
printf "found: %d, %d\n", $n, $m - $n;
$found = 1;
}
}
exit if $found;
}
print "not found.";
exit;
sub find_7110 {
my ($n1, $n2, $x) = @_;
while (($x = $n1 + $n2) < 7110) {
my $k = "$n1 + $n2";
return 0 if exists $seen{$k}; # not found
$seen{$k} = 1;
$n1 = $n2;
$n2 = $x;
}
return ($x == 7110);
}
渡米して数年のポスドク。最近やや行き詰まり気味なので、現実逃避しつつ現状把握および打開策を見つけるためにパソコン内を再構築中。時期的に興味を持たれる人もあろうかと思ったので、恐る恐る一応公開してみることに。
（[]はフォルダ）
http://www.nikkeibp.co.jp/article/sj/20100125/206958/?P=5
http://blog.goo.ne.jp/jyoshige/e/6d0713908f0e40daa4b0497d3d250eba
http://benli.cocolog-nifty.com/la_causette/2010/01/post-abc5.html
戦いの発端は森永<.strong>氏。氏曰く「実は日本は雇用の厳格性はそれほど高くねーよ。根拠？OECDの統計だよ！」
OECD（経済協力開発機構）では、労働者保護に関する「雇用保護の厳格性」という数字を公表している。それによると、正社員のみと正社員＋非正社員のそれぞれについて、主な先進国は次のような数字になっている。数字が大きければ大きいほど雇用保護が手厚いことを示している。
OECD（経済協力開発機構）による各国の「雇用保護の厳格性」
国 正社員のみ 正社員＋非正社員 米国 0.17 0.21 イギリス 1.12 0.75 デンマーク 1.63 1.50 日本 1.87 1.43 フランス 2.47 3.05 オランダ 2.72 1.95 ドイツ 3.00 2.12 引用元のサイトを見るとわかるが、米国がもっとも解雇が容易で、欧州は一般的に解雇が難しく、日本はその中間という感じである。フランス、オランダ、ドイツは、日本よりもずっと雇用が保護されているが、それでも経済がまわっていて、GDPもそこそこ稼いでいるわけだ。
これに城氏が噛み付く。氏曰く「『雇用保護の厳格性』っつうのは文字通りに解釈できねーよ！」
この「雇用保護の厳格性」（Strictness of employment protection）を文字通りに
受け取ってはならない。
以前も述べたとおり、この数値は以下の3つの指標を総合したものだ。
１． 手続きの不便さ
３． 解雇の難しさ
http://blog.goo.ne.jp/jyoshige/e/6d0713908f0e40daa4b0497d3d250eba
この発言に小倉氏が噛み付く。氏曰く「お前の定義と違ってるよ。嘘つくなよ、ぼけなす！」
OECDによれば、この指標は、
(1)Individual dismissal of workers with regular contracts
(2)Additional costs for collective dismissals
(3)Regulation of temporary contracts
の３つのサブ指標を総合したものとされています。あれ、既に城さんの解説は、OECDのものと異なっているようです。
http://benli.cocolog-nifty.com/la_causette/2010/01/post-abc5.html
ぱっと見ると城氏が間違っているように見える。しかし個人的に気になったのは http://stats.oecd.org/Index.aspx?DataSetCode=EPL_R の「time series」のところで「Version 1」と「Version 3」が選択できること。それで調べてみたんだが、間違っているのは、森永氏と小倉氏のようだ。二人は指標を明らかに理解していない。城氏も悪い点があるが、それは過失といったところだろう。
データの解説が次のPDFファイルにある（http://www.oecd.org/dataoecd/24/40/42740190.pdf）。これのP.5に図があるのでこれがわかりやすい。これによるといくつかのレベルに分かれているようだ。トップレベルの指標は「overall summary indicator」で、「包括的な指標」ということだろう。これはレベル2の指標の「Regular contracts」「Temporary contracts」「collective dismissals」に分かれる。いってみればそれぞれ「正社員にかんする指標」「非正規社員に関する指標」「大規模なリストラに関する指標」ということだろう。「Resular contracts」のデータが http://stats.oecd.org/Index.aspx?DataSetCode=EPL_R で、「Temporaray contracts」のデータが http://stats.oecd.org/Index.aspx?DataSetCode=EPL_T 、「collective dismissals」のデータが http://stats.oecd.org/Index.aspx?DataSetCode=EPL_CD だ。
ここまでの説明で、森永氏は間違っているといえる。森永氏は「雇用保護の厳格性」は「正社員」と「正社員＋非正社員」で指標が出されているとしている。しかし「Strictness of employment protection」は正社員等の種別に出されている訳ではない。「Regular contracts」「Temporary contracts」は「Strictness of employment protection」の構成要素なのである。また「正社員＋非正社員」という指標があるとするのも間違いだ。そんな指標はない。「Strictness of employment protection」は「collective dismissals」の指標も含んでいるからだ。
森永氏の間違いを説明したので、指標の説明を再開する。レベル2の指標である「Resgular contracts」についてはさらにレベル3の指標「Procedural inconveniencdes」「Notice and severance pya for no-fault individual dismissals」「Difficulty of dismissal」で構成される。これが城氏がいう
だろう。また「Temporary contracts」はレベル3の指標「Fixed term contracts」「Temporaray work agency employment」で構成される。「Collective dismissals」についてはレベル3の指標がない。そしてレベル3の各指標は一番レベルの低いレベル4の21の指標から算出される。指標に関する説明は以上だ。
次に実際の指標を見ていこう。レベル1とレベル2の指標についてはHTMLで公開されているので省略し、問題となる「Difficulty of dismissal」をExcelファイルから探そう。「Difficulty of dismissal」はレベル3なので、「Level 3 Sub-components」というシートを開こう。すると「REGULAR1」などの指標がある。「Read Me」というシートに
| Variable | Description | Data availability |
| REGULAR1 | Procedural inconveniences of individual dismissal of employees on regular contracts - calculated as unweighted average of items REG1 and REG2 | 1985-2008 |
| REGULAR2 | Notice and severance pay for no-fault individual dismissal - weighted sum of items REG3A, REG3B, REG3C, REG4A, REG4B, REG4C | 1985-2008 |
| REGULAR3_v1 | Difficulty of dismissal - calculated as unweighted average of items REG5, REG6, REG7, REG8 | 1985-2008 |
| REGULAR3_v3 | Difficulty of dismissal - calculated as unweighted average of items REG5, REG6, REG7, REG8, REG9 | 2008 |
| TEMPORARY1 | Fixed-term contracts - calculated as weighted sum of items FTC1, FTC2, FTC3 | 1985-2008 |
|TEMPORARY2_v1|Temporary work agency employment - calculated as weighted sum of items TWA1, TWA2, TWA3 1985-2008
| TEMPORARY2_v3 | Temporary work agency employment - calculated as weighted sum of items TWA1, TWA2, TWA3, TWA4, TWA5 | 2008 |
という指標があるので、「Difficulty of dismissal」は「REGULAR3_v1」か「REGULAR3_v3」ということになる。これは算出方法のVersionの違いなのだが、そろそろ説明が面倒になってきたのでソースをそのままのせる。
Version 1 is an unweighted average of the sub-indicators for regular and temporary contracts. The indicator for regular contracts does not include item 9 (maximum to make a claim of unfair dismissal) and the indicator for temporary contracts does not include items 16 (authorisation and reporting requirements for TWAs) and 17 (equal treatment for TWA workers). Annual time series data are available for version 1 of the indicator from 1985-2008 from www.oecd.org/employment/protection.
Version 2 is the weighted sum of the sub-indicators for regular and temporary contracts and collective dismissals. The indicators for regular and temporary contracts are the same as for version 1. Annual time series data are available for version 2 of the indicator from 1998-2008 from www.oecd.org/employment/protection.
Version 3 of the overall summary indicator incorporates three new data items collected for the first time in 2008 (items 9, 16 and 17) and is the main indicator of employment protection used in the paper. Data for version 3 are available for 2008 from www.oecd.org/employment/protection. However, it is impracticable to accurately collect information about the new items prior to 2008.
(P.4)
この説明で「REGULAR3_v3」を見るのがよいことがわかる。簡単にいえばVersion 1では入っていない要素（「Difficulty of dismissal」だと「Maximum time for claim」）があるからだ。これによれば日本はOECDでは一番解雇が難しいことがわかる。日本は3.80であり、これより高いのは中国、インド、インドネシアだけだからだ。
ここまでの説明で、小倉氏が間違っていることが明らかになった。「解雇の難しさ」に関する指標はちゃんとあり、日本はOECDでは一番高い数値が出ている。それなりにソースを読んでいるようなので、高い確率で小倉氏は「Strictness of employment protection」という指標を理解していないと考えられる。レベルの階層や算出方法のVersionがあることも理解していないように見受けられる。
以上で森永氏と小倉氏の間違いを指摘したが、城氏にも悪い点がないとはいえない。説明を省き過ぎだろう。レベル1, 2だけでなく、レベル3の指標のランキングを押さえていることから見て、城氏は正確に指標を理解していると考えられる。しかし説明を省きすぎ、その結果記述が誤っているかのように見えている。その結果小倉氏の勘違いにつながったのだと考えられる。
結論：指標を見るときは指標の説明をちゃんと読もうね。おじさんとの約束だよ。
元ネタ http://phpspot.org/blog/archives/2009/12/phpjavascriptph_1.html
面白そうだと思ったので僕もやってみた。モジュールはPerl5.8系の標準モジュールのみ利用可という制限。
全部はキツイので関数処理関係の関数(http://php.benscom.com/manual/ja/ref.funchand.php)だけ実装してみた。
use strict; use warnings; =head2 call_user_func $ret = call_user_func($function,@param); $ret = call_user_func([$class,$method],@param); example1 sub plus { $_[0] + $_[1] } print call_user_func('plus',10,20); # 30 example2 package Foo; sub plus { $_[1] + $_[2] } package main; print call_user_func(['Foo','plus'],10,20); # 30 =cut sub call_user_func { my $proto = shift; if ( ref $proto eq 'ARRAY' ) { return $$proto[0]->${\$$proto[1]}(@_); } else { require Pod::Functions; if ( $Pod::Functions::Flavor{$proto} ) { return eval qq{$proto(\@_)}; } else { no strict 'refs'; return $proto->(@_); } } } =head2 call_user_func_array $ret = call_user_func_array($function,\@param); $ret = call_user_func_array([$class,$method],\@param); example sub plus { $_[0] + $_[1] } print call_user_func_array('plus',[10,20]); # 30 =cut sub call_user_func_array { return call_user_func(shift,@{+shift}); } =head2 create_function $code = create_function($args_str,$code_str); example $code = create_function('$c,$d=1','print $c+$d'); $code->(10); # 11 =cut sub create_function { my $args = shift; my $code = shift; my $default = 0; my @args = split /,/,$args; my $code_str = 'sub {'; for my $arg (@args) { if ( $arg =~ /^\s*(\$[a-zA-Z][\w]*)\s*(?:=\s*(.+))?\s*$/ ) { my $val = $1; my $def = $2; if ( defined $def ) { $default = 1; $code_str .= qq{my $val = \@_ ? shift : $def;\n}; } else { die 'parse error' if $default; $code_str .= qq{my $val = shift;\n}; } } } $code_str .= $code . '}'; my $sub = eval $code_str; die $@ if $@; return $sub; } =head2 forward_static_call $ret = forward_static_call($function,@param); $ret = forward_static_call([$class,$method],@param); =cut sub forward_static_call { call_user_func(@_); } =head2 forward_static_call_array $ret = forward_static_call_array($function,\@param); $ret = forward_static_call_array([$class,$method],\@param); =cut sub forward_static_call_array { call_user_func_array(@_); } =head2 func_get_arg $arg = func_get_arg($no) example sub foo { print func_get_arg(1) } foo(100,200); # 200 =cut sub func_get_arg { my $n = shift; package DB; @DB::args = (); () = caller(1); return defined $DB::args[$n] ? $DB::args[$n] : undef; } =head2 func_get_args @args = func_get_args() example sub foo { print join ':', func_get_args() } foo(11,22,33); # 11:22:33 =cut sub func_get_args { my $n = shift; package DB; @DB::args = (); () = caller(1); return @DB::args; } =head2 func_num_args $arg_count = func_num_args() example sub foo { print func_num_args() } foo(11,22,33); # 3 =cut sub func_num_args { my $n = shift; package DB; @DB::args = (); () = caller(1); return scalar @DB::args; } =head2 function_exists $bool = function_exists($func) example sub foo {} print function_exists('foo'); # 1 print function_exists('bar'); # 0 print function_exists('rand'); # 1 =cut sub function_exists { my $func = shift; return 1 if exists &$func; require Pod::Functions; return $Pod::Functions::Flavor{$func} ? 1 : 0; } =head2 get_defined_functions $funcs = get_defined_functions() =cut sub get_defined_functions { require Pod::Functions; return { internal => [ keys %Pod::Functions::Flavor ], user => [ grep { exists &$_ } keys %:: ], }; } =head2 register_shutdown_function register_shutdown_function($func,@param); register_shutdown_function([$class,$method],@param); =cut { my $REGISTER_SHUTDOWN_FUNCTION = []; sub register_shutdown_function { my $proto = shift; push @$REGISTER_SHUTDOWN_FUNCTION, [ do { if ( ref $proto eq 'ARRAY' ) { $$proto[0]->can($$proto[1]); } else { require Pod::Functions; if ( $Pod::Functions::Flavor{$proto} ) { sub { eval qq{$proto(\@_)} }; } else { no strict 'refs'; \&$proto; } } }, [@_] ] } END { $_->[0]->(@{$_->[1]}) for @$REGISTER_SHUTDOWN_FUNCTION; } }
思ったよりも難しかった。標準関数一覧を取る手段がなかったので標準モジュールを利用して標準関数の一覧を取得した。
あと文字列から標準関数を呼び出すスマートな手段が思いつかなかったのでeval便りに。
create_functionはかなりゴリ押し。myを勝手に付けたりデフォルト引数にも対応してたり細かい芸が光る（自分で言うな）
forward_static_callはぶっちゃけPerl的にcall_user_funcと殆ど処理が変わらないのでそのまま利用。
func_get_arg系は結構クリティカルだなー。@DB::argsをリアルに使ったの初めてだよ。
register_shutdown_functionはちょっとねー。ENDブロックを利用してるわけなんだけど当然mod_perlとかではうまく動かない。あとシグナルとか使った方が良いのかもしれない。
ヒマがあったら他の関数とかも実装してみたいかも。
1 名前：以下、名無しにかわりましてVIPがお送りします[] 投稿日：2009/09/25(金) 13:35:12.60 ID:+TARyGqc0
一生童貞だろうか
84 名前：以下、名無しにかわりましてVIPがお送りします[] 投稿日：2009/09/25(金) 15:52:07.44 ID:LOkx6/No0
1から100までの数をプリントするプログラムを書け。ただし3の倍数のときは数の代わりに｢Fizz｣と、5の倍数のときは｢Buzz｣とプリントし、3と5両方の倍数の場合には｢FizzBuzz｣とプリントすること。
86 名前：以下、名無しにかわりましてVIPがお送りします[] 投稿日：2009/09/25(金) 15:55:18.62 ID:+TARyGqc0
sub function main
for i as integer = 1 to 100
if
87 名前：以下、名無しにかわりましてVIPがお送りします[] 投稿日：2009/09/25(金) 15:58:55.18 ID:+TARyGqc0
書いてる途中で送ったからやる気がなくなったすまん。
本当に書けないのかよ…
参考:http://www.aoky.net/articles/jeff_atwood/why_cant_programmers_program.htm
引用元:http://yutori7.2ch.net/test/read.cgi/news4vip/1253853312/
Memberships & Subscriptions
Name: Professional Membership
Qty: 1
Line Total: $99
Amount Paid: $99.00
Amount Due: $0
Name: Communications Of The Acm
Qty: 1
Line Total: $0
Amount Paid: $0
Amount Due: $0
Qty: 1
Line Total: $99
Amount Paid: $99.00
Amount Due: $0
Memberships & Subscriptions Sub-Total
Line Total: $0
Amount Paid: $198
Amount Due: $0
----------------------------------------------------------------------------------
Single Purchase Items
Name: Email Forwarding Account
Qty: 1
Line Total: 0
Amount Paid: $0
Amount Due: $0
Single Purchase Sub-Total
Line Total: $0
Amount Paid: $0
Amount Due: $0
----------------------------------------------------------------------------------
Grand Total
Amount Paid: $198
Amount Due: $0
スーパーpre記法がアレなまま直ってないわけで。
姉妹サイト(?)ができていたわけで。
なにやらcookieを食べようとした形跡があるわけで。
#!/usr/local/bin/perl -w use strict; use warnings; use Web::Scraper; use URI; use Perl6::Say; use MIME::Type; use HTTP::Cookies; use LWP::UserAgent; use Path::Class; use Data::Dumper;sub p { print Data::Dumper::Dumper(@_) }; # cookie_jar
http://anond.hatelabo.jp/20090408100019
ベンチを取ってみると、ハッシュの方が速かったです。
UPSERT処理SQL生成処理の汎用化に使用中だったのですが、プロファイルすると結構時間をくっていたので、key設定時まで遡って再構築したいと思います。
#!/usr/bin/perl use strict; use warnings; use Benchmark; my $item = { date => undef, type => undef, value => undef, title => undef, views => undef }; my @key = ('date', 'type'); my %key; my @update; timethese(1000000, { use_grep => sub { @update = grep { my $a = 1; foreach my $b (@key) { $a = 0 if $_ eq $b; } $a; } keys %{$item}; }, use_hash => sub { %key = map { $_ => 1 } @key; @update = grep { not exists $key{$_} } keys %{$item}; }, } );
実行結果
Benchmark: timing 1000000 iterations of use_grep, use_hash... use_grep: 10 wallclock secs ( 9.84 usr + 0.00 sys = 9.84 CPU) @ 101595.04/s (n=1000000) use_hash: 5 wallclock secs ( 6.43 usr + 0.00 sys = 6.43 CPU) @ 155593.59/s (n=1000000)
ところでサー
javascriptってラッパー作りやすくていいよね。
名前を変えずにラップ出来るから好き。
クラスもインスタンスもメソッドも関数もオーバーライドしてラップして、好き勝手出来るから好き。
(function(){ var origin = hoge.prototype.foo; hoge.prototype.foo = function(){ ... }; hoge.prototype.foo.origin = origin; })();
perlはオーバーライドできるけど、元のメソッド呼べなくなる。すべてのインスタンスに影響する（たしか）。チョイめんどい。
use hoge; package hoge; sub foo { ... } package main; ...
他の言語では、どんな技がありますか？
[追記]
\&hoge::foo で元のコードのリファレンス取れたっけ？
すっかり忘れてる。
GIGABYTE M912は台湾のPCメーカーGIGABYTEのULCPC
初出はCOMPUTEX 2008 IN TAIPEI
| CPU | Intel Atom 1.6GHz |
|---|---|
| OS(オプション) | 正規版 Windows XP, 正規版 Windows Vista Home Basic |
| チップセット | Intel 945GSE |
| 構成 | メモリ 1GB, HDD 160GB |
| 液晶 | 8.9インチ 液晶 パネル/WXGA(1280x768), ワイドタッチスクリーン, 180度回転 |
| HDD | 2.5インチSATA HDD, 9.5mm |
| 光学ドライブ (オプション) | USB接続 外付けドライブ |
| キーボード | 80 key キーボード / タッチパッド |
| I/O ポート | USB x 3,マイク入力端子, イヤホン端子, D-SUB RJ45, Express card, SD/MMC/MS |
| Audio | 内蔵 Realtek ALC268, Azalia I/F, 2 Channels Speaker 1.5 W x 2 |
| Bluetooth | BlueTooth 2.0 内蔵 |
| Webカメラ | 1.3M pixel webcam |
| 無線LAN | 802.11b/g by mini-card |
| 防犯 | ケンジントンロック |
| バッテリー | Li-ion 4500 mAh |
| バッテリー駆動時間 | 3.5 時間 |
| 体積 | 235 x 180 x 28~42mm |
| 重量 | 1.3kg (含む2.5インチHDD) |
おれはもうMooseしかつかわねぇ。後にも先にもMooseMooseMooseMooseMoose!!!!!!！！！！！１１１１１１１
ってな人の為にいつでもどこでもMooseする。automooseを実装しますた。
package automoose; use strict; use warnings; sub import { strict->import; warnings->import; } package automoose::before; use Moose; no Moose; package automoose::after; use Moose; my @before = keys %automoose::before::; my @after = keys %automoose::after::; my @exports = do { my %u; @u{@before} = (); grep { !exists $u{$_} } @after }; package UNIVERSAL; use Moose; for my $func (@exports) { __PACKAGE__->meta->remove_method($func); __PACKAGE__->meta->add_method($func,sub { my $class = shift; my $auto = $class.'::__auto__'; no warnings 'redefine'; local *Moose::_get_caller = sub { return $class }; Moose->import( { into => $auto } ); my $code = $auto->can($func); $class->meta->add_method($func,sub { shift; goto $code; }); goto $code; }); } 1;
使い方はいたって簡単。useするだけ。
use automoose; my $obj = Foo->new;
いきなりnewが呼べちゃう。
他にも
use automoose; Foo->has( hoge => is => 'rw' ,default => 9999 ); Foo->has( muge => is => 'rw' ,default => 7777 ); print Foo->new->hoge; print Foo->new->muge; Bar->extends('Foo'); print Bar->new->hoge;
ょーかんたん。げーべんり。
しっかしこれ、automooseだけど実装するの結構めんどかったのよ。Moose-0.44をベースに作ったんだけどさ。
Moose内部で使用している$CALLERって変数がレキシカルなもんだから、どうやってそれを外から制御すればいいのかすんごい苦労したわけさね。
で結局importの引数にinto渡してさらにMoose::_get_caller関数を上書き無理矢理ハックしたってわけさ。
でもね。でもね。でもね。ちょっと聞いてよ。
ふと最新のMoose-0.50見てみたらさ、Moose::__CURRY_EXPORTS_FOR_CLASS__なんて関数が定義されてるわけよ。
外から明示的に$CLASSを変更できるインターフェイスなわけよ。おいおいおいおい、勘弁してくれよ。こっちゃ折角苦労してハックしたのにあっさり公式対応するなってばよ。メゲルヨ？ぼく。
まぢめげるよ。めげる。ってかもうめげたよ。もうMooseなんてつかわんね！つかわんね！
Mooseなんて大嫌いだー！
俺はMooooooooooseをやめるぞぉおおおおおおおおお、ＪＯＪＯぉぉぉおおおおお！！！！１１
最近Perl界隈ではMoose、MooseってなんかMooseってのが流行ってるらしい。
自分自身のブログでは、さもずっと前からMoose知ってたかのように振舞うために、増田で先に放出しておく。てへへ。
プログラマ層が限りなく低い増田にこんなこと書いてもだれも見てくれない気はするけど。
初めてのMoose - Mooseのすすめ - はてな#hide-k
meta object protocol について考えてみる - TokuLog 改めChumbyとどきました日記
YappoLogs: Moose のコードを探索して理解を深めた
Mooseってのは結局のところClass::MOPのラッパーみたいなもんだと。
で、Class::MOPってのは何だ？ってことだけど、メタなんとかプログラミング？え？プロトコル？まーどっちでもいい。
よくよく読んでいくとメタなんとかとか大層な名前が付いてるけど、結局のところPerlのpackageそのものの操作をオブジェクティブ扱えるようにしたものみたいだ。
つまりだな、例えばpackageに対して動的に(静的ではなく！)メソッドを追加したい場合、今までなら
package Foo; **Foo::method = sub { return 'hoge'; }; print Foo->method;
のように型グロブに関数のリファレンスを突っ込むということをしなければなかったが
use Class::MOP; my $class = Class::MOP::Class->create('Foo'); $class->add_method('method',sub { return 'hoge'; }); print Foo->method;
みたいな感じでかっこよく追加できるってわけさ。ま、これはほんの一例だけどな。（他にもメソッドを削除したりフックしたり色々できる。その辺は今回省略。）
本来なら「package Foo」とするところを「my $class = Class::MOP::Class->create('Foo');」と書ける。
これの何が良いのかというと、$classというオブジェクト経由でFooパッケージを色々操作できるところにつきる。
型グロブを使用したり「no (warnings|strict)」をしたりパッケージを操作する処理っていうのはPerlのキチャナイ構文が多かったのだが、Class::MOPのおかげでスッキリ綺麗に書けるようになったってこった。
で、次にMooseだが、これは結局のところClass::MOPのパッケージ管理の部分に＋αしただけのラッパーだ。
でもその＋αってのが結構凄かったりする。
もうこの辺の話はさんざん既出だが、例えばhasという関数を使ってアクセサや型定義が出来たり
package Foo; use Moose; has 'method' => ( is => 'rw', isa => 'Int' , default => '10' ); my $obj = Foo->new; print $obj->method; # 10 $obj->method(50); print $obj->method; # 50 $obj->method('hoge') # Int型じゃないのでエラー
Moose::Roleを使ってRubyのMixinみたいなことができたりする。
でも実はこれらの処理ってのは本当は別に凄くもなんとも無い。
アクセサ生成なんてClass::Accessorがあるし、関数の引数の型チェックなんてのもParams::Validate等昔から存在してるし、Mixinに関してはもともとPerlは多重継承できるので最初からできるし。
じゃあなんでみんなMoose、Moose言ってるのかっていうと、それはやはりClass::MOPの存在が大きいであろう。
綺麗且つ柔軟にパッケージの操作が出来るClass::MOPが土台にあって、今まで別々の役割として存在してきたモジュール達を統合し、よりわかりやすく、より柔軟に、そしてより強力なPerlのオブジェクト指向を構築できるようにした。それがMooseなのだ。
・・・しかし、小生。
Mooseについて調べていくうちに一つ残念に思ったことがある。
オブジェクトにメソッドを追加する機構がないのだ。
オブジェクトにメソッドを追加する、だ。パッケージにではなく、オブジェクトに、だ。
具体例をあげる。
package Foo; use Moose; my $obj = Foo->new; $obj->meta->add_method('hoge', sub { return 'hoge' }); print $obj->hoge; # hoge
ちなみに$obj->metaというのはFooパッケージを管理するClass::MOPへのアクセサだ。
ということは上記の処理はFooに対してhogeというメソッドを追加していることになる。
では次の例。
package Foo; use Moose; my $obj = Foo->new; $obj->meta->add_method('hoge', sub { return 'hoge' }); print $obj->hoge; # hoge my $obj_2 = Foo->new; print $obj_2->hoge; # hoge
$obj_2->hogeが呼べてしまうわけだ。
$obj->metaは結局のところFooパッケージなのだから、そこにメソッドを追加しているので当然の結果である。
$objだけにメソッドを追加することは、Mooseではできないのだ。
非常に残念である。ああ、残念だ。
・・・しかし、小生。
これでもプログラマの端くれである。こんなことでめげていてはMooserを名乗れないのである。（あ、MooserってのはMoose使いの人の俗称ね。今僕が考えたの）
なのでオブジェクトにメソッドを追加できるように拡張して見せよう。
package Foo; use Moose; use Class::Object; my $class_object = Class::Object->can('new'); override new => sub { ref($class_object->(shift))->SUPER::new(@_) }; my $obj = Foo->new; $obj->meta->add_method('hoge', sub { return 'hoge' }); print $obj->hoge; # hoge my $obj_2 = Foo->new; print $obj_2->hoge; # エラー
たった3行追加するだけで実現できる。さすがMoose。
ただし、Class::Objectを利用しているのでFoo->newで返ってくるパッケージがFoo::0といったようにFooではなくなってしまっているのでrefとかでパッケージ名の比較ができなくなってしまう問題が発生する。
でもこれも継承順をいじったりと本気で頑張れば、表向きに見せるパッケージ名をFooすることも可能だろう。
その添削の役目はどこかのハッカーに任せるとして、今日のところはこの辺で終了としたい。
Moooooooooooooose!と叫ぶのが流行ってるみたいなので、もっとも長くMooooooooooooooose!と叫んだ最初の男となるべく下記の処理を残しておく。
length q chdir uc and print chr ord uc q rmdir and do { print chr ord q xor x while $a++ < 0xffffffff } or print chr ord qw q sin q and print chr ord q ne sin and print chr hex length q q shift shmread bless q;
@oo[2, 5, 8, 11] = (' ', ' ', ' ', ' '); $xx[5] = ' '; for($s=4; $s < 201; $s++){ for($i = 2; $i <= ($s+1) / 2; $i++){ next if $i == 3; $j = $s - $i; &test_base($i, $j); &test_base($j, $i) if $i <=> $j; } print "$s\[$oo[$s]]\n" if $oo[$s] ne ''; $min = length $oo[$s] || 999; if($ox[$s] ne '' and length $ox[$s] < $min){ print "$s\[$ox[$s]>\n"; $min = length $ox[$s]; }if($xo[$s] ne '' and length $xo[$s] < $min){ print "$s<$ox[$s]]\n"; $min = length $xo[$s]; }if($xx[$s] ne '' and length $xx[$s] < $min){ print "$s<$xx[$s]>\n"; } } sub test_base{ my ($i, $j); ($i, $j) = @_; if($oo[$i] ne ''){ &test($oo[$i], $oo[$j], \$oo[$s]); &test($oo[$i], $xo[$j], \$oo[$s]); &test($oo[$i], $ox[$j], \$ox[$s]); &test($oo[$i], $xx[$j], \$ox[$s]); }if($ox[$i] ne ''){ &test($ox[$i], $oo[$j], \$oo[$s]); &test($ox[$i], $ox[$j], \$ox[$s]); }if($xo[$i] ne ''){ &test($xo[$i], $oo[$j], \$xo[$s]); &test($xo[$i], $xo[$j], \$xo[$s]); &test($xo[$i], $ox[$j], \$xx[$s]); &test($xo[$i], $xx[$j], \$xx[$s]); }if($xx[$i] ne ''){ &test($xx[$i], $oo[$j], \$xo[$s]); &test($xx[$i], $ox[$j], \$xx[$s]); } } sub test{ return if $_[1] eq ''; my($a, $b, $c, $tmp); ($a, $b, $c) = @_; $tmp = "$a$b"; ${$c} = $tmp if ${$c} eq '' or (length $tmp) < (length ${$c}); return; }
public class Main { public static void main( String[] args ) { // ( 5 - 3 ) + 1 Exp exp = new Add(new Sub(new Num(5), new Num(3)), new Num(1)); System.out.println(exp.eval()); } } /** * 抽象クラス */ abstract class Exp { public abstract int eval(); } /** * 足し算 */ class Sub extends Exp { /** 左辺 */ private Exp hidari; /** 右辺 */ private Exp migi; /** * コンストラクタ */ public Sub(Exp hidari, Exp migi){ this.hidari = hidari; this.migi = migi; } /** * 評価 */ @Override public int eval() { return hidari.eval() - migi.eval(); } } /** * 引き算 */ class Add extends Exp { /** 左辺 */ private Exp hidari; /** 右辺 */ private Exp migi; /** * コンストラクタ */ public Add(Exp hidari, Exp migi){ this.hidari = hidari; this.migi = migi; } /** * 評価 */ @Override public int eval() { return hidari.eval() + migi.eval(); } } /** * 数 */ class Num extends Exp { /** * 数 */ private int self; /** * コンストラクタ */ public Num(int self) { this.self = self; } /** * 評価 */ @Override public int eval() { return self; } }
Rubyは他の言語を知らないと良さがわからない(笑)とかぃゎれたから、PHPとPerlもちょっとだけさわってみたょ。
とりあえずPHPでSNSとか作ったりして遊んでた。そしたら、PHPちょーかんたん。まぢやばいあれ。
だけどぺーる？ってなに？あれ？もうまぢきもい。subとかmyとかlocalとかなに？$_とかまぢ意味不明(笑)
それにPerl使ってる人はもっとキモイ。PHPとかはかっこいいデザイナーとかがバリバリ使ってるイメージだけど、Perlとかサスペンダーつけた変なおぢさんとか、変な会社とか意味不明な売りでやってる会社が使ってるくらいのイメージしかない(笑)
主体＝Subjectとは、本来「主」である神に対して「Sub」な存在として、集団から離れたった一人でソレと向き合うことを意味する。
恋人はあなたに向かって「世界であなたと真摯に向き合うたった一人のわたし」でいようとしてくれている。つまりその状況においては、温かい人間集団から離れ、たった一人荒野でひたすら神の言葉を待つように彼女はSubjective＝主体的、なのだ。
キリスト教世界で他人の意見に左右されることを戒めるのは、「他人に対してではなく、ただ神に対してのみSubであれ」という前提付のことであって、「神も何も関係なく、全て自分で考えて独自な意見を打ち出せ」という風にそれを解釈するのは余りにも辛いことである。常に自分の意見を持って欲しいと恋人に求める元増田は、恋人からすれば自分の恋人（＝自分の神）としての主体性を放棄しているようにすら見えているかもしれない。双方がそんな風に勘違いし合うというのは、やはり不幸なのではないか。
そんなわけで、元増田は、たまには彼女の目をじっと見つめて、自分が彼女の命運を握っているという厳粛な気持ちを持ちつつ、託宣を下すがごとくに言葉を発してみるべきだと思う。
今日は焼き肉だ！
http://blogs.wankuma.com/episteme/archive/2007/11/08/106927.aspx
かなりテキトー。エラー処理とかしない。
package Animal; sub new { bless { cnt => 1 } , $_[0] } sub Sound { printf "%s\n", $_[0]->{voice} x $_[0]->{cnt} } sub SetCount { $_[0]->{cnt} = $_[1]; $_[0] } sub SetVoice { $_[0]->{voice} = $_[1]; $_[0] } package Dog; use base qw/Animal/; sub new { $_[0]->SUPER::new->SetVoice('Wan') } package Cat; use base qw/Animal/; sub new { $_[0]->SUPER::new->SetVoice('Nya-') } my $animal; $animal = Dog->new; $animal->Sound; $animal->SetCount(3); $animal->Sound; $animal = Cat->new; $animal->Sound;
唐突にClass::Data::Inheritableのソースコードについて説明してやんよ。
使い方とかの説明はこの辺でも読んでから出直して来い、ごるぁ！
まぁとりあえずソース見てみろ、下記にはっつけてやっからよぉ！
1: package Class::Data::Inheritable; 2: 3: use strict qw(vars subs); 4: use vars qw($VERSION); 6: $VERSION = '0.06'; 7: 8: sub mk_classdata { 9: my ($declaredclass, $attribute, $data) = @_; 10: 11: if( ref $declaredclass ) { 12: require Carp; 13: Carp::croak("mk_classdata() is a class method, not an object method"); 14: } 15: 16: my $accessor = sub { 17: my $wantclass = ref($_[0]) || $_[0]; 18: 19: return $wantclass->mk_classdata($attribute)->(@_) 20: if @_>1 && $wantclass ne $declaredclass; 21: 22: $data = $_[1] if @_>1; 23: return $data; 24: }; 25: 26: my $alias = "_${attribute}_accessor"; 27: *{$declaredclass.'::'.$attribute} = $accessor; 28: *{$declaredclass.'::'.$alias} = $accessor; 29: } 30: 31: 1;
短いソースだなーこれ。でもな、なめんじゃねーぞ。短いけど色々な技術が盛り込まれてんだよコレはよぉ。
ハイ、まず3行目。
かるくstrictについて説明してやんよ。心して聞けよオマエラ。
strictっつーのはだな、つまりPerlにおける曖昧な部分をすこーしだけチェックしてくれるスグレモノなんだなコレが。
とりあえずざっくり言うと三つの機能があってだな、下記のよーに書くわけだ。
use strict 'vars'; use strict 'subs'; use strict 'refs';
varsってーのは簡単に言うとmyとかourとか宣言しろボケってやつですわ。
subsは裸体は許さんってやつですの、$とか%とかついていない裸の文字列をエラーにしてくれんだよ。
refsってのが一番やっかいな代物でな、これはムツカシイ言葉で言うとシンボリックリファレンスってんだが、要は変数名に変数を使うとエラーにしてくれるってこったよ。
で、これら全部ひっくるめてuse strict;なんだな。わかったか？オラ！
ちゅーことはだ、3行目を見ると意図的にrefsだけ外してるのがわかるよな。
つまりコレはこのコードのどこかで変数名に変数を使うってことを明示していることにもなるわけだ。けけけ。
あーもういいもういい、次だ、次。
4,5行目を見てみろよ。今時our使わずにuse vars使うなんてどんだけー。
ははは、まぁまてよ。
ourってのは明示的にグローバル変数を定義するもんなんだが、このourってやつが導入されたのがPerl5.6からなんだよ。
Perl5.5のころはourなんてなかったからグローバル変数定義すんのにこのuse varsを使っていたわけだ。
つまりこのモジュールはPerl5.5環境でも動くように配慮しているわけなんだな、ちゃんちゃん。ほほほ。
あーもう全然すすまねーよ。チクショウ、が、ま・・・・。
で、11-14行目。これはref関数使って$declaredclassがオブジェクトだったら死ぬって処理だ。
require CarpっつーのはCarpモジュールを動的にロードしてるっていうことだよぅ。
で、Carp::croak関数使ってエラー文はいて死ぬ、と。ちなみにこのCarp::croakってはまぁdie関数みたいなもんなんだ。
違いとしてはエラーの発生した原因を呼び出し元の奴のせいにして自分は悪くないんだよってアピールすることかな。まぁ実際使ってみりゃわかるよ。
さぁ、16行目。本編突入だ。長かった。長い道のりだったなお前ら。
sub {}ってのは無名サブルーチン(関数のリファレンス)ってやつだ。で、ここで注目すべき点はただひとつ！！！！！
19-23行目あたりをぼーっとみてると$declaredclass, $attribute, $dataっていう変数を使用していることがわかる。
これらの変数は9行目で受け取ったmk_classdataへの引数だ。
ここで問題が発生する。
myで宣言された変数の賞味期限はスコープの終端だ。それはわかるな？
つまり9行目で宣言された$declaredclass, $attribute, $dataといった変数どもは29行目のスコープの終端で消滅してしまうわけだ。
しかし！その消えてしまうはずの変数どもをsub {}という無名サブルーチンの中で使用してしまっている！！！
これが世間一般に語られているクロージャという仕組みなのだ！！！！！！うはははははははｈ！！！
本来生涯をまっとうするはずだった変数たちが別のサブルーチンの中にまぎれてしまうとその別のサブルーチンが消えてなくなるまでは死ぬことを許されなくなるのである！！！ざ・不☆老☆不☆死！
なんたる奇妙奇天烈なことであるが、この現実を受け入れることによってお前らの道が開けるんだ！！！すげーだろぉがよぉ！！
ボクはッ、キミがッ、クロージャを受け入れるまでッ、殴るのをやめないッ！
さて、肝心の16-24行目のアクセサ部分の処理の解説だけども、
引数が渡されてなければ特になんの処理もせずに$dataを返している。$dataってのは死ぬことを許されなくなったカワイソウな変数君だ。
つまり、Class::Data::Inheritableってやつはアクセサに渡された値をどこで保存してるのかというと、紛れも無いこの$data君に他ならない。
$data君がニート君になっちゃうとたちまちデータの読み書きができなくなるのであまり働かせ過ぎないように注意しよーね！
ハイ、次はアクセサに引数が渡された時の処理だけどな、20行目を見てみろ。$declaredclassに格納されてる値はmk_classdataメソッドを使用したときに格納された値になる。
package Hoge; use base qw/Class::Data::Inheritable/; Hoge->mk_classdata('hoge_accessor');
つまり上記の処理で例えると、$declaredclassには'Hoge'という文字列が入ってることになんだな。
で、この'Hoge'と$wantclassに入ってる値を比較しているわけだが、
package Hoge; use base qw/Class::Data::Inheritable/; Hoge->mk_classdata('hoge_accessor'); Hoge->hoge_accessor('aaa');
上記の処理で例えると$wantclassには$declaredclassと同じく'Hoge'が入ってくることになんだな。うっひょー。
んで、20行目のif文は$wantclassと$declaredclasが違う場合にだけ19行目の処理を実行しているわけだからこの場合はスルーするわけだぁ。ひょひょひょ。
じゃあだな、$wantclassと$declaredclasが違う場合ってどんな場合？ってことだが、下記に例を示すから目ん玉引ん剥いて網膜から直接見てみろよこのボケ野郎どもが。
package Hoge; use base qw/Class::Data::Inheritable/; Hoge->mk_classdata('hoge_accessor'); package Foo; use base qw/Hoge/; Foo->hoge_accessor('bbb');
HA！HA！HA！こういう場合だよ米ベー。$wantclass=Fooで$declaredclas=Hogeになるんで19行を実行し、Fooをベースにしてmk_classdataを呼ぶことでFooに同じ名前の新たなアクセサを提供し、元クラスHogeの値を壊さないようにするわけですなぁ。
考えた人すごいですなぁ。これがClass::Data::Inheritableが継承可能なクラス変数といわれる由縁でするまする。
で、最後の26-28行目はコレらの便利な処理をしてくれる$accessorさんをクラスに登録するというわけですよぉ。
27,28行目の*ってのは型グロブ変数ってという奴で、型グロブに対して無名サブルーチンを突っ込むと動的に関数を定義できるんだなぁコレが。
でここで、初めに俺が語った話を覚えてるか？へっ、オマエラなら覚えてないだろうなけっけ。use strictの話だよ。refsだよrefs。
ここでrefsを省いていたのが利いて来るんだ。refsって何だった？ホラ言ってミソ？
で良く見てみると型グロブ変数に対して「$declaredclass.'::'.$attribute」っていう変数を使おうとしているよね？これをしたかったからrefsだけ仲間外れにしてたわけですね。
はは。
あー、あー、あー。
これで終わりだよぅ。みんなわかったかな！？
コレ読んでもわからんやつはもう死ぬか、もしくはわからん用語について死ぬほど調べてもっかい読みなおしてみろこのド低のぅッ・・・ごふんごふん、このクサレ脳みそがぁ！！！！！！！！！！！！１１
やってしまった・・・。
方針：
package SixtyLinesTemplate; use strict; use warnings; our $VERSION = '0.01'; sub convert { return unless defined(my $str = shift); $str =~ s{&}{&}gso; $str =~ s{<}{<}gso; $str =~ s{>}{>}gso; $str =~ s{\"}{"}gso; $str; } sub include_template { my $tmpl = shift; my %c = %{+shift}; eval convert_template($tmpl); die $@ if $@; } sub convert_template { my $tmpl = shift; my $cache = $tmpl.'.cache'; return scalar do { open my ($FH) , $cache; local $/; <$FH> } if ( -f $cache && (stat($tmpl))[9] <= (stat($cache))[9] ); my $out = do { open my ($FH) , $tmpl; local $/; <$FH> }; $out =~ tr/()/\x28\x29/; $out =~ s/\[%\s*(foreach|if|unless|end)\s*(.+?)\s*{?\s*%\]/");".(lc($1) eq 'end' ? '} print q(' : "$1 $2 { print q(")/ige; $out =~ s/\[%(.+?)%\]/);print $1; print q(/g; $out =~ s/\[#(.+?)#\]/);print SixtyLinesTemplate::convert($1); print q(/g; $out = 'print q('.$out.');'; open my ($FH) , '>' , $cache; print $FH $out; $out; } 1;
サンプルコード：
use SixtyLinesTemplate; my $context = { 'title' => 'Example', 'list' => [10,'<A&B>'] }; SixtyLinesTemplate::include_template('template.tmpl',$context);
サンプルテンプレート：
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <title>[# $c{title} #]</title> </head> <body> <h1>[# $c{title} #]</h1> <table> [% foreach my $i (0..@{$c{list}}-1) %] <tr bgcolor="[% $i % 2 ? '#FFCCCC' : '#CCCCFF' %]"> <td>[% $i %]</td> <td>[# $c{list}[$i] #]</td> </tr> [% end %] </table> </body> </html>
出力例：
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> <head> <title>Example</title> </head> <body> <h1>Example</h1> <table> <tr bgcolor="#CCCCFF"> <td>0</td> <td>10</td> </tr> <tr bgcolor="#FFCCCC"> <td>1</td> <td><A&amp;B></td> </tr> </table> </body> </html>
foreachんところが汚く見えるかもしれませんが、あれは添え字を取ろうとするとああなるんでご勘弁を。
普通にループするだけならforeach my $item (@$c{title}) でいけますゆえ。
あと存在しない変数とか使うと死んだり警告でたりするのでevalの前にno strictとno warningsをやった方がいいかもねぇ。
って何まじめに検証してんだ俺・・・orz
追記：
SixtyじゃなくてFortyだね。恥ずかし！
追追記：
でも＆amp;の奴はちゃんと書いてるんだけども投稿すると勝手にエスケープされてしまってるんだよね。何でだろ？
ちなみにこのconvertの処理はCGI::Utilから拝借しました。
夕食を食べている時に、アパートで一緒に住んでいるインド系アメリカ人Yは言った。
『同じガイナックス制作でも、フリクリは好きなんだけど、エヴァは嫌いだよ。
1話2話は見たけど、後はすっげーつまんなくて、見るのを辞めちゃった。』
アメリカではシンジ君のような内気な少年タイプの主人公はあまり理解されないと言う。以前ネットで見つけた
"アメリカオタクが選ぶ好きなアニメキャラクターアンケート"みたいなページでシンジ君がボロクソにけなされていたのを
思い出す。Yも優柔不断なシンジ君が嫌いなんだと思った。でも、Yの次の発言は少し予想外だった。
『映画版のエヴァ(古い方)も最悪。でも、唯一、テレビ版の最後の二話は最高だった。』
え、という感じだ。おめでとう、で終わるテレビ版のラストは日本のファンには不評だった。作者自身もテレビ版の最後を上書きするように
映画版を見た。映像美がクライマックスに達するのも、哲学的な主題に一応の結論が出されるのも映画版のエヴァだ。何でテレビ版の
最後は良くて、他は駄目なんだろう。Yは続けた。
『宗教的すぎるんだよ。キリスト教のさわりだけかじったようなストーリーが受けつけないんだ』
あ、と思った。かなりEye-openingな発言だった。
キリスト教的価値観はアメリカという国の根本的なものを形成している。
宗教的自由を求めて移民してきた中産階級達が設立者となった国である。妊娠中絶の問題も
ゲイの婚姻問題もIntelligence Design(笑)も、アメリカの政治のジューシーな部分を占めるのはキリスト教(もちろんプロテスタントが主流)
が関係する政策論議だ。宗教右派からの支援に頼っている政治家だけでなく、民主党左派系の政治家達もキリスト教へのリップサービス無しには
国民多数からの支持を得られない。
そんな国である。キリスト教教育に関しては日本より何歩も先にいっている国である。
そんな国で、旧約聖書だの、リリンだの、キリスト教を土台にしたストーリーのアニメが受けるか否か。
作者はアメリカンアニメギークのポリティカルコンパスのぶれ具合を全く知らないのであるが、
まず、聖書の教えに忠実でないストーリーは保守・右派には受けないであろうことが予想される。
更に、Evangellionという題名がEvangelical(宗教右派とほぼ同意語で使われる)を連想させることから
宗教右派にあまり良い印象を持たない左派(都会のスタバでラテを飲みながらThe New York Timesを読む人たち)
にも支持を受けないに違いない。
キャラの性格云々よりも、宗教的なストーリー故に、エヴァンゲリオンはアメリカで受け入れられにくいのでは無いか、Yと話している
時にそんな仮説が浮かんだ。作者は余り覚えていないが、Yに好評だったテレビ版のラスト二話は、
More philosophical, but less religiousだったと記憶しているが、まぁ、定かではない。
そんなYは今、ファイル共有ソフトでDLしたアニメ版ひぐらし(Free Fan Sub)に夢中だ。園崎魅音と梨花ちゃまがお気に入りだそうだ。
グローバル化の波を感じずにはいられない。