(defun group (list key &optional (test #'eql))
(let ((tbl (make-hash-table :test test)))
(dolist (x list) (push x (gethash (funcall key x) tbl)))
tbl))
(defun make-puzzle (words)
(let ((tbl1 (group words (lambda (s) (elt s 0)))))
(loop for grp1 being each hash-value of tbl1 nconc
(loop for a in grp1 and rest1 on (cdr grp1) nconc
(loop for b in rest1
if (char/= (elt a 3) (elt b 3)) nconc
(loop for c in (gethash (elt a 3) tbl1) nconc
(loop for d in (gethash (elt b 3) tbl1)
if (char= (elt c 3) (elt d 3))
collect (list a b c d))))))))
;;; test
(compile 'make-puzzle)
(let ((words (with-open-file (s "words.txt" :direction :input)
(loop for x = (read-line s nil) while x collect x))))
(print (time (make-puzzle words))))
kozima
#3658()
[
Common Lisp
]
Rating0/0=0.00
(defun group (list key &optional (test #'eql)) (let ((tbl (make-hash-table :test test))) (dolist (x list) (push x (gethash (funcall key x) tbl))) tbl)) (defun make-puzzle (words) (let ((tbl1 (group words (lambda (s) (elt s 0))))) (loop for grp1 being each hash-value of tbl1 nconc (loop for a in grp1 and rest1 on (cdr grp1) nconc (loop for b in rest1 if (char/= (elt a 3) (elt b 3)) nconc (loop for c in (gethash (elt a 3) tbl1) nconc (loop for d in (gethash (elt b 3) tbl1) if (char= (elt c 3) (elt d 3)) collect (list a b c d)))))))) ;;; test (compile 'make-puzzle) (let ((words (with-open-file (s "words.txt" :direction :input) (loop for x = (read-line s nil) while x collect x)))) (print (time (make-puzzle words))))Rating0/0=0.00-0+
1 reply [ reply ]