Aufgaben1

Aus ProgrammingWiki

Archivierte Version vom 2010-04-11T17:14:23+00:00. Aktuelle Version

(require-library 'sisc/libs/srfi/srfi-19)
(import srfi-19)
(time-second (current-time))

(define random-maker
 (let* ((multiplier 48271)
        (modulus 2147483647)
        (apply-congruence
         (lambda (current-seed)
           (let ((candidate (modulo (* current-seed multiplier) modulus)))
             (if (zero? candidate)
                 modulus
                 candidate))))
        (coerce
         (lambda (proposed-seed)
           (if (integer? proposed-seed)
               (- modulus (modulo proposed-seed modulus))
               19860617))))  ;; an arbitrarily chosen birthday
 (lambda (initial-seed)
   (let ((seed (coerce initial-seed)))
     (lambda args
       (cond ((null? args)
              (set! seed (apply-congruence seed))
              (/ (- modulus seed) modulus))
             ((null? (cdr args))
              (let* ((proposed-top
                      (ceiling (abs (car args))))
                     (exact-top
                      (if (inexact? proposed-top)
                          (inexact->exact proposed-top)
                          proposed-top))
                     (top
                      (if (zero? exact-top)
                          1
                          exact-top)))
                (set! seed (apply-congruence seed))
                (inexact->exact (floor (* top (/ seed modulus))))))
             ((eq? (cadr args) 'reset)
              (set! seed (coerce (car args))))
             (else
              (display "random: unrecognized message")
              (newline))))))))

(define random (random-maker (time-nanosecond (current-time))))

(define tl
  (lambda (ls v)
    (if (null? ls)
        (values '() '())
        (call-with-values
         (lambda () (tl (cdr ls) v))
         (lambda (li re)
           (let ((x (car ls)))
             (if (< x v)
                 (values (cons x li) re)
                 (values li (cons x re)))))))))

(define quicksort
  (lambda (list test)
  (if (< (length list) 2) list
      (let ((p (list-ref list (random (length list)))))
        (append (quicksort (filter (lambda (x) (< x p)) list) test)
                (filter (lambda (x) (= x p)) list)
                (quicksort (filter (lambda (x) (> x p)) list) test))))))

(define test
  (lambda (n)
    (let ((list (rest (build-list n (lambda (x) (random n))))))
    (time-nanosecond (quicksort list test)
    'done))))

<eval id="4bc2036fb47a4">(quicksort (zufallsliste 40) (test 2000))</eval>

Aufgaben1

Suche