Optimization Coach Demo - RacketCon 2012

cantor-pairing-image.rkt

#lang racket

(require slideshow unstable/gui/slideshow)

(define points
  (for/list ([i 10])
    (disk 10)))

(define named-points
  (for/list ([p points] [i (in-naturals)])
    (vc-append p (blank 5) (text (number->string i)))))

(define padded-points
  (for/list ([p named-points])
    (inset p 20)))

(define placed-points
  (tabular (list (list-ref padded-points 9)
                 (blank)
                 (blank)
                 (blank))
           (list (list-ref padded-points 5)
                 (list-ref padded-points 8)
                 (blank)
                 (blank))
           (list (list-ref padded-points 2)
                 (list-ref padded-points 4)
                 (list-ref padded-points 7)
                 (blank))
           (list (list-ref padded-points 0)
                 (list-ref padded-points 1)
                 (list-ref padded-points 3)
                 (list-ref padded-points 6))))

(define chained-points
  (for/fold ([res placed-points])
      ([from points]
       [to   (rest points)])
    (pin-arrow-line 15 res from cc-find to cc-find)))

chained-points

cantor-pairing-v0.rkt

#lang typed/racket

(: pair : Integer Integer -> Integer)
(define (pair x y)
  (+ (quotient (* (+ x y) (+ y x 1)) 2) y))

(: unpair : Integer -> (values Integer Integer))
(define (unpair z)
  (define w (inexact->exact (floor (assert (/ (- (sqrt (+ (* 8 z) 1)) 1) 2)
                                           real?))))
  (define t (/ (+ (* w w) w) 2))
  (define y (assert (- z t) exact-integer?))
  (define x (assert (- w y) exact-integer?))
  (values x y))

(: check : Integer -> Void)
(define (check z)
  (define-values (x y) (unpair z))
  (unless (= (pair x y) z)
    (eprintf "~s => ~s ~s => ~s\n"
             z x y (pair x y))))

(time
 (for ([i (in-range 3000000)])
   (check i)))

cantor-pairing-v1.rkt

#lang typed/racket

(require racket/flonum)

(: pair : Integer Integer -> Integer)
(define (pair x y)
  (+ (quotient (* (+ x y) (+ y x 1)) 2) y))

(: unpair : Integer -> (values Integer Integer))
(define (unpair z)
  (define w (inexact->exact (floor (/ (- (flsqrt (+ (* 8 (->fl z)) 1)) 1) 2))))
  (define t (/ (+ (* w w) w) 2))
  (define y (assert (- z t) exact-integer?))
  (define x (assert (- w y) exact-integer?))
  (values x y))

(: check : Integer -> Void)
(define (check z)
  (define-values (x y) (unpair z))
  (unless (= (pair x y) z)
    (eprintf "~s => ~s ~s => ~s\n"
             z x y (pair x y))))

(time
 (for ([i (in-range 3000000)])
   (check i)))

cantor-pairing-v2.rkt

#lang typed/racket

(require racket/flonum)

(: pair : Float Float -> Float)
(define (pair x y)
  (+ (/ (* (+ x y) (+ y x 1)) 2) y))

(: unpair : Float -> (values Float Float))
(define (unpair z)
  (define w (floor (/ (- (flsqrt (+ (* 8 z) 1)) 1) 2)))
  (define t (/ (+ (* w w) w) 2))
  (define y (- z t))
  (define x (- w y))
  (values x y))

(: check : Float -> Void)
(define (check z)
  (define-values (x y) (unpair z))
  (unless (= (pair x y) z)
    (eprintf "~s => ~s ~s => ~s\n"
             z x y (pair x y))))

(time
 (for ([i (in-range 3000000)])
   (check (->fl i))))