example problem file

database.rkt

@@ -49,7 +49,7 @@
 (define (string->classname s) (string->symbol s))
 
 (define (normalize-name s)
-  (let* ([s (regexp-replace* #px"[-_ ]" s "_")]
+  (let* ([s (regexp-replace* #px"[-_ ]" s "")]
          [s (regexp-replace #px"\u2082" s "2")]
          [s (regexp-replace #px"\u2122" s "")])
     (string-downcase s)))
@@ -104,19 +104,21 @@
     (define raw-data (match v [(list x) x] [_ (fail)]))
     (define classname (string->classname (hash-ref raw-data 'className fail)))
     (define building
-      (match (hash-ref raw-data 'producedIn #f)
+      (match (hash-ref raw-data 'producedIn '())
         [(list cn) (string->classname cn)]
-        [_ (fail)]))
+        [_ #f]))
     (define duration
       (number->exact (hash-ref raw-data 'duration fail)))
     (define ratios
-      (for/hasheq ([m (in-list '(-1 +1))]
+      (for/hasheq ([k (in-list '(ingredients products))]
-                   [k (in-list '(ingredients products))]
+                   [d (in-list (if (zero? duration)
+                                   '(-1 +1)
+                                   (list (- duration) duration)))]
                    #:do [(define vs (hash-ref raw-data k '()))]
                    [v (in-list vs)])
         (define cn (string->classname (hash-ref v 'item fail)))
         (define amt (number->exact (hash-ref v 'amount fail)))
-        (values cn (/ (* m amt) duration))))
+        (values cn (/ amt d))))
     (recipe-info raw-data
                  classname
                  building
@@ -252,8 +254,8 @@
 ;; item database
 
 (struct item-database
-  [classname->
+  [classname=>
-   name->])
+   name=>])
 
 (define (list->item-database items)
   (item-database
@@ -270,15 +272,15 @@
      i)))
 
 (define (item-database-count db)
-  (hash-count (item-database-classname-> db)))
+  (hash-count (item-database-classname=> db)))
 
 (define current-item-database
   (make-parameter (list->item-database '())))
 
 (define (query-item name [db (current-item-database)])
   (if (string? name)
-      (hash-ref (item-database-name-> db) (normalize-name name) #f)
+      (hash-ref (item-database-name=> db) (normalize-name name) #f)
-      (hash-ref (item-database-classname-> db) name #f)))
+      (hash-ref (item-database-classname=> db) name #f)))
 
 (module+ test
   (define example-items-data
@@ -359,17 +361,15 @@
 
   (check-false (item-info-liquid? iron-ingot))
   (check-false (item-info-liquid? screws))
-  (check-true  (item-info-liquid? water))
+  (check-true  (item-info-liquid? water)))
-
-  )
 
 ;; -------------------------------------
 ;; recipe database
 
 (struct recipe-database
-  [classname->
+  [classname=>
-   name->
+   name=>
-   item->*])
+   item=>*])
 
 (define (list->recipe-database recipes)
   (recipe-database
@@ -393,20 +393,20 @@
      r)))
 
 (define (recipe-database-count db)
-  (hash-count (recipe-database-classname-> db)))
+  (hash-count (recipe-database-classname=> db)))
 
 (define current-recipe-database
   (make-parameter (list->recipe-database '())))
 
 (define (query-recipe name [db (current-recipe-database)])
   (if (string? name)
-      (hash-ref (recipe-database-name-> db) (normalize-name name) #f)
+      (hash-ref (recipe-database-name=> db) (normalize-name name) #f)
-      (hash-ref (recipe-database-classname-> db) name #f)))
+      (hash-ref (recipe-database-classname=> db) name #f)))
 
 (define (query-recipes/item item
                             [db (current-recipe-database)]
                             [idb (current-item-database)])
-  (hash-ref (recipe-database-item->* db)
+  (hash-ref (recipe-database-item=>* db)
             (cond
               [(symbol? item) item]
               [(item-info? item) (item-info-classname item)]
@@ -420,6 +420,7 @@
   (check-equal? (normalize-name "Iron Plate") (normalize-name "iron-plate"))
   (check-equal? (normalize-name "Iron Ingot") (normalize-name "IRON_INGOT"))
   (check-equal? (normalize-name "Reinforced Iron Plate") (normalize-name "reinforced iron plate"))
+  (check-equal? (normalize-name "Reinforced Iron Plate") (normalize-name "reinforcedironplate"))
 
   (define rdb (make-recipe-database example-recipes-data))
 
@@ -445,6 +446,4 @@
     (check-not-false (member recipe-cast-screws zs))
 
     (check-equal? (query-recipes/item "iron ingot" rdb idb) (query-recipes/item iron-ingot rdb idb))
-    (check-equal? (query-recipes/item "reinforced iron plate" rdb idb) '())
+    (check-equal? (query-recipes/item "reinforced iron plate" rdb idb) '())))
-
-    ))

main.rkt

@@ -4,23 +4,33 @@
  racket/match
  racket/logging
  racket/date
+ racket/format
+ racket/list
 
  "./logging.rkt"
  "./scrape.rkt"
  "./database.rkt"
+ "./sle.rkt"
 
  (rename-in "./logging.rkt"
             [log-calc-info INFO]
-            [log-calc-debug DEBUG])
+            [log-calc-debug DEBUG]))
- )
 
 ;; -----------------------------------------------------------------------------
 
 (define (item-filter* i)
-  (not (memq (item-info-classname i) '(Desc_SpikedRebar_C))))
+  (not (memq (item-info-classname i)
+             '(; ammo
+               Desc_SpikedRebar_C
+               Desc_NobeliskExplosive_C
+               ; biomass
+               Desc_Biofuel_C
+               Desc_GenericBiomass_C
+               Desc_Wood_C))))
 
 (define (recipe-filter* r)
-  (and (not (recipe-info-alternate? r))
+  (and (recipe-info-building r)
+       (not (recipe-info-alternate? r))
        (for/and ([i (in-hash-keys (recipe-info-ratios r))])
          (query-item i))))
 
@@ -34,32 +44,175 @@
   ;(unless allow? (DEBUG "recipe filtered out: ~s" (recipe-info-name i)))
   allow?)
 
+(define input-file-path (make-parameter "problem.rktd"))
+(define print-dot? (make-parameter #f))
+
 (define (main)
+  (define problem (with-input-from-file (input-file-path) simple-read-and-eval))
+  (define inputs (hash-ref problem 'inputs '()))
+  (define outputs (hash-ref problem 'outputs hasheq))
+  (define recipes (hash-ref problem 'recipes '()))
+  (define period (hash-ref problem 'period 60))
+
+  (DEBUG "inputs: ~s" inputs)
+  (DEBUG "outputs: ~s" outputs)
+  (DEBUG "recipes: ~s" recipes)
+  (DEBUG "period: ~as" period)
+
   (current-item-database
    (make-item-database
     (get-items-data)
     #:filter item-filter))
 
+  (DEBUG "loaded ~a items" (item-database-count (current-item-database)))
+
   (current-recipe-database
    (make-recipe-database
     (get-recipes-data)
     #:filter recipe-filter))
 
-  (define i (query-item "iron rod"))
+  (DEBUG "loaded ~a recipes" (recipe-database-count (current-recipe-database)))
-  (INFO "Recipes using ~s:" (item-info-name i))
+
-  (for ([r (in-list (query-recipes/item i))])
+  (define item=>lhs (make-hasheq))
-    (INFO "* ~s" (recipe-info-name r)))
+  (define item=>rhs (make-hasheq))
+
+  (for ([r-name (in-list recipes)])
+    (define r-info (query-recipe r-name))
+    (define r-cn (recipe-info-classname r-info))
+    (DEBUG "begin recipe: ~s (~a)" (recipe-info-name r-info) r-cn)
+    (for ([(i-cn ratio) (in-hash (recipe-info-ratios r-info))])
+      (define (add e) (lexpr+ e (lexpr* ratio (symbol->lexpr r-cn))))
+      (hash-update! item=>lhs i-cn add (lexpr 0))))
+
+  (for ([name (in-list inputs)])
+    (define info (query-item name))
+    (define cn (item-info-classname info))
+    (DEBUG "init input: ~s (~a)" (item-info-name info) cn)
+    (hash-set! item=>rhs cn (symbol->lexpr cn)))
+
+  (for ([(name qty) (in-hash outputs)])
+    (define info (query-item name))
+    (define cn (item-info-classname info))
+    (DEBUG "init output: ~s (~a)" (item-info-name info) qty)
+    (hash-set! item=>rhs cn (number->lexpr (/ qty period))))
+
+  (define sle (make-sle))
+  (for ([cn (in-hash-keys item=>lhs)])
+    (define lhs (hash-ref item=>lhs cn))
+    (define rhs (hash-ref item=>rhs cn (lexpr 0)))
+    (sle-equal! sle lhs rhs))
+
+  (define (format-amt x) (~r x #:sign '++ #:precision 2))
+  (define (format-qty n) (string-append (~r n #:precision 2) "x"))
+
+  (define (item-amt-string i)
+    (define cn (item-info-classname i))
+    (define value (lexpr* period (sle-simpl sle (hash-ref item=>lhs cn))))
+    (parameterize ([current-lexpr-number->string format-amt])
+      (lexpr->string value)))
+
+  (define (recipe-qty-string r)
+    (define cn (recipe-info-classname r))
+    (define value (sle-simpl sle (lexpr cn)))
+    (parameterize ([current-lexpr-number->string format-qty])
+      (lexpr->string value)))
+
+  (INFO "Net items:")
+  (let ([items (sort (map query-item (hash-keys item=>lhs))
+                     string<? #:key item-info-name)])
+    (for ([info (in-list items)])
+      (INFO "~a ~s"
+            (~a (item-amt-string info) #:min-width 5 #:align 'right)
+            (item-info-name info))))
+
+  (INFO "Recipes:")
+  (for ([name (in-list recipes)])
+    (define info (query-recipe name))
+    (INFO "~a ~s"
+          (~a (recipe-qty-string info) #:min-width 5 #:align 'right)
+          (recipe-info-name info)))
+
+  (when (print-dot?)
+    (DEBUG "generating DOT graph")
+    (let ([recipes (map query-recipe recipes)]
+          [inputs (map query-item inputs)]
+          [outputs (map query-item (hash-keys outputs))])
+      (define item=>recipes (make-hasheq))
+
+      (for* ([r (in-list recipes)]
+             [i-cn (in-hash-keys (recipe-info-ratios r))])
+        (define (add rs) (cons r rs))
+        (hash-update! item=>recipes i-cn add '()))
+
+      (printf "digraph {\n")
+
+      (for ([i (in-list (append inputs outputs))])
+        (define i-cn (item-info-classname i))
+        (define label (format "~a\n~a" (item-info-name i) (item-amt-string i)))
+        (printf "~a [" i-cn)
+        (printf "label=~s" label)
+        (printf "];\n"))
+
+      (for ([r (in-list recipes)])
+        (define r-cn (recipe-info-classname r))
+        (define label (format "~a\n~a" (recipe-info-name r) (recipe-qty-string r)))
+        (printf "~a [" r-cn)
+        (printf "shape=box,label=~s" label)
+        (printf "];\n"))
+
+      (for* ([(i-cn rs) (in-hash item=>recipes)]
+             [r12 (in-combinations rs 2)]
+             #:do [(define r1 (car r12))
+                   (define r2 (cadr r12))
+                   (define v1 (hash-ref (recipe-info-ratios r1) i-cn))
+                   (define v2 (hash-ref (recipe-info-ratios r2) i-cn))]
+             ; signs differ
+             #:when (negative? (* v1 v2)))
+        (define cn1 (recipe-info-classname r1))
+        (define cn2 (recipe-info-classname r2))
+        (if (negative? v1)
+            ; r1 is sink, r2 is source
+            (printf "~a -> ~a;\n" cn2 cn1)
+            ; r1 is source, r2 is sink
+            (printf "~a -> ~a;\n" cn1 cn2)))
+
+      (for* ([i (in-list (append inputs outputs))]
+             #:do [(define i-cn (item-info-classname i))]
+             [r (in-list (hash-ref item=>recipes i-cn '()))])
+        (define r-cn (recipe-info-classname r))
+        (define v (hash-ref (recipe-info-ratios r) i-cn))
+        (if (negative? v)
+            (printf "~a -> ~a;\n" i-cn r-cn)
+            (printf "~a -> ~a;\n" r-cn i-cn)))
+
+      (printf "}\n")))
 
   (void))
 
+(define (simple-read-and-eval [port (current-input-port)])
+  (define/match (val e)
+    [{`(list . ,es)} (map val es)]
+    [{`(hash . ,es)} (apply hash (map val es))]
+    [{`(quote ,v)} v]
+    [{(or (? string?) (? number?))} e]
+    [{_} (error "syntax error: invalid expression\n  at: ~s" e)])
+  (for/fold ([scope (hasheq)]) ([d (in-port read port)])
+    (match d
+      [`(define ,x ,e) (hash-set scope x (val e))]
+      [_ (error "syntax error: invalid definition\n  at: ~s" d)])))
+
 ;; =====================================
 
 (module+ main
+  (require racket/cmdline)
+
+  (define verbose (make-parameter 0))
+
   (define (time-string)
     (parameterize ([date-display-format 'iso-8601])
       (date->string (current-date) #t)))
 
-  (define (on-log v)
+  (define (print-log v)
     (match-define (vector lvl msg _ _) v)
     (eprintf "~a ~a~a\n"
              (time-string)
@@ -71,8 +224,22 @@
                [_ ""])
              msg))
 
+  (command-line
+   #:multi
+   [("-v" "--verbose")
+    "Verbose log messages"
+    (verbose (add1 (verbose)))]
+   #:once-each
+   [("--dot")
+    "Print DOT graph"
+    (print-dot? #t)]
+   #:args ([infile (input-file-path)]) (input-file-path infile))
+
   (with-intercepted-logging
-    on-log
+    print-log
     main
-    'debug
+    (cond
+      [(= (verbose) 2) 'debug]
+      [(= (verbose) 1) 'info]
+      [else 'warning])
     #:logger calc-logger))

problem.rktd

@@ -0,0 +1,19 @@
+(define recipes
+  (list "supercomputer"
+        "computer"
+        "circuit board"
+        "ai limiter"
+        "high-speed connector"))
+
+(define inputs
+  (list "plastic"
+        "cable"
+        "quickwire"
+        "copper sheet"))
+
+(define outputs
+  (hash "supercomputer" 1
+        ;"computer" 4
+        ;"circuit board" 10
+        ;"high-speed connector" 1
+        ))

sle.rkt

@@ -0,0 +1,407 @@
+#lang racket/base
+
+(provide
+ lexpr?
+ number->lexpr
+ symbol->lexpr
+ lexpr
+ lexpr+
+ lexpr-
+ lexpr*
+
+ sle?
+ make-sle
+ sle-simpl
+ sle-set!
+ sle-zero!
+ sle-equal!
+
+ exn:sle?
+ exn:sle:contradiction?
+
+ pretty-print-lexpr lexpr->string
+ pretty-print-sle sle->string
+ current-lexpr-number->string
+ current-lexpr-symbol->string)
+
+(require
+ (only-in racket/list partition))
+
+(module+ test
+  (require rackunit))
+
+;; -----------------------------------------------------------------------------
+;; assoc list utils
+
+(define (find-assoc-index x xs)
+  (let loop ([i 0] [xs xs])
+    (cond
+      [(null? xs) #f]
+      [(eq? (caar xs) x) i]
+      [else (loop (add1 i) (cdr xs))])))
+
+(define (reverse-append xs ys)
+  (cond
+    [(null? xs) ys]
+    [else (reverse-append (cdr xs) (cons (car xs) ys))]))
+
+(define (remove-assoc-at i xs)
+  (let loop ([i i] [xs xs] [ys '()])
+    (cond
+      [(zero? i) (values (cdar xs)
+                         (reverse-append ys (cdr xs)))]
+      [else (loop (sub1 i)
+                  (cdr xs)
+                  (cons (car xs) ys))])))
+
+;; -----------------------------------------------------------------------------
+;; linear expressions e.g. "ax + by + c"
+
+(define zero '())
+(define constant '||)
+
+; '([x1 . a1] [x2 . a2] … [|| . c]) == "(a1 * x1) + (a2 * x2) + … + c"
+(define (lexpr? x)
+  (and (list? x)
+       (andmap (λ (t) (and (pair? t)
+                           (symbol? (car t))
+                           (number? (cdr t))))
+               x)))
+
+(define (number->lexpr c)
+  (if (zero? c) zero (list (cons constant c))))
+
+(define (symbol->lexpr x)
+  (when (eq? x constant)
+    (error "cannot use that symbol"))
+  (list (cons x 1)))
+
+; a * X (unchecked)
+(define (mul a X)
+  (map (λ (x) (cons (car x) (* a (cdr x)))) X))
+
+; X + a * Y (unchecked)
+(define (add-mul X a Y)
+  ; does a full join, like in 'merge'. constant is always the last symbol
+  (cond
+    [(null? X) (mul a Y)]
+    [(null? Y) X]
+    [(symbol<? (caar Y) (caar X))
+     (cons (car X) (add-mul (cdr X) a Y))]
+    [(symbol<? (caar X) (caar Y))
+     (cons (cons (caar Y) (* a (cdar Y))) (add-mul X a (cdr Y)))]
+    [else ; (= (caar X) (caar Y))
+     (define x (caar X))
+     (define c (+ (cdar X) (* a (cdar Y))))
+     (if (zero? c)
+         (add-mul (cdr X) a (cdr Y))
+         (cons (cons x c) (add-mul (cdr X) a (cdr Y))))]))
+
+; X + Y
+(define (add X Y)
+  (add-mul X 1 Y))
+
+; Y - X
+(define (sub X Y)
+  (add-mul Y -1 X))
+
+; a * X
+(define (lexpr* a X)
+  (if (zero? a)
+      zero
+      (mul a X)))
+
+; X + Y + …
+(define lexpr+
+  (case-lambda
+    [() zero]
+    [(X) X]
+    [(X Y) (add X Y)]
+    [(X . Ys) (foldl add X Ys)]))
+
+; X - Y - …, or -X for a single argument
+(define lexpr-
+  (case-lambda
+    [(X) (mul -1 X)]
+    [(X Y) (sub Y X)]
+    [(X . Ys) (foldl sub X Ys)]))
+
+; (lexpr) = "0"
+; (lexpr a) = "a"  where (number? a)
+; (lexpr x) = "x"  where (symbol? x)
+; (lexpr a x) = "a*x"
+; (lexpr a1 x1 a2 x2 …) = "a1*x1 + a2*x2 + …"
+; (lexpr a1 x1 a2 x2 … c) = "a1*x1 + a2*x2 + … + c"
+(define lexpr
+  (case-lambda
+    [() zero]
+    [(v) (cond [(symbol? v) (symbol->lexpr v)]
+               [(number? v) (number->lexpr v)]
+               [else (raise-argument-error 'lexpr "lexpr/c" v)])]
+    [(a x) (lexpr* a (symbol->lexpr x))]
+    [(a x . vs) (lexpr+ (lexpr a x) (apply lexpr vs))]))
+
+;; -----------------------------------------------------------------------------
+;; system of linear equations
+
+(struct exn:sle exn:fail [] #:transparent)
+(struct exn:sle:contradiction exn:sle [] #:transparent)
+
+(define (raise-sle-contradiction who)
+  (raise (exn:sle:contradiction (format "~a: contradiction" who)
+                                (current-continuation-marks))))
+
+(struct sle [vars])
+
+(define (make-sle)
+  (sle (make-hasheq)))
+
+(define (sle-copy s)
+  (sle (hash-copy (sle-vars s) values)))
+
+(define (sle-bound-vars s)
+  (hash-keys (sle-vars s)))
+
+(define (sle-free-vars s)
+  (hash-keys
+   (for*/hasheq ([A (in-hash-values (sle-vars s))]
+                 [a (in-list A)]
+                 #:do [(define x (car a))]
+                 #:unless (eq? x constant))
+     (values x #t))))
+
+(define (sle-simpl s A)
+  (define vars (sle-vars s))
+  ; A = B + C, where variables in B can be substituted, C cannot
+  (define (known? a) (hash-has-key? vars (car a)))
+  (define-values [B C] (partition known? A))
+  (for/fold ([C C]) ([b (in-list B)])
+    ; x := b1 x1 + b2 x2 + … + b
+    ; C  = c1 x1 + c2 x2 + … + c
+    ; ---
+    ; C + a x = (c1 + a b1) x1 + (c2 + a b2) x2 + … + (c + a b)
+    (add-mul C (cdr b) (hash-ref vars (car b)))))
+
+; sets x := C
+(define (sle-set! s x A)
+  (sle-set!* s x (sle-simpl s A)))
+
+(define (sle-set!* s x B)
+  (define vars (sle-vars s))
+  (hash-set! vars x B)
+  (for ([(y A) (in-hash vars)])
+    (define i (find-assoc-index x A))
+    (when i
+      ; y = a x + A' := A' + a B
+      (define-values [a A*] (remove-assoc-at i A))
+      (hash-set! vars y (add-mul A* a B)))))
+
+; solves A == B
+(define (sle-equal! s A B)
+  (sle-zero!* 'sle-equal! s (sub (sle-simpl s A)
+                                 (sle-simpl s B))))
+
+; solves C == 0
+(define (sle-zero! s C)
+  (sle-zero!* 'se-zero! s (sle-simpl s C)))
+
+(define (sle-zero!* who s C)
+  (cond
+    ; 0 == 0
+    [(null? C) (void)]
+    ; c /= 0
+    [(eq? (caar C) constant)
+     (raise-sle-contradiction who)]
+    [else
+     ; a x + C' == 0
+     ; ---
+     ; x := (-1/a) C'
+     (define x (caar C))
+     (define a (cdar C))
+     (sle-set!* s x (mul (/ -1 a) (cdr C)))]))
+
+;; -----------------------------------------------------------------------------
+;; pretty printing
+
+(define current-lexpr-symbol->string (make-parameter symbol->string))
+(define current-lexpr-number->string (make-parameter number->string))
+
+(define (pretty-print-lexpr A [port (current-output-port)])
+  (define var->str (current-lexpr-symbol->string))
+  (define num->str (current-lexpr-number->string))
+  (when (null? A)
+    (write-string (num->str 0) port))
+  (for ([a (in-list A)]
+        [i (in-naturals)]
+        #:do [(define first? (zero? i))])
+    (cond
+      ; c
+      [(and first? (eq? (car a) constant))
+       (write-string (num->str (cdr a)) port)]
+      ; -x
+      [(and first? (= (cdr a) -1))
+       (write-string "-" port) (write-string (var->str (car a)) port)]
+      ; x
+      [(and first? (= (cdr a) 1))
+       (write-string (var->str (car a)) port)]
+      ; c x
+      [first?
+       (write-string (num->str (cdr a)) port)
+       (write-string " " port) (write-string (var->str (car a)) port)]
+      ; A - c
+      [(and (eq? (car a) constant) (negative? (cdr a)))
+       (write-string " - " port) (write-string (num->str (- (cdr a))) port)]
+      ; A + c
+      [(eq? (car a) constant)
+       (write-string " + " port) (write-string (num->str (cdr a)) port)]
+      ; A - x
+      [(= (cdr a) -1)
+       (write-string " - " port) (write-string (var->str (car a)) port)]
+      ; A + x
+      [(= (cdr a) 1)
+       (write-string " + " port) (write-string (var->str (car a)) port)]
+      ; A - c x
+      [(negative? (cdr a))
+       (write-string " - " port) (write-string (num->str (- (cdr a))) port)
+       (write-string " " port) (write-string (var->str (car a)) port)]
+      ; A + c x
+      [else
+       (write-string " + " port) (write-string (num->str (cdr a)) port)
+       (write-string " " port) (write-string (var->str (car a)) port)])))
+
+(define (pretty-print-sle s [port (current-output-port)])
+  (define var->str (current-lexpr-symbol->string))
+  (define (pretty-print-vars xs)
+    (for/fold ([start "{"]
+               [end "{}"]
+               #:result (write-string end port))
+              ([x (in-list xs)])
+      (write-string start port)
+      (write-string (var->str x) port)
+      (values ", " "}")))
+  (define bvs (sort (sle-bound-vars s) symbol<?))
+  (define fvs (sort (sle-free-vars s) symbol<?))
+  (write-string "bound vars: " port) (pretty-print-vars bvs)
+  (newline port)
+  (write-string "free vars: " port) (pretty-print-vars fvs)
+  (newline port)
+  (for ([x (in-list bvs)])
+    (define A (hash-ref (sle-vars s) x))
+    (write-string (var->str x) port)
+    (write-string " = " port)
+    (pretty-print-lexpr A port)
+    (newline port)))
+
+(define (lexpr->string A)
+  (define port (open-output-string))
+  (pretty-print-lexpr A port)
+  (get-output-string port))
+
+(define (sle->string A)
+  (define port (open-output-string))
+  (pretty-print-sle A port)
+  (get-output-string port))
+
+;; =============================================================================
+
+(module+ test
+  (check-equal? (find-assoc-index 'x '([a 0] [b 1] [c 2] [x 3] [d 4] [e 5])) 3)
+  (check-equal? (find-assoc-index 'y '([a 0] [b 1] [c 2] [x 3] [d 4] [e 5])) #f)
+  (let-values ([[x xs] (remove-assoc-at 3 '([a 0] [b 1] [c 2] [x 3] [d 4] [e 5]))])
+    (check-equal? x '[3])
+    (check-equal? xs '([a 0] [b 1] [c 2] [d 4] [e 5])))
+
+  ;; ---
+
+  (define x (symbol->lexpr 'x))
+  (define y (symbol->lexpr 'y))
+  (check-false (equal? x y))
+
+  (check-equal? (lexpr 'x) x)
+  (check-equal? (lexpr 'y) y)
+  (check-equal? (lexpr) zero)
+  (check-equal? (lexpr 0) zero)
+  (check-equal? (lexpr 2) (number->lexpr 2))
+  (check-equal? (lexpr 2 'x) (lexpr* 2 x))
+
+  (check-equal? (lexpr+ (lexpr 2) (lexpr 3)) (lexpr 5))
+  (check-equal? (lexpr- (lexpr 2) (lexpr 3)) (lexpr -1))
+  (check-equal? (lexpr+ (lexpr 2) (lexpr 3) (lexpr -8)) (lexpr (+ 2 3 -8)))
+  (check-equal? (lexpr- (lexpr 2) (lexpr 3) (lexpr -8)) (lexpr (- 2 3 -8)))
+  (check-equal? (lexpr* 4 (lexpr 3)) (lexpr 12))
+
+  (check-equal? (lexpr+ x y) (lexpr+ y x))
+  (check-equal? (lexpr- x x) (lexpr 0))
+  (check-equal? (lexpr* 3 (lexpr* 4 x)) (lexpr* 12 x))
+  (check-equal? (lexpr* 1 x) x)
+  (check-equal? (lexpr* 0 x) (lexpr 0))
+
+  ;; ---
+
+  (check-equal? (lexpr->string (lexpr 2)) "2")
+  (check-equal? (lexpr->string (lexpr -2)) "-2")
+  (check-equal? (lexpr->string (lexpr)) "0")
+  (check-equal? (lexpr->string (lexpr 1)) "1")
+  (check-equal? (lexpr->string (lexpr -1)) "-1")
+  (check-equal? (lexpr->string (lexpr 2 'x)) "2 x")
+  (check-equal? (lexpr->string (lexpr -2 'x)) "-2 x")
+  (check-equal? (lexpr->string (lexpr 'x)) "x")
+  (check-equal? (lexpr->string (lexpr -1 'x)) "-x")
+  (check-equal? (lexpr->string (lexpr 3 'x 2)) "3 x + 2")
+  (check-equal? (lexpr->string (lexpr 3 'x -2)) "3 x - 2")
+  (check-equal? (lexpr->string (lexpr 3 'x 1)) "3 x + 1")
+  (check-equal? (lexpr->string (lexpr 3 'x -1)) "3 x - 1")
+  (check-equal? (lexpr->string (lexpr 3 'x 2 'w)) "3 x + 2 w")
+  (check-equal? (lexpr->string (lexpr 3 'x -2 'w)) "3 x - 2 w")
+  (check-equal? (lexpr->string (lexpr 3 'x 1 'w)) "3 x + w")
+  (check-equal? (lexpr->string (lexpr 3 'x -1 'w)) "3 x - w")
+  (check-equal? (lexpr->string (lexpr 3 'x 2 'w 4)) "3 x + 2 w + 4")
+  (check-equal? (lexpr->string (lexpr 3 'x -2 'w 4)) "3 x - 2 w + 4")
+  (check-equal? (lexpr->string (lexpr 3 'x 1 'w -4)) "3 x + w - 4")
+  (check-equal? (lexpr->string (lexpr 3 'x -1 'w -4)) "3 x - w - 4")
+
+  ;; ---
+
+  (define (check-contradiction s A [B (lexpr)])
+    (check-exn exn:sle:contradiction? (λ () (sle-equal! s A B))))
+
+  (let ([s (make-sle)])
+    (check-equal? (sle-simpl s (lexpr 1 'a 2 'b)) (lexpr 1 'a 2 'b))
+    (check-equal? (sle-bound-vars s) '())
+    (check-equal? (sle-free-vars s) '())
+    ; a := 4x - y + 3
+    (sle-set! s 'a (lexpr 4 'x -1 'y 3))
+    (check-equal? (sle-simpl s (lexpr   'a)) (lexpr 4 'x -1 'y 3))
+    (check-equal? (sle-simpl s (lexpr 2 'a)) (lexpr 8 'x -2 'y 6))
+    ; b := 2x + z + 1
+    (sle-set! s 'b (lexpr 2 'x 1 'z 1))
+    (check-equal? (sle-simpl s (lexpr 'b)) (lexpr 2 'x  1 'z  1))
+    ; ex: a - 2b + 3c = -y - 2z + 3c + 1
+    (check-equal? (sle-simpl s (lexpr 1 'a -2 'b 3 'c))
+                  (lexpr -1 'y -2 'z 3 'c 1))
+
+    (check-equal?
+     (sle->string s)
+     (string-append "bound vars: {a, b}\n"
+                    "free vars: {x, y, z}\n"
+                    "a = -y + 4 x + 3\n"
+                    "b = z + 2 x + 1\n"))
+
+    ; a == b
+    (sle-equal! s (lexpr 'a) (lexpr 'b))
+    (check-equal? (length (sle-bound-vars s)) 3)
+    (check-equal? (length (sle-free-vars s)) 2)
+    ; (4x - y + 3) = (2x + z + 1)
+    ; 2x - y - z + 2 = 0
+    ; y = 2x - z + 2
+    (check-equal? (sle-simpl s (lexpr 'y))
+                  (sle-simpl s (lexpr 2 'x -1 'z 2))))
+
+  (let ([s (make-sle)])
+    (sle-equal! s (lexpr 0) (lexpr 0))
+    ; 1 /= 2
+    (check-contradiction s (lexpr 1) (lexpr 2))
+    ; x = -x => x = 0
+    (sle-equal! s (lexpr 'x) (lexpr -1 'x))
+    ; x /= 1
+    (check-contradiction s (lexpr 'x) (lexpr 1))))