zpcollections.zp

(defprotocol left-collec (pop-left 1) (append-left 2))
(defimpl left-collec vector?
         ((pop-left vector:head)
          (append-left (lambda (v el) (++ (vector el) v)))))
(defimpl left-collec byte-vector?
         ((pop-left byte-vector:head)
          (append-left (lambda (b el) (++ (byte-vector el) b)))))
(defimpl left-collec string?
         ((pop-left string:head)
          (append-left (lambda (s el) (++ (string el) v)))))
(defimpl left-collec list?
         ((pop-left list:car)
          (append-left list:append)))

(defprotocol right-collec (pop-right 1))
(defimpl right-collec vector? ((pop-right vector:last)))
(defimpl right-collec byte-vector? ((pop-right byte-vector:last)))
(defimpl right-collec string? ((pop-right string:last)))

(defprotocol extensible-collec (append :overloaded) (extend :overloaded))
(defimpl extensible-collec vector? ((append +=) (extend ++)))
(defimpl extensible-collec byte-vector? ((append +=) (extend ++)))
(defimpl extensible-collec string? ((append +=) (extend ++)))
(defimpl extensible-collec list? ((append +=) (extend ++)))

(define (collec-val:found? val)
  "do not expose"
  (cadr val))
(define (collec-val:val val)
  "do not expose"
  (car val))
(define (collec-val:found val)
  "do not expose"
  (list val #t))
(define (collec-val:not-found)
  "do not expose"
  (list (nil) #f))

(define (collec:get-from-skeleton f)
  "a skeleton to nicely integrate your collection into the get-from world;
   expects a function that takes the collection, an element to get and a default return element.

   params:
    - f: a functionf that accepts a collection, an index or key to find and a default return element
   complexity: O(1) (this function only generates the get-from implementation!
   returns: a get-from implementation"
  (lambda (collec elems . dflt)
    (let* ((dflt (if (null? dflt) (nil) (car dflt)))
           (elems (if (list? elems) elems (list elems))))
      (if (null? elems)
        collec
        (let* ((ret (f collec (car elems)))
               (stop (not (collec-val:found? ret)))
               (ret (collec-val:val ret)))
          (cond
            (stop dflt)
            ((collec? ret) (get-from ret (cdr elems) dflt))
            (else (if (null? (cdr elems)) ret dflt))))))))

(define (collec:update-in-skeleton f)
  "do not expose"
  (lambda (collec elems uf)
    (let ((elems (if (list? elems) elems (list elems))))
      (cond
        ((null? elems) collec)
        ((null? (cdr elems))
          (if (or (not (callable? uf)) (in? collec (car elems)))
            (f collec (car elems) (if (callable? uf) uf (lambda args uf)))
            collec))
        (else
          (let ((ret (get-from collec (car elems))))
            (if (updatable-collec? ret)
              (f collec (car elems) (lambda args (update-in ret (cdr elems) uf)))
              collec)))))))

(define (collec:delete-from-skeleton f)
  "do not expose"
  (lambda (collec elems)
    (let ((elems (if (list? elems) elems (list elems))))
      (cond
        ((null? elems) collec)
        ((null? (cdr elems))
          (if (in? collec (car elems))
            (f collec (car elems)))
            collec)
        (else
          (let ((ret (get-from collec (car elems))))
            (if (updatable-collec? ret)
              (update-in collec (car elems) (lambda args (delete-from ret (cdr elems))))
              collec)))))))

(defprotocol traversable-collec (car 1) (cdr 1) (null? 1) (empty 1))
(defimpl traversable-collec list? ((car list:car)
                                   (cdr list:cdr)
                                   (null? list:null?)
                                   (empty (lambda (l) []))))
(defimpl traversable-collec vector? ((car vector:head)
                                     (cdr vector:tail)
                                     (null? vector:empty?)
                                     (empty (lambda (v) {}))))
(defimpl traversable-collec byte-vector? ((car byte-vector:head)
                                          (cdr byte-vector:tail)
                                          (null? byte-vector:empty?)
                                          (empty (lambda (b) b{}))))
(defimpl traversable-collec string? ((car string:head)
                                     (cdr string:tail)
                                     (null? string:empty?)
                                     (empty (lambda (s) ""))))

(define head car)
(define tail cdr)

(defprotocol collec (length 1) (in? 2) (get-from :overloaded))
(defimpl collec vector?
         ((length vector:length)
          (in? vector:in?)
          (get-from (collec:get-from-skeleton
                      (lambda (v i)
                        (if (> (length v) i) (collec-val:found (v i)) (collec-val:not-found)))))))
(defimpl collec byte-vector?
         ((length byte-vector:length)
          (in? byte-vector:in?)
          (get-from (collec:get-from-skeleton
                      (lambda (v i)
                        (if (> (length v) i) (collec-val:found (v i)) (collec-val:not-found)))))))
(defimpl collec list?
         ((length list:length)
          (in? list:in?)
          (get-from (collec:get-from-skeleton
                      (lambda (l i)
                        (if (> (length l) i)
                          (collec-val:found (list:ref l i))
                          (collec-val:not-found)))))))
(defimpl collec hash-map?
         ((length (lambda (x) (list:length (hash:keys x))))
          (in? hash:contains?)
          (get-from (collec:get-from-skeleton
                      (lambda (h el)
                        (if (in? h el) (collec-val:found (h el)) (collec-val:not-found)))))))
(defimpl collec string?
         ((length string:length)
          (in? string:in?) 
          (get-from (collec:get-from-skeleton
                      (lambda (s i)
                        (if (> (length s) i)
                          (collec-val:found (string:ref s i))
                          (collec-val:not-found)))))))

(defprotocol updatable-collec (update-in 3) (delete-from 2))
(defimpl updatable-collec hash-map?
         ((update-in (collec:update-in-skeleton hash:update))
          (delete-from (collec:delete-from-skeleton hash:remove))))

(defprotocol summable (gsum 1))
(defimpl summable vector? ((gsum (lambda (x) (math:list-sum (vector->list x))))))
(defimpl summable byte-vector? ((gsum (lambda (x) (math:list-sum (byte-vector->list x))))))
(defimpl summable list? ((gsum math:list-sum)))

(defprotocol indexable (index-of 2))
(defimpl indexable vector? ((index-of vector:index)))
(defimpl indexable byte-vector? ((index-of byte-vector:index)))
(defimpl indexable list? ((index-of list:index)))
(defimpl indexable string? ((index-of string:find)))

(define (take n c)
  "returns a list of the first <par>n</par> items in the collection <par>c</par>,
or all items if there are fewer than <par>n</par>.

   params:
    - n: the number of values
    - c: the collection
   complexity: O(n)
   returns: a list of the arguments to <par>n</par>."
  (define (internal i acc c)
    (if (or (= i n) (null? c))
      acc
      (internal (add1 i) (++ acc (car c)) (cdr c))))
  (if (< 0 n)
    (internal 0 (empty c) c)
    (empty c)))

(define (drop n c)
  "elides the first <par>n</par> values from the collection <par>c</par>.

   params:
    - n: the number of values
    - c: the collection
   complexity: O(n)
   returns: a list of the arguments from <par>n</par> on."
  (define (internal i c)
    (if (null? c)
      []
      (if (= i n)
        c
        (internal (add1 i) (cdr c)))))
  (if (<= 0 n)
    (internal 0 c)
    c))

(define (take-while pred c)
  "returns a list of all the first items of the collection <par>c</par>
while <par>pred</par> is true.

  params:
    - pred: the predicate
    - c: the collection
  complexity: O(n*k) where k is the complexity of <par>pred</par>
  returns: a list of matching items"
  (define (internal acc c)
    (if (null? c)
      acc
      (let ((f (car c)))
        (if (pred f)
          (internal (++ acc f) (cdr c))
          acc))))
  (internal (empty c) c))

(define (drop-while pred c)
  "elides values from the collection <par>c</par> as long as <par>pred</par> is true.

   params:
     - pred: the predicate
     - c: the collection
   complexity: O(n*k) where k is the complexity of <par>pred</par>
   returns: a list of matching items"
  (define (internal c)
    (if (and (not (null? c)) (pred (car c)))
      (internal (cdr c))
      c))
  (internal c))

(define (take-nth n c)
 "returns a list of every nth item in the collection c.

  params:
    - n: the skip counter
    - c: the collection
  complexity: O(n)
  returns: a list of every <par>n</par>th item in the collection"
  (define (internal i acc c)
    (if (null? c)
      acc
      (internal (add1 i) (++ acc (if (eq? 0 (mod i n)) (car c) [])) (cdr c))))
  (internal 0 (empty c) c))

(define (split-at n c)
  "equivalent to chaining <fun>take</fun> and <fun>drop</fun>

   params:
    - n: the number
    - c: the collection
   complexity: O(n)
   returns: <zepto>[(take n c) (drop n c)]</zepto>"
  (list (take n c) (drop n c)))

(define (split-with pred c)
  "equivalent to chaining <fun>take-while</fun> and <fun>drop-while</fun>

   params:
    - pred: the predicate
    - c: the collection
   complexity: O(n)
   returns: <zepto>[(take-while pred c) (drop-while pred c)]</zepto>"
  (list (take-while pred c) (drop-while pred c)))

(define (frequencies collec)
  "takes an iterable collection and returns a hashmap that contains
   the count of every element in the collection.

   params:
    - collec: the collection
   complexity: O(n)
   returns: a hashmap that contains the count of every element in <par>collec</par>"
  (let loop ((collec collec)
             (acc #{}))
    (if (null? collec)
      acc
      (let ((h (car collec))
            (t (cdr collec)))
        (loop t (hash:set acc h (add1 (get-from acc h 0))))))))

(define (position coll)
  "returns a hashmap from item to the position of its first occurence in <par>coll</par>.

   params:
    - coll: the collection to process
   complexity: O(n*2)
   returns: a new hashmap"
  (make-hash (reverse (indexed-map list coll))))

(define (slice n coll)
  "divides <par>coll</par> into <par>n</par> approximately equal slices.

   params:
     - n: the number of slices
     - coll: the collection
   complexity: O(n)
   returns: a list of slices"
   (partition-all (ceil (/. (length coll) n)) coll))

(define (single? coll)
  "Does the collection have only one element?

   params:
    - coll: the collection
   complexity: O(1)
   returns: a boolean"
  (and (not (null? coll)) (null? (cdr coll))))