分室の分室

【385】Gimp『集中線』フィルターのソースを特定

perl, script-fu, gimp

　チョイネタです。

『フィルター(R)』―『下塗り(R)』―『集中線(N)』

　Gimp の『集中線』フィルターの実行結果は『アンチエイリアス』が効いていて、綺麗な斜線が引ける。それのソースが見たくて Perl の grep で探してみた。

grep のソースはこちら。↓
2012-06-28 Thu
【254】プロシージャブラウザで GIMP の関数を調べるが、よく分からず…
http://d.hatena.ne.jp/foussin/searchdiary?word=gimp-grep.pl

c:\usr\edit\test-lib\perl2scfu\ex.pl>gimp-grep.pl line
/usr/GIMPPortable/Data/.gimp/scripts/circle-mosaic.scm
/usr/GIMPPortable/Data/.gimp/scripts/electricity-logo.scm
/usr/GIMPPortable/Data/.gimp/scripts/exploding.scm
/usr/GIMPPortable/Data/.gimp/scripts/feather-selection.scm
/usr/GIMPPortable/Data/.gimp/scripts/feurio-logo.scm
/usr/GIMPPortable/Data/.gimp/scripts/framed-glass-text.scm
/usr/GIMPPortable/Data/.gimp/scripts/ice-cube-logo.scm
/usr/GIMPPortable/Data/.gimp/scripts/icefire-logo.scm
/usr/GIMPPortable/Data/.gimp/scripts/perl2scfu-pset.scm
/usr/GIMPPortable/Data/.gimp/scripts/perl2scfu-stroke.scm
/usr/GIMPPortable/Data/.gimp/scripts/plasticlogo.scm
/usr/GIMPPortable/Data/.gimp/scripts/scan-line.scm
/usr/GIMPPortable/Data/.gimp/scripts/set-brush.scm
/usr/GIMPPortable/Data/.gimp/scripts/smart-sharpening.scm
/usr/GIMPPortable/Data/.gimp/scripts/text-neon-logo.scm
/usr/GIMPPortable/Data/.gimp/scripts/tile-maker.scm
/usr/GIMPPortable/Data/.gimp/scripts/toycamera.scm
/usr/GIMPPortable/Data/.gimp/scripts/wax-seal.scm
/usr/GIMPPortable/Data/.gimp/scripts/zahnpasta.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/3d-outline.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/alien-neon-logo.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/chalk.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/chrome-it.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/comic-logo.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/crystal-logo.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/gimp-online.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/glossy.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/land.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/line-nova.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/neon-logo.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/palette-export.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/perspective-shadow.scm
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/script-fu-compat.init
/usr/GIMPPortable/App/gimp/share/gimp/2.0/scripts/sota-chrome-logo.scm

c:\usr\edit\test-lib\perl2scfu\ex.pl>

　集中線…というぐらいなので、line で検索(grep)してみた。

　赤字の『line-nova.scm』というのがアヤシイ…。開いてみたら、ビンゴ!!　これでした。作者は日本人なんですね。

　ソースをちょっと見ただけではよく分からないけど『gimp-image-select-云々』というプロシージャを頻繁に使っているのがポイントと思われます。

　r4rs 準拠の古いコードなので、r5rs しか知らない自分が理解するには時間がかかりそう。このコードを見て勉強するのは、別の機会にでもじっくりやることにする。ただ、ひとつだけ驚いたことが…↓

　　(2pi (* 2 *pi*))

　変数名が『数字から始まっている』ところ。たしかに、前置記法の Scheme にはシンボルの名前付けに制限はない。でも、これは盲点でした。…それにしても『2pi』は分かり易い名前です(角度：360度を意味する)。これは真似したいな。

　あと、*name* という変数名は、グローバル変数を目立たせる慣例だと思っていたけど、そういうワケでもないらしい(let-バインド変数として使っているので)。とりあえず、不変の定数値を格納する変数(破壊的代入をしない変数)として使っているようです。。。

　まあ、グローバル変数も破壊的代入を行うと問題が起き易いので、同じ意味合いから目立たせている…そういうことか。

Permalink | コメント(0) | トラックバック(0) | 23:16

【380】shift の戻り値を push の引数に渡すとリング構造になる

perl

　はてなダイアリー投稿のインターバルが空かないようにしようと思って、Perl や Scheme のチョイネタを予め仕込んでいる。今回はチョイネタ。

　以前、ちょろっと紹介した『なんちゃって repl』を使って試してみる。

2013-02-23 Sat【347】eval でコードチェック
http://d.hatena.ne.jp/foussin/20130223/1361560685

c:\usr\edit\test-lib\perl2scfu\test.pl>eval.pl
input code> @list = ("hoge", "piyo")
2
input code> push @list, shift(@list)
2
input code> "@list"
piyo hoge
input code> push @list, shift(@list)
2
input code> "@list"
hoge piyo
input code> :q
bye.

c:\usr\edit\test-lib\perl2scfu\test.pl>

…ということは『【378】2つの手続を交互に実行』のコードは

my @list = ("hoge", "fuga");
my $i = 10;
while ($i) {
    my $ret = push @list, shift(@list);     # 先頭要素を末尾へ送る
    ($ret eq "hoge") ? hoge() : fuga();
    --$i;
}

…こういう風にも書ける。もしくは

    my $ret = unshift @list, pop(@list);    # 末尾要素を先頭へ送る

…こういう風にも書ける。

Permalink | コメント(0) | トラックバック(0) | 20:12

【323】以前テレビで観たアメリカのクイズ番組のアレ。。。

perl

　今回はちょっと息抜き。こちらの記事を観て ↓

http://d.hatena.ne.jp/iww/20130111/1357875502

『モンティホール問題』っていうのか。

　三択の(クイズ?)番組…最初は外れる確率が高い(2/3：だから変更した方が得)。マリリン凄いけど、選択を変えて外した場合、非常に悔しい思いをする(司会者のドヤ顔がむかつく)。

ルール、そして経緯…

・3つの箱の中に 1つだけ豪華商品が入っている。
・回答者は、その中から 1つを選ぶ。
・すると司会者は、ハズレの箱を 1個開いてしまう。そして、

    アタリはあなたが選んだ方か、残りの方かどちらかになります。
    さあ、どうします?　今なら変えてもいいですよ。

…と言う。で、回答者は悩む。変えるべきか、変えないべきか…と。

　このクイズ(?)番組について、数学者のマリリンさんが

　　「変えた方が得よ!」

…と言い出したため、プロの数学者も巻き込んだ大論争が沸き起こった。。。

一様擬似乱数でシミュレーションしてみる

　確かに、確率論では『変えた方が得』だと思えるが、実際にシミュレーションで確認してみたくなった…そうしたら、思っていた以上に衝撃的な結果が…。↓

#!/usr/bin/perl

# monty.pl
use strict;
use warnings;

$ARGV[0] or $ARGV[0] = 0;
if ($ARGV[0] == 100) {      # ゲームを 100回 実行 x 5セット
    game100();  game100();  game100();  game100();  game100();
} else {                    # ゲームを 1回 実行(default)
    my ($ans_1, $other, $atari, $del) = game();
    my @sorted = sort {$a <=> $b } ($ans_1, $other, $del);
    my @simbol;
    foreach (@sorted) {
        ($_ == $del)    and push @simbol, "[X]";
        ($_ == $other)  and push @simbol, "[$other]";
        ($_ == $ans_1)  and push @simbol, "[$ans_1]";
    }
    my @select = sort {$a <=> $b } ($ans_1, $other);
    print <<"EOT";
### ゲームを1回実行：
司会者：ここに 3つの箱があり、1つだけ豪華商品が入っています。
司会者：0, 1, 2 のどれか 1つを選んでください。

回答者：(回答者は $ans_1 を選択した)

司会者：…ちなみに、$del はハズレです!
司会者：アタリはあなたが選んだ $ans_1 か、残りの $other か、どちらかです。
司会者：さあ、どうします?　今なら変えてもいいですよ。

3つの箱 → $simbol[0]  $simbol[1]  $simbol[2]
EOT
    print "\n選択してください($select[0] or $select[1])：";
    chomp(my $sel = <STDIN>);
    ($sel =~ /[$ans_1$other]/) or $sel = 3;  # 想定外の回答は不正解
    ($sel == $atari)
        ? print "\n司会者：おめでとうございます。正解です。\n"
        : ($sel == 3)
            ? print "\n南千秋：ぶぶ〜。おととい来やがれ、バカヤロー。\n"
            : print "\n司会者：残念…不正解。正解は $atari です。\n";
} # end of default

sub game {                      # ゲーム開始
    my @list  = (0, 1, 2);      # 三択問題
    my $atari = int(rand 3);    # 正解を決める
    my $ans_1 = int(rand 3);    # 1stアンサー (正解率 1/3)
    # ここで司会者は『1stアンサー以外のハズレ』を 1枚見せなければならない
    # ($atari != $ans_1) なら、見せられるハズレは 1枚しかない(2/3 の確率)
    # ($atari == $ans_1) なら、見せられるハズレは 2枚ある    (1/3 の確率)
    my @del;
    foreach (@list) {
        ($_ == $atari) and next;
        ($_ == $ans_1) and next;
        push @del, $_;
    }
    my $del =  0;
    (@del > 1) and $del = int(rand 2);  # (0 or 1)
    $del = $del[$del];                  # 除外するハズレを決定
    # ここで二択問題になる
    # 2ndアンサーを 1stアンサーと同じにするか、変えるか…と問題をすり替え
    # (変えるなら $other, 変えないなら $ans_1 を選択)
    my $other = "";
    foreach (@list) {
        ($_ == $del)   and next;
        ($_ == $ans_1) and next;
        $other = $_;
    }
    return($ans_1, $other, $atari, $del);
} # game

sub game100 {                           # ゲームを 100回 実行
    my $ans_1_avg = 0;
    my $other_avg = 0;
    for (my $i=0; $i<100; ++$i) {
        my ($ans_1, $other, $atari) = game();
        ($atari == $ans_1) and ++$ans_1_avg;
        ($atari == $other) and ++$other_avg;
    }
    print "### ゲームを100回実行：\n";  # 結果発表
    print "1stアンサーを変えない場合の正解率：$ans_1_avg %\n";
    print "1stアンサーから変えた場合の正解率：$other_avg %\n";
    print "\n";
    return;
} # game100
__END__

　行数は85行。やや冗長かも…。実行すると、とりあえずゲームを体験できます。↓

c:\usr\edit\test-lib\perl2scfu>monty.pl
### ゲームを1回実行：
司会者：ここに 3つの箱があり、1つだけ豪華商品が入っています。
司会者：0, 1, 2 のどれか 1つを選んでください。

回答者：(回答者は 0 を選択した)

司会者：…ちなみに、2 はハズレです!
司会者：アタリはあなたが選んだ 0 か、残りの 1 か、どちらかです。
司会者：さあ、どうします?　今なら変えてもいいですよ。

3つの箱 → [0]  [1]  [X]

選択してください(0 or 1)：1

司会者：おめでとうございます。正解です。

c:\usr\edit\test-lib\perl2scfu>monty.pl
### ゲームを1回実行：
司会者：ここに 3つの箱があり、1つだけ豪華商品が入っています。
司会者：0, 1, 2 のどれか 1つを選んでください。

回答者：(回答者は 1 を選択した)

司会者：…ちなみに、0 はハズレです!
司会者：アタリはあなたが選んだ 1 か、残りの 2 か、どちらかです。
司会者：さあ、どうします?　今なら変えてもいいですよ。

3つの箱 → [X]  [1]  [2]

選択してください(1 or 2)：2

司会者：残念…不正解。正解は 1 です。

c:\usr\edit\test-lib\perl2scfu>

　画面表示を見れば、ゲームのルールは把握できると思う。ポイントは、最終的には『二択問題』になる…ということ。二択なのに『変な答』を入力すると ↓

c:\usr\edit\test-lib\perl2scfu>monty.pl
### ゲームを1回実行：
司会者：ここに 3つの箱があり、1つだけ豪華商品が入っています。
司会者：0, 1, 2 のどれか 1つを選んでください。

回答者：(回答者は 0 を選択した)

司会者：…ちなみに、2 はハズレです!
司会者：アタリはあなたが選んだ 0 か、残りの 1 か、どちらかです。
司会者：さあ、どうします?　今なら変えてもいいですよ。

3つの箱 → [0]  [1]  [X]

選択してください(0 or 1)：2

南千秋：ぶぶ〜。おととい来やがれ、バカヤロー。

c:\usr\edit\test-lib\perl2scfu>

…と、南千秋に罵倒されます。このゲームを何百回と繰り返していけば、マリリンが言ってるとおりの確立になるハズだが、それはさすがに面倒くさい。そこで、こうした。↓

c:\usr\edit\test-lib\perl2scfu>monty.pl 100
### ゲームを100回実行：
1stアンサーを変えない場合の正解率：34 %
1stアンサーから変えた場合の正解率：66 %

### ゲームを100回実行：
1stアンサーを変えない場合の正解率：37 %
1stアンサーから変えた場合の正解率：63 %

### ゲームを100回実行：
1stアンサーを変えない場合の正解率：38 %
1stアンサーから変えた場合の正解率：62 %

### ゲームを100回実行：
1stアンサーを変えない場合の正解率：41 %
1stアンサーから変えた場合の正解率：59 %

### ゲームを100回実行：
1stアンサーを変えない場合の正解率：30 %
1stアンサーから変えた場合の正解率：70 %

　引数として『100』を指定すると、ゲームを『100回 x 5セット』実行し、その正解率を算出する仕様とした。この結果を見ると確率は、ほぼ 2：1 で『変えた方が正解率が高い』。これではもう、番組は成り立たない。回答者は、みんな変える方を選んでしまうだろうからねえ。。。

Permalink | コメント(0) | トラックバック(0) | 23:39

【321】リファレンス覚書

perl

あけましておめでとうございます。
本年も宜しくお願い致します。

　↑頑張って Inkscape で作ってみたが、詰めが甘い(頭がイビツに見えるのは眼の位置が変なのも一因としてある…)。ただ、簡単に曲線を描く 自分なりの方法 を見つけた(いずれダイアリーで紹介するかも…しないかも)。

　年が明けて既に 5日も経過。新年の一発目は、やはり初心忘れるべからずの Perl で。特にリファレンスは、複数の配列を引数指定する以外に使ったことがないので、知らないことも多々ある。

#!/usr/bin/perl

# <title> リファレンス覚書 1 </title>
use strict;
use warnings;

# 適当に初期化
my $scalar = 'スカラー';
my @array  = ('配', '列');

# リファレンス生成
my $sca_ref  = \$scalar;
my $arr_ref  = \@array;
my @elm_ref  = \(@array);
my $lis_ref  = \('hoge', 'fuga');

print "01: ", $sca_ref, "\n";
print "02: ", $arr_ref, "\n";
print "03: ", @elm_ref, "\n";
print "04: ", $lis_ref, "\n";
print "05: type: ", ref $sca_ref, "\n";
print "06: type: ", ref $arr_ref, "\n";
print "07: type: ", ref @elm_ref, "\n";
print "08: type: ", ref $lis_ref, "\n";
print "09: type: ", ref $scalar , "\n";
print "10: ", $$lis_ref, "\n";
print "11: ", $elm_ref[0], "\n";
print "12: ", ${$elm_ref[0]}, "\n";

# デリファレンス(無名配列)
my $array_ref = ["abcd", "efg", "hijk"];
print "13: ", $array_ref->[1], "\n";

$array_ref->[1] = "lmn";
print "14: ", $array_ref->[1], "\n";
__END__

c:\usr\edit\test-lib\perl2scfu\ex.pl>ref.pl
01: SCALAR(0x15585ac)
02: ARRAY(0x155860c)
03: SCALAR(0x65beec)SCALAR(0x65bf7c)
04: SCALAR(0x65bfcc)
05: type: SCALAR
06: type: ARRAY
07: type:
08: type: SCALAR
09: type:
10: fuga
11: SCALAR(0x65beec)
12: 配
13: efg
14: lmn

今回やりたいのは

　　my (@new, $new, $new2) = hoge_fuga(\@old, \$old, \$old2, $opt);

…こんな感じで、リファレンスの引数は内部で別の形に上書きし、普通のスカラー変数と区別する。さらに、それらを加工したデータを戻値として返す…こんなヤツ。要は、配列のリファレンスとスカラー変数のリファレンスを一緒に扱う。

#!/usr/bin/perl

# <title> リファレンス覚書 2 </title>
use strict;
use warnings;

my $old1 = 10;
my $old2 = 20;
my @old  = (30, 40);
my ($new1, $new2, @new) = hoge(\$old1, \$old2, \@old, "opt: x5");
my $opt = pop @new;

print <<"EOT";
(var + $opt)
old1    : $old1
old2    : $old2
old[0]  : $old[0]
old[1]  : $old[1]

(var * $opt)
new1    : $new1
new2    : $new2
new[0]  : $new[0]
new[1]  : $new[1]
EOT

sub hoge {
    my $opt = "";
    ($_[-1] =~ /opt:/) and $opt = pop @_;
    $opt =~ tr/0-9//cd;
    my @new;
    foreach my $i (@_) {
        if (ref($i) eq "SCALAR") {
            $$i += $opt;
            push @new, $$i * $opt;
        } elsif (ref($i) eq "ARRAY") {
            for (my $j=0; $j<@$i; ++$j) {
                $$i[$j] += $opt;
                push @new, $$i[$j] * $opt;
            }
        } else { next; }
    }
    return(@new, $opt);
}
__END__

c:\usr\edit\test-lib\perl2scfu\ex.pl>ref2.pl
(var + 5)
old1    : 15
old2    : 25
old[0]  : 35
old[1]  : 45

(var * 5)
new1    : 75
new2    : 125
new[0]  : 175
new[1]  : 225

　とりあえず、想定どおりに動いた。この構文を使って、昨年の続き(Gimp 関連)をやろうと思っている。

Permalink | コメント(0) | トラックバック(0) | 23:46

【310】s///g (置換演算子) の備忘

perl

　現在、perl2scfu.pl のバージョンアップを検討中。。。

　Perl で Script-Fu (Scheme) のコードを出力する時、つい…

my @list = ("abcd", "efg", "hijk", "lmn");
print "(define perl2scfu-data-list '(@list) )\n";

…のように書いてしまうが、これだと

(define perl2scfu-data-list '(abcd efg hijk lmn) )

…シンボルのリストになってしまう。文字列のリストにするには "abcd" のようにクォートしないといけないんだけど…これでいいんだっけ… ? ↓

my @list = ("abcd", "efg", "hijk", "lmn");
my $list = "@list"; # 空白区切りにする
$list   =~ s/(\w+)/"$1"/g;
print "(define perl2scfu-data-list '($list) )\n";

c:\usr\edit>hoge.pl
(define perl2scfu-data-list '("abcd" "efg" "hijk" "lmn") )

c:\usr\edit>

　良いみたい。

("abcd" "abcd" "abcd" "abcd")　　…になるかと勘違いしてた。

Permalink | コメント(0) | トラックバック(0) | 12:16