;;    pairs = ( (letter1 digit1)  (letter2  digit2) ... )
;;    letters = ( alphabet of the problem )
;;    lst = ( the three words of the problem )


(define (solve-alphametic lst)

    (define  w1  (every  se  (car  lst)) ) ; separate letters of words
    (define  w2  (every  se  (cadr  lst)) )
    (define  w3  (every  se  (caddr  lst)) )

   (define   letters  (remove-dup (se  w1  w2  w3) ) )  ; domain of the problem 

   (if  (>  (count  letters)  10)   ()  ; 10 letters <-->  10 digits

		; this is to save us the procesing of one more letter
           (if (and (> (count w3) (count w2)) (> (count w3) (count w1)) )
			; the left most letter of word3 is 1
		(begin   ; remove it from letters, and assign it 1
		(define leters (remove (car w3) letters)    ) 
		(s-alpha (list (list (car w3) 1) )  leters  lst) 
		)
               ;else 
	       (s-alpha  ()  letters  lst)
	)
   )
 )

(define  (s-alpha  pairs  letters  lst)

   (cond  ( (empty?  letters)       ; finished assigning values
			(if  (check  pairs  lst)    ; values are correct 
				(qsort  pairs)      ; sort solution 
				; else    ; not the correct values
				  () ) )

	  (  #t   (metic  pairs  letters  0  lst))   ;continue searching
   )
 )

(define  (metic  pairs letters dig lst)

	(define fst (car letters) )
	(define one  (first (car lst ) ) )   ; first letter of first word
	(define two  (first (cadr lst) ) )  ; first letter of second word
	(define tre  (first (caddr lst) ) )  ;  ...

 (cond  ((and     (= dig 0) 
                  (or (equal? fst one) (equal? fst two) (equal? fst tre)))
		        (metic pairs letters 1 lst)  
	)	  ; the first letter of a word cannot be 0  

	((=  dig  10)  () )          ; max digit is 9
        ( #t  (if   (conflict dig  pairs)    ; digit already used
			  (metic pairs letters (1+ dig) lst)

				; else consider value as valid and continue
 		         (let ((final  
				    (s-alpha    (cons (list  fst  dig) pairs)
				       		(cdr  letters)  lst) ) )

			    (if final final 
			          (metic pairs letters (1+ dig) lst)) 
			)      
		)
        )
 )
)


(define  (conflict  n  pairs)   ; there is a conflict if the value is 
				; already used 

	(cond  ((empty?  pairs)  #f)
	       ((=  (cadar pairs)  n)   #t)
	       (#t   (conflict  n  (bf  pairs) ) )
	)
)


(define  (check  pairs  lst)

   (define  num1  (transform  pairs  (car  lst) )) ; get numbers out of words
   (define  num2  (transform  pairs  (cadr  lst) ))
   (define  num3  (transform  pairs  (caddr  lst) ))

	 (=  (+  num1  num2)  num3)  ; check the summation

)



(define  (transform  pairs  wd)    ; change a word into a number using pairs

	(cond ( (empty?  wd)   "")
	      (#t (word (trans  pairs (first  wd)) (transform pairs (bf wd) )))
	)
 )


(define  (trans  pairs  lett)            ; change a letter into a digit        

	(define  par  (assoc  lett  pairs) )

	(cadr  par) 
 )


(define (qsort l)          ; to sort the final list of values (pairs)
 
       (cond  ((<= (count l) 1) l)
              ( (let ((pivot (caar l)))
                  (define les (keep (lambda (x) (before? (car x) pivot) ) l) )
                  (define mor (keep (lambda (x) (not (before? (car x) pivot)) )
								 (bf l)) )
                  (append  (qsort les) (list (car l)) (qsort mor) )
                )
              )
        )
)


(define (remove-dup  l)      ; rempve duplicates

     (if (empty? l) l
     (append (list (car l)) (remove-dup (remove (car l) l) )  )
     )
)