[plt-scheme] HtDP newbie question, 12.4.2

From: Cooke Kelsey (cookekelsey at yahoo.com)
Date: Mon Mar 31 10:45:53 EDT 2008

OK, now I can celebrate....
   
  In the solution I posted before, I accidentally put "(cons empty empty)" instead of "empty" in Helper #3, which added an unnecessary list to each word.
   
  Thanks again, cooke
   
  FINAL SOLUTION:
   
  ;MAIN FUNCTION: arrangements: word --> list of words
  (define (arrangements a-word)
  (cond [(empty? a-word) (cons empty empty)]
        [else (insert-everywhere/in-all-words (first a-word) (arrangements (rest
 a-word)))]))
   
  ;HELPER #1: insert-everywhere/in-all-words : letter, list of words --> list of words
  (define (insert-everywhere/in-all-words s low)
  (cond
    [(empty? (rest low)) (insert-everywhere/one-word s (first low))]
    [else (append (insert-everywhere/one-word s (first low)) (insert-everywhere/in-all-words s (rest low)))]))
  
  ;HELPER #2: insert-everywhere/one-word : letter, word --> list of words
  ;NOTE: this function just adds the last word to Helper #3
  (define (insert-everywhere/one-word letter a-word)
  (append (list (append a-word (list letter))) (insert-everywhere-except-last-letter letter a-word)))
   
  ;HELPER #3: insert-everywhere-except-last-letter : letter, word --> list of words
  (define (insert-everywhere-except-last-letter letter a-word)
  (cond
    [(empty? a-word) empty]
    [(empty? (rest a-word)) (cons (list letter (first a-word)) empty)]
    [else (cons (cons letter a-word) (add-first-letter (first a-word) (insert-everywhere-except-last-letter letter (rest a-word))))]))
   
  ;HELPER #4 : add-first-letter : letter, list of words --> list of words
  (define (add-first-letter letter low)
  (cond 
    [(empty? (rest low)) (cons (append (list letter) (first low)) empty)]
    [else (cons (append (list letter) (first low)) (add-first-letter letter (rest low)))]))

  ;test
(arrangements (list 'd 'a 'r 'e))
  ;result
  (list
 (list 'e 'r 'a 'd)
 (list 'd 'e 'r 'a)
 (list 'e 'd 'r 'a)
 (list 'e 'r 'd 'a)
 (list 'a 'e 'r 'd)
 (list 'd 'a 'e 'r)
 (list 'a 'd 'e 'r)
 (list 'a 'e 'd 'r)
 (list 'e 'a 'r 'd)
 (list 'd 'e 'a 'r)
 (list 'e 'd 'a 'r)
 (list 'e 'a 'd 'r)
 (list 'r 'e 'a 'd)
 (list 'd 'r 'e 'a)
 (list 'r 'd 'e 'a)
 (list 'r 'e 'd 'a)
 (list 'a 'r 'e 'd)
 (list 'd 'a 'r 'e)
 (list 'a 'd 'r 'e)
 (list 'a 'r 'd 'e)
 (list 'r 'a 'e 'd)
 (list 'd 'r 'a 'e)
 (list 'r 'd 'a 'e)
 (list 'r 'a 'd 'e))

       
---------------------------------
Like movies? Here's a limited-time offer: Blockbuster Total Access for one month at no cost.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20080331/e90b4280/attachment.html>

Posted on the users mailing list.