challenge 四字熟語パズルの作成

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

出力例:

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

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

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

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

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

Posted feedbacks - Scheme

188秒@Pen4 2.6GHz 12118件でした。
頭のハッシュテーブル、尻のハッシュテーブルを作って、そこから頭尻のハッシュテーブルを作る。
結果から回転や反転などの重複を消すのにもハッシュテーブルを使う。
ハッシュテーブルとダンスでもしてな。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
(use srfi-1)
(use util.combinations)

(define ht-head (make-hash-table 'eqv?))
(define ht-tail (make-hash-table 'eqv?))
(define ht-headtail (make-hash-table 'string=?))

(define (print-puzzle j0 j1 j2 j3)
  (print j0)
  (print (string-ref j2 1) "  " (string-ref j1 1))
  (print (string-ref j2 2) "  " (string-ref j1 2))
  (print j3)
  (newline))

(define (main args)
  (call-with-input-file (cadr args) (lambda (in)
                                      (port-for-each
                                       (lambda (x)
                                         (hash-table-push! ht-head (string-ref x 0) x)
                                         (hash-table-push! ht-tail (string-ref x 3) x))
                                       (lambda () (read-line in)))))
  (hash-table-for-each ht-tail (lambda (key-tail value-tail)
                                 (for-each (lambda (x)
                                             (hash-table-push! ht-headtail (string (string-ref x 0) key-tail) x))
                                           (filter (lambda (x) (hash-table-exists? ht-head (string-ref x 0))) value-tail))))
  (let ((all-keys (hash-table-keys ht-headtail))
        (ht-dup (make-hash-table 'equal?)))
    (for-each (lambda (w0)
                (for-each (lambda (w3)
                            (let ((w1 (string (string-ref w0 1) (string-ref w3 1)))
                                  (w2 (string (string-ref w0 0) (string-ref w3 0))))
                              (when (and (not (char=? (string-ref w1 0) (string-ref w3 0)))
                                         (hash-table-exists? ht-headtail w1)
                                         (hash-table-exists? ht-headtail w2))
                                (hash-table-put! ht-dup (sort (list w0 w1 w2 w3)) (list w0 w1 w2 w3)))))
                          all-keys))
              all-keys)
    (hash-table-for-each ht-dup (lambda (key value)
                                  (for-each (lambda (x) (apply print-puzzle x))
                                            (cartesian-product (map (lambda (x)
                                                                      (hash-table-get ht-headtail x))
                                                                    value)))))))

少し高速化しました。157秒@Pen4 2.6GHz
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
(use srfi-1)
(use util.combinations)

(define (print-puzzle j0 j1 j2 j3)
  (print j0)
  (print (string-ref j2 1) "  " (string-ref j1 1))
  (print (string-ref j2 2) "  " (string-ref j1 2))
  (print j3)
  (newline))

(define (main args)
  (define ht-head (make-hash-table 'eqv?))
  (define ht-headtail (make-hash-table 'string=?))
  (define ht-dup (make-hash-table 'equal?))
  (call-with-input-file (cadr args) (lambda (in)
                                      (port-for-each
                                       (lambda (x)
                                         (hash-table-push! ht-head (string-ref x 0) #f)
                                         (hash-table-push! ht-headtail (string (string-ref x 0) (string-ref x 3)) x))
                                       (lambda () (read-line in)))))
  (hash-table-for-each
   ht-headtail
   (lambda (w0 _)
     (when (hash-table-exists? ht-head (string-ref w0 1))
       (hash-table-for-each
        ht-headtail
        (lambda (w3 _)
          (unless (char=? (string-ref w0 1) (string-ref w3 0))
            (let ((w1 (string (string-ref w0 1) (string-ref w3 1)))
                  (w2 (string (string-ref w0 0) (string-ref w3 0))))
              (when (and (hash-table-exists? ht-headtail w1)
                         (hash-table-exists? ht-headtail w2))
                (hash-table-put! ht-dup (sort (list w0 w1 w2 w3)) (list w0 w1 w2 w3))))))))))
  (hash-table-for-each ht-dup (lambda (key value)
                                (for-each (lambda (x) (apply print-puzzle x))
                                          (cartesian-product (map (lambda (x)
                                                                    (hash-table-get ht-headtail x))
                                                                  value))))))

アルゴリズムは変えずにもう少し速くしてみました。

  • string-refは最悪O(n)になるので内側のループで使うのは避けた方が良いでしょう。
  • string=? hash tableは一般にはequal? hash tableより速いですが、#3867の場合、lookupのたびに文字列を作るので、今回はequal? hash tableにしてキーは文字をconsするだけの方が速いです。
  • cartesian-productの結果をfor-eachに食わせるなら、cartesian-product-for-eachを使うと中間リストを作らずに済みます。
  • ht-headは存在チェックだけやってるのでhash-table-push!する必要はないですね。

手元では3.5倍くらい速くなりました。これ以上はアルゴリズムの工夫かな。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
(use srfi-1)
(use util.combinations)

(define (print-puzzle j0 j1 j2 j3)
  (print j0)
  (print (string-ref j2 1) "\u3000\u3000" (string-ref j1 1))
  (print (string-ref j2 2) "\u3000\u3000" (string-ref j1 2))
  (print j3)
  (newline))

(define (main args)
  (define ht-head (make-hash-table 'eqv?))
  (define ht-headtail (make-hash-table 'equal?))
  (define ht-dup (make-hash-table 'equal?))
  (with-input-from-file (cadr args)
    (cut port-for-each
         (lambda (x)
           (hash-table-put! ht-head (string-ref x 0) #t)
           (hash-table-push! ht-headtail
                             (cons (string-ref x 0) (string-ref x 3))
                             x))
         read-line))
  (hash-table-for-each
   ht-headtail
   (lambda (w0 _)
     (when (hash-table-exists? ht-head (cdr w0))
       (hash-table-for-each
        ht-headtail
        (lambda (w3 _)
          (unless (char=? (cdr w0) (car w3))
            (let ((w1 (cons (cdr w0) (cdr w3)))
                  (w2 (cons (car w0) (car w3))))
              (when (and (hash-table-exists? ht-headtail w1)
                         (hash-table-exists? ht-headtail w2))
                (hash-table-put! ht-dup
                                 (sort (list w0 w1 w2 w3)
                                       (lambda (a b)
                                         (or (char<? (car a) (car b))
                                             (and (char=? (car a) (car b))
                                                  (char<? (cdr a) (cdr b))))))
                                 (list w0 w1 w2 w3))))))))))
  (hash-table-for-each ht-dup
                       (lambda (key value)
                         (cartesian-product-for-each
                          (cut apply print-puzzle <>)
                          (map (cut hash-table-get ht-headtail <>) value)))))

そして何よりもっ!速さがたりない!
ああ、また計算量を縮めてしまった。

アルゴリズムを見直したら1.6秒になりました。Gaucheはすごいです。
一発でこれを投稿できるようになりたいです。
shiro氏の助言(#3887)に感謝します。
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
(use srfi-1)
(use util.combinations)

(define (print-puzzle j0 j1 j2 j3)
  (print j0)
  (print (string-ref j2 1) "\u3000\u3000" (string-ref j1 1))
  (print (string-ref j2 2) "\u3000\u3000" (string-ref j1 2))
  (print j3)
  (newline))

(define (main args)
  (define ht-head (make-hash-table 'eqv?))
  (define ht-headtail (make-hash-table 'equal?))
  (define ht-dup (make-hash-table 'equal?))
  (call-with-input-file (cadr args) (lambda (in)
                                      (port-for-each
                                       (lambda (x)
                                         (hash-table-push! ht-headtail (cons (string-ref x 0) (string-ref x 3)) x))
                                       (lambda () (read-line in)))))
  (hash-table-for-each ht-headtail (lambda (key _)
                                     (hash-table-push! ht-head (car key) key)))
  (hash-table-for-each 
   ht-headtail
   (lambda (w0 _)
     (for-each (lambda (w1)
                 (for-each (lambda (w2)
                             (unless (char=? (cdr w0) (cdr w2))
                               (let1 w3 (cons (cdr w2) (cdr w1))
                                 (when (hash-table-exists? ht-headtail w3)
                                   (hash-table-put! ht-dup
                                                    (sort (list w0 w1 w2 w3)
                                                          (lambda (a b)
                                                            (or (char<? (car a) (car b))
                                                                (and (char=? (car a) (car b))
                                                                     (char<? (cdr a) (cdr b))))))
                                                    (list w0 w1 w2 w3))))))
                           (hash-table-get ht-head (car w0) '())))
               (hash-table-get ht-head (cdr w0) '()))))
  (hash-table-for-each ht-dup
                       (lambda (_ value)
                         (cartesian-product-for-each
                          (cut apply print-puzzle <>)
                          (map (cut hash-table-get ht-headtail <>) value)))))

Index

Feed

Other

Link

Pathtraq

loading...