anagrams

For the Compleat Fan
Locked
Sammo
Posts: 180
Joined: Sat Dec 06, 2003 6:11 pm
Location: Loveland, Colorado USA

anagrams

Post by Sammo »

Inspired by someone in the NeoBook forum to generate anagrams, I wrote this:

Code: Select all

(define (anagrams s)
    (if (<= (length s) 1)
        (list s)
        (flat (map (fn (n) (aux (rotate-string s n))) (sequence 1 (length s))))))

(define (aux rs)
    (map (fn (x) (append (first rs) x)) (anagrams (rest rs))))

(define (rotate-string s n)
    (join (rotate (explode s) n)))
which generates

(anagrams "abcdefgh") --> 40,320 anagrams in 5.6 seconds
(anagrams "abcdefghi") --> 362,880 anagrams in 64.5 seconds

on my 500 MHz 192Mbyte laptop. Does anyone see any significant speed or code improvements? What about the use of 'append' in the 'aux' function to prepend a character to a string? Would 'string' be a better choice? And how about that 'rotate-string' function? It looks relatively expensive time-wise.

eddier
Posts: 289
Joined: Mon Oct 07, 2002 2:48 pm
Location: Blue Mountain College, MS US

Post by eddier »

To keep from creating a list in (rotate-string and joining
you might try

Code: Select all

(define (rotate-string s n , p)
  (setq p (- (length s) n))
  (append (slice s p) (slice s 0 p)))
Eddie

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

Checking the speed of rotate-string isolated from the anagram algorithm, the Eddie solution is faster, but measuring the speed of the overall algorithm, there seems to be no difference, which 'rotate-string' is used, and the 'rotate/explode' solution looks definitely very elegant.

Sam asked about 'append' versus 'string': 'string' should only be used if elements of the stuff to append have to be converted to strings. when everything is a string already (as in Sam's case) than append is much faster.

I am also contemplating a total different solution for the 'anagram' algorithm: somehow generating the permutations just with numbers and than using 'select' or 'collect' to re-arrange the letters from the string:

(collect "newLISP" 3 4 5 6 0 1 2) => "LISPnew"
or
(select "newLISP" '(3 4 5 6 0 1 2)) => "LISPnew"


Lutz

Sammo
Posts: 180
Joined: Sat Dec 06, 2003 6:11 pm
Location: Loveland, Colorado USA

Post by Sammo »

Hi Lutz,

Now that's an interesting idea! I think the advantage is that the anagrams can be precomputed for any reasonable length string and then applied to a particular string. I experimented with

Code: Select all

(setq b6 (anagrams "012345"))
(setq a6 (map (fn (s) (map integer (explode s))) b6))
which is the same as

Code: Select all

(setq a6 (map (fn (s) (map integer (explode s))) (anagrams "012345")))
and found that

Code: Select all

(map (fn (pattern) (select "abcdef" pattern)) a6)
measures 13 times faster than

Code: Select all

(anagrams "abcdef")
where 'anagrams' is my original code from above.

nigelbrown
Posts: 429
Joined: Tue Nov 11, 2003 2:11 am
Location: Brisbane, Australia

Post by nigelbrown »

See http://www.idt.mdh.se/kpt/Homepage/source/rank for a permutation approach that generates permutated interger 'lists' reproducibly for an integer from 0 to n!-1 - then you use this to generate the final perm. And here http://iis1.cps.unizar.es/Oreilly/perl/ ... h04_20.htm has some discussion of the approach.

http://www.cs.berkeley.edu/~fateman/mma1.6/comb.lisp gives some interesting comb and perm lisp stuff.

Lutz
Posts: 5289
Joined: Thu Sep 26, 2002 4:45 pm
Location: Pasadena, California
Contact:

Post by Lutz »

here is anagrams programs based on permutations of numbers:

Code: Select all

(define (permutations lst)
  (if (= (length lst) 1) 
   lst 
   (apply append (map (fn (rot) (map (fn (perm) (cons (first rot) perm)) 
      (permutations (rest rot))))
    (rotations lst)))))

(define (rotations lst)
  (map (fn (x) (rotate lst)) (sequence 1 (length lst))))


(define (anagrams str)
  (map (fn (perm) (select str perm)) (permutations (sequence 0 (- (length str) 1))))) 
Sam's solution is still double as fast and a bit shorter, but the permutations function might come in handy for other projects. Investigating Nigel's links I also realized that other solutions (liked the rank/unrank method) lack a 'rotate' function and are longer for that reason than the newLISP solution.

Developing this I realized that 'rotate' crashes on an empty list. This is fixed and will be in the next developers release.

Lutz

Locked