; Automatic F&SF competition enterer

; Given a phrase (e.g. a book title) find all distance-1 misspellings
; of any of its words.  Output all the titles containing exactly one
; such misspelling.

(define print-entries
  (lambda (phrase)
    (for-each print (competition-entries phrase))))

(define competition-entries
  (lambda (phrase)
    (let ((words (map symbol->string phrase))
	  (each-string->symbol
	   (lambda (strings) (map string->symbol strings))))
      (map each-string->symbol
	   (all-picks words (map find-misspellings words))))))

; Pre: (length WORDS) = (length MISSPELLINGS)
;      and MISSPELLINGS is a list of lists.
; Return a list of all ways to make a phrase with each word from either
; WORDS or MISSPELLINGS in the same position, such that each phrase has
; exactly one choice from MISSPELLINGS.
(define all-picks
  (lambda (words misspellings)
    (if (null? words)
	'()
	(append (map (lambda (misspelling)
		       (cons misspelling (cdr words)))
		     (car misspellings))
		(map (lambda (rest) (cons (car words) rest))
		     (all-picks (cdr words) (cdr misspellings)))))))

(define find-misspellings
  (lambda (word)
    (deduplicate (map chars->word
		      (corrections dictionary (word->chars word) 1)))))

(define chars->word list->string)

(define deduplicate
  (lambda (ls)
    (let ((adjoin (lambda (x xs)
		    (if (member x xs) xs (cons x xs)))))
      (foldr adjoin '() ls))))