| 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.

C-ORM: docs, API.

Last 100 entries

Weird Componentized Virus; Interesting Argentinian Author - Antonio Di Benedetto; Useful Thread on MetaPhysics; RAND on fighting online anarchy (2001); Now Is Cat Soft LLC's Chance To Save Up To 32% On Mail; NSA Hacked; Call Center Services for Cat Soft LLC; Very Good LRB Article on Brexit; Nussbaum on Anger; Credit Card Processing for Cat Soft LLC; Discover new movies on demand in our online cinema; Tasting; Credit Card Processing for Cat Soft LLC; Apple + Kiwi Jam; Hit Me; Increase Efficiency with GPS Vehicle Tracking for Cat Soft LLC; Sudoku - CSP + Chaos; Recycling Electronics In Santiago; Vector Displays in OpenGL; Call Center Services for Cat Soft LLC; And Anti-Aliased; OpenGL - Render via Intermediate Texture; And Garmin Connect; Using Garmin Forerunner 230 With Linux; Payroll Service Quotes for Cat Soft LLC; (Beating Dead Horse) StackOverflow; Current State of Justice in China; Now Is Cat Soft LLC's Chance To Save Up To 32% On Mail; Axiom of Determinacy; Ewww; Fee Chaos Book; Course on Differential Geometry; Increase Efficiency with GPS Vehicle Tracking for Cat Soft LLC; Okay, but...; Sparse Matrices, Deep Learning; Sounds Bad; Applebaum Rape; Tomato Chutney v4; Have to add...; Culturally Liberal and Nothing More; Weird Finite / Infinite Result; Your diamond is a beaten up mess; Maths Books; Good Bike Route from Providencia / Las Condes to Panul\; Iain Pears (Author of Complex Plots); Plum Jam; Excellent; More Recently; For a moment I forgot StackOverflow sucked; A Few Weeks On...; Chilean Book Recommendations; How To Write Shared Libraries; Jenny Erpenbeck (Author); Dijkstra, Coins, Tables; Python libraries error on OpenSuse; Deserving Trump; And Smugness; McCloskey Economics Trilogy; cmocka - Mocks for C; Concept Creep (Americans); Futhark - OpenCL Language; Moved / Gone; Fan and USB issues; Burgers in Santiago; The Origin of Icosahedral Symmetry in Viruses; autoenum on PyPI; Jars Explains; Tomato Chutney v3; REST; US Elections and Gender: 24 Point Swing; PPPoE on OpenSuse Leap 42.1; SuperMicro X10SDV-TLN4F/F with Opensuse Leap 42.1; Big Data AI Could Be Very Bad Indeed....; Cornering; Postcapitalism (Paul Mason); Black Science Fiction; Git is not a CDN; Mining of Massive Data Sets; Rachel Kaadzi Ghansah; How great republics meet their end; Raspberry, Strawberry and Banana Jam; Interesting Dead Areas of Math; Later Taste; For Sale; Death By Bean; It's Good!; Tomato Chutney v2; Time ATAC MX 2 Pedals - First Impressions; Online Chilean Crafts; Intellectual Variety; Taste + Texture; Time Invariance and Gauge Symmetry; Jodorowsky; Tomato Chutney; Analysis of Support for Trump; Indian SF; TP-Link TL-WR841N DNS TCP Bug; TP-Link TL-WR841N as Wireless Bridge; Sending Email On Time; Maybe run a command; Sterile Neutrinos

© 2006-2015 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