----Next_Part(Sat_Dec_20_20_39_44_2003_708)--
Content-Type: Text/Plain; charset=iso-2022-jp
Content-Transfer-Encoding: 7bit

さかいです。

From: "TOYOFUKU Chikanobu" <nobu_toyofuku / nifty.com>
Date: Sat, 20 Dec 2003 02:33:34 +0900

>   豊福です。
> 
> さかいさん
> > 試しに、ちょー手抜きプログラムをRubyでい瞳彁擦靴討澆泙靴拭

  すばらしい。
> といっても情でまだ動かしてないままで図々しい追加希望を;
有向グラフの形式で呂靴 苒瘰蔬蝴 などで図示できませんか。
> できれば図示した結果も。
>   なんとなくきれいな図になるのではないかと想像しています。

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

--
酒井 政裕 / Masahiro Sakai


--
ML: haskell-jp / quickml.com
使い方: http://QuickML.com/
----Next_Part(Sat_Dec_20_20_39_44_2003_708)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="poset.rb"

require 'finite-set'
require 'finite-map'
require 'stringio'

class Poset
  def initialize(underlying_set, &lt_eq)
    lt_eq  ambda{|a,b| a <  } unless lt_eq
    @underlying_set  nderlying_set
    @lt_eq  t_eq
  end
  attr_reader :underlying_set

  def lt_eq(a,b)
    @lt_eq.call(a,b)
  end

  def lt(a,b)
    not a.eql?(b) and lt_eq(a,b)
  end

  def **(other)
    ary  ther.underlying_set.to_a

    s  et[]

    f  ap.phi(self.underlying_set)
    func  ambda{|i|
      if i < ary.size
        c  ry[i]
        @underlying_set.each{|d|
          f[c]  
          func.call(i+1)
        }
      else
        if other.underlying_set.all?{|a|
            other.underlying_set.all?{|b|
              lt_eq(f[a],f[b]) or not other.lt_eq(a,b)
            }
          }
          s.push(MonotonicFunction.new(f.dup, other, self))
        end
      end
    }
    func.call(0)

in
    s  @underlying_set ** other.underlying_set).select_s{|f|
      other.underlying_set.all?{|a|
        other.underlying_set.all?{|b|
          lt_eq(f[a],f[b]) or not other.lt_eq(a,b)
        }
      }
    }.map_s{|f|
      MonotonicFunction.new(f, other, self)
    }
濺

セgin
    Poset.new(s)
濺
    elem_to_upper_closure  ash.new
    s.each{|f|
       elem_to_upper_closure[f]  .select_s{|g| f <  }
    }
    Poset.new(s){|f,g|  elem_to_upper_closure[f].member?(g) }
  end

  def edges_of_hasse_diagram
    edges  ]

    @underlying_set.each{|a|
      s  underlying_set.select_s{|b| X3.lt(a, b) }
      s.each{|b|
	edges.push([a,b]) unless s.any?{|c| X3.lt(c, b) }
      }
    }

    edges
  end

  def to_dot(&item_to_label)
    unless item_to_label
      item_to_label  ambda{|item| item.to_s }
    end

    s  tringIO.new
    s.puts "digraph G {"
    s.puts "rankdir;"

    @underlying_set.each{|a|
      label  tem_to_label[a]
      s.puts "#{label};"
    }

    edges_of_hasse_diagram.each{|(a,b)|
      label_a  tem_to_label[a]
      label_b  tem_to_label[b]
      s.puts "#{label_b} -> #{label_a};"
    }

    s.puts "}"

    s.string
  end
end


class MonotonicFunction
  def initialize(underlying_map, dom, cod)
    @underlying_map  nderlying_map
    @dom  om
    @cod  od 
  end
  attr_reader :underlying_map
  attr_reader :dom
  attr_reader :cod

  def [](e)
    @underlying_map[e]
  end

  def <ther)
    @dom.underlying_set.all?{|a| @cod.lt_eq(self[a], other[a]) }
  end
end


if __FILE__ $0
  A  oset.new(Set[0,1,2])
  def F(x)
    A**x
  end
  
  X0  oset.new(Set[0])
  X1  (X0)
  X2  (X1)
  X3  (X2)

  #p X0.underlying_set.size #1
  #p X1.underlying_set.size #3
  #p X2.underlying_set.size #10
  #p X3.underlying_set.size #126

  item_to_label  ash.new
  i  
  X3.underlying_set.each{|item|
    item_to_label[item]  x#{i}" 
    i  .succ
  }
  print X3.to_dot{|item| item_to_label[item] }
end

----Next_Part(Sat_Dec_20_20_39_44_2003_708)--
Content-Type: Text/Plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="X3.dot"

digraph G {
rankdir;
x0;
x1;
x2;
x3;
x4;
x5;
x6;
x7;
x8;
x9;
x10;
x11;
x12;
x13;
x14;
x15;
x16;
x17;
x18;
x19;
x20;
x21;
x22;
x23;
x24;
x25;
x26;
x27;
x28;
x29;
x30;
x31;
x32;
x33;
x34;
x35;
x36;
x37;
x38;
x39;
x40;
x41;
x42;
x43;
x44;
x45;
x46;
x47;
x48;
x49;
x50;
x51;
x52;
x53;
x54;
x55;
x56;
x57;
x58;
x59;
x60;
x61;
x62;
x63;
x64;
x65;
x66;
x67;
x68;
x69;
x70;
x71;
x72;
x73;
x74;
x75;
x76;
x77;
x78;
x79;
x80;
x81;
x82;
x83;
x84;
x85;
x86;
x87;
x88;
x89;
x90;
x91;
x92;
x93;
x94;
x95;
x96;
x97;
x98;
x99;
x100;
x101;
x102;
x103;
x104;
x105;
x106;
x107;
x108;
x109;
x110;
x111;
x112;
x113;
x114;
x115;
x116;
x117;
x118;
x119;
x120;
x121;
x122;
x123;
x124;
x125;
x21 -> x0;
x14 -> x1;
x78 -> x2;
x34 -> x2;
x124 -> x3;
x54 -> x3;
x22 -> x3;
x73 -> x4;
x60 -> x5;
x49 -> x6;
x105 -> x6;
x111 -> x7;
x80 -> x7;
x38 -> x7;
x57 -> x8;
x119 -> x9;
x75 -> x9;
x31 -> x10;
x71 -> x10;
x95 -> x10;
x113 -> x11;
x79 -> x11;
x106 -> x12;
x109 -> x13;
x22 -> x13;
x59 -> x14;
x24 -> x14;
x65 -> x15;
x56 -> x15;
x121 -> x16;
x6 -> x16;
x68 -> x17;
x14 -> x17;
x82 -> x18;
x48 -> x18;
x43 -> x19;
x0 -> x19;
x12 -> x20;
x61 -> x20;
x59 -> x21;
x97 -> x22;
x96 -> x22;
x11 -> x23;
x53 -> x23;
x4 -> x24;
x67 -> x25;
x75 -> x25;
x88 -> x26;
x44 -> x26;
x19 -> x27;
x118 -> x27;
x112 -> x27;
x114 -> x28;
x16 -> x28;
x65 -> x29;
x98 -> x29;
x28 -> x29;
x28 -> x30;
x70 -> x30;
x7 -> x31;
x110 -> x31;
x54 -> x32;
x109 -> x32;
x81 -> x33;
x18 -> x33;
x125 -> x33;
x122 -> x34;
x32 -> x35;
x119 -> x35;
x115 -> x35;
x45 -> x36;
x101 -> x36;
x38 -> x36;
x65 -> x37;
x92 -> x37;
x70 -> x37;
x78 -> x38;
x15 -> x38;
x37 -> x38;
x111 -> x39;
x101 -> x39;
x55 -> x40;
x44 -> x40;
x27 -> x40;
x47 -> x41;
x89 -> x41;
x117 -> x41;
x123 -> x42;
x33 -> x42;
x84 -> x42;
x68 -> x43;
x21 -> x43;
x52 -> x44;
x19 -> x44;
x78 -> x45;
x83 -> x45;
x107 -> x45;
x67 -> x46;
x3 -> x46;
x115 -> x46;
x69 -> x46;
x91 -> x47;
x40 -> x47;
x116 -> x47;
x86 -> x48;
x64 -> x48;
x5 -> x49;
x40 -> x50;
x104 -> x50;
x99 -> x51;
x8 -> x51;
x43 -> x52;
x113 -> x53;
x94 -> x53;
x18 -> x53;
x123 -> x54;
x96 -> x54;
x41 -> x54;
x52 -> x55;
x118 -> x55;
x99 -> x56;
x25 -> x56;
x46 -> x56;
x42 -> x57;
x76 -> x57;
x50 -> x58;
x117 -> x58;
x60 -> x58;
x4 -> x59;
x104 -> x60;
x26 -> x60;
x106 -> x61;
x112 -> x61;
x71 -> x62;
x121 -> x63;
x69 -> x63;
x66 -> x64;
x106 -> x64;
x118 -> x64;
x114 -> x65;
x63 -> x65;
x46 -> x65;
x1 -> x66;
x17 -> x66;
x74 -> x67;
x103 -> x67;
x22 -> x67;
x59 -> x68;
x124 -> x69;
x74 -> x69;
x85 -> x69;
x114 -> x70;
x77 -> x70;
x110 -> x71;
x102 -> x71;
x36 -> x71;
x10 -> x72;
x62 -> x72;
x97 -> x74;
x87 -> x74;
x103 -> x75;
x76 -> x75;
x33 -> x76;
x32 -> x77;
x3 -> x77;
x13 -> x77;
x56 -> x78;
x92 -> x78;
x122 -> x78;
x108 -> x78;
x20 -> x79;
x30 -> x80;
x29 -> x80;
x37 -> x80;
x116 -> x81;
x82 -> x81;
x12 -> x82;
x64 -> x82;
x56 -> x83;
x51 -> x83;
x89 -> x84;
x125 -> x84;
x87 -> x85;
x41 -> x85;
x84 -> x85;
x66 -> x86;
x47 -> x87;
x94 -> x87;
x125 -> x87;
x52 -> x88;
x116 -> x89;
x93 -> x89;
x119 -> x90;
x67 -> x90;
x13 -> x90;
x27 -> x91;
x64 -> x91;
x61 -> x91;
x35 -> x92;
x90 -> x92;
x77 -> x92;
x46 -> x92;
x88 -> x93;
x55 -> x93;
x91 -> x94;
x48 -> x94;
x7 -> x95;
x36 -> x95;
x39 -> x95;
x81 -> x96;
x113 -> x96;
x47 -> x96;
x50 -> x97;
x47 -> x97;
x16 -> x98;
x63 -> x98;
x57 -> x99;
x75 -> x99;
x115 -> x99;
x14 -> x100;
x21 -> x100;
x15 -> x101;
x83 -> x101;
x45 -> x102;
x2 -> x102;
x33 -> x103;
x96 -> x103;
x87 -> x103;
x53 -> x103;
x44 -> x104;
x58 -> x105;
x5 -> x105;
x1 -> x106;
x100 -> x106;
x51 -> x107;
x108 -> x107;
x99 -> x108;
x35 -> x108;
x9 -> x108;
x11 -> x109;
x96 -> x109;
x2 -> x110;
x38 -> x110;
x15 -> x111;
x29 -> x111;
x100 -> x112;
x0 -> x112;
x91 -> x113;
x20 -> x113;
x82 -> x113;
x121 -> x114;
x3 -> x114;
x42 -> x115;
x54 -> x115;
x85 -> x115;
x103 -> x115;
x55 -> x116;
x64 -> x116;
x40 -> x117;
x26 -> x117;
x93 -> x117;
x43 -> x118;
x100 -> x118;
x17 -> x118;
x23 -> x119;
x109 -> x119;
x103 -> x119;
x72 -> x120;
x124 -> x121;
x105 -> x121;
x90 -> x122;
x25 -> x122;
x9 -> x122;
x81 -> x123;
x89 -> x123;
x97 -> x124;
x58 -> x124;
x41 -> x124;
x116 -> x125;
x48 -> x125;
}

----Next_Part(Sat_Dec_20_20_39_44_2003_708)----