0～9の数字からなる3～4桁の組み合わせで1と6を含むもの

をサクッと知りたかった。

	;; http://d.hatena.ne.jp/ibaza/20080303/1204476552
	;; nCr（n個からr個取り出す組合せ）は、
	;; 1. リストの先頭要素を除いた残りのリストからr-1個を選ぶ組合せのそれぞれに先頭要素を加えたものと、
	;; 2. リストの先頭要素を除いたリストからr個を選ぶ組合せの合計となる(1および2はそれぞれ再帰処理となる)。
	;; 3. n = r のときは選び方は一つなのでリストをそのままリストにして返す。例：(a b c) なら ((a b c)) にして返す
	;; 4. r = 1 のときは選び方はn通りあるのでリストの要素をそれぞれリストにして返す。例：(a b c) なら ((a) (b) (c)) にして返す
	;; 5. r = 0 または r がリストの要素数より大きいときは空リストを返す。
	(define (combination ls r)
	(let ((nlen (length ls)))
	(cond ((or (null? ls)
	(not (positive? r))
	(< nlen r)) '())
	((= r 1)(map list ls))
	((= nlen r)(list ls))
	(else (append (map (pa$ cons (car ls))
	(combination (cdr ls)(- r 1)))
	(combination (cdr ls) r))))))
	(print (combination '(1 2 3 4 5 6 7 8 9) 3))
	(use util.combinations)
	(use srfi-1)
	(lset= equal?
	(combination '(1 2 3 4 5 6 7 8 9) 3)
	(combinations '(1 2 3 4 5 6 7 8 9) 3))
	(define (members ls obj . objs)
	(let ((objs (cons obj objs)))
	(every identity (map (cut member <> ls) objs))))
	(define (members ls obj . objs)
	(let ((objs (cons obj objs)))
	(every identity (map (compose not not (cut member <> ls)) objs))))
	(define (members ls obj . objs)
	(let ((objs (cons obj objs)))
	(let/cc hop
	(fold (lambda (e acc)
	(if e
	(cons e acc)
	(hop #f)))
	'()
	(map (cut member <> ls) objs)))))
	(print (members '(1 2 3 4 5) 3 5))
	(print (members '(1 2 3 4 5) 6))
	(define (contains ls n . ns)
	(let ((ns (cons n ns)))
	(filter (lambda (ls)
	(apply members ls ns))
	ls)))
	(contains (combinations (iota 5) 2) 1)
	(contains (combinations (iota 10) 4) 6 1)
	(contains (combinations (iota 10) 3) 6 1)
	(define (combinations-list src count . counts)
	(let ((counts (cons count counts)))
	(fold (lambda (e acc)
	(append acc (combinations src e)))
	'()
	counts)))
	(combinations-list (iota 5) 3 4)
	(combinations-list (iota (- 4 (- 3 1)) 3))
	(define (make-list min max . opt)
	(let-optionals* opt ((step 1))
	(iota (- (quotient max step)(- min 1)) min step)))
	;; (define (contains-combinations src min max obj . objs)
	;; (let ((objs (cons obj objs)))
	;; (apply contains (apply combinations-list src (make-list min max)) objs)))
	;; (contains-combinations (iota 10 0) 3 4 1 6)
	(contains (combinations-list (iota 10) 3 4) 1 6)
	(define (disp-combinations ls)
	(for-each print
	ls))
	(disp-combinations (contains (combinations-list (iota 10) 3 4) 1 6))
	;; (0 1 6)
	;; (1 2 6)
	;; (1 3 6)
	;; (1 4 6)
	;; (1 5 6)
	;; (1 6 7)
	;; (1 6 8)
	;; (1 6 9)
	;; (0 1 2 6)
	;; (0 1 3 6)
	;; (0 1 4 6)
	;; (0 1 5 6)
	;; (0 1 6 7)
	;; (0 1 6 8)
	;; (0 1 6 9)
	;; (1 2 3 6)
	;; (1 2 4 6)
	;; (1 2 5 6)
	;; (1 2 6 7)
	;; (1 2 6 8)
	;; (1 2 6 9)
	;; (1 3 4 6)
	;; (1 3 5 6)
	;; (1 3 6 7)
	;; (1 3 6 8)
	;; (1 3 6 9)
	;; (1 4 5 6)
	;; (1 4 6 7)
	;; (1 4 6 8)
	;; (1 4 6 9)
	;; (1 5 6 7)
	;; (1 5 6 8)
	;; (1 5 6 9)
	;; (1 6 7 8)
	;; (1 6 7 9)
	;; (1 6 8 9)

view raw combinations-filter.scm hosted with ❤ by GitHub

• Gauche ユーザリファレンス: 11.42 util.combinations - 組み合わせ
• 組合せのアルゴリズム - sketch code

gauche の util.combinations の combinations 手続きのソースがエレガントだったぁ・・・。

• SourceForge.net Repository - [gauche] Contents of /Gauche/trunk/lib/util/combinations.scm

ローカルだと

• /Gauche/share/gauche/0.9/lib/util/combinations.scm