guile-website-example/app/lib/utils/list-utils.scm

(library (lib utils list-utils)
  (export list-prefix?
          list-suffix?
          multirember*-with-equal-proc
          multirember-with-equal-proc
          multirember-equal
          multirember*-equal
          list-prefixes
          list-prefixes-long-to-short)
  (import
    (rnrs base)
    (only (guile) lambda* λ)
    ;; SRFIs
    ;; list procs
    (srfi srfi-1)
    ;; custom modules
    (prefix (logging) log:)))


(define rest
  (λ (lst)
    (cdr lst)))


(define list-prefix?
  (λ (lst lst-prefix)
    (cond
     [(null? lst-prefix) #t]
     [(null? lst) #f]
     [else
      (cond
       [(equal? (first lst) (first lst-prefix))
        (list-prefix? (rest lst) (rest lst-prefix))]
       [else #f])])))


(define list-suffix?
  (λ (lst maybe-suffix)
    (cond
     [(null? maybe-suffix) #t]
     [(null? lst) #f]
     [else
      (cond
       [(equal? (first lst) (first maybe-suffix))
        (equal? lst maybe-suffix)]
       [else
        (list-suffix? (rest lst) maybe-suffix)])])))


(define multirember*-with-equal-proc
  (λ (equal-proc)
    (λ (lst unwanted)
      (let loop ([remaining-list lst])
        (cond
         [(null? remaining-list)
          '()]
         ;; case for finding the unwanted element in the list
         [(equal-proc (first remaining-list) unwanted)
          (loop (rest remaining-list))]
         ;; case for handling nested lists
         [(pair? (first remaining-list))
          (cons (loop (first remaining-list))
                (loop (rest remaining-list)))]
         [else
          (cons (first remaining-list)
                (loop (rest remaining-list)))])))))


(define multirember-with-equal-proc
  (λ (equal-proc)
    (λ (lst unwanted)
      (let loop ([remaining-list lst])
        (cond
         [(null? remaining-list)
          '()]
         [(equal-proc (first remaining-list) unwanted)
          (loop (rest remaining-list))]
         [else
          (cons (first remaining-list)
                (loop (rest remaining-list)))])))))


(define multirember-equal
  (multirember-with-equal-proc equal?))


(define multirember*-equal
  (multirember*-with-equal-proc equal?))


;; TODO: Can this function be optimized for better time or space behavior?
;; Probably the current runtime is: O(n^2 + (2 * (n - 1))) = O(n^2)
(define list-prefixes
  (λ (lst)
    ;; O(n) * ... for iterating over all list elements
    (let iter ([remaining lst] [prefixes '()] [acc-prefix '()])
      (cond
       [(null? remaining) '()]
       ;; + O(2 * (n - 1)) for reversing all n-1 prefixes. Elements appear in
       ;; multiple prefixes.
       [(null? (rest remaining)) (reverse prefixes)]
       [else
        (let ([updated-acc-prefix
               ;; append is O(n). This is done for each iteration to a longer
               ;; and longer accumulated prefix. This means that this O(n) is
               ;; multiplied with the O(n) of the iteration.
               (append acc-prefix (list (first remaining)))])
          (iter (rest remaining)
                (cons updated-acc-prefix prefixes)
                updated-acc-prefix))]))))


(define list-prefixes-long-to-short
  (λ (lst)
    ;; O(n) * ... for iterating over all list elements
    (let iter ([remaining lst] [prefixes '()] [acc-prefix '()])
      (cond
       [(null? remaining) '()]
       [(null? (rest remaining)) prefixes]
       [else
        (let ([updated-acc-prefix
               ;; append is O(n). This is done for each iteration to a longer
               ;; and longer accumulated prefix. This means that this O(n) is
               ;; multiplied with the O(n) of the iteration.
               (append acc-prefix (list (first remaining)))])
          (iter (rest remaining)
                (cons updated-acc-prefix prefixes)
                updated-acc-prefix))]))))