Skip to content

Instantly share code, notes, and snippets.

@logc
Created June 6, 2017 16:57
Show Gist options
  • Save logc/2bba297b9806e40ac4bc49cb50bf84de to your computer and use it in GitHub Desktop.
Save logc/2bba297b9806e40ac4bc49cb50bf84de to your computer and use it in GitHub Desktop.
#lang typed/racket/base
(require racket/future)
(require racket/performance-hint)
(require racket/cmdline)
(require (only-in racket/unsafe/ops
unsafe-car
unsafe-cdr))
(require (rename-in racket/unsafe/ops
[unsafe-fx+ +]
[unsafe-fx- -]
[unsafe-fx= =]))
(define-type BinaryTree (U BinaryTreeLeaf BinaryTreeNode))
(define-type BinaryTreeLeaf Boolean)
(define-type BinaryTreeNode (Pair BinaryTree BinaryTree))
(define node cons)
(: make (-> Fixnum BinaryTree))
(define (make d)
(cond [(= d 0) (node #f #f)]
[else (node (make (- d 1)) (make (- d 1)))]))
(: node-left (case-> (BinaryTree -> BinaryTree)
(BinaryTreeLeaf -> BinaryTreeLeaf)))
(define (node-left t)
(cond [(pair? t) (unsafe-car t)]
[else t]))
(: node-right (case-> (BinaryTree -> BinaryTree)
(BinaryTreeLeaf -> BinaryTreeLeaf)))
(define (node-right t)
(cond [(pair? t) (unsafe-cdr t)]
[else t]))
(begin-encourage-inline
(: check (case-> (BinaryTree Fixnum -> Fixnum)
(BinaryTreeLeaf Fixnum -> Fixnum)))
(define (check t acc)
(cond [(node-left t) (check (node-right t) (check (node-left t) (+ acc 1)))]
[else (+ acc 1)]))
)
(: main (-> Fixnum Void))
(define (main n)
(define min-depth : Fixnum 4)
(define max-depth : Fixnum (max (+ min-depth 2) n))
(define stretch-depth : Fixnum (+ max-depth 1))
(printf "stretch tree of depth ~a\t check: ~a\n" stretch-depth (check (make stretch-depth) 0))
(define long-lived-tree : BinaryTree (make max-depth))
(: generate-trees-and-check (-> Integer Void))
(define (generate-trees-and-check d)
(define iterations (arithmetic-shift 1 (+ (- max-depth d) min-depth)))
(printf "~a\t trees of depth ~a\t check: ~a\n"
iterations
d
(for/sum ([_ (in-range iterations)])
(check (make d) 0))))
(let ([futures : (Listof (Futureof Void)) (for/list ([d (in-range 4 (add1 max-depth) 2)])
(future (lambda () (generate-trees-and-check d))))])
(for ([f futures]) (touch f)))
(printf "long lived tee of depth ~a\t check: ~a\n" max-depth (check long-lived-tree 0)))
(command-line #:args (#{n : String})
(main (assert (string->number n) fixnum?)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment