project.ss
(module project mzscheme
  
  (require (all-except (lib "contract.ss") any)
           (lib "etc.ss")
           (lib "pretty.ss")
           (lib "list.ss" "srfi" "1"))
  
  ;; item->keys : list (list-of boolean) -> list
  ;;
  ;; Data and mask must be the same length. Each member of mask corresponds to a member of data.
  ;;
  ;; Returns a list of all members of data for which the corresponding mask boolean is set.
  (define (filter-keys data mask)
    (filter-map (lambda (key? item)
                  (if key? item #f))
                mask
                data))
  
  ;; partition-data : list (list-of boolean) -> (values list list)
  ;;
  ;; Data and mask must be the same length. Each member of mask corresponds to a member of data.
  ;;
  ;; Splits members of data into two lists: a list og members for which the corresponding mask bit is #t,
  ;; and a list of members for which the bit is #f.
  ;;
  ;; Returns both lists: the #t list first and the #f list second.
  (define (partition/mask data mask)
    (let loop ([data data] [mask mask] [accum1 null] [accum2 null])
      (if (null? data)
          (values (reverse accum1)
                  (reverse accum2))
          (if (car mask)
              (loop (cdr data)
                    (cdr mask)
                    (cons (car data) accum1)
                    accum2)
              (loop (cdr data)
                    (cdr mask)
                    accum1
                    (cons (car data) accum2))))))
  
  ;; project+fold
  ;;     : iterator
  ;;       accum
  ;;       (list-of (list-of (U key nonkey)))
  ;;       (list-of boolean)
  ;;       [ (key key -> boolean) ]
  ;;    -> accum
  ;;
  ;; where:
  ;;     iterator : (list key ... (list-of (list-of nonkey))) accum -> accum
  ;;     key      : any
  ;;     nonkey   : any
  ;;     accum    : any
  ;;
  ;; Iterates over the members of data:
  ;;   - Splits each member into a listof keys and a list of nonkeys (according to the mask):
  ;;         (list-of (U key nonkey)) -> (values (list-of key) (list-of nonkey))
  ;;   - For each sublist where adjacent members have matching keys, and accumulates their nonkeys into a list:
  ;;         -> (list key ... (list-of (list-of nonkey)))
  ;;   - Calls the iterator function, passing it this data structure and the current accumulator.
  ;;   - Continues iterating using the result of the iterator as the next accumulator.
  ;;   - When there is no more data, returns the final accumulator.
  (define project+fold
    (opt-lambda (proc initial-accum data mask [same? eq?])
      (if (null? data)
          null
          ; key-accum : (list-of any)
          ; rest-accum : (list-of (list-of any))
          ; ans-accum : (list-of (list any ... (list-of any)))
          ;
          ; Stores the keys from the last data item processed. As long as the keys stay the same,
          ; we keep key-accum the same and add data to rest-accum. If any keys change, we add a
          ; new row to ans-accum, change keys-accum, and set rest-accum to #f.
          (let loop ([data data] [key-accum (filter-keys (car data) mask)] [nonkey-accum null] [ans-accum initial-accum])
             (if (null? data)
                 (proc (append key-accum (list (reverse nonkey-accum)))
                       ans-accum)
                 (let-values ([(keys nonkeys) (partition/mask (car data) mask)])
                   ;(printf "data    ~a~nmask    ~a~nkeys    ~a~nnonkeys ~a~nkeya    ~a~nnonkeya ~a~nansa    ~a~n"
                   ;        data
                   ;        mask
                   ;        keys
                   ;        nonkeys
                   ;        key-accum
                   ;        nonkey-accum
                   ;        ans-accum)
                   (if (andmap same? keys key-accum)
                       (loop (cdr data)
                             key-accum
                             (cons nonkeys nonkey-accum)
                             ans-accum)
                       (loop (cdr data)
                             keys
                             (list nonkeys)
                             (proc (append key-accum (list (reverse nonkey-accum)))
                                   ans-accum)))))))))
  
  ;; project
  ;;     : (list-of (list-of (U key nonkey)))
  ;;       (list-of boolean)
  ;;       [ (key key -> boolean) ]
  ;;    -> accum
  ;;
  ;; Iterates over the members of data:
  ;;   - Splits each member into a list of keys and a list of nonkeys (according to the mask):
  ;;         (list-of (U key nonkey)) -> (values (list-of key) (list-of nonkey))
  ;;   - For each sublist where adjacent members have matching keys, and accumulates their nonkeys into a list:
  ;;         -> (list key ... (list-of (list-of nonkey)))
  ;;   - Accumulates and returns a list of these structures.
  (define project
    (opt-lambda (data mask [same? eq?])
      (reverse (project+fold cons null data mask same?))))
  
  ;; project+map
  ;;     : (key ... (list-of (list-of nonkey)) -> ans)
  ;;       (list-of (list-of (U key nonkey)))
  ;;       (list-of boolean)
  ;;       [ (key key -> boolean) ]
  ;;    -> (list-of ans)
  ;;
  ;; where:
  ;;     ans : any
  (define project+map
    (opt-lambda (proc data mask [same? eq?])
      (reverse (project+fold (lambda (data accum)
                               (cons (apply proc data) accum))
                             null
                             data
                             mask
                             same?))))
  
  ;; project+for-each
  ;;     : (key ... (list-of (list-of nonkey)) -> void)
  ;;       (list-of (list-of (U key nonkey)))
  ;;       (list-of boolean)
  ;;       [ (key key -> boolean) ]
  ;;    -> void
  ;;
  ;; where:
  ;;     ans : any
  (define project+for-each
    (opt-lambda (proc data mask [same? eq?])
      (reverse (project+fold (lambda (data accum)
                               (apply proc data))
                             (void)
                             data
                             mask
                             same?))
      (void)))
  
  ; Provide statements ---------------------------
  
  (provide partition/mask)
  
  (provide/contract
   [project+fold (opt-> (procedure?
                         any/c
                         (or/c pair? null?)
                         (listof boolean?))
                        (procedure?)
                        any/c)]
   [project      (opt-> ((or/c pair? null?)
                         (listof boolean?))
                        (procedure?)
                        any/c)]
   [project+map  (opt-> (procedure?
                         (or/c pair? null?)
                         (listof boolean?))
                        (procedure?)
                        (or/c pair? null?))]
   [project+for-each (opt-> (procedure?
                             (or/c pair? null?)
                             (listof boolean?))
                            (procedure?)
                            any/c)])
  
  )