zplist.zp

(define reduce
  (case-lambda
    ((f acc l) (fold f acc l))
    ((f l) (fold f (car l) (cdr l)))))

(define (list . objs) "creates a list from objects"
  objs)

(define (list:matches? pred? l) "check whether there is an element in l that matches the predicate pred?"
  (cond ((null? l) #f)
        ((pred? (car l)) #t)
        (else (list:matches? pred? (cdr l)))))

(define (list:find f l) "find element that matches f in l; otherwise get nil"
  (cond ((null? l) (nil))
        ((f (car l)) (car l))
        (else (list:find f (cdr l)))))

(define (list:index l el) "get index of el in l; otherwise get -1"
  (define (internal l el c)
    (cond
      ((null? l) -1)
      ((eq? (car l) el) c)
      (else (internal (tail l) el (add1 c)))))
  (internal l el 0))

(define (list:after l el) "returns sublist of l after first occurrence of element el"
  (indexed-tail l (+ (list:index l el) 1)))

(define (list:count l el) "returns number of occurences of el in l"
  (reduce (lambda (acc now) (if (eqv? now el) (+ acc 1) acc)) 0 l))

(define (max first . l) "maximum of values"
  (fold (lambda (old new) (if (> old new) old new)) first l))

(define (min first . l) "minimum of values"
  (fold (lambda (old new) (if (< old new) old new)) first l))

(define (list:min l) "minimum in list"
  (fold (lambda (old new) (if (< old new) old new)) (car l) (cdr l)))

(define (list:max l) "maximum in list"
  (fold (lambda (old new) (if (> old new) old new)) (car l) (cdr l)))

(define (list:in? l el) "returns boolean signifying whether element is in list"
  (<= 0 (list:index l el)))

(define (indexed-tail l k) "get tail of a list starting at index"
  (if (or (null? l) (zero? k))
    l
    (indexed-tail (cdr l) (- k 1))))

(define (list:drop-while f l) "drops elements from l as long as f matches"
  (if (null? l)
    l
    (if (f (car l))
      (list:drop-while f (cdr l))
      l)))

(define (list:take-while f l) "takes elements from l as long as f matches"
  (define (internal f l acc)
    (if (null? l) l
      (if (f (car l))
        (internal f (cdr l) (++ acc (car l)))
        acc)))
  (internal f l []))

(define list:drop (flip indexed-tail))

(define (list:take n l)
  (define (internal l acc n)
    (if (or (null? l) (> 1 n))
      acc
      (internal (cdr l) (++ acc (car l)) (sub1 n))))
  (internal l [] n))


(define (list:sublist l from to) "get sublist of list from element from (inclusive) to element to (exclusive)"
  (define (_internal l new f t)
    (cond
      ((or (= 0 t) (null? l)) new)
      ((>= 0 f) (_internal (tail l) (++ new (head l)) (sub1 f) (sub1 t)))
      (else (_internal (tail l) new (sub1 f) (sub1 t)))))
  (if (< from to)
    (_internal l [] from to)
    []))

(define (list:ref l . k) "get reference to list element at certain point"
    (if (= 1 (length k))
        (car (indexed-tail l (car k)))
        (reverse (indexed-tail (reverse (indexed-tail l (car k))) (- (length l) (cadr k))))))

(define (list:remove-n l n) "deletes nth element from list"
  (define (internal il n traversed)
    (cond
      ((null? il) l)
      ((= n 0) (++ traversed (tail il)))
      (else (internal (tail il) (sub1 n) (++ traversed (car il))))))
  (if (< n 0)
    l
    (internal l n [])))

(define (list:remove l el) "deletes element el from list"
  (define (internal il el traversed)
    (cond
      ((null? il) l)
      ((eq? (car il) el) (++ traversed (tail il)))
      (else (internal (tail il) el (++ traversed (car il))))))
  (internal l el []))

(define (list:insert l i el) "adds element el into list l at index i"
  (define (internal i l acc)
    (if (null? l)
      (++ acc el)
      (if (eq? 0 i)
        (++ acc el l)
        (internal (sub1 i) (tail l) (++ acc (head l))))))
  (internal i l []))

(define (list:intercalate l el) "intercalates element el into list l"
  (define (internal l acc)
    (cond 
      ((null? l) acc)
      ((eq? (length l) 1) (++ acc (car l)))
      (else (internal (cdr l) (++ acc (car l) el)))))
  (internal l []))

(define (list:tail l) "get tail of a list"
  (cdr l))

(define (list:length l) "length of list"
  (fold (lambda (x y) (+ x 1)) 0 l))

(define (list:but-last l) "returns a list of everything but the last element of the list"
  (list:sublist l 0 (sub1 (length l))))

(define (list:last l) "get last element in l"
  (if (null? l)
    (nil)
    (list:ref l (- (length l) 1))))

(define (list:semireverse l n) "reverse n elements of l"
  (define (continue front back n)
    (cond
      ((null? back) front)
      ((zero? n) (cons (car back) (++ front (cdr back))))
      (else (continue (cons (car back) front) (cdr back) (- n 1)))))
  (continue '() l n))
 
(define (list:shuffle l) "shuffle l"
  (do ((v (list->vector l)) (n (length l) (- n 1)))
      ((zero? n) (vector->list v))
    (let* ((r (randint n)) (t (vector:ref v r)))
      (vector:set! v r (vector:ref v (- n 1)))
      (vector:set! v (- n 1) t))))

(define (list:flatten l) "flatten l"
  (reduce (lambda (acc x) (if (list? x) (++ acc (list:flatten x)) (++ acc x))) [] l))

(define (reverse l) "reverse list"
  (fold (flip cons) '() l))

(define (my-mem-helper obj lst cmp-proc)
    (cond
        ((null? lst) #f)
        ((cmp-proc obj (car lst)) lst)
        (else (my-mem-helper obj (cdr lst) cmp-proc))))

(define (memq obj lst) (my-mem-helper obj lst eq?))

(define (memv obj lst) (my-mem-helper obj lst eqv?))

(define (member obj lst) (my-mem-helper obj lst equal?))

(define (mem-helper pred op) (lambda (acc next) (if (and (not acc) (pred (op next))) next acc)))

(define (assq obj alist) (fold (mem-helper (curry eq? obj) car) #f alist))

(define (assv obj alist) (fold (mem-helper (curry eqv? obj) car) #f alist))

(define (assoc obj alist) (fold (mem-helper (curry equal? obj) car) #f alist))

(define (map func l) "map function to list"
  (foldr (lambda (x y) (cons (func x) y)) [] l))

(define (mapcat f l) "maps and concats a list"
  (apply ++ (map f l)))

(define (indexed-map func l) "indexed map function to list"
  (cdr (foldl (lambda (x y) 
    (let ((i (car x)))
      (cons (add1 i) (cons (func y i) (cdr x)))))
    [0] l)))

(define (zip a b) "zips two lists together"
  (zip-with list a b))

(define (zip-with f a b) "zips two lists together, takes a function that has two arguments"
  (define (internal f a b acc)
    (if (or (null? a) (null? b))
      acc
      (internal f (cdr a) (cdr b) (++ acc (f (car a) (car b))))))
  (internal f a b []))

(define foreach map)

(define (filter pred l) "filter list with predicate"
  (foldr (lambda (x y) (if (pred x) (cons x y) y)) [] l))

(define (remp pred l) "filter list with predicate (inverse to filter)"
  (foldr (lambda (x y) (if (not (pred x)) (cons x y) y)) [] l))

(define (any? pred lst) "does anything in the list satisfy the predicate?"
  (let any* ((l (map pred lst)))
    (cond
      ((null? l) #f)
      ((car l) #t)
      (else
        (any* (cdr l))))))

(define (every? pred lst) "do all values in the list satisfy the predicate?"
  (let every* ((l (map pred lst)))
    (cond
      ((null? l) #t)
      ((car l)
       (every* (cdr l)))
      (else
        #f))))

(define (range x . l)
  (begin
    (define build (lambda (c) (if (< c x) (cons c (build (+ c 1))) [])))
    (define from-to (lambda (x y) (if (>= x y) [] (cons x (from-to (+ x 1) y)))))
    (define step (lambda (x y z) (if (>= x y) [] (cons x (step (+ x z) y z)))))
    (cond ((null? l) (build 0))
          ((= 1 (length l)) (from-to x (car l)))
          ((= 2 (length l)) (step x (car l) (cadr l)))
          (else (error "usage: range [from] to [step]")))))

(define (replicate n el) "build a list of length n with only el in it"
  (if (< n 1)
    '()
    (+= (replicate (- n 1) el) el)))

(define (countdown n) "build a list from n to 0."
  (if (zero? n)
      '()
      (cons n (countdown (- n 1)))))

(define keep
  (case-lambda
    ((l) (map truthy? l))
    ((pred l) (map pred l))))

(define (dedupe c)
  "returns a list removing consecutive duplicates in the collection c"
  (reduce (lambda (acc x) (if (eq? (list:last acc) x) acc (++ acc x))) [] c))

(define (distinct c)
  "returns a list removing all duplicates from the collection c"
  (reduce (lambda (acc x) (if (in? acc x) acc (++ acc x))) [] c))

(define (distinct? c)
  "returns a truth value representing whether every item in the collection c is unique"
  (list? (reduce (lambda (acc x)
                   (if (or (eq? #f acc) (in? acc x))
                     #f
                     (++ acc x)))
                 []
                 c)))

(define (interpose sep c)
  "returns a list of the elements of the collection c separated by sep"
  (reduce (lambda (acc x) (++ acc sep x)) (car c) (cdr c)))

(define (replace replacers c)
  "given a map of replacement pairs and a collection, returns a
collection with any elements = a key in smap replaced with the
corresponding val in smap."
  (map (lambda (el) (get-from replacers el el)) c))

(define (zipmap keys vals) "returns a map with the keys mapped to the corresponding vals"
  (apply make-hash (zip keys vals)))