Unit Testing in Scheme/Lisp : Roman Numeral Algorithm

After watching this Roman Numerals Kata I was inspired to write the same algorithm in Scheme/Lisp, but one thing let to another and before I knew I had a couple of libraries, unit tested and all.

Download the files here.

File: scheme-test.ss

(load "strings.ss")

(define (displayln text)
  (begin (display text)
         (newline)))

(define (show key value)
  (begin (display key)
         ;(newline)
         (display " => ")
         (displayln value)))

(define test-run-count 0)
(displayln test-run-count)
(define test-succeeded-count 0)
(define test-failed-count 0)

(define (start-testing)
  (set! test-run-count 0)
  (set! test-succeeded-count 0)
  (set! test-failed-count 0))

(define (finished-testing)
  (displayln " ===========================================")
  (display "   Number of tests: ")
  (display test-run-count)
  (display "     Succeeded: ")
  (display test-succeeded-count)
  (display "     Failed: ")
  (displayln test-failed-count)
  (displayln " =========================================="))

(define (test assumption actual predicate? expected)
  (set! test-run-count (+ test-run-count 1))
  (cond ((predicate? expected actual)
              (displayln (& "Test \"" assumption
                                  "\" Succeeded!")))
        (else (displayln (& "Test \"" assumption
                                   "\" Faild!"))
              (display "\tExpected : ")
              (displayln expected)
              (display "\tbut was  : ")
              (displayln actual))))

File: strings.ss

(define (string-repeat times s)
  (cond ((< times 1) "")
        ((equal? times 1) s)
        (else (string-append s
                            (string-repeat (- times 1) s)))))

(define & string-append)

File: strings-test.ss

(load "strings.ss")
(load "scheme-test.ss")

(displayln " === Strings Tests === ");

(test "Repeat a string 0 times results in an empty string"
      (string-repeat 0 "test") equal? "")

(test "Repeat a string 1 times results in the same string"
      (string-repeat 1 "test") equal? "test")

(test "Repeat a string 3 times results in 3 times the string"
      (string-repeat 3 "test") equal? "testtesttest")

(displayln "");

File: lists.ss

(define empty-list '())
(define (empty-list? l) (eq? l empty-list))
(define (!empty-list? l) (not (eq? l empty-list)))

(define (head l) (car l))
(define (tail l) (cdr l))

(define (make-list x) (cons x '()))

(define (insert-list l x) (cons x l))

(define (append-list l x)
  (cond ((empty-list? l) (cons x l))
        ((empty-list? (tail l))
                      (cons (head l) (cons x empty-list)))
        (else (cons (head l) (append-list (tail l) x)))))

(define (last? l)
  (if (empty-list? (tail l)) #t #f))

(define (last-in-list l)
    (if (last? l) (head l)
        (last-in-list (tail l))))

(define (count-list l)
    (if (empty-list? l) 0
          (+ 1 (count-list (tail l)))))

File: lists-test.ss

(load "scheme-test.ss")
(load "lists.ss")

(displayln " === Lists Tests === ");

(test "Append 1 to an empty list results into a new list…
       with the value 1"
      (append-list empty-list 1) equal? '(1))

(test "Append 2 to a list with the value 1 results into a…
       list with the values 1 and 2"
      (append-list '(1) 2) equal? '(1 2))

(test "Append 3 to a list with the values 1 and 2 results…
       into a list with the values 1, 2 and 3"
      (append-list '(1 2) 3) equal? '(1 2 3))

(test "Make-list with parameter 1 results into a list with…
       the value 1"
      (make-list 1) equal? '(1))

(test "Insert value 2 results into a list that starts with…
       the value 2"
      (insert-list '(9 8 7 6) 2) equal? '(2 9 8 7 6))

(test "Append value 2 results into a list that ends with…
      the value 2"
      (append-list '(9 8 7 6) 2) equal? '(9 8 7 6 2))

(test "Last in list results into 9"
      (last-in-list '(1 2 3 4 5 6 7 8 9)) equal? 9)

(test "Count an empty list results into 0"
      (count-list empty-list) equal? 0)

(test "Count a list with 5 items results into 5"
      (count-list '(1 7 3 9 4)) equal? 5)

(displayln "");

File: dict.ss

(load "lists.ss")

(define (first list)
  (cond ((empty-list? list) empty-list)
        (else (car list))))

(define (first-in list) (first list))
(define (rest-of list) (cdr list))
(define (next-in list) (rest-of list))

(define (make-pair key value) #(key value))
(define (key pair) (first-in pair))
(define (value pair)
  (cond ((empty-list? pair) empty-list)
        (else (first (rest-of pair)))))

(define (first-pair-in list) (first-in list))
(define (first-pair-key-in dict)
        (key (first-pair-in dict)))
(define (first-pair-value-in dict)
        (value (first-pair-in dict)))
(define (next-pair-in list)
        (first (next-in list)))
(define (next-pair-key-in dict)
        (key (next-pair-in dict)))
(define (next-pair-value-in dict)
        (value (next-pair-in dict)))

(define (make-dict) (list "*dict*"))

(define (dict-add dict key value)
  (cond ((empty-list? (next-in dict))
            (set-cdr! dict (list (list key value))))
        (else (dict-add (rest-of dict) key value))))

(define (dict-add-many dict pair-list)
  (cond ((empty-list? pair-list) empty-list)
        (else (begin
                (dict-add dict (first-pair-key-in pair-list)
                          (first-pair-value-in pair-list))
                (dict-add-many dict (rest-of pair-list))))))

(define (dict-make-many pair-list)
  (let ((d (make-dict)))
   (dict-add-many d pair-list)
   d))

(define (dict-find-pair-in dict key)
  (cond ((empty-list? (next-in dict)) empty-list)
        ((equal? (next-pair-key-in dict) key)
                                         (next-pair-in dict))
        (else (dict-find-pair-in (rest-of dict) key))))

(define (dict-has-key? dict key)
  (cond ((empty-list? (dict-find-pair-in dict key)) #f)
        (else #t)))

(define (dict-for-each-in dict f)
  (cond ((empty-list? (next-pair-in dict)) empty-list)
        (else (f (next-pair-in dict))
         (dict-for-each-in (rest-of dict) f))))

(define (dict-get-value dict key)
 (value (dict-find-pair-in dict key)))

(define (dict-get-keys-from dict)
   (cond ((empty-list? (next-in dict)) empty-list)
        (else (cons (next-pair-key-in dict)
                    (dict-get-keys-from (rest-of dict))))))

(define (dict-get-values-from dict)
   (cond ((empty-list? (next-in dict)) empty-list)
        (else (cons (next-pair-value-in dict)
                    (dict-get-values-from (rest-of dict))))))

File: dict-test.ss

(load "scheme-test.ss")
(load "dict.ss")

(displayln " === Dict Tests === ");

(test "creating a dictionary with an initial list of key…
       value pair results into a initialized dictionary"
      (dict-make-many
       (list '(1000 "M") '(900 "CM") '(500 "D")
             '(400 "CD") '(100 "C") '(90 "XC")
             '(50 "L") '(40 "XL") '(10 "X")
             '(9 "IX") '(5 "V") '(4 "IV") '(1 "I")))
        equal?
        (list "*dict*"
              '(1000 "M")
              '(900 "CM")
              '(500 "D")
              '(400 "CD")
              '(100 "C")
              '(90 "XC")
              '(50 "L")
              '(40 "XL")
              '(10 "X")
              '(9 "IX")
              '(5 "V")
              '(4 "IV")
              '(1 "I")))

(test "creating a new dictionary results in a new empty…
      dictionary"
      (make-dict)
      equal?
      (list "*dict*"))

(test "creating a new dictionary and adding a key value…
      pair results into a dictionary with 1 key value pair"
      (let ((dict1 (make-dict)))
            (dict-add dict1 "key1" "value1")
            dict1)
      equal?
      (list "*dict*" '("key1" "value1")))

(test "creating a new dictionary and adding 2 key value…
      pairs results into a dictionary with 2 key value pairs"
      (let ((dict1 (make-dict)))
            (dict-add dict1 "key1" "value1")
            (dict-add dict1 "key2" "value2")
            dict1)
      equal?
      (list "*dict*" '("key1" "value1") '("key2" "value2")))

(test "Finding a pair in an empty dictionary results into…
      returning an empty list"
      (let ((dict1 (make-dict)))
            (dict-find-pair-in dict1 "key2"))
      equal?
      empty-list)

(test "Finding the first pair on key in a dictionary results…
      into returning the right key value pair"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (dict-find-pair-in dict1 "key1"))
      equal?
      '("key1" "value1"))

(test "Finding an existing pair on key in a dictionary
      results into returning the right key value pair"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (dict-find-pair-in dict1 "key2"))
      equal?
      '("key2" "value2"))

(test "Finding the last pair on key in a dictionary results…
       into returning the right key value pair"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (dict-find-pair-in dict1 "key4"))
      equal?
      '("key4" "value4"))

(test "Finding a pair with a non-existing key in a…
       dictionary results into returning the empty list"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")


                                         '("key4" "value4")))))
            (dict-find-pair-in dict1 "key99"))
      equal?
      empty-list)

(test "Getting the value of a pair in an empty dictionary…
       with a non-existing key results into returning…
       the empty list"
      (let ((dict1 (make-dict)))
            (dict-get-value dict1 "key"))
      equal?
      empty-list)

(test "Getting the value of the first pair in a dictionary…
       with a key results into returning the right value"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (dict-get-value dict1 "key1"))
      equal?
      "value1")

(test "Getting the value of a pair in a dictionary…
       with a key results into returning the right value"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (dict-get-value dict1 "key2"))
      equal?
      "value2")

(test "Getting the value of the last pair in a dictionary…
       with a key results into returning the right value"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (dict-get-value dict1 "key4"))
      equal?
      "value4")

(test "Getting the value of a pair in a dictionary with a…
      non-existing key results into returning the empty list"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (dict-get-value dict1 "key99"))
      equal?
      empty-list)

(test "Getting the next pair's key in an empty dictionary…
       results into returning the empty list"
      (let ((dict1 (make-dict)))
            (next-pair-key-in dict1))
      equal?
      empty-list)

(test "Getting the next pair's value in an empty dictionary…
       results into returning the empty list"
      (let ((dict1 (make-dict)))
            (next-pair-value-in dict1))
      equal?
      empty-list)

(test "Getting the next pair's key in dictionary results…
       into returning the right key"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (next-pair-key-in dict1))
      equal?
      "key1")

(test "Getting the next pair's value in dictionary results…
       into returning the right value"
      (let ((dict1 (dict-make-many (list '("key1" "value1")
                                         '("key2" "value2")
                                         '("key3" "value3")
                                         '("key4" "value4")))))
            (next-pair-value-in dict1))
      equal?
      "value1")

(displayln "");

File: math.ss

(define % modulo)
(define (square x) (* x x))

File: math-test.ss

(load "math.ss")
(load "scheme-test.ss")

(displayln " === Math Tests === ");

(test "Square of -2 results in 4"
      (square -2) equal? 4)

(test "Square of 0 results in 0"
      (square 0) equal? 0)

(test "Square of 2 results in 4"
      (square 2) equal? 4)

(displayln "");

File: roman.ss

(load "dict.ss")
(load "strings.ss")
(load "math.ss")

;===========================================================
; I     The easiest way to note down a number is to make
        that many marks - little I's. Thus I means 1,
        II means 2, III means 3. However, four strokes
        seemed like too many....
; V     So the Romans moved on to the symbol for 5 - V.
        Placing I in front of the V — or placing any
        smaller number in front of any larger number —
        indicates subtraction. So IV means 4. After V comes
        a series of additions - VI means 6, VII means 7,
        VIII means 8.
; X     X means 10. But wait — what about 9? Same deal.
        IX means to subtract I from X, leaving 9. Numbers in
        the teens, twenties and thirties follow the same form
        as the first set, only with X's indicating the number
        of tens. So XXXI is 31, and XXIV is 24.
; L     L means 50. Based on what you've learned, I bet you
        can figure out what 40 is. If you guessed XL, you're
        right = 10 subtracted from 50. And thus 60, 70, and
        80 are LX, LXX and LXXX.
; C     C stands for centum, the Latin word for 100. A
        centurion led 100 men. We still use this in words
        like "century" and "cent." The subtraction rule means
        90 is written as XC. Like the X's and L's, the C's
        are tacked on to the beginning of numbers to indicate
        how many hundreds there are: CCCLXIX is 369.
; D     D stands for 500. As you can probably guess by this
        time, CD means 400. So CDXLVIII is 448. (See why we
        switched systems?)
; M     M is 1,000. You see a lot of Ms because Roman numerals
        are used a lot to indicate dates. For instance, this
        page was written in the year of Nova Roma's founding,
        1998 CE (Common Era; Christians use AD for Anno Domini,
        "year of our Lord"). That year is written as
        MCMXCVIII. But wait! Nova Roma counts years from the
        founding of Rome, ab urbe condita. By that reckoning
        Nova Roma was founded in 2751 a.u.c. or MMDCCLI.


;===========================================================


(define roman-dict (dict-make-many
   (list '(1000 "M")
         '(900 "CM")
         '(500 "D")
         '(400 "CD")
         '(100 "C")
         '(90 "XC")
         '(50 "L")
         '(40 "XL")
         '(10 "X")
         '(9 "IX")
         '(5 "V")
         '(4 "IV")
         '(1 "I"))))

(define (numeric->roman n)
  (cond ((< n 1) "Romans know nothing about this number!")
        (else (let ((result ""))
         (dict-for-each-in roman-dict
                 (lambda (pair)
                   (let ((r (% n (key pair))))
                     (cond ((equal? r n) "")
                           ((equal? r 0) (set! result…
…(string-append result (string-repeat (/ n (key pair))
                               (value pair)))) (set! n r))
                           (else (set! result…
…(string-append result (string-repeat (/ n (key pair))
                               (value pair))))
                                 (set! n r))))))
              result))))

File: roman-test.ss

(load "common.ss")
(load "roman.ss")
(load "scheme-test.ss")

(displayln " === Romans Tests === ");

;(repeat 2015 (lambda(x) (show x (numeric->roman x))))

(test "Roman dictionary is properly loaded"
        roman-dict
        equal?
        (list "*dict*" '(1000 "M") '(900 "CM")
                       '(500 "D") '(400 "CD")
                       '(100 "C") '(90 "XC")
                       '(50 "L") '(40 "XL")
                       '(10 "X") '(9 "IX")
                       '(5 "V") '(4 "IV")
                       '(1 "I")))

(test "Roman numbers are properly loaded"
        (dict-get-keys-from roman-dict)
        equal?
        '(1000 900 500 400 100 90 50 40 10 9 5 4 1))

(test "Roman symbols are properly loaded"
        (dict-get-values-from roman-dict)
        equal?
        '("M" "CM" "D" "CD" "C" "XC" "L"
          "XL" "X" "IX" "V" "IV" "I"))

(test "2010 results into MMX"
      (numeric->roman 2010) equal? "MMX")

(test "2009 results into MMIX"
      (numeric->roman 2009) equal? "MMIX")

(displayln "");
Advertisements

About this entry