;; qsort-library.ss and vector-library.ss (combined for hw9 convenience)
;;
;; export:
;;
;;   partition : ((vector num) num num num -> (list num num))
;;   (* See description below *)
;;
;;   fori= : (num num num (num -> void) -> void)
;;   (* perform some action for some range of numbers *)
;;
;;   V* : ((vector num) (vector num) -> num)
;;   (* This is also named S*, to match handout *)
;;
;; hidden: 
;;   reduce-vector : ((vector X) Y (X num Y -> Y) -> Y)
;;   (* vector-reduce *)

(unit/sig (fori= S* V* reduce-vector partition)
  (import plt:userspace^)

;; (* Description of partition:
;;  (partition v left right pivot)
;;  Input:
;;    v is a vector of numbers,
;;    pivot is a number,
;;    left, right are indices such that
;;       left..right-1 are valid for v
;;      (NOTE that right should be one more than the
;;       last index you want partitioned!  This
;;       convention for index ranges is often convenient;
;;       consider the meanings of the return value, below.)
;;
;;  Effect: The elements of v from left...right-1
;;    may be re-arranged, subject to the below.
;;
;;  Return: (list s1 s2), where s1, s2  are
;;    indices such that the following holds:
;;    Locations left..s1-1    of v are < pivot,
;;    locations   s1..s2-1    of v are = pivot,
;;    locations   s2..right-1 of v are > pivot.
;;    Warning:  In general,
;;    s1-1 might be left-1 (if all elements of v > pivot), and
;;    s2 might be right    (if all elements of v < pivot);
;;    these might not be legal indices.
;;  End description of partition *)
;;
;; Algorithm: First sweep all values < pivot
;; to the left of location s1.
;; Then sweep all values from s1..right-1
;; which are =pivot to the left.
;; Watch out for s1=right.
;;
(define  (partition v left right pivot)
  (let* ((s1 (sweep-left v left right 
			 (lambda (n) (< n pivot))))
         (s2 (if (< s1 right)
		 (sweep-left v s1 right
			     (lambda (n) (= n pivot)))
		 s1)))
    (list s1 s2)))

  
;; (sweep-left v l r p?)
;; v is a vector
;; l,r are indices such that l..r-1 are legal indices of v,
;; and r > l.
;; p? is a function from elements of v to boolean.
;;
;; Side effect: shuffle elements of v in range l..r-1
;;
;; Return an index s, such that:
;; elements l..s-1 of v meet p?
;; elements s..r-1 of v fail p?
;;
;; Caution: s might be l or r.
;;
(define (sweep-left v l r p?)
  (let* ((r-1 (- r 1))
	 (leftVal (vector-ref v l)))
    (cond ((= l r-1) (if (p? leftVal) r l))
	  ((p? leftVal)
	   (sweep-left v (+ l 1) r p?))
	  (else  ;; not (p? leftVal)
	   (begin (vector-set! v l (vector-ref v r-1))
		  (vector-set! v r-1 leftVal)
		  (sweep-left v l r-1 p?))))))
  


;; (fori= start end step p)
;; A loop which has an index from start,
;; incremented by step, while the index is < stop.
;; At each pass, call the function p, passing it the index.
;;
(define (fori= start end step p)
  (if (>= start end)
      (void) 
      (begin (p start)
             (fori= (+ start step) end step p))))


;; reduce-vector:
;;   (num alpha (num (union alpha beta) -> beta) -> (union alpha beta))
;; N: num
;; base: alpha
;; combine: num (union alpha beta) -> beta
;; result: (union alpha beta)
;; Reduce the vector from right to left, structurally
(define (reduce-vector N base combine)
  (cond
    ((= N 0) base)
    (else (combine (sub1 N) (reduce-vector (sub1 N) base combine)))))

;; From vectors to lists
(define (vec->list vec)
  (reverse! 
    (reduce-vector (vector-length vec) null
      (lambda (i rest) (cons (vector-ref vec i) rest)))))

;(printf "test vec->list: ~s should be ~s~n"
;  (vec->list (vector 3 4)) (vector->list (vector 3 4)))

;; The norm of a vector
(define (norm vec)
  (sqrt (reduce-vector (vector-length vec) 0
	  (lambda (i rest) (+ (square (vector-ref vec i)) rest)))))
		  
(define (square x) (* x x))

;(printf "test norm: ~s should be 5~n" (norm (vector 3 4)))

;; The V* product of a vector (inner product)
(define (V* vec1 vec2)
  (unless (= (vector-length vec1) (vector-length vec2))
    (error 'S* "the vectors must be of the same length"))
  (reduce-vector (vector-length vec1) 0
    (lambda (i rest) (+ (* (vector-ref vec1 i) (vector-ref vec2 i)) rest))))

;; alternate name to match handout
(define S* V*)

;(printf "test s*: ~s should be 12~n" (s* (vector 3 4 5) (vector 1 1 1)))

  )