Alchemical Reduction

September 10, 2019

This task was solved in a blog entry by Philippe Gaultier, who explains that he started learning Scheme very recently. He gives this solution, using Chicken Scheme:

(import matchable

(define (char-case-opposite-casing? a b)
  (let* ((a-code (char->integer a))
         (b-code (char->integer b))
         (diff (- a-code b-code)))
    (= (* 32 32) (* diff diff))))

(define (chem-react acc x)
  (match acc
    [() (cons x acc)]
    [(a . arest) (if (char-case-opposite-casing? a x)
                     (cons x acc))]))

(->> (open-input-file "/Users/pgaultier/Downloads/aoc5.txt")
     (foldl chem-react '())

Perhaps Gaultier’s purpose was to learn about pattern matching or explore the Chicken ecosystem, but he took a simple task and made it complicated. Here is my solution:

(define (chem str)
  (let loop ((cs (string->list str)) (zs (list)))
    (cond ((null? cs) (reverse zs))
          ((null? zs) (loop (cdr cs) (cons (car cs) zs)))
          ((and (char-ci=? (car cs) (car zs))
                (not (char=? (car cs) (car zs))))
            (loop (cdr cs) (cdr zs)))
          (else (loop (cdr cs) (cons (car cs) zs))))))

> (do ((str (read) (read))) ((eof-object? str))
    (display (length (chem str))) (newline))

With respect to Gaultier, I prefer my solution, which is written in standard RnRS and requires no imports. The do loop is a common idiom, and to my mind is easier to read than the “easy-to-read” ->> macro; quickly, why is the null list passed to chem-react in the call to foldl? (It’s the initialization of acc, which forces acc to an unnatural position as the first parameter rather than the second parameter.) And despite Gaultier’s claim, character comparisons are better than integer-to-character conversions.

You can run the program at


Pages: 1 2

6 Responses to “Alchemical Reduction”

  1. Zack said

    Nifty little exercise. Not sure if it qualifies as alchemy, but it’s definitely a nice challenge. Here is my take using Julia 1.1:

  2. Zack said

    There was a bug in my previous attempt (a cool exercise in itself!) so here is the refined code:

  3. chaw said

    Here’s a simple solution in R7RS Scheme, focusing on clarity. The
    imports are all trivial.

    (import (scheme base)
            (scheme write)
            (only (scheme char)
    (define (alchemical-reduction str)
      (let loop ((unseen (string->list str))
                 (seen '()))
        (if (null? unseen)
            (apply string (reverse seen))
            (loop (cdr unseen)
                  (if (and (pair? seen)
                           (pair? unseen)
                           (and (char-ci=? (car seen)
                                           (car unseen))
                                (not (char=? (car seen)
                                             (car unseen)))))
                      (cdr seen)
                      (cons (car unseen) seen))))))
    (display (alchemical-reduction "dabAcCaCBAcCcaDA"))


  4. Graham said

    My Haskell solution relies mostly on a single



    module Main where
    import Data.Char (isLetter, toLower)
    react :: String -> String
    react = foldr step ""
      step x (y : ys) | x /= y && toLower x == toLower y = ys
      step x ys       = x : ys
    part1 :: String -> Int
    part1 = length . react
    part2 :: String -> Int
    part2 s = minimum $ fmap (length . react . remove) ['a' .. 'z']
      where remove c = filter ((/= c) . toLower) (react s) -- save recomputation
    main :: IO ()
    main = do
      input <- filter isLetter <$> readFile "input"
      print . part1 $ input
      print . part2 $ input

    Regarding blog posts, I really like the elegance of this one, which shows this is just an exercise in group theory.

  5. matthew said

    Here’s a little C++ solution, doing in-place modification of a 0-terminated char array.

    #include <stdio.h>
    #include <string.h>
    char *transform(char *s) {
      int n = strlen(s);
      for (int i = 1, j = 1; i <= n; i++) {
        if (j && (s[i]^s[j-1]) == 0x20) j--;
        else s[j++] = s[i];
      return s;
    int main(int argc, char *argv[]) {
      printf("%s\n", transform(argv[1]));

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: