guile-vocabulary-trainer/vector-procs.scm

(library (vector-procs)
  (export vector-filter
          vector-union
          vector-contains
          vector-shuffle
          vector-update-elements)
  (import (except (rnrs base) vector-map)
          (only (guile)
                lambda* λ)
          (ice-9 exceptions)
          ;; SRFIs
          ;; srfi-43 for vector procs
          (srfi srfi-43)
          ;; custom libs
          (random-utils)
          (iter-utils)))


(define vector-copy-elements!
  (λ (source target indices)
    "Copy elements from vector SOURCE at INDICES to vector TARGET."
    ;; Iteratively copy all elements, which are matching.
    (let iter ([remaining-indices indices]
               [target-next-ind 0])
      (cond
       ;; If no more indices are left, return the new vector.
       [(null? remaining-indices) target]
       [else
        ;; Copy over the value from the source vector.
        (vector-set! target
                     target-next-ind
                     (vector-ref source (car remaining-indices)))
        ;; Continue with the rest of the indices.
        (iter (cdr remaining-indices)
              (+ target-next-ind 1))]))))


(define vector-filter
  (λ (pred vec)
    "Filter a vector and return the filtered vector."

    (define iter
      (λ (index entries-found-count indices)
        "Iterate over the whole vector from last to first
element, keeping track of elements, for which the predicate
pred is true. Build a list in reverse, which will be in the
order of going from first to last element of the vector,
without the need to reverse it later."
        (cond
         ;; If the whole vector has been searched for
         ;; matching elements, return the indices of
         ;; matching elements and the number of matching
         ;; elements found.
         [(< index 0)
          (values indices entries-found-count)]
         ;; Otherwise continue iterating over the vector.
         [else
          (let ([vec-elem (vector-ref vec index)])
            (cond
             ;; Case for matching elements.
             [(pred vec-elem)
              (iter (- index 1)
                    (+ entries-found-count 1)
                    (cons index indices))]
             [else
              (iter (- index 1)
                    entries-found-count
                    indices)]))])))

    (let-values ([(indices entries-found-count)
                  (iter (- (vector-length vec) 1)
                        0
                        '())])
      (vector-copy-elements! vec
                             (make-vector entries-found-count
                                          'undefined)
                             indices))))


(define vector-contains
  (lambda* (vec elem #:key (equal-test equal?))
    "Check whether the vector contains the given element is
in the given vector under the given equal-test function."
    (vector-any (λ (in-vec-item) (equal-test elem in-vec-item))
                vec)))


(define vector-union
  (lambda* (vec1 vec2 #:key (equal-test equal?))
    "Construct a new vector, containing all values of vector
vec1 and and vector vec2, but at most once."
    (let ([vec1-len (vector-length vec1)])
      (let iter ([index (- (vector-length vec1) 1)]
                 [result-lst (vector->list vec2)])
        (cond
         ;; Base case.
         [(< index 0)
          (list->vector result-lst)]
         [else
          (let ([elem (vector-ref vec1 index)])
            (cond
             ;; If the element was already in vec2, do not add
             ;; it to the result list.
             [(vector-contains vec2 elem #:equal-test equal?)
              (iter (- index 1) result-lst)]
             ;; If the element was not already in vec2, add it
             ;; to the result list.
             [else
              (iter (- index 1) (cons elem result-lst))]))])))))


(define vector-shuffle
  (lambda* (vec #:key (seed #f))
    "Shuffle the elements of a given vector and return a
shuffled version of the vector."
    (let* ([vec-len (vector-length vec)]
           [indices
            (if seed
                (fisher-yates-shuffle (range 0 vec-len) #:seed seed)
                (fisher-yates-shuffle (range 0 vec-len)))]
           [new-vec (make-vector vec-len 'undefined)])
      (let iter ([remaining-indices indices]
                 [new-vec-ind 0])
        (cond
         [(null? remaining-indices)
          new-vec]
         [else
          (vector-set! new-vec
                       new-vec-ind
                       (vector-ref vec (car remaining-indices)))
          (iter (cdr remaining-indices)
                (+ new-vec-ind 1))])))))


(define vector-update-elements
  (lambda* (current
            update
            #:key
            (should-update? (λ (elem-base elem-changed) #f))
            (update-item (λ (elem-base elem-changed) elem-changed)))
    "Update the given CURRENT vector using the given UPDATE
vector. Items are updated depending on
SHOULD-UPDATE?. UPDATE-ITEM performs the actual update of
the elements of CURRENT.
Runtime is O(m * n), where m is the number of elements in
the CURRENT vector and n is the number of elements in the
UPDATE vector."
    (define current-length (vector-length current))
    (define update-length (vector-length update))
    ;; We need map over current elements so that we get a
    ;; vector of same length.
    (vector-map
     (λ (i current-elem)
       ;; Inner loop loops over the updates, one by one,
       ;; checking if any of the updates applies to the
       ;; current element, using should-update?.
       (let next-update ([index 0])
         (cond
          ;; If no update applies to the current element,
          ;; simply return the current element.
          [(>= index update-length)
           current-elem]
          ;; Otherwise look at the update element.
          [else
           (let ([update-elem (vector-ref update index)])
             (cond
              ;; If the current element should be updated,
              ;; make use of the given merge-items procedure
              ;; to do so, in a way specified by the caller.
              [(should-update? current-elem update-elem)
               (update-item current-elem update-elem)]
              ;; Otherwise recur. Check if the next update
              ;; element might apply.
              [else
               (next-update (+ index 1))]))])))
     current)))