;;; Copyright (c) 2023 Jeremy Steward
;;; All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions are met:
;;;
;;; 1. Redistributions of source code must retain the above copyright notice,
;;; this list of conditions and the following disclaimer.
;;;
;;; 2. Redistributions in binary form must reproduce the above copyright notice,
;;; this list of conditions and the following disclaimer in the documentation
;;; and/or other materials provided with the distribution.
;;;
;;; 3. Neither the name of the copyright holder nor the names of its
;;; contributors may be used to endorse or promote products derived from this
;;; software without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
;;; CONSEQUENTIAL DAMAGES  INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGE.

(test-error "make-interval with differing ranks is an error"
            (make-interval #(1) #(4 4 4)))

(test-error "make-interval with not-fixnums is an error"
            (make-interval #(0 0 0) #("string" 1.0 4)))

(test-error "make-interval with flonums is an error"
            (make-interval #(0 0 0) #(1.0 2.0 1.0)))

(test-error "make-interval with rank 0 is an error"
            (make-interval #() #()))

(test "interval with start > end has length 0"
      0
      (interval-length (make-interval #(5 5) #(0 0))))

(test-assert "interval with start > end is empty"
             (interval-empty? (make-interval #(5 5) #(0 0))))

;; Have to name this rng instead of range so that it doesn't collide with the
;; `range` procedure from transducers
(define interval
  (make-interval (vector 0 0 0 0) (vector 2 3 2 3)))

(define expected-values
  (transduce
    range-fold
    (compose
      (map (lambda (i)
             (transduce
               range-fold
               (map (lambda (j)
                      (transduce
                        range-fold
                        (map (lambda (k)
                               (transduce
                                 range-fold
                                 (map (lambda (m)
                                        (vector i j k m)))
                                 (collect-list)
                                 (range 0 3))))
                        (collect-list)
                        (range 0 2))))
               (collect-list)
               (range 0 3))))
      flatten-list)
    (collect-list)
    (range 0 2)))

(test-assert "all values folded over are contained in interval"
             (transduce interval-fold
                        values
                        (collect-all
                          (lambda (idx) (interval-contains? interval idx)))
                        interval))

(test "interval-fold over [(0, 0, 0, 0) (2, 3, 2, 3))"
      expected-values
      (transduce interval-fold
                 values
                 (collect-list)
                 interval))

(test "zip-interval over [(0, 0, 0, 0) (2, 3, 2, 3))"
      expected-values
      (transduce range-fold
                 (compose
                   (zip-interval interval)
                   (map cdr))
                 (collect-list)
                 (counter 0)))

(test "reverse-interval-fold over [(0, 0, 0, 0) (2, 3, 2, 3))"
      (reverse expected-values)
      (transduce reverse-interval-fold
                 values
                 (collect-list)
                 interval))

(test "reverse-zip-interval over [(0, 0, 0, 0) (2, 3, 2, 3))"
      (reverse expected-values)
      (transduce range-fold
                 (compose
                   (reverse-zip-interval interval)
                   (map cdr))
                 (collect-list)
                 (counter 0)))

(test-group "fold reflectivity"
  (define (forward-reverse-fold-test name interval)
    (test name
          (transduce interval-fold
                     values
                     (collect-list)
                     interval)
          (transduce reverse-interval-fold
                     values
                     (collect-reverse-list)
                     interval)))
  (let ((interval (make-default-interval #(3))))
    (forward-reverse-fold-test
      "forward and reverse folds on 1D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3))))
    (forward-reverse-fold-test
      "forward and reverse folds on 2D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3 3))))
    (forward-reverse-fold-test
      "forward and reverse folds on 3D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3 3 3))))
    (forward-reverse-fold-test
      "forward and reverse folds on 4D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3 3 3 3))))
    (forward-reverse-fold-test
      "forward and reverse folds on 5D interval produce same values"
      interval)))

(test-group "zip reflectivity"
  (define (forward-reverse-zip-test name interval)
    (test name
          (transduce range-fold
                     (compose
                       (zip-interval interval)
                       (map cdr))
                     (collect-list)
                     (counter 0))
          (transduce range-fold
                     (compose
                       (reverse-zip-interval interval)
                       (map cdr))
                     (collect-reverse-list)
                     (counter 0))))

  (let ((interval (make-default-interval #(3))))
    (forward-reverse-zip-test
      "forward and reverse folds on 1D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3))))
    (forward-reverse-zip-test
      "forward and reverse folds on 2D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3 3))))
    (forward-reverse-zip-test
      "forward and reverse folds on 3D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3 3 3))))
    (forward-reverse-zip-test
      "forward and reverse folds on 4D interval produce same values"
      interval))

  (let ((interval (make-default-interval #(3 3 3 3 3))))
    (forward-reverse-zip-test
      "forward and reverse folds on 5D interval produce same values"
      interval)))

(define expected-pairs
  (list (cons 0 #(0 0))
        (cons 1 #(0 1))
        (cons 2 #(0 2))
        (cons 3 #(0 3))
        (cons 4 #(1 0))
        (cons 5 #(1 1))
        (cons 6 #(1 2))
        (cons 7 #(1 3))
        (cons 8 #(2 0))
        (cons 9 #(2 1))
        (cons 10 #(2 2))
        (cons 11 #(2 3))))

(test "zipping interval produces expected pairs"
      expected-pairs
      (transduce range-fold
                 (zip-interval (make-default-interval #(3 4)))
                 (collect-list)
                 (counter 0)))

(define expected-pairs
  (list (cons 0  #(2 3))
        (cons 1  #(2 2))
        (cons 2  #(2 1))
        (cons 3  #(2 0))
        (cons 4  #(1 3))
        (cons 5  #(1 2))
        (cons 6  #(1 1))
        (cons 7  #(1 0))
        (cons 8  #(0 3))
        (cons 9  #(0 2))
        (cons 10 #(0 1))
        (cons 11 #(0 0))))

(test "reverse-zip interval produces expected pairs"
      expected-pairs
      (transduce range-fold
                 (reverse-zip-interval (make-default-interval #(3 4)))
                 (collect-list)
                 (counter 0)))