prepress-tips

対話・検索・選択によるプログラミング

最終更新：2008年10月29日 16:40

prepress-tips

- view

管理者のみ編集可

最終更新日時： 2008/10/29

perlで狼・山羊・キャベツの川渡し
最初の対話

２回目の対話

３回目の対話

４回目の対話

最後の対話

完成したソース

ソースの書式を変えてみる
書き換えルール

書き換えの利点

書き換えを戻すスクリプト

Edit

形式手法モデル理論アプローチを利用すればプログラムの内部構造に立ち入ってライブラリを利用することができる。
そのようなライブラリの利用を前提とした対話的プログラミングを考えてみる。
※ ここで使っているソースの詳細は形式手法モデル理論アプローチ３を参照してください。

perlで狼・山羊・キャベツの川渡し

最初の対話

mainで何をしますか？
- title を表示する。
- Wgc問題を解く。
- 解いた結果 answer を表示する。
- 終了。
title はどんな方法で表示しますか？
- ここでライブラリを検索していろいろな説明などを読み
  msgで表示する方法を選ぶとする。
Wgc問題はどんな方法で解きますか？
- ここでもライブラリを検索しいろいろな説明などを読んで
  goal_seekerで解く方法を選ぶとする。
解いた結果はどんな方法で表示しますか？
- 先ほどと同じく msgで表示する方法を選ぶとする。

ここまでで次のソースができる。

{
    msg( title() );
    goal_seeker( Wgc::InitialState() );
    msg( answer() );
    exit( 0 );
}

ライブラリから次のソースを読み込む。

sub msg { print map do { $_."\x0a" }, @_; }
sub goal_seeker {
    my ( $state, $ready, ) = @_; $state || return;
    $ready || ( $twice = {}, @StateSequence = () );
    ! $twice->{ $state->toString } && $state->constraint || return;
    $state->goal && ( $state->goal_lambda, return );
    $state->lambda();
    $twice->{ $state->toString } = 1; push @StateSequence, $state;
    map do { goal_seeker( $_, 1 ); }, map do { $state->Delta( $_ ); }, $state->Actions;
    pop @StateSequence; $twice->{ $state->toString } = undef;
    $state->lambda_back();
}

未解決の部分は次のようになる。

sub title {}
{ package Wgc;
    sub InitialState {}
1; }
sub answer{}

これでエラーは出ないが確認のため次のようにしておく。

sub title { 'title'; }
{ package Wgc;
    sub InitialState { print 'Wgc::InitialState'."\x0a"; undef; }
1; }
sub answer{ 'answer'; }

これで実行すればソースに問題のないことが確認できる。

２回目の対話

title は？
- Wgc問題の title
answer は？
- Wgc問題の answer
Wgc問題について ‥
title は？
- '狼・山羊・キャベツの川渡し問題'
answer は？
- @answer
状態とするものは？
- 川の左側を文字列で表したもの
初期状態は？
- "wgcf"
- ここで @answer を初期化しておく
状態を文字列でユニークに表現する方法を用意する必要があります。
その方法は？
- ここでライブラリを検索し uniqueを選ぶとする。

ここまでで次のソースができる。

sub title { Wgc::title(); }
sub answer { Wgc::answer(); }
{ package Wgc;
    sub title {
        '狼・山羊・キャベツの川渡し問題';
    }
    sub answer {
        @answer;
    };
    @answer;
    sub State {
        bless{ state => $_[0] };
    }
    sub InitialState {
        @answer = ();
        State( "wgcf" );
    }
    sub toString {
        unique( $_[0]->{state} );
    }
1; }

ライブラリから次のソースを読み込む。

{ package Wgc;
    sub unique { my $r = ""; for( sort split "", $_[0] ) { $r =~ s/($_|$)/$_/; } $r; }
1; }

未解決部分は次のようにしておく。

{ package Wgc;
    sub goal { 0; }
    sub goal_lambda {}
    sub lambda { push @answer, $_[0]->toString; }
    sub lambda_back {}
    sub Actions {}
    sub Delta {}
    sub constraint { 1; }
1; }

これらを前のソースに追記すると、未解決部分はオーバーライドされ、
これで実行すればソースに問題のないことが確認できる。

３回目の対話

Wgc問題について ‥
ゴールは？
- ""
ゴールですることは？
- 状態の推移を文字列に変えて解に追加する
状態の推移は？
- @sequence
- @sequence は初期状態で初期化しておく
文字列に変える方法は？
- "answer: ".join ' → ', @sequence

これでソースは次のようになり

{ package Wgc;
    sub goal {
        $_[0]->{state} eq "";
    }
    sub goal_lambda {
        push @answer, "answer: ".join ' → ', @sequence;
    }
    @sequence;
    sub InitialState {
        @answer = ();
        @sequence = ();
        State( "wgcf" );
    }
1; }

未解決部分は次のようにする。

{ package Wgc;
    sub lambda { push @sequence, $_[0]->toString; }
    sub Actions { ""; }
    sub Delta { State( "" ); }
1; }

これらを前のソースに追記し実行すればソースに問題のないことが確認できる。

４回目の対話

Wgc問題について ‥
新しい状態ですることは？
- 状態を状態の推移に記録する
前の状態に戻すには？
- 状態の推移の最後の記録を消す

これでソースは次のようになり

{ package Wgc;
    sub lambda { push @sequence, $_[0]->toString; }
    sub lambda_back { pop @sequence; }
1; }

未解決部分は次のようにする。

{ package Wgc;
    sub Actions { $_[0]->{state} =~ /^./ ? $' : "" ; } #'
    sub Delta { State( $_[1] ); }
1; }

これらを前のソースに追記し実行すればソースに問題のないことが確認できる。

最後の対話

Wgc問題について ‥
ある状態で実行できることは？
- 状態に"f"が含まれれば状態を１文字ずつに分けたもの
  そうでないならば状態に含まれない文字を１つずつに分けたもの
ある状態で実行できることを実行したあとの状態は？
- 状態に"f"が含まれないならば状態に"f"と実行するものを加える
  そうでないならば状態から"f"と実行するものを除く
状態が満たさなくてはいけないことは？
- 状態に"f"が含まれれば
  状態に "w","g"のどちらがありかつ "g","c"のどちらかがあること
  （両方あってもよい）
  そうでないならば
  状態に "w"と"g"がともにはなくかつ "g"と"c"がともにはないこと

これでソースは次のようになり

{ package Wgc;
    sub Actions {
        my $state = $_[0]->{state};
        $state =~ /f/ && ( return split "", $state );
        map do { $state =~ /$_/ ? () : $_ ; }, split "", "wgcf";
    }
    sub Delta {
        my $state = $_[0]->{state};
        $state =~ /f/ || ( return State( $state."f".$_[1] ) );
        $state =~ s/f//g; $state =~ s/$_[1]//g; return State( $state );
    }
    sub constraint {
        my $state = $_[0]->{state};
        if( $state =~ /f/ ) {
            return ( $state =~ /w/ || $state =~ /g/ ) && ( $state =~ /g/ || $state =~ /c/ );
        }
        return ! ( $state =~ /w/ && $state =~ /g/ ) && ! ( $state =~ /g/ && $state =~ /c/ );
    }
1; }

未解決部分はなく対話は終了。
これを前のソースに追記し実行すればソースに問題のないことが確認できる。

完成したソース

オーバーライド部分を削除して最終的にできたソースは次のようになる。

{
    msg( title() );
    goal_seeker( Wgc::InitialState() );
    msg( answer() );
    exit( 0 );
}
sub msg { print map do { $_."\x0a" }, @_; }
sub goal_seeker {
    my ( $state, $ready, ) = @_; $state || return;
    $ready || ( $twice = {}, @StateSequence = () );
    ! $twice->{ $state->toString } && $state->constraint || return;
    $state->goal && ( $state->goal_lambda, return );
    $state->lambda();
    $twice->{ $state->toString } = 1; push @StateSequence, $state;
    map do { goal_seeker( $_, 1 ); }, map do { $state->Delta( $_ ); }, $state->Actions;
    pop @StateSequence; $twice->{ $state->toString } = undef;
    $state->lambda_back();
}
sub title { Wgc::title(); }
sub answer { Wgc::answer(); }
{ package Wgc;
    sub title {
        '狼・山羊・キャベツの川渡し問題';
    }
    sub answer {
        @answer;
    };
    @answer;
    sub State {
        bless{ state => $_[0] };
    }
    sub toString {
        unique( $_[0]->{state} );
    }
    sub unique { my $r = ""; for( sort split "", $_[0] ) { $r =~ s/($_|$)/$_/; } $r; }
    sub goal {
        $_[0]->{state} eq "";
    }
    sub goal_lambda {
        push @answer, "answer: ".join ' → ', @sequence;
    }
    @sequence;
    sub InitialState {
        @answer = ();
        @sequence = ();
        State( "wgcf" );
    }
    sub lambda { push @sequence, $_[0]->toString; }
    sub lambda_back { pop @sequence; }
    sub Actions {
        my $state = $_[0]->{state};
        $state =~ /f/ && ( return split "", $state );
        map do { $state =~ /$_/ ? () : $_ ; }, split "", "wgcf";
    }
    sub Delta {
        my $state = $_[0]->{state};
        $state =~ /f/ || ( return State( $state."f".$_[1] ) );
        $state =~ s/f//g; $state =~ s/$_[1]//g; return State( $state );
    }
    sub constraint {
        my $state = $_[0]->{state};
        if( $state =~ /f/ ) {
            return ( $state =~ /w/ || $state =~ /g/ ) && ( $state =~ /g/ || $state =~ /c/ );
        }
        return ! ( $state =~ /w/ && $state =~ /g/ ) && ! ( $state =~ /g/ && $state =~ /c/ );
    }
1; }

ソースの書式を変えてみる

書き換えルール

ソースの記述のしかたを次のようなルールで書き換えてみる。

{                         ? main
   proc           ←→        proc
}

sub name {                ? name
   proc           ←→        proc
}

{ package name;           ? package name
    func          ←→        func
1; }

@name;            ←→    ? @name

先ほどのソースは次のように書き換えられる。

wgc.txt

? main
    msg( title() );
    goal_seeker( Wgc::InitialState() );
    msg( answer() );
    exit( 0 );
? msg
    print map do { $_."\x0a" }, @_;
? goal_seeker
    my ( $state, $ready, ) = @_; $state || return;
    $ready || ( $twice = {}, @StateSequence = () );
    ! $twice->{ $state->toString } && $state->constraint || return;
    $state->goal && ( $state->goal_lambda, return );
    $state->lambda();
    $twice->{ $state->toString } = 1; push @StateSequence, $state;
    map do { goal_seeker( $_, 1 ); }, map do { $state->Delta( $_ ); }, $state->Actions;
    pop @StateSequence; $twice->{ $state->toString } = undef;
    $state->lambda_back();
? title
    Wgc::title();
? answer
    Wgc::answer();
? package Wgc
    ? title
        '狼・山羊・キャベツの川渡し問題';
    ? answer
        @answer;
    ? @answer
    ? State
        bless{ state => $_[0] };
    ? toString
        unique( $_[0]->{state} );
    ? goal
        $_[0]->{state} eq "";
    ? goal_lambda
        push @answer, "answer: ".join ' → ', @sequence;
    ? @sequence
    ? InitialState
        @answer = ();
        @sequence = ();
        State( "wgcf" );
    ? lambda
        push @sequence, $_[0]->toString;
    ? lambda_back
        pop @sequence;
    ? Actions
        my $state = $_[0]->{state};
        $state =~ /f/ && ( return split "", $state );
        map do { $state =~ /$_/ ? () : $_ ; }, split "", "wgcf";
    ? Delta
        my $state = $_[0]->{state};
        $state =~ /f/ || ( return State( $state."f".$_[1] ) );
        $state =~ s/f//g; $state =~ s/$_[1]//g; return State( $state );
    ? constraint
        my $state = $_[0]->{state};
        if( $state =~ /f/ ) {
            return ( $state =~ /w/ || $state =~ /g/ ) && ( $state =~ /g/ || $state =~ /c/ );
        }
        return ! ( $state =~ /w/ && $state =~ /g/ ) && ! ( $state =~ /g/ && $state =~ /c/ );
    ? unique
        my $r = "";
        for( sort split "", $_[0] ) { $r =~ s/($_|$)/$_/; }
        $r;

書き換えの利点

対話がソースに反映されメンテナンスしやすくなる。
プログラムの構造に関して言語特有の表現が除去される。
その結果 ‥
他言語への変換がしやすくなる。
プログラムの構造を言語に依存せずに確認することができる。
違う言語のプログラムを組み合わせて使う可能性が増える。

　のではなかろうか？

書き換えを戻すスクリプト

書き換えたテキストをソースに戻すスクリプトは次の通り。
- goal_seekerで使わない関数をコメントアウトしました。
- 使うときは IN の前の＜を半角に変えてください。
- 使い方の例：
  perl txt_to_pl.pl wgc.txt > wgc.pl

txt_to_pl.pl

{
    @in = (); {
        @ARGV > 0 || err( 'ファイル名を指定してください。' );
        my $fn = $ARGV[0];
        -f $fn || err( 'ファイルがありません。' );
        open( IN, '<'.$fn ) || err( 'オープンエラー：'.$fn );
        @in = map do { s/\s*$//; $_; }, ＜IN>;
        close( IN );
    }
    goal_seeker( InitialState() );
    msg( @in );
    exit( 0 );
}
sub err { msg( @_ ); exit( 1 ); }
sub msg { print map do { $_."\x0a" }, @_; }
sub goal_seeker {
    my ( $state, $ready, ) = @_; $state || return;
#    $ready || ( $twice = {}, @StateSequence = () );
#    ! $twice->{ $state->toString } && $state->constraint || return;
#    $state->goal && ( $state->goal_lambda, return );
#    $state->lambda();
#    $twice->{ $state->toString } = 1; push @StateSequence, $state;
    map do { goal_seeker( $_, 1 ); }, map do { $state->Delta( $_ ); }, $state->Actions;
#    pop @StateSequence; $twice->{ $state->toString } = undef;
#    $state->lambda_back();
}

sub State {
    bless{ state => $_[0] };
}
#sub toString { $_[0]->{state}; }
sub InitialState { State( 0 ); }

#sub goal { 0; }
#sub goal_lambda {}
#sub lambda {}
#sub lambda_back{}

sub Actions { # 行頭空白が最長の行
    my $p = 0; {
        my @sp = map do { /$match/ ? length( $1 ) : -1 ; }, @in;
        my $n = 0; my $r = -1; map do { $n++; $r < $_ && ( $r = $_, $p = $n ); }, @sp;
    }
    $p < 1 ? () : ( $p - 1 );
}

BEGIN {
    $match = '^(\s*)\?\s*((package\s+|\@)?[a-zA-Z0-9_]+)(?=\s|$)';
}

sub Delta { # 指定された行を変換
    my $i = ""; my $n = ""; $r = ""; { # 行頭空白，名前，後ろの文字列
        $in[ $_[1] ] =~ /$match/ && ( $i = $1, $n = $2, $r = $' ); #'
    }
    my $s = ""; { # 始めの行
        $s = ( $n =~ /^package\s/i ) ? $i."{ $n;".$r :
             ( $n =~ /^main$/i ) ?     $i."{".$r :
             ( $n =~ /^\@/ ) ?         $i."$n;".$r :
                                       $i."sub $n {".$r ;
        $in[ $_[1] ] = $s; # 始めの行を置換
    }
    my $e = ""; { # 終わりの行
        $e = ( $n =~ /^package\s/i ) ? $i."1; }" :
             ( $n =~ /^\@/ ) ?         "" :
                                       $i."}" ;
    }
    my $p = $_[1] + 1; { # 終わりの行の挿入位置
        for( ; $p < @in; $p++ ) {
            $in[ $p ] =~ /$match/ && length( $1 ) <= length( $i ) && last;
        }
        $e && splice( @in, $p, 0, $e ); # 終わりの行を挿入
    }
    State( $_[0]->{state} + 1 );
}
#sub constraint { 1; }

このテーマは役立ちそうなのでもう少し調べる。→ ソースの書式を変えてみる

Edit

「対話・検索・選択によるプログラミング」をウィキ内検索

人気記事ランキング

最近更新されたページ

急上昇Wikiランキング

急上昇中のWikiランキングです。今注目を集めている話題をチェックしてみよう！

人気Wikiランキング

atwikiでよく見られているWikiのランキングです。新しい情報を発見してみよう！

新規Wikiランキング

最近作成されたWikiのアクセスランキングです。見るだけでなく加筆してみよう！

全体ページランキング

最近アクセスの多かったページランキングです。話題のページを見に行こう！

対話・検索・選択によるプログラミング

perlで 狼・山羊・キャベツの川渡し

最初の対話

２回目の対話

３回目の対話

４回目の対話

最後の対話

完成したソース

ソースの書式を変えてみる

書き換えルール

書き換えの利点

書き換えを戻すスクリプト

更新履歴

perlで狼・山羊・キャベツの川渡し