四字熟語パズルの作成 in Smalltalk DouKaku?

四字熟語パズルの作成

与えられた四字熟語のリストから下のように四角く配置することのできる熟語の組み合わせを探すプログラムを作成してください。

出力例:

無憂無風
礼　　林
千　　火
万水千山

知行合一
者　　筆
不　　勾
言語道断

四字熟語は左から右、上から下へ読むものとします。また右上隅の漢字と左下隅の漢字は異なるものでなければいけません。

四字熟語のデータは扱いやすい形(たとえばユニコード文字列のリスト)で与えられていると仮定して構いません。サンプルデータが必要であれば FOR Microsoft IME The四字熟語辞典(データ / 文書作成) にテキスト形式のデータが入っているのでそれを使えると思います。

問題の規模の参考までに、40行程度のPythonスクリプトでこのデータ(重複をのぞいて8312件)を処理してみたところ2.4GHzのCPUで13秒程度かかりました。結果は8133件出力されました。

post comment

Posted feedbacks - Smalltalk

Squeak Smalltalk で。

四字熟語のデータは、熟語ごとに行を改めた Unicode のテキストファイル（in.txt）で与えられているとします。

#groupBy:having: は、レシーバ（コレクション）に対し、まず第一引数のブロックで指定した条件（キー）にもとづいて要素を括りだした後、各グループについてあらためて第二引数で与えたブロックの条件に合致するかをチェックし、当てはまるものだけを集めて返すメソッドです。

結果として得られた四個の組の要素に重複がないことは組をセットにしてその要素を数えること（quartet asSet size = 4）で、また、右上隅と左下隅の文字が異なることは、最初の熟語の最後の文字と、最後の熟語の最初の文字が一致しないこと（quartet first last ~= quartet last first）でチェックしています。

お題の例と同じデータを使っているはずなのですが、出力件数は 11712 でした。熟語四組の抽出には、1.0 GHz PowerPC (Mac OS X 10.4.10) で 14 秒弱ほどかかりました（ただし、入出力時間は含まず）。

| in yojis yoji firstCharDict pairs bothCharsDict results out timeToRun |

in := FileStream fileNamed: 'in.txt'.
yojis := OrderedCollection new.
[(yoji := in nextLine) notNil] whileTrue: [yojis add: yoji].
in close.

timeToRun := [
    firstCharDict := yojis
        groupBy: [:each | each first]
        having: [:group | group size > 1].

    pairs := OrderedCollection new.
    yojis do: [:first |
        firstCharDict at: first last ifPresent: [:found |
            found do: [:second | pairs add: {first. second}]]].

    bothCharsDict := pairs
        groupBy: [:pair | {pair first first. pair second last}]
        having: [:group | group size > 1].

    results := OrderedCollection new.
    bothCharsDict do: [:val | val combinations: 2 atATimeDo: [:pair |
        | quartet |
        quartet := pair first, pair second.
        (quartet asSet size = 4 and: [quartet first last ~= quartet last first])
            ifTrue: [results add: quartet]]]
] timeToRun.

out := FileStream fileNamed: 'out.txt'.
results do: [:quartet |
    out nextPutAll: quartet first; cr.
    (2 to: 3) do: [:idx |
        out nextPut: (quartet third at: idx).
        out nextPutAll: '　　'.
        out nextPut: (quartet second at: idx); cr].
    out nextPutAll: quartet last; cr; cr].
out edit.

^{results size. timeToRun}   "=> #(11712 13835) "

DouKaku?

四字熟語パズルの作成

Posted feedbacks - Smalltalk

Index

Feed

Other

Link

Pathtraq