Lisp is Lovable

Tagged as LISP, Programming

Written on 2009-05-27 15:59:11

I'm about to run to class but I thought I'd throw up a Lisp solution I coded to the Funny Words problem which I worked through in Haskell earlier. I used sb-ext:save-lisp-and-die thanks to a helpful guide to dump a core image and used unix's time command to time it. The output of time ./funnyWords.core english-words.txt was as follows:
real 0m4.053s
user 0m3.913s
sys 0m0.057s

That's significantly shorter than the corresponding Haskell time and I wonder why. This code is a lot more imperative but I'm curious exactly where the speedups are. By the way, LOOP is awesome. As for the differences, I'll spend time sorting it out when I have time later. NOTE: solrize posted an improvement to my Haskell code that made it run in umm...half a second? Less? The main speedup seemed to be coming from using Data.Map and using the sort of each word as the key during insertion. That way, you get isAnagram for free, among other things. If you have thoughts on this code or the earlier Haskell code, where the differences lie or how to make them lispier or haskellier please let me know! :) Here's the code:

;; how to find words like cosmicomics:
;; words which can be split into anagrams by the middle letter
;; PRESENTLY ASSUME THAT ALL WORDS ARE LOWERCASE! how can we type/test for this?

(defparameter *dict* nil)
(defparameter *results* nil)
(defparameter *file* nil)

(defun main ()
  (let ((*file* (or (second *posix-argv*)
		    *file*)))
    (funny-words *file*))
  1)

(defun funny-words (wordlist)
  (let ((result nil))
    (with-open-file (in wordlist)
      (loop for word = (read-line in nil) while word do
	(push word result)))
    (setf *dict* result))
  (mapcar #'partial-find *dict*))
;;  (concat-map #'partial-find *dict*))

(defun is-anagram (word1 word2)
  (string= (sort (copy-seq word1) #'char-lessp)
	   (sort (copy-seq word2) #'char-lessp)))

(defun has-joiner (word1 word2)
  (let ((strlen (- (length word1) 1)))
    (char= (elt word1 strlen) (elt word2 0))))

(defun is-funny-word (word1 word2)
  (and (has-joiner word1 word2)
       (is-anagram word1 word2)
       (not (string= word1 word2))))

(defun build-word (word1 word2)
  (concatenate 'string word1 (subseq word2 1)))

(defun same-length (word lst)
  (loop for item in lst
	when (= (length word) (length item))
	  collecting item))

(defun partial-find (word)
  (loop for item in (same-length word *dict*)
	when (is-funny-word item word)
	  do (let ((answer (build-word item word)))
	       (push answer *results*)
	       (print answer))))

;;(defun concat-map (f lst)
;;  (loop for item in lst appending (funcall f item)))

• ← Previous
• Next →