結城浩の『Perlクイズ』

[PQ/P][Perl Quiz 2003-02-08 Puzzle.0027]

===========================================================
結城浩の『Perlクイズ』≪パズル≫ 2003-02-08 Puzzle.0027
http://www.hyuki.com/pq/
[PQ/P]≪パズル≫では実用性を無視したクイズを出します。
===========================================================
■今日の一言
-----------------------------------------------------------
こんにちは。結城浩です。すごく、すごーく、ごぶさたしています。
申し訳ありません。
最近は暗号本の執筆にどっぷりつかっておりまして(以下言い訳省略)。
http://www.hyuki.com/cr/

    ==== NEWS FLASH ====
    2003年2月17日に、ちょっとニュースがあるかもしれません。
    また追って連絡しますね。
    そだそだ、パールちゃんもよろしく!
    http://www.hyuki.com/pq/pqbook.html
    ===================

では、解答編です。

あ、そうです。はじめにお断りしておきますが、
tieを使った解答の場合、
Perlのバージョンによって振る舞いが違うという報告をいただいています。
解答をお手元のPerlで実行なさるときにはその点をご注意ください。
===========================================================
■今回のクイズ≪パズル≫
-----------------------------------------------------------
(今回は解答編なのでクイズ≪パズル≫はありません)
===========================================================
■前回の解答
-----------------------------------------------------------
●クイズ
-----------------------------------------------------------
以下に、
puzzle.plという1つのスクリプトの最後の部分を示します。
このスクリプトの(省略)と書かれている部分を補って、
Figに示す実行結果とぴったり同じになるようにしてください。

◆List:前の部分が省略されたスクリプトpuzzle.pl
(省略)
$puzzle = 0;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 1;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 2;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 3;
print "$puzzle, " for (1..10);
print "\n";

◆Fig:実行結果
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 
4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 
6, 12, 18, 24, 30, 36, 42, 48, 54, 60, 
-----------------------------------------------------------
●結城の解答
-----------------------------------------------------------
●解答1
-----------------------------------------------------------
Perlのtieという機能を利用しています。
tieは、変数へのアクセスをオブジェクトへのアクセスに変換する仕組みです。
詳しくはperldoc perltie参照。

以下では、変数$puzzleをPuzzleというクラスのオブジェクトへ関連付けています。
$puzzleへ代入が行われると、サブルーチンSTOREが呼び出され、
参照が行われると、サブルーチンFETCHが呼び出されます。

◆List:スクリプトpuzzle.pl
package Puzzle;

sub TIESCALAR {
    my $classname = shift;
    my $delta = shift;
    my $self = {
        delta => $delta,
        current => 0,
    };
    return bless $self, $classname;
}

sub FETCH {
    my $self = shift;
    $self->{current} += $self->{delta};
    return $self->{current};
}

sub STORE {
    my $self = shift;
    $self->{delta} = shift;
    $self->{current} = 0;
    return $self->{delta};
}

package main;

my $puzzle;
tie($puzzle, 'Puzzle');

$puzzle = 0;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 1;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 2;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 3;
print "$puzzle, " for (1..10);
print "\n";
-----------------------------------------------------------
●解答2
-----------------------------------------------------------
問題文に登場する部分をすべて無視する、という手もあります。

◆List:スクリプトpuzzle.pl
for (1..4) {
    print scalar(<DATA>);
}
__END__
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 
4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 
6, 12, 18, 24, 30, 36, 42, 48, 54, 60, 

$puzzle = 0;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 1;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 2;
print "$puzzle, " for (1..10);
print "\n";
$puzzle = 3;
print "$puzzle, " for (1..10);
print "\n";
-----------------------------------------------------------
●読者の解答(瓜生聖さん)
-----------------------------------------------------------
たまたま夜中起きてたので最速目指してみました。

print <<END
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
2, 4, 6, 8, 10, 12, 14, 16, 18, 20,
4, 8, 12, 16, 20, 24, 28, 32, 36, 40,
6, 12, 18, 24, 30, 36, 42, 48, 54, 60,
END
__DATA__
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
はいっ、おみごと。最速解答でした。ぱちぱち。
でも、ごめんなさい、私の解答編の発行が遅くて…。
Perlでは__DATA__以降はプログラムとしては無視されることを
利用しています。
-----------------------------------------------------------
●読者の解答(萩原佳明さん)
-----------------------------------------------------------
select STDIN;
END{
  print STDOUT <<_;
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 
4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 
6, 12, 18, 24, 30, 36, 42, 48, 54, 60, 
_
}

一旦STDOUTをデフォルト出力先の座から引きずり降ろし、
print "\n";等をぜーんぶ無効にしておいてから、
END{}で最後に正解をそのまんま出力します。
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
ふみ? 思わず perldoc -f selectを読み直しちゃいました。
select FILEHANDLEで、printの出力先をFILEHANDLEにするわけですね。
なるほど――って、select STDINって入力を無理やり出力先にして
いるんですね。うーん。すごいというかなんというか。
一応 perl -w すると警告が出ますが、パズルとしては正解。
# よい子はまねをしてはいけません。たぶん。
-----------------------------------------------------------
●読者の解答
-----------------------------------------------------------
sub TIESCALAR { bless [0, 0] => shift }
sub FETCH     { my $self = shift ; $self->[1] += $self->[0] }
sub STORE     { my $self = shift ; @$self = (2 * shift, 0)  }
tie my $puzzle => 'main';

しかし、これ、ActivePerl 5.6.1 Binary Build 633 のほうで実行すると、
FETCH が二回ずつコールされて、数字がぜんぶ二倍になるんですよね…。なので、
その場合には、sub STORE 内での " 2 * " という部分が必要なくなります。
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
tieを使ったコンパクトな解答です。
別パッケージを作らずに、mainパッケージに関連付けています。
Perlのオブジェクトはblessされたリファレンスですが、
ここでは2要素の配列へのリファレンスがオブジェクトになっています。
0番目の要素が「増分」で、1番目の要素が「総計」になっているのですね。
-----------------------------------------------------------
●読者の解答(抜粋)
-----------------------------------------------------------
題意を満たす手段として、「通常のスカラー変数のように見えるが、変数展開
される際に何かアクションを起こすもの」という機能を持つ、スカラーのタイ
変数を使いました。タイ変数の実体に何を使うのかを変えて、3通りの回答を
用意してみました。

ちなみに以下のスクリプト群は、perl-5.6.1 で実行すると題意通りの表示を
行いますが、perl-5.8.0 で実行すると題意とは異なる表示となるようです。

これは、変数展開される変数を含む文字列をprintに渡すと、

  perl-5.6.1 ではその変数は2回参照される
  perl-5.8.0 ではその変数は1回しか参照されない

という違いに起因しているようです。

(その1:配列版、その2:ハッシュ版を省略しました。ごめんなさい)

--- その3: コード版 --------
package Tie::Counter;
sub TIESCALAR {
    my ($v, $c);
    bless sub { $#_ ? (($v, $c) = ($_[1], 0)) : ($v * ++$c); }
}
sub STORE { &{$_[0]} }
sub FETCH { &{$_[0]} }
package main;
tie my $puzzle, 'Tie::Counter';
--- 以後は出題にあったスクリプトの後半部分 ---

実体にサブルーチンへのリファレンスを用いています。パズルとしてはこれが
一番面白いでしょうか?

オブジェクト生成時に、「値」と「参照回数」をレキシカル変数として生成し
ます。そして、そのレキシカル変数を使って配列版やハッシュ版と同じ機能を
実現する無名サブルーチンを作り、そのリファレンスを返します。いわゆるク
ロージャですね。要求されたアクションが代入なのか参照なのかは、サブルー
チンへの引数の個数で判断します。

STOREとFETCHは、サブルーチン本体を起動するラッパーに過ぎません。本体の
呼び出しに「& を明示して引数を列挙しない」という記法を用いることで、自
分自身の @_ 配列をそのまま本体に素通ししています。
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
STOREとFETCHが同じsubを呼ぶという発想が面白いですね。
なるほど、両者は確かに引数の個数$#_ で区別できますねえ。
面白い、面白い。
-----------------------------------------------------------
●読者の解答
-----------------------------------------------------------
use overload '""' => sub{${+shift}*$_*2}, '0+'=>sub{${+shift}};
BEGIN {
    overload::constant (integer => sub{my $a=shift; bless \$a, 'main'})
}
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
overloadを使った解答を多数いただいたのですが、
この方がおそらく一番コンパクトでした。
詳しくは(私もきちんと説明できる自信がないので)
perldoc -f overload
をごらんください。ヒントは、
overload::constant (integer => ... )
の部分で、0や1といった整数定数の評価にフックをかけているところ。
しかもその値自身をスカラー変数へのリファレンスをblessしたオブジェクトにしている(!)。
そして、
use overload のうちの、
'""' => ... では、文字列への変換部分にフックをかけ、
'0+' => ... では、数値への変換部分にフックをかけています。
それらのフックの中で、さっきblessして作ったオブジェクトを
いじっているわけですね。
-----------------------------------------------------------
●読者の解答
-----------------------------------------------------------
sub _print  {
  my($text)=@_;
  $text=~s/(\d+)/$1*$_*2/e;
  print $text;
}

eval  join('',map {s/\bprint\b/_print/g;  $_  } <DATA>);

__DATA__
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
まず、プログラムをDATAとして読み取り、
printを強引に_printに置き換えるという手法です。
-----------------------------------------------------------
●読者の解答
-----------------------------------------------------------
use vars qw($puzzle);
use Inline C => << 'EOC';
int puzzle_get(SV* sv, MAGIC* mg) {
    sv_setiv(sv,  SvIV(mg->mg_obj) * SvIV(DEFSV) * (int)*mg->mg_ptr);
    return 1;
}
int puzzle_set(SV* sv, MAGIC* mg) {
    sv_setiv(mg->mg_obj, SvIV(sv));
    return 1;
}
MGVTBL puzzle_accessors = {puzzle_get, puzzle_set, 0, 0, 0};
void puzzle(SV* sv) {
    MAGIC* mg;
    int mn = 2;
    sv_magic(sv, newSViv(SvIV(sv)), /*PERL_MAGIC_ext*/ '~',
        &mn, sizeof(int));
    mg = mg_find(sv, /*PERL_MAGIC_ext*/ '~');
    mg->mg_virtual = &puzzle_accessors;
    SvMAGICAL_on(sv);
}
EOC
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
すみません。
この解析は *ガッツ* のある人におまかせということで(^_^;
perldoc perlgutsを参照してください。
要するに、わざわざCを使ってPerl APIを呼んでいるわけでして…。
===========================================================
■読者からのお便り
-----------------------------------------------------------
●読者から
-----------------------------------------------------------
なかなか面白かったです。
結構難しかったけど。puzzleはこのくらいがいいですね。
いろんなパターンが考えられるし。こういうのが一番好きです。
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
『Perlクイズ』の≪パズル≫に解答する方って、
シンプルでややこしそうな問題に対して「燃える」傾向がありますね。(^_^)
いつもご解答ありがとうございます。
-----------------------------------------------------------
●読者から
-----------------------------------------------------------
レベルとしては若葉並なのですが、
久しぶりだったので無理を承知で挑戦してみました。

が・・・
やっぱり難しくてさっぱりわかりませんでした。
少なくとも通常の上から下へ処理していく方法では
だめなんだろうなと考えて、
サブルーチン化しようとしたり
(最後に"}"がつけられないので無理)、
"$puzzle = 1;"あたりをラベルに設定してなんとか
インタラプトをかけようとしたり
(セミコロンが入っているので無理)、
出力には最後に改行が入っていないからそこらへんが
ヒントかと考えてなんとかしようとしたり…
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
努力のあとを紹介してくださってありがとうございます。(^_^)
-----------------------------------------------------------
●読者から
-----------------------------------------------------------
いつも面白いクイズありがとうございます。
私はいつもひとつぐらいしか思いつかないのですが、
今回もどんなにバリエーションがあるのか楽しみです。
-----------------------------------------------------------
●結城から
-----------------------------------------------------------
みなさんの解答、いかがでしたか。
何だか圧倒されちゃいますよね。(@_@)

と、ともあれ、Enjoy Perl!
===========================================================
結城浩の『Perlクイズ』
Copyright (C) 1999-2003 by Hiroshi Yuki. <hyuki@hyuki.com>
http://www.hyuki.com/pq/
お送りくださる文章やプログラムは、
書籍や連載などで無断で利用させていただく場合があります。
===========================================================

このメルマガは現在休刊中です

ついでに読みたい

このメルマガは
現在休刊中です

他のメルマガを読む