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 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.
We need an e.g. delete-first
for multi-sets.