結果として得られた四個の組の要素に重複がないことは組をセットにしてその要素を数えること（quartet asSet size = 4）で、また、右上隅と左下隅の文字が異なることは、最初の熟語の最後の文字と、最後の熟語の最初の文字が一致しないこと（quartet first last ~= quartet last first）でチェックしています。
お題の例と同じデータを使っているはずなのですが、出力件数は 11712 でした。熟語四組の抽出には、1.0 GHz PowerPC (Mac OS X 10.4.10) で 14 秒弱ほどかかりました（ただし、入出力時間は含まず）。
sumim
#3661()
[
Smalltalk
]
Rating0/0=0.00
四字熟語のデータは、熟語ごとに行を改めた 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) "Rating0/0=0.00-0+
1 reply [ reply ]