Skip to content

Instantly share code, notes, and snippets.

@rain-1 rain-1/another way
Last active Mar 12, 2019

Embed
What would you like to do?
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
You can’t perform that action at this time.