guile-ml/utils/test.scm

(define-module (utils test))


(use-modules
 ;; SRFI 64 for unit testing facilities
 (srfi srfi-64))


(define-public approximately-equal?
  (lambda (value1 value2 epsilon)
    "Check whether two values are approximately equal by checking whether their
difference is less than a given epsilon."
    (<= (abs (- (abs value1)
                (abs value2)))
        epsilon)))


(define-public vectors-approximately-equal?
  (lambda (v1 v2 epsilon compare-proc)
    "Check whether all vector elements of vector v2 are approximately equal according to the
compare-proc."
    (define compare-vector-elements
      (lambda (v1 v2 epsilon compare-proc)
        "Assume, that the length of both vectors is equal."
        (let ([num-elems (vector-length v1)])
          (let loop ([index 0])
            (cond
             [(< index num-elems)
              (if (compare-proc (vector-ref v1 index)
                                (vector-ref v2 index)
                                epsilon)
                  (loop (+ index 1))
                  #f)]
             [else #t])))))

    (cond
     [(= (vector-length v1) (vector-length v2))
      (compare-vector-elements v1 v2 epsilon compare-proc)]
     [else #f])))


(define-public lists-of-vectors-approximately-equal?
  (lambda (l1 l2 epsilon compare-proc)
    "Check whether lists of vectors are approximately equal, by checking whether
the vectors within the lists are approximately equal."
    (define (check-elements l1 l2 epsilon)
      (cond [(and (null? l1) (null? l2)) #t]
            [(compare-proc (car l1) (car l2) epsilon)
             (check-elements (cdr l1) (cdr l2) epsilon)]
            [else #f]))

    (if (= (length l1) (length l2))
        (check-elements l1 l2 epsilon)
        #f)))


(define-public vector-set
  (lambda (a-vector pos value)
    "Update a vector in a functional way, returning a new vector, which is the
same as the given vector, except that it has an updated value at position pos."
    (let ([vec-len (vector-length a-vector)])
      (let ([res-vec (make-vector vec-len)])
        (let iter ([index 0])
          (cond
           [(< index vec-len)
            (if (= pos index)
                (vector-set! res-vec index value)
                (vector-set! res-vec index (vector-ref a-vector index)))
            (iter (+ index 1))]
           [else res-vec]))))))