6f1ffecc23
clean up build Moved `float-complex?' and `number->float-complex' to `math/base', documented them Documented `flexpt1p' Removed `samples->immutable-hash' (not covariant anyway; not going to use hashes)
57 lines
2.3 KiB
Racket
57 lines
2.3 KiB
Racket
#lang typed/racket/base
|
|
|
|
(require racket/list
|
|
racket/sequence
|
|
"../../base.rkt"
|
|
"../unsafe.rkt")
|
|
|
|
(provide samples->hash
|
|
count-samples
|
|
(struct-out sample-bin)
|
|
Real-Bin
|
|
bin-real-samples)
|
|
|
|
(struct: (A) sample-bin ([min : A] [max : A] [values : (Listof A)]) #:transparent)
|
|
|
|
(define-type Real-Bin (sample-bin Real))
|
|
|
|
(: samples->hash (All (A) ((Sequenceof A) -> (HashTable A Positive-Integer))))
|
|
(define (samples->hash xs)
|
|
(define: h : (HashTable A Positive-Integer) (make-hash))
|
|
(for: ([x : A xs])
|
|
(hash-set! h x (unsafe-fx+ 1 (hash-ref h x (λ () 0)))))
|
|
h)
|
|
|
|
(: count-samples (All (A) ((Sequenceof A) -> (Values (Listof A) (Listof Positive-Integer)))))
|
|
(define (count-samples xs)
|
|
(define h (samples->hash xs))
|
|
(define xws (hash-map h (λ: ([x : A] [c : Positive-Integer]) (cons x c))))
|
|
(values (map (λ: ([xw : (Pair A Positive-Integer)]) (car xw)) xws)
|
|
(map (λ: ([xw : (Pair A Positive-Integer)]) (cdr xw)) xws)))
|
|
|
|
(: bin-real-samples ((Sequenceof Real) (Sequenceof Real) -> (Listof Real-Bin)))
|
|
(define (bin-real-samples bin-bounds xs)
|
|
(let* ([bin-bounds (list* -inf.0 +inf.0 (sequence->list bin-bounds))]
|
|
[bin-bounds (filter (λ: ([x : Real]) (not (eqv? x +nan.0)))
|
|
(remove-duplicates bin-bounds))]
|
|
[bin-bounds (sort bin-bounds <)]
|
|
[x-min (first bin-bounds)]
|
|
[x-max (last bin-bounds)]
|
|
[xs (sequence->list xs)]
|
|
[xs (filter (λ: ([x : Real]) (<= x-min x x-max)) xs)]
|
|
[xs (sort xs <)])
|
|
(define-values (res rest-xs)
|
|
(for/fold: ([res : (Listof Real-Bin) empty]
|
|
[xs : (Listof Real) xs]
|
|
) ([x1 (in-list bin-bounds)]
|
|
[x2 (in-list (rest bin-bounds))])
|
|
(define-values (lst rest-xs)
|
|
(let: loop : (Values (Listof Real) (Listof Real)) ([lst : (Listof Real) empty]
|
|
[xs : (Listof Real) xs])
|
|
(if (and (not (empty? xs)) (<= x1 (first xs) x2))
|
|
(loop (cons (first xs) lst) (rest xs))
|
|
(values lst xs))))
|
|
(cond [(empty? lst) (values res rest-xs)]
|
|
[else (values (cons (sample-bin x1 x2 (reverse lst)) res) rest-xs)])))
|
|
(reverse res)))
|