Created
January 4, 2015 14:25
-
-
Save bahmanm/468f724279c0f411030a to your computer and use it in GitHub Desktop.
Computes the combinations of any number of given lists as a lazy sequence.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
; Copyright Bahman Movaqar <Bahman AT BahmanM.com> | |
; Source -> https://github.com/bahmanm/touka/blob/master/misc.scm | |
; Tests -> https://github.com/bahmanm/touka/blob/master/tests/misc-tests.scm | |
;; Collects the CAR of each list in the given list of lists! | |
(define (cars list-of-lists) | |
(map car list-of-lists)) | |
;; Collects the CDR of each list in the given list of lists! | |
(define (cdrs list-of-lists) | |
(map cdr list-of-lists)) | |
;; Calculates the combinations of the given lists. | |
;; For example, calling (list-combinations '(a b) '(1) '(X Y Z)) produces | |
;; (a 1 X), (a 1 Y), (a 1 Z), (b 1 X), (b 1 Y), (b 1 Z) | |
(define (list-combinations . lists) | |
(let lc ((current lists) (first-element? #t)) | |
(lazy-seq | |
(if first-element? (cons (cars current) (lc current #f)) | |
(let ((advanced (%advance-current current lists #t))) | |
(if (equal? advanced lists) '() | |
(cons (cars advanced) | |
(lc advanced #f)))))))) | |
;; Advances the current list of lists one element ahead. As meaningless as | |
;; it sounds, it is at the heart of the list combinations. | |
;; A couple of examples: | |
;; 1) current-lists: ((a b c) (10 20) (w x y)) | |
;; original-lists: ((a b c) (10 20) (w x y)) | |
;; result: ((b c) (10 20) (w x y)) | |
;; 2) current-lists: (() (20) (x y)) | |
;; original-lists: ((a b c) (10 20) (w x y)) | |
;; result: ((a b c) (10 20) (x y)) | |
(define (%advance-current current-lists original-lists advance?) | |
(cond | |
((null? current-lists) '()) | |
((not advance?) current-lists) | |
(else | |
(let ((new-current-list (cdr (car current-lists)))) | |
(if (null? new-current-list) | |
(append (list (car original-lists)) | |
(%advance-current (cdr current-lists) | |
(cdr original-lists) #t)) | |
(append (list new-current-list) | |
(%advance-current (cdr current-lists) | |
(cdr original-lists) #f))))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment