guile-ml/utils/list.scm

(define-module (utils list))


(use-modules
 ;; SRFI 1 for additional list procedures
 (srfi srfi-1)
 ;; SRFI-27 for random number utilities
 (srfi srfi-27)
 (utils string)
 (utils collections)
 (utils random))


(define-public map*
  (lambda (proc lst)
    (cond [(null? lst) '()]
          [(pair? (car lst))
           (cons (map* proc (car lst))
                 (map* proc (cdr lst)))]
          [else
           (cons (proc (car lst))
                 (map* proc (cdr lst)))])))


(define-public stringify*
  (lambda (lst)
    (map* stringify lst)))


(define-public apply-multiple
  (lambda (procs val)
    (cond
     [(null? procs) val]
     [else
      (apply-multiple (cdr procs) ((car procs) val))])))


(define-public fisher-yates-shuffle
  (lambda* (lst #:key (seed #f))
    (let ([get-rand-int (make-random-integer-generator #:seed seed)]
          [lst-as-vec (list->vector lst)])
      (let loop
          ;; Build up a list as result, which contains the elements of the
          ;; original list.
          ([result '()]
           ;; The list needs to have the same amount of elements as the original
           ;; list.
           [elements-to-pick (vector-length lst-as-vec)])
        (cond
         [(zero? elements-to-pick) result]
         [else
          (let*
              ;; Get a random number. [0,limit)
              ;; example: limit = 10, rand-int = 9
              ([rand-int (get-rand-int elements-to-pick)]
               ;; Get randomly an existing value from the vector of values, which
               ;; was created from the given list.
               ;; example: val = 9th value
               [val (vector-ref lst-as-vec rand-int)])
            ;; At the position, where we go the value from, set another value,
            ;; overwriting the value we already picked.  Overwrite it with the
            ;; value, which otherwise cannot be picked any longer, as we count
            ;; down the elements-to-pick and lower the limit for the random
            ;; integer generation.

            ;; There are 2 cases here:

            ;; Case 1: The picked value was already the value at the position (-
            ;; elements-to-pick 1). In this case, it does not matter, that the
            ;; value can not be picked again and we only write it back to its own
            ;; position.

            ;; Case 2: The picked value was any value at an index lower than (-
            ;; elements-to-pick 1). In this case, we keep the possibility, that
            ;; the value at (- elements-to-pick 1) can be picked in the next
            ;; iteration, by writing that value to the position of the picked
            ;; value.

            ;; This way, as the limit for random integers gets lower, all values
            ;; will eventually be picked.

            ;; Save the value at the highest possible index, so that it can be
            ;; picked next iteration. Overwrite already picked value.
            (vector-set! lst-as-vec
                         rand-int
                         ;; Take the value at the highest index.
                         (vector-ref lst-as-vec
                                     (- elements-to-pick 1)))
            (loop
             ;; Add the randomly chosen value to the list of values.
             (cons val result)
             ;; Count down the elements, which we still need to pick.
             (- elements-to-pick 1)))])))))


(define-public list-reduce (make-reducer car cdr null?))


(define-public accumulate
  (lambda (op initial seq)
    (if (null? seq)
        initial
        ;; Is is getting the first element of the sequence, but to calculate the
        ;; result, it requires, that the result for the rest of the sequence is
        ;; calculated. With strict evaluation order, this means, that the first
        ;; actual application of `op` is going to happen with the last element
        ;; of the sequence and the given `initial` value.
        (op (car seq)
            (accumulate op initial (cdr seq))))))


(define-public fold-right
  (lambda (op initial seq)
    ;; folding right means to start folding on the right and progress towards
    ;; the left side, assuming a reading direction and display direction of the
    ;; sequence from left to right.
    (accumulate op initial seq)))


(define-public fold-left
  (lambda (op initial seq)
    ;; folding left means to accumulate a result starting by applying the `op`
    ;; to the `initial` value and the first element of the sequence, resulting
    ;; in an intermediate result and then progressing through the sequence,
    ;; always applying `op` to the updated intermediate result and the first
    ;; element of the rest of the sequence.
    (define (iter result remaining)
      (if (null? remaining)
          result
          (iter (op (car remaining) result)
                (cdr remaining))))
    (iter initial seq)))


(define-public flatten
  (lambda (lst)
    (cond
     [(null? lst) '()]
     [else
      (let ([head (car lst)]
            [tail (cdr lst)])
        (cond
         [(pair? head)
          (append (flatten head) (flatten tail))]
         [else
          (cons head (flatten tail))]))])))


(define-public list-range
  (lambda (lst start end)
    "Get the sub list of a list starting at start and ending at end, including
the start index and excluding the end index: [start, end)."
    (cond
     [(null? lst) '()]
     [else
      (take (drop lst start)
            (- end start))])))


;; Procedures not included in Scheme or Guile need to be added. count was added
;; for porting the code from Racket to Scheme.
(define-public count
  (lambda (pred ls)
    "Count the elements of the list ls for which the predicate pred returns #t."
    (let iter ([remaining ls] [count 0])
      (cond
       [(null? remaining) count]
       [else
        (if (pred (car remaining))
            (iter (cdr remaining) (+ count 1))
            (iter (cdr remaining) count))]))))


#;(define-public list-mean
  (lambda (lst)
    "Calculate the inexact mean of a list of numbers."
    (exact->inexact
     (/ (apply + lst)
        (length lst)))))


(define-public take-up-to
  (lambda (n xs)
    "Take the first n elements from the list."
    (cond
     [(or (zero? n) (null? xs))
      '()]
     [else
      (cons (car xs)
            (take-up-to (- n 1) (cdr xs)))])))


(define-public drop-up-to
  (lambda (n xs)
    "Drop the first n elements from the list xs."
    (cond
     [(or (= n 0) (null? xs))
      xs]
     [else
      (drop-up-to (- n 1) (cdr xs))])))


(define-public split-into-chunks-of-size-n
  (lambda (xs n)
    "Split up a list xs into sub lists, which contain at maximum n elements. It
is possible, that the last sub list contains less elements, if the length of the
list is not divisable by n."
    (cond
     [(null? xs) '()]
     [else
      (let ([first-chunk (take-up-to n xs)]
            [rest (drop-up-to n xs)])
        (cons first-chunk (split-into-chunks-of-size-n rest n)))])))


(define-public range
  (lambda* (start end #:optional (step 1))
    (cond
     [(>= start end) '()]
     [else
      (cons start
            (range (+ start step)
                   end
                   step))])))