DouKaku? 3867 ocaml-nagoya: 少し高速化しました。157秒@Pen4 ...(四字熟語パズルの作成)

Comment detail

少し高速化しました。157秒@Pen4 2.6GHz

(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倍くらい速くなりました。これ以上はアルゴリズムの工夫かな。

(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)))))

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq