Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
134 lines (114 sloc) 4.63 KB

Add tests.

{for-each,map,reduce}-{un}ordered-subsets with optional k

These should cover all cases, right? See here for permutations; here for combinations. Permutations (e.g. ordered subsets) look simpler.

(use debug
     define-record-and-printer
     srfi-1)

(define ordered-subset-for-each
  (case-lambda
   ((f list)
    (for-each-ordered-subset list (length list)))
   ((f list k)
    (let iter ((list list)
               (k k) 
               (subset '()))
      (if (zero? k)
          (f subset)
          (for-each
              (lambda (element)
                (iter (delete element list)
                      (sub1 k)
                      (cons element subset)))
            list))))))

(define ordered-subset-fold
  (case-lambda
   ((cons nil list)
    (ordered-subset-fold cons nil list (length list)))
   ((cons nil list k)
    (let ((nil (make-parameter nil)))
      (ordered-subset-for-each
       (lambda (subset)
         (nil (cons subset (nil))))
       list k)
      (nil)))))

(define ordered-subset-map
  (case-lambda
   ((f list) (ordered-subset-map f list (length list)))
   ((f list k)
    (ordered-subset-fold cons '() list k))))

Is reduce or fold sufficient to implement for-each and map?

Let’s make this bitch circular; pop a sentinel on there; and recurse.

Hmm: we either have to copy the list or destroy it to make it circular:

(define (circular-list val1 . vals)
  (let ((ans (cons val1 vals)))
    (set-cdr! (last-pair ans) ans)
        ans))

We can apply the list to circular-list, but we run up against the apply ceiling; fuck it, let’s run up against it for now.

See this talk; uses the multiple index trick. There are some more notes.

This guy did it functionally.

See: Ehrlich, G. (1973b). Loopless algorithms for generating permutations, combinations, and other combinatorial configurations. Journal of the ACM 20 (3) 500–513.

(use debug
     vector-lib)

(define (project subset list)
  (vector-fold (lambda (i projection j)
                 (cons (list-ref list j) projection))
               '()
               subset))

;;; Thanks, Daniel Ángel Jiménez:
;;; <http://www.cs.utexas.edu/users/djimenez/utsa/cs3343/lecture25.html>.
(define unordered-subset-for-each
  (case-lambda
   ((f list)
    (unordered-subset-for-each f list (length list)))
   ((f list k)
    (let ((subset (make-vector k))
          (n (length list)))
      (let iter ((start 0)
                 (p 0))
        (if (= p k)
            (f (project subset list))
            (do ((i start (+ i 1)))
                ((= i n))
              (vector-set! subset p i)
              (iter (add1 i) (add1 p)))))))))

(define unordered-subset-fold
  (case-lambda
   ((cons nil list)
    (unordered-subset-fold cons nil list (length list)))
   ((cons nil list k)
    (let ((nil (make-parameter nil)))
      (unordered-subset-for-each
       (lambda (subset)
         (nil (cons subset (nil))))
       list
       k)
      (nil)))))

(define unordered-subset-map
  (case-lambda
   ((f list) (unordered-subset-map f list (length list)))
   ((f list k)
    (unordered-subset-fold cons '() list k))))

(unordered-subset-for-each display '(1 2 3 4) 3)
(debug (unordered-subset-fold cons '() '(1 2 3 4) 3)
       (unordered-subset-map values '(1 2 3 4) 3))

Replacement

Replacement is another dimension, too. Damn. Provide replacement as a flag, or use another procedure?

This merely affects (at least in the case of permutations), the delete operations.

Multi-sets

We need an e.g. delete-first for multi-sets.