#lang racket (struct queue (h r hlen rlen)) ;; empty-queue : -> queue-of-X (define (empty-queue) (queue '() '() 0 0)) ;; add : queue-of-X X -> queue-of-X (define (add q v) (match q [(queue h r hl rl) (balance (queue h (stream-cons v r) hl (add1 rl)))])) ;; balance : queue-of-X -> queue-of-X ;; Makes sure that the forward list has at least ;; as many values as the reverse list (define (balance q) (match q [(queue h r hl rl) (if (rl . < . hl) q (queue (stream-append h (stream-reverse r)) '() (+ hl rl) 0))])) (define (stream-reverse s [accum empty]) (cond [(stream-empty? s) accum] [else (stream-reverse (stream-rest s) (stream-cons (stream-first s) accum))])) ;; head : queue-of-X -> X (define (head q) (match q [(queue '() '() 0 0) (error "queue is empty")] [(queue h r hl rl) (stream-first h)])) ;; tail : queue-of-X -> queue-of-X (define (tail q) (match q [(queue '() '() 0 0) (error "queue is empty")] [(queue h r hl rl) (balance (queue (stream-rest h) r (sub1 hl) rl))])) (define N 100000) (define M 10) (let ([q (time (for/fold ([q (empty-queue)]) ([i (in-range N)]) (add q i)))]) (time (for/fold ([q q]) ([i (in-range N)]) (unless (= i (head q)) (error "wrong")) (tail q))) (time (for/fold ([elem #f]) ([i (in-range N)]) (head q)))) (time (let ([big-q (for/fold ([q (empty-queue)]) ([i (in-range N)]) (define m (random M)) (define added-q (for/fold ([q q]) ([i (in-range (add1 m))]) (add q 'ok))) (for/fold ([q added-q]) ([i (in-range m)]) (unless (eq? 'ok (head q)) (error "wrong")) (tail q)))]) (for/fold ([q big-q]) ([i (in-range N)]) (unless (eq? 'ok (head q)) (error "wrong")) (tail q))))