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: 蝉の声 / 近所の蝉たち