Rubyでチャーチ数

Rubyに慣れるとっかかりとしてチャーチ数を定義してみた。
lambdaで包まずに関数リファレンスを関数に渡す方法がわからない。。

# 数値(xに対するs関数の適用回数で数値を表す)
def zero  (s, x) x end 
def one   (s, x) s[x] end 
def two   (s, x) s[s[x]] end 
def three (s, x) s[s[s[x]]] end 
def four  (s, x) s[s[s[s[x]]]] end 
def five  (s, x) s[s[s[s[s[x]]]]] end 

# 足し算(m+n回だけxに対してs関数を適用する)
def plus(m, n, s, x)
  m[s, n[s, x]] 
end
n = plus(
  lambda{|s, x| five(s, x)}, 
  lambda{|s, x| two(s, x)}, 
  lambda{|n| n + 1}, 0)
print "5 + 2 = ", n, "\n"

# 掛け算(m*n回だけxに対してs関数を適用する)
def multi(m, n, s, x)
  m[lambda{lambda{|x| n[s, x]}}.call(), x]
end
m = multi(
  lambda{|s, x| four(s, x)},
  lambda{|s, x| three(s, x)},
  lambda{|n| n + 1}, 0)
print "4 * 3 = ", m, "\n"

実行すると次のようになる。

PHPとファーストコンタクト

食わず嫌いだったPHP。触ってみると手に馴染みそうで良い。
早速、フィボナッチ数列に挑む。

<?php
# 整数の無限リスト
function stream($i) {
  return function() use (&$i) {
    return $i++;
  };
}

# フィボナッチ数列の無限リスト
function fibos() {
  $lazy  = stream(0);
  $prevs = array(0, 0);
  return function() use ($lazy, &$prevs) {
    $now = $lazy();
    if ($now == 0 || $now == 1) {
      $ans = $now;
    }
    else {
      $ans = $prevs[0] + $prevs[1];
    }
    $prevs = array($prevs[1], $ans);
    return $ans;
  };
}

以前もやった遅延評価を使った。

Perlで対話型コマンドの実行

前回はTeraTermマクロで対話型コマンドの実行をがんばった。けど扱いづらい。Perl使いたい。というわけで、telnetコマンドをfork/execしてpipeで標準入出力を操作してみた。*1 *2

まず、ファイルハンドルから値を読み込む関数と書き出す関数。読み出しでは応答が1秒間無かったら入力待ちと判断してる。*3

use strict;
use warnings;
use IO::Select;

sub read_all {
  my ($stdout_r) = @_;
  my $read_line;
  my $s = IO::Select->new($stdout_r);
  while (1) {
    my @ready = $s->can_read(1);
    last if (@ready == 0);
    sysread($stdout_r, my $in, 1);
    $read_line .= $in;
  }
  return $read_line;
}

sub writeln {
  my ($stdin_w, $write_line) = @_;
  syswrite($stdin_w, "$write_line\n", length("$write_line\n"));
}

次がtelnetをfork/execするtelnet関数。ログイン処理と終了処理も行う。*4 *5

*1:CPANが使えればNet::Telnet使うんだけどな・・・。

*2:直接対話型コマンドをfork/execしても良いけど、よりユーザ環境に近づけるためにtelnetを挟みたかった。

*3:タイムアウト監視にはalarm関数を使う方法もある。

*4:exec失敗で固まったりバグだらけ。

*5:fork/execよりopen3関数を使うほうが簡潔だけど、今回はお勉強のためfork/exec

TeraTermマクロで対話型コマンドのテスト

定期的に行われる対話型コマンドの回帰テスト。バッチ化できないからって毎度手動でやるのはアホらしいよね。というわけで、TeraTermマクロでがんばってみる。

まずは簡単なテスト対象。

#include <stdio.h>

int main()
{
  int n = 0;

  do {
    printf("in => ");
    scanf("%d", &n);
    if (n == 1) {
      printf("Hello, world%d\n", n);
    }
    else {
      printf("error%d\n", n);
    }
  }
  while (n != 1);

  return 0;
}

プロンプトを表示して入力を待つ。「1」を入力したらプログラムを終了する。入力値に応じて文字列を出力する。かなり手抜き。

そして、上記を実行するTeraTermのマクロ。

そしてCOBOLerへ…

仕事でCOBOLを扱うことになった。少し勉強中。とりあえずオブジェクト指向してみる。

まず、speakメソッドを有するAnimalインタフェースを定義する。

      *>「Animal」インタフェース
       identification division.
       interface-id. Animal.

       procedure division.
         identification division.
         method-id. speak.
         procedure division.
         end method speak.
       end interface Animal.

で、それを実装するのがDogクラスとDuckクラス。

非決定性 with 例外

『On Lisp』の非決定性が面白い。

(define (two-numbers)
  (list (choose '(0 1 2 3 4 5))
        (choose '(0 1 2 3 4 5))))

(define (parlor-trick sum)
  (let ((nums (two-numbers)))
    (if (= (apply + nums) sum)
        `(the sum of ,@nums)
        (fail))))

> (parlor-trick 7)
(THE SUM OF 2 5)

On Lisp - 非決定性

　choose関数が正しい選択を行うと仮定したコードになっている。カラクリは単純。choose関数に指定された数値分の継続を順番に実行しているだけ。継続の実行をfail関数で行うことでfail関数が呼ばれないパスが求めるべき解になる。
　実は継続を使わなくても例外でできる。というわけで、D言語で実装してみる。

Perlで継続

現在、『On Lisp』が３巡目の終盤に差し掛かっている。でも、いまいち継続を理解できていない。分かり易い解説を見つけたのでPerlに翻訳してみた。(本を読む FizzBuzzとGaucheで学ぶ継続の基礎)

use strict;
use warnings;

sub fizzbuzz {
  my ($next, ($n)) = @_;
  my $answer = $n % 15 == 0 ? "FizzBuzz"
             : $n %  3 == 0 ? "Fizz"
             : $n %  5 == 0 ? "Buzz"
             : $n;

  # $nextを挟んで再帰呼び出し
  $next->(\&fizzbuzz, ($n + 1, $answer));
}

sub continuation {
  my ($next, ($n, $answer)) = @_;

  # 状態を閉じ込めた状態で関数終了
  my $cc = sub {
    my ($fun) = @_;
    $fun->($answer) if (ref $fun eq 'CODE');
    $next->(\&continuation, ($n));
  };
}

# 1〜100のfizzbuzz継続を生成してリストに保存
my @restart = fizzbuzz(\&continuation, (1));
push @restart, $restart[$#restart]->() for 2..100;

# 1〜100のfizzbuzz継続を実行
$restart[$_]->( sub{ print @_, $_ != $#restart ? '|' : '' } ) for 0..$#restart;

100までのFizzBuzzが表示される。