Reasoned Schemer (92) 符号付き

符号付きの数を作ってそれ用の足し算を作る話
1周目に脳内で書いたコードはカッコの対応がついてないところだらけ
あとdiff-sign-sumoで答えが0になるときの対応が抜けてることに気づいた

でこんな感じ

(defrel (sumo n m k)
  (conde
    ((== '() n) (== m k))
    ((== '() m) (pairo n) (== n k))
    ((fresh (ns nn ms mn)
       (== `(,ns . ,nn) n)
       (== `(,ms . ,mn) m)
       (gen-sumo ns nn ms mn k)))))

(defrel (gen-sumo ns nn ms mn k)
  (conde
    ((== ns ms) (fresh (res)
                  (+o nn mn res)
                  (== `(,ns . ,res) k)))
    ((== ns 0) (== ms 1) (diff-sign-sumo ns nn ms mn k))
    ((== ns 1) (== ms 0) (diff-sign-sumo ns nn ms mn k))))

(defrel (diff-sign-sumo ns nn ms mn k)
  (fresh (res)
    (conde
      ((== nn mn) (== '() k))
      ((-o nn mn res) (poso res) (== `(,ns . ,res) k))
      ((-o mn nn res) (poso res) (== `(,ms . ,res) k)))))

どうかなあ
だいたいできてる気もするんだけど、想定外の動きするときあるし
いろんなケースを網羅したテストも書ける気がしないので力技でテストすることに

まず便利ツール

(define (build-signed-num n)
  (cond
    ((< n 0) (cons 1 (build-num (* -1 n))))
    ((= n 0) '())
    ((> n 0) (cons 0 (build-num (* -1 n))))))

(define (show-signed-num n)
  (cond
    ((null? n) 0)
    ((= (car n) 1) (* -1 (show-num (cdr n))))
    ((= (car n) 0) (show-num (cdr n)))))

テストはこんな感じで

(define (check-equal? a b)
  (when (not (equal? a b)) (printf "not equal: ~a ~a" a b)))

(define (check-sumo-answer n m)
  (check-equal? (run* r (sumo (build-signed-num n)
                              (build-signed-num m)
                              r))
                (list (build-signed-num (+ n m)))))

(for ((n (range -5 5)))
  (for ((m (range -5 5)))
    (check-sumo-answer n m)))

なんでrackunitを使ってないかというと！
rackunitの中でもfailを定義してたから

実行
よし

違うパターンも

(define (check-sumo-augend m r)
  (check-equal? (run* n (sumo n
                              (build-signed-num m)
                              (build-signed-num r)))
                (list (build-signed-num (- r m)))))

(for ((m (range -5 5)))
  (for ((r (range -5 5)))
    (check-sumo-augend m r)))

帰ってこない

ソースを見る
じー
わからん