作者: Hiroshi Shinohara
日時: 2003/8/25(21:36)
Iconミニ講座9(分配組合せ)

 文字列で、辞書参照をするときに、文字の組合せを作ろうと思うのですが、例えば
4文字 "abcd" あって、組合せのプログラムを書くと例えば、こうなります。

-----^ PCOMB1.ICN ( date:03-08-25 time:20:43 ) -------------<cut here
####################
# 文字列分配プログラムの習作1
####################
# pcomb1.icn Rev.1.0 2003/08/25 windy 風つかい H.S.
####################
# This file is in the public domain.

procedure main()
  L := [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]] # 文字列分配パターン(文字数)
  s := "abcd"                              # テスト文字列

  write(s)
  every LL := !L do {                # 分配文字数パターンから順次取り出して、
    write("---")                     # 表示用
    every LLL := pcomb(s,LL) do {    # 分配結果を順次取り出して、
      writes(" ->")                  # 表示用
      every writes(" ",!LLL)         # 出力する。
      write()
    }
  }
end

####################
# 分配の組合せ
####################
# arg [1]: string 分配する英文字列:分配パターンのトータルに合ってること。
#     [2]: list   分配パターン(降順の list)
# value  : list   分割された文字列
# Usage  : every LL := pcomb(s,L) do ..
# ("abc",[2,1]) -> ["ab","c"],["ac","b"],["bc","a"]
# 同一分配数が複数ある場合は、無駄が生じる。
#  例:("abcd",[2,2])の場合に、["ab","cd"] と ["cd","ab"]の両方が出る。
procedure pcomb(s,L)
  if *L = 1 then return [s]   # 再帰終了
  if L[1] = 1 then {          # 後は、順に1文字ずつ listに入れるだけ
     return  [s[1]] ||| pcomb(s[2:0],    L[2:0]) # 
  }        # ↑先頭文字       ↑残り文字列 ↑残りのリスト
  # 2文字以上の指定ならば、
  every ss := scomb(s,L[1]) do {                 # 文字の組合せを作って
     suspend [ss]   ||| pcomb(ssub(s,ss),L[2:0]) # 残りの文字のため再帰
  }        # ↑組合せ文字     ↑残り文字列 ↑残りのリスト
end

####################
# 文字列の引き算
####################
# arg [1]: string 被削除文字列
#     [2]: string 削除文字列
# value  : string 結果文字列
# 文字列 s1の先頭から、文字列 s2の文字を削除。1:1で削除。
# ("abcabc","abd") -> "cabc"  s1に無い文字は無視される。
procedure ssub(s1,s2)
  every c := !s2 do {     # s2から1文字ずつ取り出して
    ss := ""              # 上記文字を削除後の文字列の格納エリア
    s1 ? {                # s1を走査対象として、
      if ss ||:= tab(upto(c)) then { # 文字が見つかれば そこ迄の文字列を
                                     # ssに足し込み
        move(1)           # 1文字スキップ
        ss ||:= tab(0)    # 残りの文字列を足し込み
        s1 := ss          # s1更新
      }
    }
  }
  return s1
end

####################
# 文字列の nCm (n = *s) n個文字列から、m文字を選ぶ。   generator
####################
# 1998/04/16 windy 名称変更 comb -> scomb (BIPLとダブルので)
# stringの組み合わせ
# nCm (n = *s)  n個のものから、m個を選ぶ。
# arg:  [1]: s: string
#       [2]: m: integer
# value:        string
# Usage: every ss := scomb(s,m) do ...
# Icon入門講座3(11)

procedure scomb(s,m)
  /m := *s                    # デフォルト nCn (n = m = *s)
  if m = 0 then return ""     # mを文字数カウンターに使う。
                              # 0なったら、そこで打ち止め。
  suspend s[i := 1 to *s] || scomb(s[i+1 : 0],        m -1)
          #↑ 1文字選ぶ  ↑ ↑←前で選んだ文字以降    ↑指定文字数に
          #               |     の文字列に対し同じ      文字列を抑え
          #               |     処理を行う。            るためのカウ
          #           文字列の連結                       ンター
end
-----$ PCOMB1.ICN ( lines:88 words:334 ) -------------------<cut here

 pcomb1 > iii とすると、こうなります。
-----^ III ( date:03-08-25 time:20:45 ) --------------------<cut here
abcd
---
 -> abcd
---
 -> abc d
 -> abd c
 -> acd b
 -> bcd a
---
 -> ab cd
 -> ac bd
 -> ad bc
 -> bc ad
 -> bd ac
 -> cd ab
---
 -> ab c d
 -> ac b d
 -> ad b c
 -> bc a d
 -> bd a c
 -> cd a b
---
 -> a b c d
-----$ III ( lines:24 words:67 ) ---------------------------<cut here

 結果を見てみますと、同じ文字数を連続して取り出す時に、["ab","cd"]と
 ["cd","ab"]が、両方でてきます。
 これは、片方だけで良いのです。 よく見ると、不要なケースは、結果の
並びが、降順になっていないケースみたいです。 そこで、降順の組合わせだけ
取り出すように、修正してみました。
 文字列の比較式で、<< という記号が出てきますが、これは文字列が辞書順に
先か後かの比較を行うものです。
 文字列組合せの scombが、同一文字指定に対応していませんでしたので、対応する
 exscombを作りました。

-----^ PCOMB2.ICN ( date:03-08-25 time:20:44 ) -------------<cut here
####################
# 文字列分配プログラムの習作2
####################
# pcomb2.icn Rev.1.0 2003/08/25 windy 風つかい H.S.
####################
# This file is in the public domain.

procedure main()
  L := [[4],[3,1],[2,2],[2,1,1],[1,1,1,1]] # 文字列分配パターン(文字数)
  s := "abcd"                              # テスト文字列

  write(s)
  every LL := !L do {                # 分配文字数パターンから順次取り出して、
    write("---")                     # 表示用
    every LLL := expcomb(s,LL) do {  # 分配結果を順次取り出して、
      writes(" ->")                  # 表示用
      every writes(" ",!LLL)         # 出力する。
      write()
    }
  }
end

####################
# 分配の組合せ
####################
# arg [1]: string 分配する英文字列:分配パターンのトータルに合ってること。
#     [2]: list   分配パターン(降順の list)
#     [3]: string 前の文字列(同一文字数指定の場合に降順のものだけ選ぶための)
# value  : list   分割された文字列( listに格納)
# Usage  : every LL := expcomb(s,L) do ..
# ("abc", [2,1]) -> ["ab","c"], ["ac","b"], ["bc","a"]
# ("abcd",[2,2]) -> ["ab","cd"],["ac","bd"],["ad","bc"]
procedure expcomb(s,L,s_ref)
  /s_ref := ""                            # 指定なければ、空文字
  s := csort(s)                           # 文字列ソート

  if *L = 1 then {                        # パターン要素の最後で、
    if L[1] = *s_ref then {               # 前回と文字数が同じで、
       if s << s_ref then return &fail    # 辞書順で前なら、失敗させる。
    }
    return [s]                            # ↑で、無ければ、文字列を返す。
  }

  # 1文字の文字列指定ならば、後は、順に1文字ずつ listに入れるだけ
  if L[1] = 1 then {                      # 1文字の文字列指定ならば、
     # 後は、順に1文字ずつ listに入れるだけ
     return  [s[1]] ||| expcomb(s[2:0],    L[2:0])
  }        # ↑先頭文字       ↑残り文字列 ↑残りのリスト

  # 2文字以上の文字列指定ならば、
  every ss := exscomb(s,L[1]) do {        # 文字の組合せを作って
    if *ss = *s_ref then {                # 前回と文字数が同じで、
       if ss << s_ref then return &fail   # 辞書順で前なら、失敗させる。
    }                                        # ↓参照用文字列
    suspend [ss] ||| expcomb(ssub(s,ss),L[2:0],ss)
  }        # ↑組合せ文字    ↑残り文字列 ↑残りのリスト
end

####################
# 文字列の引き算
####################
# arg [1]: string 被削除文字列
#     [2]: string 削除文字列
# value  : string 結果文字列
# 文字列 s1の先頭から、文字列 s2の文字を削除。1:1で削除。
# ("abcabc","abd") -> "cabc"  s2にある文字で、s1に無い文字は無視される。
procedure ssub(s1,s2)
  every c := !s2 do {     # s2から1文字ずつ取り出して
    ss := ""              # 上記文字を削除後の文字列の格納エリア
    s1 ? {                # s1を走査対象として、
      if ss ||:= tab(upto(c)) then { # 文字が見つかれば そこ迄の文字列を
                                     # ssに足し込み
        move(1)           # 1文字スキップ
        ss ||:= tab(0)    # 残りの文字列を足し込み
        s1 := ss          # s1更新
      }
    }
  }
  return s1
end

####################
# 文字列の nCm (n = *s) n個文字列から、m文字を選ぶ。   generator
####################
# stringの組み合わせ
# nCm (n = *s)  n個のものから、m個を選ぶ。
# arg:  [1]: s: string
#       [2]: m: integer
# value:        string
# Usage: every ss := exscomb(s,m) do ...
# Icon入門講座3(11)scomb()を同一文字指定対応に拡張

procedure exscomb(s,m)
  initial {
    s  := csort(s)             # 文字列をソートする。(BIPL:strings.icn)
    /m := *s                   # デフォルト nCn (n = m = *s)
  }
  if m = 0 then return ""      # mを文字数カウンターに使う。
                               # 0なったら、そこで打ち止め。
  suspend s[i := new_pos(s)] || exscomb(s[i+1 : 0],        m -1)
          #↑ 1文字選ぶ     ↑    ↑←前で選んだ文字以降   ↑指定文字数に
          #                  |        の文字列に対し同じ     文字列を抑え
          #                  |        処理を行う。           るためのカウ
          #              文字列の連結                         ンター
end


####################
# ソートされた文字列 sの左はじから、順に文字位置を出力する generator。
####################
# 手前の文字と同一ならスキップする。
# arg  [1]: s  string
# value:       integer
# Usage: every i := new_pos(s) do ...
procedure new_pos(s)
  ss := ""                     # 手前の文字を記憶しておく変数
  every i := 1 to *s do {
    if ss ~== s[i] then {      # 手前の文字と違っていたら
      ss := s[i]               # 手前文字を更新
      suspend i                # i を返す。
    }
  }
end

####################
# BIPL(Icon基本ライブラリー)の strings.icnに含まれる 文字のソート procedure
####################
procedure csort(s)             #: lexically ordered characters
   local c, s1                 # ローカル変数宣言(無くても良い)
   s1 := ""                    # 初期値クリア
   every c := !cset(s) do      # 引数を cset(文字集合)へ変換し順に取り出す。
      every find(c, s) do      # 取り出した文字で、引数文字列を検索し、
         s1 ||:= c             # 見つかる度に、文字を s1に足し込む。
   return s1
end
# csetから !で要素を取り出す時には、アルファベット順に取り出せる。
-----$ PCOMB2.ICN ( lines:136 words:501 ) ------------------<cut here

 pcomb2 > jjj とするとこうなります。 なんとか、ケースを減らせたみたい
です。
-----^ JJJ ( date:03-08-25 time:20:44 ) --------------------<cut here
abcd
---
 -> abcd
---
 -> abc d
 -> abd c
 -> acd b
 -> bcd a
---
 -> ab cd
 -> ac bd
 -> ad bc
---
 -> ab c d
 -> ac b d
 -> ad b c
 -> bc a d
 -> bd a c
 -> cd a b
---
 -> a b c d
-----$ JJJ ( lines:21 words:58 ) ---------------------------<cut here

風つかい(hshinoh@...)
IconのWWWは、  http://www.cs.arizona.edu/icon/
UniconのWWWは、http://unicon.sourceforge.net/index.html
BGM: 蝉の声 / 近所の蝉たち