| Andrew Cooke | Contents | Latest | RSS | Twitter | Previous | Next

C[omp]ute

Welcome to my blog, which was once a mailing list of the same name and is still generated by mail. Please reply via the "comment" links.

Always interested in offers/projects/new ideas. Eclectic experience in fields like: numerical computing; Python web; Java enterprise; functional languages; GPGPU; SQL databases; etc. Based in Santiago, Chile; telecommute worldwide. CV; email.

Personal Projects

Lepl parser for Python.

Colorless Green.

Photography around Santiago.

SVG experiment.

Professional Portfolio

Calibration of seismometers.

Data access via web services.

Cache rewrite.

Extending OpenSSH.

Last 100 entries

Ssh, tty, stdout and stderr; Feathers falling in a vacuum; Santiago 30m Bike Route; Mapa de Ciclovias en Santiago; How Unreliable is UDP?; SE Santiago 20m Bike Route; Cameron's Rap; Configuring libxml with Eclipse; Reducing Combinatorial Complexity With Occam - AI; Sentidos Comunes (Chilean Online Magazine); Hilary Mantel: The Assassination of Margaret Thatcher - August 6th 1983; NSA Interceptng Gmail During Delivery; General IIR Filters; What's happening with Scala?; Interesting (But Largely Illegible) Typeface; Retiring Essentialism; Poorest in UK, Poorest in N Europe; I Want To Be A Redneck!; Reverse Racism; The Lost Art Of Nomography; IBM Data Center (Photo); Interesting Account Of Gamma Hack; The Most Interesting Audiophile In The World; How did the first world war actually end?; Ky - Restaurant Santiago; The Black Dork Lives!; The UN Requires Unaninmous Decisions; LPIR - Steganography in Practice; How I Am 6; Clear Explanation of Verizon / Level 3 / Netflix; Teenage Girls; Formalising NSA Attacks; Switching Brakes (Tektro Hydraulic); Naim NAP 100 (Power Amp); AKG 550 First Impressions; Facebook manipulates emotions (no really); Map Reduce "No Longer Used" At Google; Removing RAID metadata; New Bike (Good Bike Shop, Santiago Chile); Removing APE Tags in Linux; Compiling Python 3.0 With GCC 4.8; Maven is Amazing; Generating Docs from a GitHub Wiki; Modular Shelves; Bash Best Practices; Good Emergency Gasfiter (Santiago, Chile); Readings in Recent Architecture; Roger Casement; Integrated Information Theory (Or Not); Possibly undefined macro AC_ENABLE_SHARED; Update on Charges; Sunburst Visualisation; Spectral Embeddings (Distances -> Coordinates); Introduction to Causality; Filtering To Help Colour-Blindness; ASUS 1015E-DS02 Too; Ready Player One; Writing Clear, Fast Julia Code; List of LatAm Novels; Running (for women); Building a Jenkins Plugin and a Jar (for Command Line use); Headphone Test Recordings; Causal Consistency; The Quest for Randomness; Chat Wars; Real-life Financial Co Without ACID Database...; Flexible Muscle-Based Locomotion for Bipedal Creatures; SQL Performance Explained; The Little Manual of API Design; Multiple Word Sizes; CRC - Next Steps; FizzBuzz; Update on CRCs; Decent Links / Discussion Community; Automated Reasoning About LLVM Optimizations and Undefined Behavior; A Painless Guide To CRC Error Detection Algorithms; Tests in Julia; Dave Eggers: what's so funny about peace, love and Starship?; Cello - High Level C Programming; autoreconf needs tar; Will Self Goes To Heathrow; Top 5 BioInformatics Papers; Vasovagal Response; Good Food in Vina; Chilean Drug Criminals Use Subsitution Cipher; Adrenaline; Stiglitz on the Impact of Technology; Why Not; How I Am 5; Lenovo X240 OpenSuse 13.1; NSA and GCHQ - Psychological Trolls; Finite Fields in Julia (Defining Your Own Number Type); Julian Assange; Starting Qemu on OpenSuse; Noisy GAs/TMs; Venezuela; Reinstalling GRUB with EFI; Instructions For Disabling KDE Indexing; Evolving Speakers; Changing Salt Size in Simple Crypt 3.0.0; Logarithmic Map (Moved)

© 2006-2013 Andrew Cooke (site) / post authors (content).

Basic 2D Geometry Routines

From: "andrew cooke" <andrew@...>

Date: Sat, 18 Aug 2007 16:28:41 -0400 (CLT)

I *think* this is fairy efficient, but haven't actually done any profiling
(I know...)

":";exec snow -- "$0" "$@"

(package* napito-base/v1.0.0

  (provide:
   (define (nap-default-transform)))

  (author: "Andrew Cooke <andrew at acooke.org>")
  (homepage: "http://www.acooke.org")
  (description: "Napito drawing description language - support routines")
  (keywords: graphics)
  (license: gpl/v3.0))

(define (nap-default-transform) '(1 0 0 0 1 0))

(define-syntax dot
  (syntax-rules ()
    ((_ (op1 arg1 ...) (op2 arg2 ...))
     (receive (a b c) (op1 arg1 ...)
       (receive (x y z) (op2 arg2 ...)
         (+ (* a x) (* b y) (* c z)))))))

(define-syntax row1 (syntax-rules () ((_ a b c d e f) (values a b c))))
(define-syntax row2 (syntax-rules () ((_ a b c d e f) (values d e f))))
(define-syntax col1 (syntax-rules () ((_ a b c d e f) (values a d 0))))
(define-syntax col2 (syntax-rules () ((_ a b c d e f) (values b e 0))))
(define-syntax col3 (syntax-rules () ((_ a b c d e f) (values c f 1))))
(define-syntax xyz  (syntax-rules () ((_ x y)         (values x y 1))))

(define-syntax split (syntax-rules () ((_ lst) (values (car lst) (cdr
lst)))))

(define (unpack6 lst)
  (receive (a as) (split lst)
    (receive (b bs) (split as)
      (receive (c cs) (split bs)
        (receive (d ds) (split cs)
          (receive (e es) (split ds)
            (receive (f fs) (split es)
              (values a b c d e f))))))))

(define (unpack2 lst)
  (receive (a as) (split lst)
    (receive (b bs) (split as)
      (values a b))))

(define (nap-transform-point transform point)
  (receive (a b c d e f) (unpack6 transform)
    (receive (x y) (unpack2 point)
      (list (dot (row1 a b c d e f) (xyz x y))
            (dot (row2 a b c d e f) (xyz x y))))))

(define (nap-join-transforms before extra)
  (receive (p q r s t u) (unpack6 before)
    (receive (a b c d e f) (unpack6 extra)
      (list (dot (row1 p q r s t u) (col1 a b c d e f))
            (dot (row1 p q r s t u) (col2 a b c d e f))
            (dot (row1 p q r s t u) (col3 a b c d e f))
            (dot (row2 p q r s t u) (col1 a b c d e f))
            (dot (row2 p q r s t u) (col2 a b c d e f))
            (dot (row2 p q r s t u) (col3 a b c d e f))))))

(test*
 (let ((unit '(1 0 0 0 1 0))
       (doublex '(2 0 0 0 1 0))
       (incx '(1 0 1 0 1 0))
       (one '(1 1)))
   (expect* (equal? '(1 1) (nap-transform-point unit one)))
   (expect* (equal? '(2 1) (nap-transform-point doublex one)))
   (expect* (equal? '(2 1) (nap-transform-point incx one)))
   (expect* (equal? unit (nap-join-transforms unit unit)))
   (expect* (equal? '(4 1)
                    (nap-transform-point
                     (nap-join-transforms doublex incx) one)))
   (expect* (equal? '(3 1)
                    (nap-transform-point
                     (nap-join-transforms incx doublex) one)))))

More Specific Operations

From: "andrew cooke" <andrew@...>

Date: Sat, 18 Aug 2007 17:00:31 -0400 (CLT)

(define (nap-shift-x d) (list 1 0 d 0 1 0))
(define (nap-shift-y d) (list 1 0 0 0 1 d))
(define (nap-scale f) (list f 0 0 0 f 0))
(define (nap-scale-x f) (list f 0 0 0 1 0))
(define (nap-scale-y f) (list 1 0 0 0 f 0))
(define pi 3.1415926)
(define (nap-rotate-deg d)
  (let* ((r (/ (* pi d) 180))
         (c (cos r))
         (s (sin r)))
    (list c (- s) 0 s c 0)))

(test*
 (define (almost-equal? ab pq)
   (define (close x y) (< (abs (- x y)) 0.01))
   (receive (a b) (unpack2 ab)
     (receive (p q) (unpack2 pq)
       (and (close a p) (close b q)))))
 (let ((unit '(1 0 0 0 1 0))
       (incx2 (nap-shift-x 2))
       (incy3 (nap-shift-y 3))
       (double (nap-scale 2))
       (scalex3 (nap-scale-x 3))
       (scaley4 (nap-scale-y 4))
       (rot90 (nap-rotate-deg 90))
       (one '(1 1)))
   (expect* (equal? '(3 1) (nap-transform-point incx2 one)))
   (expect* (equal? '(1 4) (nap-transform-point incy3 one)))
   (expect* (equal? '(2 2) (nap-transform-point double one)))
   (expect* (equal? '(3 1) (nap-transform-point scalex3 one)))
   (expect* (equal? '(1 4) (nap-transform-point scaley4 one)))
   (expect* (almost-equal? '(0.999 -0.001) '(1 0)))
   (expect* (almost-equal? '(-1 1) (nap-transform-point rot90 one)))))

Andrew

Not Efficient!

From: "andrew cooke" <andrew@...>

Date: Sun, 19 Aug 2007 18:00:57 -0400 (CLT)

The values/receive code is constructing and discarding vectors,
apparently.  need to rewrite...

Andrew

Significantly Faster

From: "andrew cooke" <andrew@...>

Date: Sun, 19 Aug 2007 21:15:33 -0400 (CLT)

I've removed values/receive by (1) using CPS in the macros that select
particular elements and (2) using vectors, which simplifies unpacking.

":";exec snow -- "$0" "$@"

; this is about 40% faster than napito-base.scm

; qp6 napito: ./napito-vector.scm
; warming up
; 100000 timing
; (time (speed 1 %%n1414))
;     1403 ms real time
;     1316 ms cpu time (1316 user, 0 system)
;     95 collections accounting for 571 ms real time (548 user, 0 system)
;     891208784 bytes allocated
;     no minor faults
;     no major faults

(package* napito-vector/v1.0.0

  (provide:
   (define nap-default-transform)
   (define (nap-transform-handler engine))
   (define (nap-join-transforms before extra))
   (define (nap-transform-point transform point)))

  (author: "Andrew Cooke <andrew at acooke.org>")
  (homepage: "http://www.acooke.org")
  (description: "Napito drawing description language - support routines")
  (keywords: graphics)
  (license: gpl/v3.0))

(define nap-default-transform '#(1 0 0 0 1 0))

(define (dot a b c) (lambda (p q r) (+ (* a p) (* b q) (* c r))))

(define-syntax row1 (syntax-rules () ((_ a b c d e f fun) (fun a b c))))
(define-syntax row2 (syntax-rules () ((_ a b c d e f fun) (fun d e f))))
(define-syntax col1 (syntax-rules () ((_ a b c d e f fun) (fun a d 0))))
(define-syntax col2 (syntax-rules () ((_ a b c d e f fun) (fun b e 0))))
(define-syntax col3 (syntax-rules () ((_ a b c d e f fun) (fun c f 1))))
(define-syntax xyz  (syntax-rules () ((_ x y fun)         (fun x y 1))))

; this is *much* slower
; (define (row1 a b c d e f fun) (fun a b c))
; (define (row2 a b c d e f fun) (fun d e f))
; (define (col1 a b c d e f fun) (fun a d 0))
; (define (col2 a b c d e f fun) (fun b e 0))
; (define (col3 a b c d e f fun) (fun c f 1))
; (define (xyz  x y fun)         (fun x y 1))

(define (unpack6 vec fun)
  (let* ((a (vector-ref vec 0))
         (b (vector-ref vec 1))
         (c (vector-ref vec 2))
         (d (vector-ref vec 3))
         (e (vector-ref vec 4))
         (f (vector-ref vec 5)))
    (fun a b c d e f)))

(define (unpack2 vec fun)
  (let* ((a (vector-ref vec 0))
         (b (vector-ref vec 1)))
    (fun a b)))

(define (nap-transform-point transform point)
  (unpack6 transform (lambda (a b c d e f)
    (unpack2 point (lambda (x y)
      (vector (row1 a b c d e f (xyz x y dot))
              (row2 a b c d e f (xyz x y dot))))))))

(define (nap-join-transforms before extra)
  (unpack6 before (lambda (p q r s t u)
    (unpack6 extra (lambda (a b c d e f)
      (vector (row1 p q r s t u (col1 a b c d e f dot))
              (row1 p q r s t u (col2 a b c d e f dot))
              (row1 p q r s t u (col3 a b c d e f dot))
              (row2 p q r s t u (col1 a b c d e f dot))
              (row2 p q r s t u (col2 a b c d e f dot))
              (row2 p q r s t u (col3 a b c d e f dot))))))))

(test*
 (let ((unit '#(1 0 0 0 1 0))
       (doublex '#(2 0 0 0 1 0))
       (incx '#(1 0 1 0 1 0))
       (one '#(1 1)))
   (expect* (equal? '#(1 1) (nap-transform-point unit one)))
   (expect* (equal? '#(2 1) (nap-transform-point doublex one)))
   (expect* (equal? '#(2 1) (nap-transform-point incx one)))
   (expect* (equal? unit (nap-join-transforms unit unit)))
   (expect* (equal? '#(4 1)
                    (nap-transform-point
                     (nap-join-transforms doublex incx) one)))
   (expect* (equal? '#(3 1)
                    (nap-transform-point
                     (nap-join-transforms incx doublex) one)))))

(define (nap-shift-x d) (list 1 0 d 0 1 0))
(define (nap-shift-y d) (list 1 0 0 0 1 d))
(define (nap-scale f) (list f 0 0 0 f 0))
(define (nap-scale-x f) (list f 0 0 0 1 0))
(define (nap-scale-y f) (list 1 0 0 0 f 0))
(define pi 3.1415926)
(define (nap-rotate-deg d)
  (let* ((r (/ (* pi d) 180))
         (c (cos r))
         (s (sin r)))
    (list c (- s) 0 s c 0)))

(test*
 (define (almost-equal? ab pq)
   (define (close x y) (< (abs (- x y)) 0.01))
   (receive (a b) (unpack2 ab)
     (receive (p q) (unpack2 pq)
       (and (close a p) (close b q)))))
 (let ((unit '#(1 0 0 0 1 0))
       (incx2 (nap-shift-x 2))
       (incy3 (nap-shift-y 3))
       (double (nap-scale 2))
       (scalex3 (nap-scale-x 3))
       (scaley4 (nap-scale-y 4))
       (rot90 (nap-rotate-deg 90))
       (one '#(1 1)))
   (expect* (equal? '#(3 1) (nap-transform-point incx2 one)))
   (expect* (equal? '#(1 4) (nap-transform-point incy3 one)))
   (expect* (equal? '#(2 2) (nap-transform-point double one)))
   (expect* (equal? '#(3 1) (nap-transform-point scalex3 one)))
   (expect* (equal? '#(1 4) (nap-transform-point scaley4 one)))
   (expect* (almost-equal? '#(0.999 -0.001) '#(1 0)))
   (expect* (almost-equal? '#(-1 1) (nap-transform-point rot90 one)))
   (expect* (equal? '#(3 4) (nap-transform-point
                            (nap-join-transforms incx2 incy3) one)))))

; this wraps an engine and normalizes all transform actions
(define (nap-transform-handler engine)
  (define (forward transform)
    (engine 'nap-transform transform))
  (lambda (action args)
    (case action
      ((nap-shift-x) (forward (nap-shift-x (car args))))
      ((nap-shift-y) (forward (nap-shift-y (car args))))
      ((nap-scale) (forward (nap-scale (car args))))
      ((nap-scale-x) (forward (nap-scale-x (car args))))
      ((nap-scale-y) (forward (nap-scale-y (car args))))
      ((nap-rotate-deg) (forward (nap-rotate-deg (car args))))
      (else (engine action args)))))

(define (speed n limit)
  (if (> n limit)
      '()
      (let ((a (vector n n n n n n))
            (b (vector n n n n n n)))
        (nap-join-transforms a b)
        (speed (+ n 1) limit))))

(define (measure n)
  (display "warming up\n")
  (speed 1 n)
  (display (list n " timing\n"))
  (time (speed 1 n)))

(measure 100000)

Andrew

Comment on this post