(module permute mzscheme
(require (lib "list.ss")
(lib "etc.ss")
(prefix is: (lib "integer-set.ss")))
(provide random-list
random-range)
(define (random-range low high)
(+ low (random (add1 (- high low)))))
(define (random-list lst)
(let loop ([new empty]
[is (is:make-range 0 (max 0 (sub1 (length lst))))])
(if (equal? (is:card is) 0)
new
(let* ([wfs (is:integer-set-contents is)]
[a-rr (list-ref wfs (random (length wfs)))]
[next-point (random-range (car a-rr) (cdr a-rr))])
(loop (list* (list-ref lst next-point) new)
(is:difference is (is:make-range next-point)))))))
(provide for-all for-all*)
(define-syntax (for-all stx)
(syntax-case stx ()
[(_ body (id arg) ...)
(andmap identifier? (syntax-e #'(id ...)))
#'(for-all* (lambda (id ...) body) arg ...)]))
(define (for-all* f . xs) (map (lambda (x) (apply f x)) (all-selections xs)))
(define (all-selections xs)
(cond
[(null? xs) '()]
[(null? (cdr xs)) (map list (car xs))]
[else
(let ((rest (all-selections (cdr xs))))
(apply append (map (lambda (item) (inject item rest)) (car xs))))]))
(define (inject item lists)
(cond
[(null? lists) '()]
[else (cons (cons item (car lists)) (inject item (cdr lists)))])))