alchemical reduction


Write a function that accepts a string and returns a copy of the string in which all adjacent pairs of the same letter of opposite case (e.g., "aA" or "Mm") have been removed.

 $ cat ar.rkt 
 #lang racket 
  
 (define (reducible? ch1 ch2) 
  
   ; Return true iff the given characters are the same letter 
   ; of opposite case. 
    
   (and (char-ci=? ch1 ch2) 
        (xor (char-lower-case? ch1) 
             (char-lower-case? ch2)))) 
  
    
 (define (ar-r polymer) 
  
   ; Return the given string (repeatedly) stripped of all 
   ; adjacent same letters of opposite case. 
  
   (define (reduce prefix suffix) 
     (if (null? suffix) 
       (reverse prefix) 
       (let 
  
         ((phd (car prefix)) 
          (shd (car suffix)) 
          (suffix (cdr suffix))) 
  
         (if (reducible? phd shd) 
           (reduce (cdr prefix) suffix) 
           (reduce (cons shd prefix) suffix))))) 
  
  
   (list->string (cdr (reduce '(#\$) (string->list polymer))))) 
  
  
 (define (ar-f polymer) 
  
   ; Return the given string (repeatedly) stripped of all 
   ; adjacent same letters of opposite case. 
  
   (list->string (cdr (reverse 
     (foldl (lambda (ch prefix) 
              (if (reducible? (car prefix) ch) 
                (cdr prefix) 
                (cons ch prefix))) 
            '(#\$) 
            (string->list polymer)))))) 
  
  
 (require rackunit "utl.rkt") 
  
 (define (chk f s1 s2) 
   (check-equal? (f s1) s2)) 
  
 (define (chk-it f) 
   (chk f "" "") 
   (chk f "a" "a") 
   (chk f "aA" "") 
   (chk f "abB" "a") 
   (chk f "abBA" "") 
   (chk f "abAB" "abAB") 
   (chk f "abAAB" "abAAB") 
   (chk f "dabAcCaCBAcCcaDA" "dabCBAcaDA")) 
  
 (chk-it ar-r) 
 (chk-it ar-f) 
  
 (define (check-em str) 
   (call-with-string-permutations str 
     (lambda (str) 
       (check-equal? (ar-r str) (ar-f str))))) 
  
 (check-em "aAbBcC") 
 (check-em "aAbBcCd") 
  
 $ racket ar.rkt 
  
 $