k-n-combinations.rkt
#lang racket | |
(require racket/stream) | |
(define (make-prefix len) | |
(lambda (tail) | |
(append (make-list len '_) (cons 'o tail)))) | |
(define (k-combinations k n) | |
(cond ((= k 0) | |
(list (make-list n '_))) | |
((> k n) | |
'()) | |
(else (let loop ((i 0)) | |
(if (> i (- n k)) | |
'() | |
(stream-append (stream-map (make-prefix i) | |
(k-combinations (- k 1) (- n (+ i 1)))) | |
(loop (+ i 1)))))))) | |
> (stream->list (k-combinations 3 7)) | |
'((o o o _ _ _ _) | |
(o o _ o _ _ _) | |
(o o _ _ o _ _) | |
(o o _ _ _ o _) | |
(o o _ _ _ _ o) | |
(o _ o o _ _ _) | |
(o _ o _ o _ _) | |
(o _ o _ _ o _) | |
(o _ o _ _ _ o) | |
(o _ _ o o _ _) | |
(o _ _ o _ o _) | |
(o _ _ o _ _ o) | |
(o _ _ _ o o _) | |
(o _ _ _ o _ o) | |
(o _ _ _ _ o o) | |
(_ o o o _ _ _) | |
(_ o o _ o _ _) | |
(_ o o _ _ o _) | |
(_ o o _ _ _ o) | |
(_ o _ o o _ _) | |
(_ o _ o _ o _) | |
(_ o _ o _ _ o) | |
(_ o _ _ o o _) | |
(_ o _ _ o _ o) | |
(_ o _ _ _ o o) | |
(_ _ o o o _ _) | |
(_ _ o o _ o _) | |
(_ _ o o _ _ o) | |
(_ _ o _ o o _) | |
(_ _ o _ o _ o) | |
(_ _ o _ _ o o) | |
(_ _ _ o o o _) | |
(_ _ _ o o _ o) | |
(_ _ _ o _ o o) | |
(_ _ _ _ o o o)) |
#lang racket | |
(require racket/stream) | |
;; https://en.wikipedia.org/wiki/Combination#/media/File:Combinations_with_repetition;_5_multichoose_3.svg | |
;; k-element multisets from n-element set | |
;; | |
;; e.g. k=3, n=5 | |
;; | |
;; (1 1 1) | |
;; (2 1 1) | |
;; ... | |
;; (5 5 5) | |
(define (cons/dup y) | |
(and (pair? y) (cons (car y) y))) | |
(define (+1-multiset n state) | |
(if (null? state) | |
#f | |
(if (= n (car state)) | |
(cons/dup (+1-multiset n (cdr state))) | |
(cons (+ 1 (car state)) (cdr state))))) | |
(define (k/n-multiset k n) | |
(let loop ((state (make-list k 1))) | |
(if state | |
(stream-cons state (loop (+1-multiset n state))) | |
'()))) | |
; > (stream->list (k/n-multiset 3 5)) | |
; '((1 1 1) | |
; (2 1 1) | |
; (3 1 1) | |
; (4 1 1) | |
; (5 1 1) | |
; (2 2 1) | |
; (3 2 1) | |
; (4 2 1) | |
; (5 2 1) | |
; (3 3 1) | |
; (4 3 1) | |
; (5 3 1) | |
; (4 4 1) | |
; (5 4 1) | |
; (5 5 1) | |
; (2 2 2) | |
; (3 2 2) | |
; (4 2 2) | |
; (5 2 2) | |
; (3 3 2) | |
; (4 3 2) | |
; (5 3 2) | |
; (4 4 2) | |
; (5 4 2) | |
; (5 5 2) | |
; (3 3 3) | |
; (4 3 3) | |
; (5 3 3) | |
; (4 4 3) | |
; (5 4 3) | |
; (5 5 3) | |
; (4 4 4) | |
; (5 4 4) | |
; (5 5 4) | |
; (5 5 5)) | |
(define (vector-inc! vec i) | |
(vector-set! vec i (+ 1 (vector-ref vec i)))) | |
(define (bijection-1 k n) | |
(lambda (state) | |
(let ((result (make-vector n 0))) | |
(for-each (lambda (i) (vector-inc! result (- i 1))) state) | |
(vector->list result)))) | |
; > (stream->list (stream-map (bijection-1 3 5) (k/n-multiset 3 5))) | |
; '((3 0 0 0 0) | |
; (2 1 0 0 0) | |
; (2 0 1 0 0) | |
; (2 0 0 1 0) | |
; (2 0 0 0 1) | |
; (1 2 0 0 0) | |
; (1 1 1 0 0) | |
; (1 1 0 1 0) | |
; (1 1 0 0 1) | |
; (1 0 2 0 0) | |
; (1 0 1 1 0) | |
; (1 0 1 0 1) | |
; (1 0 0 2 0) | |
; (1 0 0 1 1) | |
; (1 0 0 0 2) | |
; (0 3 0 0 0) | |
; (0 2 1 0 0) | |
; (0 2 0 1 0) | |
; (0 2 0 0 1) | |
; (0 1 2 0 0) | |
; (0 1 1 1 0) | |
; (0 1 1 0 1) | |
; (0 1 0 2 0) | |
; (0 1 0 1 1) | |
; (0 1 0 0 2) | |
; (0 0 3 0 0) | |
; (0 0 2 1 0) | |
; (0 0 2 0 1) | |
; (0 0 1 2 0) | |
; (0 0 1 1 1) | |
; (0 0 1 0 2) | |
; (0 0 0 3 0) | |
; (0 0 0 2 1) | |
; (0 0 0 1 2) | |
; (0 0 0 0 3)) | |
(define (toggle! vec i n) | |
(let loop ((j i) (n n)) | |
(if (= n 0) | |
vec | |
(begin | |
(vector-set! vec j 'x) | |
(loop (+ j 1) (- n 1)))))) | |
(define (bijection-2 k n) | |
(lambda (state) | |
(let ((result (make-vector (+ n k -1) '_))) | |
(let loop ((i 0) (state state)) | |
(if (null? state) | |
#t | |
(begin (toggle! result i (car state)) | |
(loop (+ i 1 (car state)) (cdr state))))) | |
result))) | |
; > (stream->list (stream-map (bijection-2 3 5) (stream-map (bijection-1 3 5) (k/n-multiset 3 5)))) | |
; '(#(x x x _ _ _ _) | |
; #(x x _ x _ _ _) | |
; #(x x _ _ x _ _) | |
; #(x x _ _ _ x _) | |
; #(x x _ _ _ _ x) | |
; #(x _ x x _ _ _) | |
; #(x _ x _ x _ _) | |
; #(x _ x _ _ x _) | |
; #(x _ x _ _ _ x) | |
; #(x _ _ x x _ _) | |
; #(x _ _ x _ x _) | |
; #(x _ _ x _ _ x) | |
; #(x _ _ _ x x _) | |
; #(x _ _ _ x _ x) | |
; #(x _ _ _ _ x x) | |
; #(_ x x x _ _ _) | |
; #(_ x x _ x _ _) | |
; #(_ x x _ _ x _) | |
; #(_ x x _ _ _ x) | |
; #(_ x _ x x _ _) | |
; #(_ x _ x _ x _) | |
; #(_ x _ x _ _ x) | |
; #(_ x _ _ x x _) | |
; #(_ x _ _ x _ x) | |
; #(_ x _ _ _ x x) | |
; #(_ _ x x x _ _) | |
; #(_ _ x x _ x _) | |
; #(_ _ x x _ _ x) | |
; #(_ _ x _ x x _) | |
; #(_ _ x _ x _ x) | |
; #(_ _ x _ _ x x) | |
; #(_ _ _ x x x _) | |
; #(_ _ _ x x _ x) | |
; #(_ _ _ x _ x x) | |
; #(_ _ _ _ x x x)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment