From 2ae455492daa92ff0d639bf529fcea0643f4c7c4 Mon Sep 17 00:00:00 2001 From: Nathan Froyd Subject: [PATCH 01/39] cleanup whitespace and indentation --- src/lisp/generation.lisp | 52 ++++++-------------- src/lisp/solver.lisp | 122 ++++++++++++++-------------------------------- src/lisp/structs.lisp | 52 +++---------------- src/lisp/utils.lisp | 13 +---- 4 files changed, 63 insertions(+), 176 deletions(-) diff --git a/src/lisp/generation.lisp b/src/lisp/generation.lisp index 7759e97..e4ea81c 100755 --- a/src/lisp/generation.lisp +++ b/src/lisp/generation.lisp @@ -5,16 +5,6 @@ ;;;; Date : 03/07/2009 ;;;; - -;; compiler flags -(eval-when (:compile-toplevel) - (declaim (optimize - (speed 3) - (space 0) - (safety 0) - (debug 0)))) - - ;; vars (defvar *boggle-4x4-dice* @@ -24,19 +14,16 @@ "NODESW" "HEFIYE" "ONUDTK" "TEVIGN" "ANEDVZ" "PINESH" "ABILYT" "GKYLEU")) - ;; functions -(defun get-dice(&key (dimensions '(4 4))) +(defun get-dice (&key (dimensions '(4 4))) "Gets the dice for the dimensions" - (let* - ((number-of-dice (* (first dimensions) - (second dimensions))) - (dice-list (make-array 0 - :element-type 'byte - :fill-pointer 0 - :adjustable t))) - + (let* ((number-of-dice (* (first dimensions) + (second dimensions))) + (dice-list (make-array 0 + :element-type 'byte + :fill-pointer 0 + :adjustable t))) (if (> (length *boggle-4x4-dice*) number-of-dice) (subseq *boggle-4x4-dice* 0 number-of-dice) @@ -46,7 +33,6 @@ (length *boggle-4x4-dice*)))) (dolist (o *boggle-4x4-dice*) (vector-push-extend o dice-list))))) - (setf (fill-pointer dice-list) (- number-of-dice 1)) ;; now create the 2d list @@ -60,13 +46,11 @@ (defun new-board-config(&key (dimensions '(4 4))) ;; generates a new 2d board based on the dimensions - ;; randomly arrange and roll the dice (let* ((rolled-dice (randomize-sequence (get-dice :dimensions dimensions))) ; randomly arrange dice (board (make-sequence 'list (first dimensions)))) - ;; Generate the board config from the rolled dice (dotimes (num (first dimensions) board) (setf (nth num board) @@ -96,25 +80,19 @@ #+ecl (setf *ecl-args* nil) #+ecl (ext:process-command-args :rules +ls-rules+ :args *ecl-args*) - -(defun run-board-generator() +(defun run-board-generator () ;; Main entry point if run from command line - (setf *random-state* (make-random-state t)) - - (let* ( #+ecl (args *ecl-args*) - #+ccl (args *COMMAND-LINE-ARGUMENT-LIST*) - #+sbcl (args sb-ext:*posix-argv*) - #+cmu (args extensions:*command-line-strings*) - (count (get-int-arg (second args) "1")) - (rows (get-int-arg (third args) "4")) - (cols (get-int-arg (fourth args) "4"))) + #+ccl (args *COMMAND-LINE-ARGUMENT-LIST*) + #+sbcl (args sb-ext:*posix-argv*) + #+cmu (args extensions:*command-line-strings*) + (count (get-int-arg (second args) "1")) + (rows (get-int-arg (third args) "4")) + (cols (get-int-arg (fourth args) "4"))) (dotimes (n count) (print-board-config-text - (new-board-config :dimensions (list rows cols))))) - - #-ecl 0) ;; everything is good ! + (new-board-config :dimensions (list rows cols)))))) diff --git a/src/lisp/solver.lisp b/src/lisp/solver.lisp index 4312e1c..aafe7d4 100755 --- a/src/lisp/solver.lisp +++ b/src/lisp/solver.lisp @@ -15,27 +15,12 @@ ;;#+sbcl (require :sb-sprof) -#+sbcl -(progn - (declaim (sb-ext:muffle-conditions t)) - (declaim (sb-ext:muffle-conditions sb-ext:compiler-note))) - -#+ccl -(progn - (setf ccl::*muffle-warnings* t) - (setf ccl::*suppress-compiler-warnings* t)) - - -;; compiler flags -;;(eval-when (:compile-toplevel) +#+nil (declaim (optimize (speed 3) (space 0) (safety 0) (debug 0) (compilation-speed 0))) -#+cmu (declaim (optimize-interface (speed 3) (space 0) (safety 0) (debug 0))) -;;) - ;; global consts (defvar *dict-path* @@ -47,7 +32,6 @@ (defparameter *min-word-length* 3) (defparameter *max-search-depth* 16) - ;; includes (map 'list #'(lambda (fpath) @@ -56,16 +40,11 @@ fpath))) '("utils.lisp" "structs.lisp" "generation.lisp")) - ;; functions (defun boggle-init() "Initialize things" - ;; turn off gc, beware ! - ;;#+sbcl (gc-off) ;; <= sbcl 1.0.25 - ;;#+ccl (egc nil) - - (format t "loading dictionary ~A ... " *dict-path*) + (format t "loading dictionary ~A ..." *dict-path*) (finish-output) (setf *dict-trie* (trie-from-dict (make-trie) *dict-path*)) @@ -74,13 +53,7 @@ (format t "done.~%" *dict-path*) (finish-output) - (format t "loaded ~A words. ~%" (trie-word-count *dict-trie*)) - - ;;#+sbcl (gc-on) ;(setf *gc-inhibit* nil) - ;;#+sbcl (gc :full t) - ;;#+sbcl (sb-ext:purify) - ;;#+sbcl (gc-off) ;(setf *gc-inhibit* t) - ) + (format t "loaded ~D words.~%" (trie-word-count *dict-trie*))) (defun find-words (ltr word fi tr word-func) @@ -144,62 +117,41 @@ ;; the letter is no longer in use (setf (letter-used ltr) nil))) - -(defun run-solver-from-stdin() +(defun run-solver-from-stdin () "reads boards on stdin and solves them. A word per line is output. An empty line separates the list of words for a board." - - ;;(sb-sys:without-gcing - - ;; Create boggle board - (let* ((the-board - (create-board - (board-from-stream *standard-input*))) - (results (make-array 0 - :element-type '(simple-array string) - :fill-pointer 0 - :adjustable t))) - - ;; Print out the board config - (print-board-config-text (board-config the-board)) - (format t "~%") - - ;;; Take up to 1000 samples of running (FIND-WORDS ...), and give a flat - ;;; table report at the end. Profiling will end one the body has been - ;;; evaluated once, whether or not 1000 samples have been taken. - ;; (sb-sprof:with-profiling (:max-samples 1000 - ;; :report :flat - ;; :loop nil) + (let* ((the-board + (create-board + (board-from-stream *standard-input*))) + (results (make-array 0 + :element-type '(simple-array string) + :fill-pointer 0 + :adjustable t))) - (time - (progn - (dotimes (i (board-rows the-board)) -;; (delcare (type integer i)) - (let ((row (aref (board-letters the-board) i))) - (dotimes (j (board-cols the-board)) -;; (delcare (type integer j)) - (let ((letter (aref row j))) - (find-words - letter - (make-array 20 - :initial-element #\Null - :element-type 'character - :fill-pointer 0) - 0 - *dict-trie* - #'(lambda (word) - (progn - "add the word to the results" - ;;(vector-push-extend word results) - (format t "~A~%" word) - ;;(finish-output) ;; causes long delays in ccl ?! - ))))))))) + ;; Print out the board config + (print-board-config-text (board-config the-board)) + (format t "~%") -;; ) - -;; (format t "~%~D results~%" (length results)) - ) - -;; ) - - 0) ; good times ! + (time + (progn + (dotimes (i (board-rows the-board)) + ;; (delcare (type integer i)) + (let ((row (aref (board-letters the-board) i))) + (dotimes (j (board-cols the-board)) + ;; (delcare (type integer j)) + (let ((letter (aref row j))) + (find-words + letter + (make-array 20 + :initial-element #\Null + :element-type 'character + :fill-pointer 0) + 0 + *dict-trie* + #'(lambda (word) + (progn + "add the word to the results" + ;;(vector-push-extend word results) + (format t "~A~%" word) + ;;(finish-output) ;; causes long delays in ccl ?! + ))))))))))) diff --git a/src/lisp/structs.lisp b/src/lisp/structs.lisp index a6b4c38..8bb0a61 100755 --- a/src/lisp/structs.lisp +++ b/src/lisp/structs.lisp @@ -5,15 +5,10 @@ ;;;; Date : 03/21/2009 ;;;; - - ;; consts (defconstant +empty-children+ (make-array 30 :element-type 'trie)) - - - ;; structs (defstruct (letter @@ -27,7 +22,6 @@ :type (vector letter *)) (used nil :type boolean)) - (defstruct (board) ;; represents a boggle board as a 2d list of letters. (letters nil :type (vector (vector letter *) *)) @@ -35,7 +29,6 @@ (cols nil :type integer) (config nil :type list)) - (defstruct (trie) ;; data structure used to load ;; and search the dictionary. @@ -48,7 +41,6 @@ (parent nil);;:type trie) (children (make-array 30 :element-type 'trie))) - ;; struct functions (defun print-letter (l stream level) @@ -62,8 +54,7 @@ (letter-value nletter)) (letter-neighbors l)))) - -(defun create-board(config) +(defun create-board (config) ;; creates the board and sets up the letters (let* ((board (make-board @@ -102,32 +93,25 @@ (setf (letter-neighbors letter) neighbors) (setf (aref (aref bletters y) x) - letter) - ))) board)) + letter)))) + board)) (defun curr-letter (tr str) "returns the current letter code for the level" - (declare (type trie tr) (type string str) (type (unsigned-byte 8) letter)) - - (let* ((level (trie-level tr)) - (letter (if (> (length str) level) - (char-code (aref str level)) - 0))) - letter)) - + (let ((level (trie-level tr))) + (if (> (length str) level) + (char-code (aref str level)) + 0))) (defun trie-insert (tr str) "inserts the string into the trie" - (declare (type trie tr) (type string str)) - - (let* - ((letter (curr-letter tr str))) + (let* ((letter (curr-letter tr str))) ;;((letter (aref str (trie-level tr)))) (if (eql letter 0) (progn @@ -151,7 +135,6 @@ (setf (aref children ind) ttr) (trie-insert ttr str)))))) - (defun trie-include-p (tr str) "Tests whether the str is a complete word in the trie" @@ -172,14 +155,11 @@ (and (not (eql ttr 0)) (trie-include-p ttr str))))))) - (defun trie-include-prune-p (tr str) "Tests whether the str is a complete word in the trie. If true then the word is pruned from the trie." - (declare (type trie tr) (type string str)) - (let* ((byte (aref str (trie-level tr))) (letter (char-code byte))) (if (eql letter 0) @@ -213,13 +193,10 @@ (and (not (eql ttr 0)) (trie-include-prune-p ttr str))))))) - (defun trie-begin-p (tr str) "Tests whether any words exist in the trie that begin with str" - (declare (type trie tr) (type string str)) - (let* ((byte (aref str (trie-level tr))) (letter (char-code byte))) (if (eql letter 0) @@ -231,8 +208,7 @@ (ttr (aref children ind))) (and (not (eql ttr 0)) (trie-begin-p ttr str))))))) - -(defun inc-word-count(tr) +(defun inc-word-count (tr) (declare (type trie tr)) (declare (type trie parent)) (let ((parent (trie-parent tr))) @@ -241,7 +217,6 @@ (setf (trie-word-count parent) (+ (trie-word-count parent) 1)) (inc-word-count parent))))) - (defun dec-word-count(tr) (declare (type trie tr)) (declare (type trie parent)) @@ -251,17 +226,13 @@ (setf (trie-word-count parent) (- (trie-word-count parent) 1)) (dec-word-count parent))))) - (defun get-child (tr ch) - (declare (type trie tr) (type character ch) (type trie tt) (type (unsigned-byte 8) ind)) - (let* ((ind (- (char-code ch) (char-code #\A))) (tt (aref (trie-children tr) ind))) - (if (eql 0 tt) (progn (setf tt (make-trie :level (+ (trie-level tr) 1))) @@ -269,10 +240,8 @@ (setf (trie-parent tt) tr))) tt)) - (defun board-from-stream (istr) "Reads in a board from an input stream returning a string" - (let ((board (make-array 0 :fill-pointer 0 :element-type 'list @@ -301,7 +270,6 @@ (setf prev-char char))) (coerce board 'list))) - (defun trie-from-dict (tr fpath) "Read in a dictionary file to create the trie" @@ -318,5 +286,3 @@ (if (> (length cline) depth) (setf depth (length cline))) (trie-insert tr cline)) (setf (trie-depth tr) depth))) tr) - - diff --git a/src/lisp/utils.lisp b/src/lisp/utils.lisp index 95719ce..a887ab5 100755 --- a/src/lisp/utils.lisp +++ b/src/lisp/utils.lisp @@ -6,15 +6,6 @@ ;;;; -;; compiler flags -(eval-when (:compile-toplevel) - (declaim (optimize - (speed 3) - (space 0) - (safety 0) - (debug 0)))) - - (defun randomize-sequence (sequence) "Fast enough ;-)" (loop @@ -47,7 +38,7 @@ (defun range (start end) (loop for i from start below end collect i)) -(defun get-int-arg(str default) +(defun get-int-arg (str default) (parse-integer (if (> (length str) 0) str default))) (defun concatenate-strings (strings) @@ -70,4 +61,4 @@ do (vector-push-extend i vector))) (t (error "Bad type for item ~S." item)))) - vector)) \ No newline at end of file + vector)) -- 1.6.2