作者: Hiroshi Shinohara
日時: 2003/8/30(00:16)
Iconミニ講座 おまけ(プログラムの整理)

 何かのプログラムを作っても、しばらく経つと、作った自分でも、「一体何のための
プログラムだっけ?」とか「一体何のためにこういう処理にしてるんだろう?」と悩む
ことが沢山あります。
 ハードディスクには、そんな正体不明のプログラムがあふれています。

 今後も使えそうな procedureはライブラリーにして、独立プログラムはコメントを
充実して保管したい。とは、思っていますが、なかなかできないですね。

 今回は、少しやっておこうと思います。 また、少し Iconの特徴を生かしていない
部分がありますので、書き直してみました。

<書き直し1>
      if member(T_dic,s_word)            # 辞書テーブルにあるかチェック
      then  put(T_dic[s_word],    word)  # あれば、その listに追加
      else      T_dic[s_word] := [word]  # 無ければ、listに入れて登録
 という部分があります。 よくある if .. then .. else .. で、辞書に既に 要素が
あってそれに追加する場合と、keyが無くて新たに 要素を追加するケースで、異なる
処理をしています。これは、
      if       \T_dic[s_word]            # 辞書テーブルにあるかチェック
      then  put(T_dic[s_word],    word)  # あれば、その listに追加
      else      T_dic[s_word] := [word]  # 無ければ、listに入れて登録
 と、いきなり辞書参照するようにも、書けます。 これから更に、
      put(\T_dic[s_word],word) | (T_dic[s_word] := [word])
 と、一行にできます。"|" の左辺の式が失敗した場合は、右辺の式が実行されます
 ので、等価な処理となります。

<書き直し2>
        ERR := &null                      # 辞書参照エラーフラッグリセット
        Llresult := []                    # 辞書検索結果格納 list
        every (ss := !Lword) & /ERR do {  # 細分文字を取り出して、
                              # ↑既に辞書参照エラーが発生していなければ、
          # 細分文字が辞書に存在するかチェック
          if member(T_dic,ss) then put(Llresult,T_dic[ss]) # 結果データ格納
                              else ERR := "ERR"      # 参照エラーフラッグセット
        }
 ここは、分解した文字列の各々が辞書に存在するかのチェックをしています。
 ERR というフラッグを立てているのが、美しくありません。
 これは、辞書 table参照用の別 procedureを作ると、
        Llresult := tbl_ref(T_dic,Lword) | &null
          # 分配文字列が全て辞書にあれば 辞書参照結果をセット。
          # いずれかが辞書になければ、&nullでクリア。
 と、一行にできます。
 このように、Iconでは "|"を使うと、表記がコンパクトになる場合があります。

<書き直しその他>
 共通的な procedureは、別ファイルにして、メインファイルから linkするように
してみました。 また変数名は若干変更してあります。 procedure名も1つ統一が
取れてなかったので修正しました。

 link指定は、私のライブラリ区分に従っていましたが、お試しになる場合を考えて
元のファイルから必要な部分だけ抜粋したファイルを作成し、それを linkしてあり
ます。
  ライブラリを、icont -c foo.icn      と、予めコンパイルしておき、
その後          icont    decrefp6.icn と、すれば実行ファイルができます。

-----^ DICREFP6.ICN ( date:03-08-29 time:23:15 ) -----------<cut here
####################
# クロスワードパズル支援
####################
# dicrefp6.icn Rev.1.1 2003/08/29 windy 風つかい H.S.
####################
# クロスワードパズル支援
# ・英文字のクロスワードパズルをまず解いて、その後指定の升目の文字を
#   組み合わせて最終的な単語を見つける。
# ・一部判っていない升目がある。
# ・辞書ファイルを参照。英語の単語がズラッと並んだ形式の辞書ファイル。
# ・例: 判らない文字を .で表すと、a.ahviy.r となる。
#        この場合の正解(例)は、heavy rain という2つの単語の組合せ。
# 補足
# ・コマンドライン引数から、文字列を生成して、辞書を参照し、辞書にあれば出力。
#   不明文字のための曖昧検索。単語組合せのため文字列分割。
# ・辞書参照時間短縮のため、辞書を読み込む時に、単語を文字ソート・小文字変換
#   した keyをつけて、tableに格納。 この tableを参照。
# ・辞書読込時間短縮のため、文字数毎に分割された辞書ファイルから必要な字数の
#   ファイルのみを読込む。
#   元の辞書(english.dic)は、スペルチェック用の英単語が順に並んだもの。
#   このプログラムのテストでは、DD SOFT SoundMixSpellコンポーネント
#   Ver 0.3.0 に 同梱の辞書ファイルを使用。
# ・辞書は、予め文字数毎に、e01,e02,...等に分割しておく。(別プログラム)
# ・TS Network TSabc,TSfree関連
# 履歴
#  dicrefp5.icnを修正。サブ procedureを link形式にした。
#   条件式 変数名 を見直し。訂正: mscombd -> mscomb procedure名の付与ミス
# This file is in the public domain.
link file_x,   # ファイル関係  f_name:  実行ファイル名取得
     string_x, # 文字列関係    mscomb:  英文字列重複組合せ
               #               expcomb: 英文字列分配組合せ
     number_x, # 数字関係      ndivdf:  正整数の部分和(降順 分割数・最小制限)
     stringsx  # 文字列関係(Icon基本ライブラリ BIPLに含まれるもの)
               #               deletec: 英文字列から文字を削除
               #               csort:   英文字列の辞書順ソート

procedure main(args)
  # コマンドライン引数チェック。無ければ Usage表示
  Usage := " 英単語(.はワイルドカード) 最大分割数 最短文字長"
  if *args < 1 then stop(f_name(),Usage)

  c_word := args[1]            # コマンドラインの英文字列
                # ↓左辺の式が失敗すれば、右辺の式を選ぶ
  ndiv := \args[2] | 1         # 分割数指定無しは、1(分割せず)
  nmin := \args[3] | *c_word   # 最小文字長指定無しは、引数文字列長

  # コマンドライン引数から、分割パターンを生成
  L_lpat  := []                # 文字列分割パターン格納 list
  every put(L_lpat,n_divdf(*c_word,ndiv,nmin)) # 分割パターン格納
                               # L_lpat例:[[6],[3,3]]
  # 必要な文字数の生成( setに入れて、ダブリを削除)
  S_pat  := set()              # 文字数格納 set(指定文字数ため)
  every L := !L_lpat do every insert(S_pat,!L) # 文字数を全て 格納
                               # S_pat例: (6,3)
  T_dic := table()                 # 辞書格納 table生成
  every n_pat := !S_pat do {
    # 辞書ファイル名生成
               # ↓rightは、右寄せ桁合わせ関数
    dic := "e" || right(n_pat,2,"0") # 辞書ファイル名 例:"e06","e03"
    # 辞書ファイルオープン
    dir := open(dic) | stop(" ",n_pat,"文字用の辞書が見つかりません。") 
    writes(" ",n_pat,"文字用辞書 ",dic," を読込中です。開始:",&clock)
    # 辞書読込
    n_line := 0                    # 辞書行数カウンタ
    # 辞書を1行ずつ読み込んで、
    while word := read(dir) do {
      n_line +:= 1                 # 辞書行数+1
      if n_line % 1000 = 0 then writes(&errout,"*")    # 読み込み状況表示
      # 単語を小文字変換しソートしたものを keyにして格納。
      # 同一文字を含む単語は同じ keyに対応する valueに listの形式で格納。
      # tableの key生成
             # ↓文字列ソート
      s_word := csort(map(word))   # 小文字へ変換しソート
                   # ↑小文字変換      例: "ACb" -> "abc"
      # 辞書 tableへ格納
      put(\T_dic[s_word],word) | (T_dic[s_word] := [word])
             # 格納例: key:"abc" -> value: ["ACb","Bca","cab"]
    } # end of while word ..
    close(dir)                     # 辞書ファイルクローズ
    write(&errout)
    write(" 終了:",&clock," ",n_line,"語ありました。")
  } # end of every n_pat .. 

  write("\n",c_word," を、最大分割数 ",ndiv,"、最小文字長 ",nmin,
    " にて分割してチェック。開始:",&clock)

  # 辞書参照
  n_comb := 0                      # 組合せ数カウンタ 
  n_find := 0                      # 辞書にある件数カウンタ
  s_word := deletec(c_word,'.')    # コマンドライン文字列から '.'を削除
  n_dot  := *c_word -*s_word       # '.'の数
  # ワイルドカード文字生成  ↓&lcaseは英小文字    ↓例: a-z,aa-zz,aaa-zzz
  every s_wild := mscomb(&lcase,n_dot) do {     # ワイルドカード文字を、
    s_check := s_wild || map(s_word) # コマンドライン引数の "."以外に足し、
    # 分配文字数パターン取り出し
    every Lpat:= !L_lpat do {      # Lpat例:  [6]とか、[3,3]とか
      # 文字列分割結果取り出し       Lword例: ["sunday"]とか,["day","sun"]とか
      every Lword := expcomb(s_check,Lpat) do { # 分配文字列を順次取り出して、
        n_comb +:= 1               # チェック回数カウンタ+1
        if n_comb % 1000 = 0 then writes(&errout,"*")  # チェック状況表示
        # 辞書参照して、分配結果が全て辞書にあれば、L_loutにセット
        L_lout := tbl_ref(T_dic,Lword) | &null # 分配文字列が全て辞書にあれば、
          # 辞書参照結果をセット。いずれかが辞書になければ、&nullでクリア。
          # L_lout例: [["Day"],["day"],["Sun","sun","nus"]]
        # 分配文字列が全て辞書にあれば、書き出し
        if \L_lout then {               # L_outに値がセットされていれば
           n_find +:= 1                 # カウンタ+1
           writes(&errout,"!")          # 合致表示

           # "."を除く元の文字書き出し
           writes(s_word)               #
           if *s_wild >= 1 then writes(" + ",s_wild) # ワイルドカード文字
           writes(" ->")                #

           # 辞書検索結果(2重 list)の書き出し
           every Lout := L_lout[i := 1 to *L_lout] do {
                                        # 参照結果を取り出して
             if i > 1 then writes(" +") # 先頭でなければ、区切りマーク
             every writes(" ",!Lout)    # 参照結果を書き出し
           } # end of Lout ..
           write()

        } # end of if \L_lout ..
      } # end of every Lword ..
    } # end of every Lpat ..
  } # end of s_word ..

  write(&errout)
  write(n_comb," 通りの組合せのうち、",n_find," 通りが辞書にありました。",
  " 終了:",&clock)

end

###################
# Tableを list要素で参照し、結果を list連結
###################
# arg [1]: table  key: "abc" -> value: "ABC"
#     [2]: list   参照する要素の list  例:["abc","def",...]
# value  : list   table参照結果を格納  例:["ABC","DEF",...]
# Usage  : L := tbl_ref(T,L)
# listの 要素のいずれかが tableに存在しなければ、fail

procedure tbl_ref(T,L)  #
  L1 := []
  # ↓ Lの全ての要素につき
  every x := !L do put(L1,\T[x]) | fail # 参照 tableになければ failさせる。
  return L1
end

# 条件が全て揃った場合だけ結果を返す(いずれかの条件が成立しなかった場合は、
# 全体を failさせる。)には、その部分を サブ procedureにすること。
-----$ DICREFP6.ICN ( lines:151 words:589 ) ----------------<cut here

 tbl_ref()は、今回作りましたので、この dicrefp6.icnに入れてありますが、いずれ
共通ライブラリに移す予定です。

 ちょっと長いですが、ライブラリから抜粋したファイルを付けます。
-----^ FILE_X.ICN ( date:03-08-29 time:23:17 ) -------------<cut here
####################
# file操作関係 procedure
####################
# file_x.icn Rev.1.1 2003/08/29 windy 風つかい H.S.
# file_e.icn から抜粋。
# This file is in the public domain.
link string_x       # top_get,top_cut

# f_name(file_name)                # 拡張子を除くファイル名生成(小文字)
# F_name(file_name)                # 拡張子を除くファイル名生成(大文字)

####################
# 拡張子を除くファイル名を生成
####################
# Usageの file名訂正漏れを 防ぐための作成
# f_name(),F_name() 1997/12/27 windy 大文字、小文字対応に分ける。
# f_name()          1997/08/15 windy exe_name() -> f_name()
# exe_name()  1997/06/02 windy 風つかい H.S.
# args : ファイル名
# value: string
# Icon入門講座4 Icon回り道(4)

procedure f_name(file_name)
  /file_name := &progname      # defaultは、実行ファイル名
  return map(top_get('.',top_cut('\\',file_name)))
end

procedure F_name(file_name)
  /file_name := &progname      # defaultは、実行ファイル名
  return map(top_get('.',top_cut('\\',file_name)),&lcase,&ucase)
end
-----$ FILE_X.ICN ( lines:31 words:91 ) --------------------<cut here
-----^ NUMBER_X.ICN ( date:03-08-29 time:22:49 ) -----------<cut here
####################
# 数字関係補助 procedure
####################
# number_x.icn Rev1.1 2003/08/29 windy 風つかい H.S.
# number_e.icnから抜粋
# This file is in the public domein.

# n_divd(r,max)        # 正整数の分割(降順のみ)                genarator
# n_divdf(r,ndiv,nmin) # 正整数の分割(降順、分割数・最小数制限)generator

####################
# 正整数分割 generator(降順のみ)
####################
# 5=3+2 等に分割する。分割は降順のみ許す。(例 5=2+3は除外)
# arg [1]: 分割される元の数(再帰の場合は、前の処理の余り)
#     [2]: 最大数  (5=2+2+1 の場合に、最初の 2の時 3が余るが、再帰して 3の
#          分割を始める時、3からではなく 2から始めるための細工。降順手当。)
# value  : 分解結果の数。listに格納
# Usage  : every L := n_divd(r) do ...
# Iconミニ講座3
# (4) -> [4],[3,1],[2,2],[2,1,1],[1,1,1,1]

procedure n_divd(r,max)
  /max := r                       # 指定無きは、分割される元の数そのもの
  if r < 1 then fail              # 念のため
  if r = 1 then return [1]        # 再帰終了

  # r >= 2 の場合
  if r > max then rs := max       # 分割(取り去る)数の最大数の設定。
             else rs := r         # 分割される数か 最大数指定の 小さい方
  every i :=  rs to 1 by -1 do {  # 上記指定数〜1迄、順に−1しながら
    rr := r -i                    # 新たな余り
    if rr = 0      then suspend [i]                   # 余りが無ければ
    # 余りがあれば、再帰処理
    else if rr > i then suspend [i] ||| n_divd(rr,i)  # 余りが大き過ぎる時
                   else suspend [i] ||| n_divd(rr)
  }
end


####################
# 正整数分割 generator(フィルター)
####################
# 5=3+2 等に数字分割する。この procedureは n_divdを呼びフィルターを掛けている。
# 分割パターンが多すぎる時に、制限をかけるために使用。
# arg [1]: 分割する元の数
#     [2]: 最大分割数
#     [3]: 最小数
# value  : list
# Usage  : every L := n_divdf(r,ndiv,nmin) do ..
# Iconミニ講座4
# (4,2,2) -> [4],[2,2]

procedure n_divdf(r,ndiv,nmin)
  every L := n_divd(r) do {            # r の分割結果を取り出し
    if *L <= ndiv then {               # 分割数チェック(listのサイズチェック)
      if L[*L] >= nmin then suspend L  # 最小数チェック(降順に入っているので
    }                                  # 末尾の要素をチェック)
  }
end
-----$ NUMBER_X.ICN ( lines:60 words:243 ) -----------------<cut here
-----^ STRING_X.ICN ( date:03-08-29 time:23:18 ) -----------<cut here
####################
# 文字列操作 procedure
####################
# string_x.icn Rev.1.1 2003/09/29 windy 風つかい H.S.
# string_e.icn から抜粋
# This file is in the public domain.
link stringsx          # BIPL csort

# ssub(s1,s2)          # 文字列の引き算
# top_cut(c,s)         # 先頭削除(最長一致削除)
# top_get(c,s)         # 先頭切り出し(最短一致切り出し)

# 組合せ関係
# exscomb(s,m)         # 文字の組合せ生成(同一文字対応)     generator
# mscomb(s,m)          # 文字の組合せ生成 nHm(重複取り出し) genarator

# 順列・組合せ共通
# new_pos(s)           # 文字位置生成  (同一文字対応用)     generator

# 組合せ分配
# pcomb(s,L)           # 文字の組合せを 分配                  generator
# expcomb(s,L,s_ref)   # 文字の組合せを 分配(同一文字 同一数)generator

####################
# 文字列の引き算
####################
# arg [1]: string 被削除文字列
#     [2]: string 削除文字列
# value  : string 結果文字列
# 文字列 s1の先頭から、文字列 s2の文字を削除。1:1で削除。
# ("abcabc","abd") -> "cabc"  s2にある文字で、s1に無い文字は無視される。
# Iconミニ講座9

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


####################
# 文字列の 先頭から特定文字までの部分 を取り去る。最長部分を取り去る。
####################
# arg   : cset
# value : string
# Usage : top_cut(c,s)
# Icon入門講座2(5)

procedure top_cut(c,s)
  /s := &subject                         # sの指定がなければ &subject
  /c := ' \t'                            # cの指定がなければ spaceか tab
  s ? {                                  # sを走査対象とする。
    while tab(upto(c)) do tab(many(c))   # cが見つかる限り、走査位置を
                                         # その文字の後に移動。
    return tab(0)                        # 残りの文字列を返す。
  }
end


####################
# 文字列の 先頭から特定文字までの部分 を得る。最短部分を得る。
####################
# arg   : cset
# value : string
# Usage : top_get(c,s)
# Icon入門講座2(5)

procedure top_get(c,s)
  /s := &subject                         # sの指定がなければ &subject
  /c := ' \t'                            # cの指定がなければ spaceか tab
  s ? {                                  # sを走査対象とする。
    return tab(upto(c) | 0)              # cまで走査位置を移動しその間の
  }                                      # 文字列を返す。cがみつからなけ
                                         # れば、末尾まで返す。
end


####################
# 組合せ関係
####################
####################
# 文字列の組合せ  同一文字指定を許す n文字列から m個を選ぶ組合せ generator
####################
# stringの組み合わせ
# n個から、m個を選ぶ。(同一文字指定対応)
# arg:  [1]: s: string
#       [2]: m: integer
# value:        string
# Usage: every ss := exscomb(s,m) do ...
# Icon入門講座3(11)scomb()を同一文字指定対応に拡張。 Iconミニ講座9
# ("abca",3) -> "aab","aac","abc"

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


#############################
# 文字列の nHm  n文字列から、重複して m個を選ぶ組合せ generator
#############################
# n個から 重複して、m個を選ぶ。
# arg [1]: string
#     [2]: integer
# value  : string
# Usage  : every ss := mscomb(s,m) do ..
# ("abc",2) -> "aa","ab","ac","bb","bc","cc"

procedure mscomb(s,m)
  initial {
    /m := *s
  }
  if m =0 then return ""                # 再帰終了
  every i := 1 to *s do {               # 1〜文字列長まで
           # ↓ i番目の文字を取り出して
    suspend s[i] || mscomb(s[i:0],m-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


####################
# 分配の組合せ(同一文字指定・同一文字数指定対応)
####################
# 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"]
# 分配パターン生成に、number_e.icnの n_div(),n_divd(),n_divdf()が使えるかも。
# Iconミニ講座9

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
-----$ STRING_X.ICN ( lines:198 words:657 ) ----------------<cut here
-----^ STRINGSX.ICN ( date:03-08-29 time:23:13 ) -----------<cut here
####################
# 文字列操作 procedure BIPL(Icon基本ライブラリー)より
####################
# stringsx.icn Rev.1.1 2003/08/29 windy 風つかい H.S.
# BIPL strings.icn から抜粋
# This file is in the public domain.

####################
# 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から !で要素を取り出す時には、アルファベット順に取り出せる。

####################
# strings.icnに含まれる 文字の削除 procedure
####################
procedure deletec(s, c)                  #: delete characters
   local result                          # ローカル宣言(無くても良い)
   result := ""                          # 削除後の文字列格納エリア
   s ? {                                 # sを走査対象として、
      while result ||:= tab(upto(c)) do  # cが見つかる迄の文字列を足し込んで
         tab(many(c))                    # c以外の文字までスキップ
      return result ||:= tab(0)          # 余りの文字を足し込む
      }
end
-----$ STRINGSX.ICN ( lines:32 words:117 ) -----------------<cut here

風つかい(hshinoh@...)
IconのWWWは、  http://www.cs.arizona.edu/icon/
UniconのWWWは、http://unicon.sourceforge.net/index.html
BGM: Yesterday's Dream / 山見慶子