diff --git a/pkgs/data-pkgs/data-doc/data/scribblings/enumerate.scrbl b/pkgs/data-pkgs/data-doc/data/scribblings/enumerate.scrbl index 949524752b..edc603a6f6 100644 --- a/pkgs/data-pkgs/data-doc/data/scribblings/enumerate.scrbl +++ b/pkgs/data-pkgs/data-doc/data/scribblings/enumerate.scrbl @@ -1,6 +1,8 @@ #lang scribble/manual @(require scribble/eval (for-label data/enumerate + data/enumerate/lib + racket/math racket/contract racket/base)) @@ -662,4 +664,56 @@ An @tech{enumeration} of S-expressions. (approximate any/e 5) ]} +@section{Library Enumerations} +@(the-eval '(require data/enumerate/lib)) + +@defmodule[data/enumerate/lib] + +This library defines some library @tech{enumerations} built on +@racketmodname[data/enumerate]. + +@defproc[(permutations-of-n/e [n exact-nonnegative-integer?]) + enum?]{ + +Returns an @tech{enumeration} of the permutations of the natural +numbers smaller than @racket[n]. + +@examples[#:eval the-eval +(approximate (permutations-of-n/e 3) 5) +]} + +@defproc[(permutations/e [l list?]) + enum?]{ + +Returns an @tech{enumeration} of the permutations of @racket[l]. + +@examples[#:eval the-eval +(approximate (permutations/e '(Brian Jenny Ted Ki)) 5) +]} + +@defproc[(infinite-sequence/e [e enum?]) + enum?]{ + +Returns an @tech{enumeration} of infinite sequences of elements of +@racket[e]. (Unfortunately, @racket[encode] does not work on this +@tech{enumeration}, for reasons you may be able to predict.) + +The infinite sequence corresponding to the natural number @racket[_n] +is based on dividing the bits of @racket[(* (+ 1 _n) pi)] into chunks +of bits where the largest value is @racket[(size e)]. Since +@racket[(* (+ 1 _n) pi)] has infinite digits, there are infinitely +many such chunks. Since @racket[*] is defined on all naturals, there +are infinitely many such numbers. The generation of the sequence is +efficient in the sense that the digits are generated incrementally +without needing to go deeper. The generation of the sequence is +inefficient in the sense that the approximation of @racket[(* (+ 1 _n) +pi)] gets larger and larger as you go deeper into the sequence. + +@examples[#:eval the-eval +(define bjtk/e (from-list/e '(Brian Jenny Ted Ki))) +(define bjtks/e (infinite-sequence/e bjtk/e)) +(for ([e (from-nat bjtks/e 42)] + [i (in-range 10)]) + (printf "~a = ~a\n" i e))]} + @close-eval[the-eval] diff --git a/pkgs/data-pkgs/data-enumerate-lib/data/enumerate/lib.rkt b/pkgs/data-pkgs/data-enumerate-lib/data/enumerate/lib.rkt new file mode 100644 index 0000000000..cd8b8137e8 --- /dev/null +++ b/pkgs/data-pkgs/data-enumerate-lib/data/enumerate/lib.rkt @@ -0,0 +1,176 @@ +#lang racket/base +(require racket/contract/base + data/enumerate + math/number-theory + racket/generator) + +(define (BPP-digits N) + (let loop ([8Pi -8]) + (define 8i + (+ 8 8Pi)) + + (define (E k) + (/ 1 (+ 8i k))) + + (define pi_i + (* N + (+ (* +4 (E 1)) + (* -2 (E 4)) + (* -1 (E 5)) + (* -1 (E 6))))) + + (for ([c (in-string (number->string pi_i))]) + (unless (eq? #\/ c) + (yield (- (char->integer c) (char->integer #\0))))) + + (loop 8i))) + +(define (bits-of k) + (/ (log k) (log 2))) + +;; XXX just subtract k if greater than k and then push the digit to +;; left and go on +(define (10-sequence->K-sequence k seq) + (cond + [(< k 10) + (10-sequence->sub10-sequence k seq)] + [(= k 10) + seq] + [else + (10-sequence->sup10-sequence k seq)])) + +(define (10-sequence->sub10-sequence k seq) + (in-generator + (for ([d seq]) + (when (< d k) + (yield d))))) + +(define (10-sequence->sup10-sequence k seq) + (in-generator + (let loop () + (define d + (for/sum ([i (in-range (ceiling (/ (log k) (log 10))))] + [sub-d seq]) + (* sub-d (expt 10 i)))) + (yield (modulo d k)) + (loop)))) + +(module+ main + (define HOW-MANY 5000) + + (define (test-seq K seq) + (define d->i (make-hasheq)) + (for ([i (in-range HOW-MANY)] + [d seq]) + (hash-update! d->i d add1 0)) + + (define total + (for/fold ([cnt 0]) ([i (in-range K)]) + (define i-cnt (hash-ref d->i i 0)) + (printf "\t~a => ~a" i i-cnt) + (when (and (= 4 (modulo i 5)) (not (= i (sub1 K)))) (newline)) + (+ cnt i-cnt))) + (newline) + + (unless (= HOW-MANY total) + (error 'digits "Missed some: ~a" total))) + + (define (test-digits N) + (printf "BPP ~a\n" N) + (test-seq 10 (in-generator (BPP-digits N)))) + + (test-digits 1) + (test-digits 9) + + (define (test-tetris K N) + (printf "BPP ~a -> ~a\n" N K) + (test-seq K (10-sequence->K-sequence K (in-generator (BPP-digits N))))) + + (test-tetris 7 1) + (test-tetris 7 2) + (test-tetris 15 1) + (test-tetris 15 2) + + (test-tetris 100 2)) + +(define (infinite-sequence/e inner/e) + (define seed/e nat/e) + (define K (size inner/e)) + (define (seed->seq N) + (define K-seq + (10-sequence->K-sequence K (in-generator (BPP-digits (+ 1 N))))) + (in-generator + (for ([k K-seq]) + (yield (from-nat inner/e k))))) + (map/e seed->seq error seed/e)) + +(module+ test + (define sevens/e (infinite-sequence/e (below/e 7))) + (define s (from-nat sevens/e 42)) + (for ([e s] + [i (in-range 10)]) + (printf "~a = ~a\n" i e))) + +(define PERMS (make-hasheq)) +(define (permutations-of-n/e n) + (hash-ref! + PERMS n + (λ () + (cond + [(zero? n) + (const/e '())] + [else + (dep2/e + (factorial n) + (below/e n) + (λ (v) + (map/e + (λ (l) + (for/list ([i (in-list l)]) + (if (= i v) + (sub1 n) + i))) + (λ (l) + (for/list ([i (in-list l)]) + (if (= i (sub1 n)) + v + i))) + (permutations-of-n/e (sub1 n)))))])))) + +(module+ test + (define perms/e (permutations-of-n/e 3)) + (for ([i (in-range (size perms/e))]) + (define l (from-nat perms/e i)) + (printf "~a = ~a = ~a\n" i + l + (to-nat perms/e l)))) + +(define (permutations/e l) + (define idx->e (list->vector l)) + (define e->idx + (for/hash ([e (in-list l)] + [i (in-naturals)]) + (values e i))) + (map/e + (λ (l) + (for/list ([idx (in-list l)]) + (vector-ref idx->e idx))) + (λ (l) + (for/list ([e (in-list l)]) + (hash-ref e->idx e))) + (permutations-of-n/e (vector-length idx->e)))) + +(module+ test + (define abcds/e (permutations/e '(a b c d))) + (for ([i (in-range 10)]) + (define l (from-nat abcds/e i)) + (printf "~a = ~a = ~a\n" i l (to-nat abcds/e l)))) + +(provide + (contract-out + [infinite-sequence/e + (-> enum? enum?)] + [permutations/e + (-> list? enum?)] + [permutations-of-n/e + (-> exact-nonnegative-integer? enum?)]))