From: Tomas Hlavaty
Subject: Add-A-Gram
Date: 
Message-ID: <ct62dg$1i0c$1@ns.felk.cvut.cz>
This is a multi-part message in MIME format.
--------------000303010908000506010003
Content-Type: text/plain; charset=us-ascii; format=flowed
Content-Transfer-Encoding: 7bit

I found http://www.itasoftware.com/careers/programmers-archive.php and 
tried to solve Add-A-Gram problem in Lisp. The code is attached.

I was curious to compare my Lisp solution to their C++, Java, Perl and 
Python implementations because I am rather Lisp beginner fascinated by 
the language. I was surprised that my implementation was faster (using 
SBCL) than the other programs!

Does anybody have any comments and suggestions how to write the code 
more "Lispy" or improve performance?

Thanks, Tomas

--------------000303010908000506010003
Content-Type: text/plain;
 name="addagram.lisp"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="addagram.lisp"

;;; addagram.lisp -- Program to solve the "Add-A-Gram" problem
;;;
;;; Written by Tomas Hlavaty <········@seznam.cz> on January 15, 2004
;;;
;;; From http://www.itasoftware.com/careers/programmers-archive.php
;;;
;;; An "add-a-gram" is a sequence of words formed by starting with a 3-letter
;;; word, adding a letter and rearranging to form a 4-letter word, and so on.
;;; For example, here are add-a-grams of the words "CREDENTIALS"
;;; and "ANACHRONISM":
;;;
;;; ail + s =                 mar + c =
;;; sail + n =                cram + h =
;;; nails + e =               march + s =
;;; aliens + t =              charms + o =
;;; salient + r =             chromas + n =
;;; entrails + c =            monarchs + i =
;;; clarinets + e =           harmonics + a =
;;; interlaces + d =          maraschino + n =
;;; CREDENTIALS (length 11)   ANACHRONISM (length 11)
;;;
;;; Test your own credentials: given the dictionary found here (WORD.LST 1.66MB),
;;; what is the longest add-a-gram?

(defvar *dictionary* nil)

(defun load-dictionary (&optional (file "WORD.LST"))
  "Load words from FILE that are longer than 2 characters."
  (with-open-file (stream file :direction :input)
		  (loop for word = (read-line stream nil nil)
			while word
			when (< 2 (length word))
			collect word)))

;;(time (prog1 t (setq *dictionary* (load-dictionary))))

(defun category (word)
  "Return category of WORD."
  (sort (copy-seq word) #'char<))

;;(category "hello")

(defvar *categories* nil)

(defun create-categories ()
  "Return hash-table containing list of words from *dictionary* for each category."
  (let ((categories (make-hash-table :test 'equal :size (length *dictionary*))))
    (dolist (word *dictionary* categories)
      (push word (gethash (category word) categories)))))

;;(time (prog1 t (setq *categories* (create-categories))))

(defun subcategories (category)
  "Return list of categories with one character less than CATEGORY."
  (loop for i from 0 to (1- (length category))
	collect (concatenate 'string
			     (subseq category 0 i)
			     (subseq category (1+ i)))))

;;(subcategories (category "credentials"))

(defun subwords (category)
  "Return list of words from subcategories of CATEGORY."
  (loop for c in (subcategories category)
	when #1=(gethash c *categories*)
	append #1#))

;;(subwords (category "credentials"))

(defstruct state word parent)

(defun expand (state)
  "Expand STATE into list of successor states."
  (loop for word in (subwords (category (state-word state)))
	collect (make-state :word word :parent state)))

;;(expand (make-state :word "credentials" :parent nil))

(defun search-solution (word &optional (done (make-hash-table :test 'equal)))
  "Return a state with the word length 3 leading to WORD."
  (do ((open (list (make-state :word word :parent nil))))
      ((null open))
    (let* ((state (pop open))
	   (existing (gethash (state-word state) done)))
      (if existing
	  existing
	(progn
	  (setf (gethash (state-word state) done) state)
	  (when (>= 3 (length (state-word state)))
	    (return state))
	  (dolist (new-state (expand state))
	    (push new-state open)))))))

(defun print-solution (state)
  "Print all parent states of STATE."
  (loop for s = state then (state-parent s)
	while s
	do (format t "~A~%" (state-word s))))

;;(print-solution (search-solution "credentials"))
;;(print-solution (search-solution "anachronism"))
;;(print-solution (search-solution "xxxx"))

(defun search-max ()
  "Return one of the longest add-a-grams."
  (let ((done (make-hash-table :test 'equal)))
    (dolist (word *dictionary*)
      (let ((result (search-solution word done)))
	(when result
	  (return result))))))

;;(prog1 t (setq *dictionary* (sort *dictionary* #'(lambda (a b) (> (length a) (length b))))))
;;(time (print-solution (search-max))) => (length "indeterminations") => 16

(defun run ()
  (format t "-- loading dictionary~%")
  (time (setq *dictionary* (load-dictionary)))
  (format t "-- creating categories~%")
  (time (setq *categories* (create-categories)))
  (format t "-- sorting dictionary~%")
  (time (setq *dictionary* (sort *dictionary* #'(lambda (a b) (> (length a) (length b))))))
  (format t "-- searching~%")
  (time (print-solution (search-max))))

--------------000303010908000506010003--

From: Edi Weitz
Subject: Re: Add-A-Gram
Date: 
Message-ID: <u4qh5s63a.fsf@agharta.de>
On Tue, 25 Jan 2005 19:16:21 +0100, Tomas Hlavaty <········@seznam.cz> wrote:

> I found http://www.itasoftware.com/careers/programmers-archive.php
> and tried to solve Add-A-Gram problem in Lisp. The code is attached.
>
> I was curious to compare my Lisp solution to their C++, Java, Perl
> and Python implementations because I am rather Lisp beginner
> fascinated by the language. I was surprised that my implementation
> was faster (using SBCL) than the other programs!

Well, it's Lisp... :)

> Does anybody have any comments and suggestions how to write the code
> more "Lispy" or improve performance?

Try to search Google Groups, there was a longish thread in
comp.lang.lisp a while (one or two years, I think) ago where many
participants submitted interesting solutions.

FWIW, my OCaml solution is here:

  <http://weitz.de/files/add-a-gram.ml>

But it's probably not worth looking at - it was my first OCaml program
ever and I haven't used the language since.

Cheers,
Edi.

-- 

Lisp is not dead, it just smells funny.

Real email: (replace (subseq ·········@agharta.de" 5) "edi")
From: Edi Weitz
Subject: Re: Add-A-Gram
Date: 
Message-ID: <uwtu1qrdb.fsf@agharta.de>
On Tue, 25 Jan 2005 19:42:49 +0100, Edi Weitz <········@agharta.de> wrote:

> Try to search Google Groups, there was a longish thread in
> comp.lang.lisp a while (one or two years, I think) ago where many
> participants submitted interesting solutions.

  <http://groups-beta.google.com/group/comp.lang.lisp/browse_frm/thread/ecfa7e65c62cfd1a/cd919fe5032cc0b4#cd919fe5032cc0b4>

Sorry, but these new Google links are just crazy...

Edi.

-- 

Lisp is not dead, it just smells funny.

Real email: (replace (subseq ·········@agharta.de" 5) "edi")
From: Pascal Bourguignon
Subject: Re: Add-A-Gram
Date: 
Message-ID: <87u0p5ktmu.fsf@thalassa.informatimago.com>
Tomas Hlavaty <········@seznam.cz> writes:

> I found http://www.itasoftware.com/careers/programmers-archive.php and
> tried to solve Add-A-Gram problem in Lisp. The code is attached.
> 
> I was curious to compare my Lisp solution to their C++, Java, Perl and
> Python implementations because I am rather Lisp beginner fascinated by
> the language. I was surprised that my implementation was faster (using
> SBCL) than the other programs!
> 
> Does anybody have any comments and suggestions how to write the code
> more "Lispy" or improve performance?

> (defun subwords (category)
>   "Return list of words from subcategories of CATEGORY."
>   (loop for c in (subcategories category)
> 	when #1=(gethash c *categories*)
> 	append #1#))


This is not more efficent than:

(defun subwords (category)
   "Return list of words from subcategories of CATEGORY."
   (loop for c in (subcategories category)
 	when (gethash c *categories*)
 	append (gethash c *categories*)))


The following might be slighly more efficient, or equal, depending on
the compiler:

(defun subwords (category)
   "Return list of words from subcategories of CATEGORY."
   (loop for c in (subcategories category)
 	     for h = (gethash c *categories*)
         when h
         append h))


-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

There is no worse tyranny than to force a man to pay for what he does not
want merely because you think it would be good for him. -- Robert Heinlein
From: Peter Seibel
Subject: Re: Add-A-Gram
Date: 
Message-ID: <m33bwp2jiu.fsf@javamonkey.com>
Pascal Bourguignon <····@mouse-potato.com> writes:

> Tomas Hlavaty <········@seznam.cz> writes:
>
>> I found http://www.itasoftware.com/careers/programmers-archive.php and
>> tried to solve Add-A-Gram problem in Lisp. The code is attached.
>> 
>> I was curious to compare my Lisp solution to their C++, Java, Perl and
>> Python implementations because I am rather Lisp beginner fascinated by
>> the language. I was surprised that my implementation was faster (using
>> SBCL) than the other programs!
>> 
>> Does anybody have any comments and suggestions how to write the code
>> more "Lispy" or improve performance?
>
>> (defun subwords (category)
>>   "Return list of words from subcategories of CATEGORY."
>>   (loop for c in (subcategories category)
>> 	when #1=(gethash c *categories*)
>> 	append #1#))
>
>
> This is not more efficent than:
>
> (defun subwords (category)
>    "Return list of words from subcategories of CATEGORY."
>    (loop for c in (subcategories category)
>  	when (gethash c *categories*)
>  	append (gethash c *categories*)))
>
>
> The following might be slighly more efficient, or equal, depending on
> the compiler:
>
> (defun subwords (category)
>    "Return list of words from subcategories of CATEGORY."
>    (loop for c in (subcategories category)
>  	     for h = (gethash c *categories*)
>          when h
>          append h))

Or this:

  (defun subwords (category)
    "Return list of words from subcategories of CATEGORY."
    (loop for c in (subcategories category)
       when (gethash c *categories*) append it))

-Peter

-- 
Peter Seibel                                      ·····@javamonkey.com

         Lisp is the red pill. -- John Fraser, comp.lang.lisp
From: Edi Weitz
Subject: Re: Add-A-Gram
Date: 
Message-ID: <uzmyxrsp5.fsf@agharta.de>
On 25 Jan 2005 23:53:45 +0100, Pascal Bourguignon <····@mouse-potato.com> wrote:

> The following might be slighly more efficient, or equal, depending
> on the compiler:
>
> (defun subwords (category)
>    "Return list of words from subcategories of CATEGORY."
>    (loop for c in (subcategories category)
>  	     for h = (gethash c *categories*)
>          when h
>          append h))

LOOP has an idiom for this:

  (defun subwords (category)
    "Return list of words from subcategories of CATEGORY."
    (loop for c in (subcategories category)
          when (gethash c *categories*)
          append it))

Edi.

-- 

Lisp is not dead, it just smells funny.

Real email: (replace (subseq ·········@agharta.de" 5) "edi")
From: Holger Duerer
Subject: Re: Add-A-Gram
Date: 
Message-ID: <877jm08f7b.fsf@ronaldann.demon.co.uk>
>>>>> "Tomas" == Tomas Hlavaty <········@seznam.cz> writes:

    Tomas> I found
    Tomas> http://www.itasoftware.com/careers/programmers-archive.php
    Tomas> and tried to solve Add-A-Gram problem in Lisp. The code is
    Tomas> attached.

  [...]

    Tomas> Does anybody have any comments and suggestions how to write
    Tomas> the code more "Lispy" or improve performance?


  [...]
    Tomas>   (time (setq *dictionary* (sort *dictionary* #'(lambda (a b) (> (length a) (length b))))))

Well, I am a Lisp newbie myself, but I would have used (sort *dictionary* #'> :key #'length) .

My reasoning is that a) I find it more readable and b) I would have
thought that in the general case it allows the compiler to optimise
the key access (do only O(n) calls to the key function rather than 
O(n log n) as with your method. 

Maybe one of the Lisp wizards here would comment on this reasoning?


  [...]

  Holger
From: Rahul Jain
Subject: Re: Add-A-Gram
Date: 
Message-ID: <87is5jy0bi.fsf@nyct.net>
Holger Duerer <········@gmx.net> writes:

>     Tomas>   (time (setq *dictionary* (sort *dictionary* #'(lambda (a b) (> (length a) (length b))))))
>
> Well, I am a Lisp newbie myself, but I would have used (sort *dictionary* #'> :key #'length) .
>
> My reasoning is that a) I find it more readable and b) I would have
> thought that in the general case it allows the compiler to optimise
> the key access (do only O(n) calls to the key function rather than 
> O(n log n) as with your method. 
>
> Maybe one of the Lisp wizards here would comment on this reasoning?

In theory, yes. In practice, the code is probably equivalent in terms of
efficiency. The overhead of keeping a mapping of item to key is probably
far too high when key functions are usually very fast.

-- 
Rahul Jain
·····@nyct.net
Professional Software Developer, Amateur Quantum Mechanicist
From: Tomas Hlavaty
Subject: Re: Add-A-Gram
Date: 
Message-ID: <ctaevp$2657$1@ns.felk.cvut.cz>
Thank you all for your comments.

Tomas

Rahul Jain wrote:
> Holger Duerer <········@gmx.net> writes:
> 
> 
>>    Tomas>   (time (setq *dictionary* (sort *dictionary* #'(lambda (a b) (> (length a) (length b))))))
>>
>>Well, I am a Lisp newbie myself, but I would have used (sort *dictionary* #'> :key #'length) .
>>
>>My reasoning is that a) I find it more readable and b) I would have
>>thought that in the general case it allows the compiler to optimise
>>the key access (do only O(n) calls to the key function rather than 
>>O(n log n) as with your method. 
>>
>>Maybe one of the Lisp wizards here would comment on this reasoning?
> 
> 
> In theory, yes. In practice, the code is probably equivalent in terms of
> efficiency. The overhead of keeping a mapping of item to key is probably
> far too high when key functions are usually very fast.
> 
From: Alex Mizrahi
Subject: Re: Add-A-Gram
Date: 
Message-ID: <35t8nmF4n1tbdU1@individual.net>
(message (Hello 'Tomas)
(you :wrote  :on '(Tue, 25 Jan 2005 19:16:21 +0100))
(

 TH> I was curious to compare my Lisp solution to their C++, Java, Perl and
 TH> Python implementations because I am rather Lisp beginner fascinated by
 TH> the language. I was surprised that my implementation was faster (using
 TH> SBCL) than the other programs!

really??
i found c++ is about 2 times faster than cmucl and sbcl (i use versions that
are about a year old).

maybe you didn't enable optimizations in c++? without optimizations it's
really poor - it's like all lisp library functions being interpreted rather
than compiled..

)
(With-best-regards '(Alex Mizrahi) :aka 'killer_storm)
(prin1 "People who lust for the Feel of keys on their fingertips (c)
Inity"))
From: Tomas Hlavaty
Subject: Re: Add-A-Gram
Date: 
Message-ID: <ctd03u$n1a$1@ns.felk.cvut.cz>
>  TH> I was curious to compare my Lisp solution to their C++, Java, Perl and
>  TH> Python implementations because I am rather Lisp beginner fascinated by
>  TH> the language. I was surprised that my implementation was faster (using
>  TH> SBCL) than the other programs!
> 
> really??
> i found c++ is about 2 times faster than cmucl and sbcl (i use versions that
> are about a year old).

I took the C++ version from 
http://www.itasoftware.com/careers/programmers-archive.php and when 
compiled as

$ gcc -O3 addagram.cpp -o addagram -lstdc++

it is still slightly slower than my lisp program. I use SBCL 0.8.17.

Maybe you have better C++ implementation of the problem.

> maybe you didn't enable optimizations in c++? without optimizations it's
> really poor - it's like all lisp library functions being interpreted rather
> than compiled..

Yes, the C++ program is two times slower without any optimisation.