In [haskell-jp:296] Re: 不動点としての再帰プログラム
>さかいです。

>図示するのは簡単ですが、結果はそう面白いものではないと思います。
>http://web.sfc.keio.ac.jp/~s01397ms/tmp/X3.png

すばらしいー。

でも、あまり Ruby プログラムをぼんぼん飛ばすのはまずいですよ。^^;

Haskell で考えましょう。まず問題設定。

【Xn 問題】
ある集合に不等号 <= が定義されているとき、Pos (partially
 ordered set) と呼ぶ。 a, b が Pos のとき、power(a, b)
で b から a への単調増加関数 f〔x <= y なら f(x) <= f(y)〕
全体を表す。power(a, b) の要素 f, g に対して、全ての x に
対して f(x) <= g(x) となるとき f <= g と不等号を定義する。
このとき power(a, b) も Pos になる。
さて、D2 = [0, 1, 2], D0 = [0] を Pos だと思い、
  X(0) = D0
  X(n+1) = power(D2, X(n)), n = 0, 1, 2, ...
と定義するとき、X(3) の個数あるいは更に順序構造を求めよ。


いつまで経っても自力で Haskell プログラムを書けないので、なんと
かこれを例題にやりたいなあ。どなたか書けたらお願いします。(い
きなり人頼みかよ。)


次の Ruby プログラム(やっぱりそれかよ)は、酒井さんのを高速化
したものです。それでも X(4) は何時間動かしても答が出ない。

Haskell ならできるかな。


#!/usr/bin/env ruby

class Poset
  include Enumerable
  attr_reader :le

  def initialize(*m, &le)
    @le = le || proc{|x, y| x <= y}
    @leh = {}
    @body = {}

    m.each do |x|
      @body.store(x, true)
    end
  end

  def power(other)
    a = {}
    s = [a]
    other.each do |x|
      tmp = []
      each do |y|
        s.each do |m|
          if m.all?{ |a, b|
              (!other.le[x, a] || @le[y, b]) &&
                      (!other.le[a, x] || @le[b, y])
            }
            mext = m.dup; mext[x] = y
            tmp << mext
          end
        end
      end
      s = tmp
    end

    self.class.new(*s) { |f, g|
      @leh[[f,g]] ||= other.all?{|x| @le[f[x], g[x]]}
    }
  end

  alias ** power

  def const_graph(table, x, y)
    table[y] ||= []
    table[y].delete_if do |z, i|
      @le[x, z] and return
      @le[z, x]
    end
    table[y] << x
  end

  def graph
    table = {}
    each_pair do |x, y|
      if @le[x, y]
        const_graph(table, x, y)
      elsif @le[y, x]
        const_graph(table, y, x)
      end
    end
    table
  end

  def each_pair
    stock = []
    each do |x|
      stock.each do |a|
        yield a, x
      end
      stock.push x
    end
  end

  def each(&b)
    @body.each_key(&b)
  end
end

def set_name(d, names = {})
  d.each_with_index do |x, i|
    names[x] ||= "x#{i}"
    #  '"' + x.to_s + '"'
  end
  names
end

$name = {}
def print_graph(d)
  set_name(d, $name)

  print "digraph G {\nrankdir=TB;\n"
  d.each do |x|
    printf("%s;\n", $name[x])
  end

  graph = d.graph

  graph.each do |x, a|
    a.each do |y|
      printf("%s -> %s;\n", $name[x], $name[y])
    end
  end
  print "}\n"
end

if $0 == __FILE__
  $n = Integer(ARGV.shift || 3)
  $o = Integer(ARGV.shift || 2)
  omega = Poset.new(*(0..$o))
  x = Poset.new(0)
  $n.times do |i|
    x = omega ** x
  end
  print_graph(x)
end


--
ML: haskell-jp / quickml.com
使い方: http://QuickML.com/