guile-ml/test/list-utils-test.scm

(use-modules
 ;; SRFI 64 for unit testing facilities
 (srfi srfi-64)
 ;; utils - the code to be tested
 (utils list))


(test-begin "list-utils-test")


(test-group
 "map-asterisk"

 (test-equal "map*-1"
   '(1 4 (9 16) 25 36)
   (map* (lambda (n) (* n n))
         '(1 2 (3 4) 5 6)))

 (test-equal "map*-2"
   '("1" "4" ("9" "16") "25" "36")
   (map* (lambda (num)
           (number->string (* num num)))
         '(1 2 (3 4) 5 6))))


(test-group
 "stringify*"

 (test-equal "stringify*-1"
   '("1" "2" ("3" "4") "5" "6")
   (stringify* '(1 2 (3 4) 5 6)))

 (test-equal "stringify*-2"
   '("1" "3.2" ("3" "#t") "5" "#f")
   (stringify* '(1 3.2 (3 #t) 5 #f))))


(test-group
 "apply-multiple"

 (test-equal "apply-multiple-1"
   8
   (apply-multiple
    (list (lambda (e) (+ e 1))
          (lambda (e) (* e 2)))
    3))

 (test-equal "apply-multiple-2"
   5
   (apply-multiple
    (list (lambda (e) (+ e 1))
          (lambda (e) (* e 2))
          (lambda (e) (- e 5)))
    4)))


(test-group
 "list-reduce"

 (test-equal "list-reduce-1"
   120
   (list-reduce '(1 2 3 4 5) * 1))

 (test-equal "list-reduce-2"
   5
   (list-reduce '(1 5 3 4 4)
                (lambda (a b) (max a b))
                4)))


(test-group
 "fisher-yates-shuffle"

 (test-assert "fisher-yates-shuffle keeps all elements of the list"
   ;; NOTE: This test tests code, which makes use of random integers. Although
   ;; unlikely, it could succeed an arbitrary number of times, before it fails,
   ;; if there is a bug in the implementation of the tested procedure.

   ;; FUTURE TODO: Perhaps it would be best to work with a random seed here,
   ;; which makes the results of the fisher-yates-shuffle deterministic.
   (let* ([elems-in-list '(1 2 3 4)]
          [shuffled-list (fisher-yates-shuffle elems-in-list)])
     (let loop ([elems-to-find elems-in-list])
       (cond
        [(null? elems-to-find) #t]
        [else
         (if (member (car elems-to-find) shuffled-list)
             (loop (cdr elems-to-find))
             #f)]))))

 (test-assert "fisher-yates-shuffle results in list of same length"
   (let ([list-to-shuffle '(1 2 3 4 5)])
     (= (length list-to-shuffle)
        (length (fisher-yates-shuffle '(1 2 3 4 5)))))))


(test-group
 "accumulate"

 (test-equal "accumulate sum"
   10
   (accumulate + 0 '(1 2 3 4)))

 (test-equal "accumulate list"
   '(1 2 3 4)
   (accumulate cons '() '(1 2 3 4))))


(test-group
 "fold-right"

 (test-equal "fold-right"
   (/ 3 8)
   (fold-right / 1 '(1 2 3 4))))


(test-group
 "fold-left"

 (test-equal "fold-left"
   (/ 8 3)
   (fold-left / 1 '(1 2 3 4))))


(test-group
 "flatten"

 (test-equal "flatten with nested list should give flattened list"
   '(1 2 3 4 5 6)
   (flatten '((1) ((2 3 4) 5) 6)))

 (test-equal "flatten with flat list should not change the list"
   '(1 2 3 4 5 6)
   (flatten '(1 2 3 4 5 6))))


(test-group
 "split-into-chunks-of-size-n"

 (test-equal "split-into-chunks-of-size-n splits and last sublist contains remaining"
   '((1 2 3) (4 5 6) (7))
   (split-into-chunks-of-size-n '(1 2 3 4 5 6 7) 3))

 (test-equal "split-into-chunks-of-size-n splits correctly if list length is divisable by n"
   '((1 2) (3 4) (5 6))
   (split-into-chunks-of-size-n '(1 2 3 4 5 6) 2))

 (test-equal "split-into-chunks-of-size-n does nothing if n greater than or equal to list length -- 1"
   '((1 2 3 4 5 6))
   (split-into-chunks-of-size-n '(1 2 3 4 5 6) 6))

 (test-equal "split-into-chunks-of-size-n does nothing if n greater than or equal to list length -- 2"
   '((1 2 3 4 5 6))
   (split-into-chunks-of-size-n '(1 2 3 4 5 6) 7)))


(test-group
 "count"

 (test-equal "count with predicate that should never be true"
   0
   (count (lambda (elem)
            (= 1 2))
          '(1 2 3 4 5)))

 (test-equal "count even numbers"
   2
   (count (lambda (elem)
            (= (remainder elem 2) 0))
          '(1 2 3 4 5)))

 (test-equal "count with tautology predicate"
   5
   (count (lambda (elem)
            (= 1 1))
          '(1 2 3 4 5))))


(test-group
 "list-range"

 (test-equal "list-range of empty list is empty list"
   '()
   (list-range '() 0 4))

 (test-equal "list-range of complete list"
   '(1 3 5 2 4)
   (list-range '(1 3 5 2 4) 0 5))

 (test-equal "list-range usual case -- 1"
   '(3)
   (list-range '(1 3 5 2 4) 1 2))

 (test-equal "list-range usual case -- 2"
   '(3 5)
   (list-range '(1 3 5 2 4) 1 3)))


(test-group
 "take-up-to"

 (test-equal "take-up-to with sufficient elements"
   '(1 2 3)
   (take-up-to 3 '(1 2 3 4 5 6 7)))

 (test-equal "take-up-to with insufficient elements"
   '(1 2 3 4)
   (take-up-to 6 '(1 2 3 4))))


(test-group
 "drop-up-to"

 (test-equal "drop-up-to with sufficient elements"
   '(4 5 6 7)
   (drop-up-to 3 '(1 2 3 4 5 6 7)))

 (test-equal "drop-up-to with insufficient elements should give empty list"
   '()
   (drop-up-to 6 '(1 2 3 4))))


(test-group
 "range"

 (test-equal "range with no step"
   '(0 1 2 3 4 5 6 7 8 9)
   (range 0 10))

 (test-equal "range with step 2"
   '(0 2 4 6 8)
   (range 0 10 2)))


(test-end "list-utils-test")