[plt-dev] coding

From: Ryan Culpepper (ryanc at ccs.neu.edu)
Date: Fri May 14 13:35:07 EDT 2010

On 05/14/2010 08:45 AM, Sam Tobin-Hochstadt wrote:
 > On Fri, May 14, 2010 at 10:42 AM, Jay 
McCarthy<jay.mccarthy at gmail.com>  wrote:
 >> And how is the performance after the fix? Is the opaque coding worth it?
 >
 > Eli's version is about 40-50% faster than Matthias':
 >
 > Large lists:
 > cpu time: 14697 real time: 14689 gc time: 4560
 > cpu time: 8400 real time: 8394 gc time: 1696
 >
 > Small lists:
 > cpu time: 3004 real time: 3016 gc time: 1588
 > cpu time: 1609 real time: 1627 gc time: 452

The docs for 'split-at-right' say this:

   Returns the same result as

     (values (drop-right lst pos) (take-right lst pos))

   except that it can be faster.

On my machine, the naive version is marginally slower on short lists 
(10) and faster (real time) on longer lists. Here are my timings:

;; (go LENGTH REPETITIONS)
;; Short lists (10 elements)
 > (go 10 100000)
naive: cpu time: 628 real time: 715 gc time: 28
v1:    cpu time: 584 real time: 670 gc time: 40
 > (go 10 100000)
naive: cpu time: 632 real time: 704 gc time: 32
v1:    cpu time: 580 real time: 697 gc time: 40
;; Medium-length lists (100 elements)
 > (go 100 10000)
naive: cpu time: 2545 real time: 2887 gc time: 196
v1:    cpu time: 2460 real time: 3122 gc time: 324
 > (go 100 10000)
naive: cpu time: 2336 real time: 2719 gc time: 180
v1:    cpu time: 2448 real time: 3092 gc time: 356
;; Long lists (20000 elements)
 > (go 20000 1)
naive: cpu time: 13161 real time: 14629 gc time: 1000
v1:    cpu time: 13081 real time: 15540 gc time: 2864
 > (go 20000 1)
naive: cpu time: 13109 real time: 14594 gc time: 952
v1:    cpu time: 12773 real time: 15138 gc time: 2936


Here's the code, if you want to try it on other machines. I deleted the 
number checks on 'take-right' and 'drop-last' like Matthias did for 
'split-at-right.v1', and I rewrote the error cases to just call 'error'.

   #lang racket/base

   (define (drop* list n)
     (if (zero? n) list (and (pair? list) (drop* (cdr list) (sub1 n)))))

   ;; ----

   (define (take-right list n)
     (let loop ([list list]
                [lead (or (drop* list n) (error 'take-right))])
       ;; could throw an error for non-lists, but be more like `take'
       (if (pair? lead)
           (loop (cdr list) (cdr lead))
           list)))

   (define (drop-right list n)
     (let loop ([list list]
                [lead (or (drop* list n) (error 'drop-right))])
       ;; could throw an error for non-lists, but be more like `drop'
       (if (pair? lead)
           (cons (car list) (loop (cdr list) (cdr lead)))
           '())))

   (define (split-at-right.v0 lst pos)
     (values (drop-right lst pos) (take-right lst pos)))

   ;; ----

   (define (split-at-right.v1 list n)
     (let loop ([list list]
                [lead (or (drop* list n) (error 'v1))]
                [pfx '()])
       ;; could throw an error for non-lists, but be more like `split-at'
       (if (pair? lead)
           (loop (cdr list) (cdr lead) (cons (car list) pfx))
           (values (reverse pfx) list))))

   ;; ====

   (define (stress-test n reps split)
     (define l (build-list n add1))
     (define _ (begin (collect-garbage) (collect-garbage)))
     (define x
       (time
        (for ([rep (in-range reps)])
          (for/list ((i (in-range n)))
            (define-values (x y) (split l i))
            (length y)))))
     (void))

   (define (go [n 20000] [reps 1])
     (display "naive: ")
     (stress-test n reps split-at-right.v0)
     (display "v1:    ")
     (stress-test n reps split-at-right.v1))

   ;(go 10 100000)
   ;(go 100 10000)
   ;(go 20000 1)

Ryan


Posted on the dev mailing list.