DouKaku? 3892 ocaml-nagoya: そして何よりもっ!速さがたりない! あ...(四字熟語パズルの作成)

Comment detail

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

アルゴリズムを見直したら1.6秒になりました。Gaucheはすごいです。
一発でこれを投稿できるようになりたいです。
shiro氏の助言(#3887)に感謝します。

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

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq