;;; Copyright Igor Rivin 2004, 2005 all rights reserved.

(define call/cc call-with-current-continuation)

(define fold
  (lambda (func l init)
    (let foldaux ((res  init) (rest l))
      (if (null? rest) 
          res
          (foldaux (func res (car rest)) (cdr rest))))))


(define foldr
  (lambda (func l init)
    (let ((funcr (lambda (x y) (func y x))))
      (let foldaux ((res init) (rest (reverse l)))
        (if (null? rest)
            res
            (foldaux (funcr res (car rest)) (cdr rest)))))))

(swaps the ith and jth element of ar)

(define swap (lambda (ar i j)
               (let ((tmp (vector-ref ar i)))
                 (vector-set! ar i (vector-ref ar j))
                 (vector-set! ar j tmp))))

;; (range n) returns the list (0 ... n-1)

(define range
  (lambda (n)
    (let raux ((n n) (l '()))
      (if (= n 0)
          l
          (let ((n-1 (- n 1)))
            (raux n-1 (cons n-1 l)))))))

;; returns a list of length len all of whose elements equal n.

(define constlist
  (lambda (len n)
    (map (lambda (x) n)
         (range len))))

;; computes the outer product of a list of lists (the outer product of two vectors v1 and v2 is a 
;; matrix M such that M[i][j] = func[v1[i], v2[j]]

(define outer
  (lambda (func l1 l2)
    (let ((tmpfunc
           (lambda (x) (map (lambda (y) (func x y))
                            l2))))
      (map tmpfunc l1))))

;; computes the dot product of two lists
(define ldot 
  (lambda (v1 v2)
    (apply + (map * v1 v2))))

;; computes transpose of a list of lists RECURSIVELY

(define transpose1
  (lambda (l)
    (if (null? (car l))
        '()
        (cons (map car l) (transpose1 (map cdr l))))))

;; computes transpose of a list of lists ITERATIVELY

(define transpose2
  (lambda (l)
    (let ((preresult 
           (let transposing ((done '()) (remaining l))
             (if (null? (car remaining))
                 done
              (let ((thecar (map car remaining))
                    (thecdr (map cdr remaining)))
                (transposing (cons thecar done)
                             thecdr))))))
      (reverse preresult))))

;(mapn func (list l1 l2 ... ln)) is synonymous to (map func l1 ... ln)

(define mapn 
  (lambda (func ll) ; func is a vararg function, ll is a list of lists
    (map (lambda (x) (apply func x))
         (transpose2 ll))))

;; everyone's favorite function
(define identity
  (lambda (x)
    x))

;; (delta n ind) will give a list of length n all of whose elements are 0 except the ind+1st one.

(define delta
  (lambda (n ind)
    (map (lambda (x) (if (= x ind) 1 0)) (range n))))


;; (mat-identity n) gives an nxn identity matrix.

(define mat-identity
  (lambda (n)
    (let id-aux ((m 0) (res '()))
      (if (= m n)
          (reverse res)
          (id-aux (+ m 1) (cons (delta n m) res))))))
 
;; returns the nxn zero matrix

(define mat-zero
  (lambda (n)
    (map (lambda (ignore) (constlist n 0)) (range n))))



(define select
  (lambda (pred l)
    (reverse (fold (lambda (x y) (if (pred y) (cons y x) x)) l '()))))

(define select2
  (lambda (pred l1 l2)
    (map car (select (lambda (x) (pred (cadr x))) (transpose2 (list l1 l2))))))

     
(define atom? (lambda (x) (not (pair? x))))

(define comb2 ; assume sexpr1 and sexpr2 have the same structure
  (lambda (sexpr1 sexpr2)
    (if (atom? sexpr1)
        (list sexpr1 sexpr2)
        (map comb2 sexpr1 sexpr2))))
    

(define flatten
  (lambda (sexpr)
    (if (not (pair? sexpr))
        (list sexpr)
        (apply append (map flatten sexpr)))))


;; compose two functions

(define compose
  (lambda (func1 func2)
    (lambda (x) (func1 (func2 x)))))