commit 70e09a5d4a3135fd10cb070bef80dc8d3fcc524c (patch)
parent d4332cf816b68e9b846890609192b336531df460
Author: Alex Karle <alex@alexkarle.com>
Date: Mon, 5 Dec 2022 23:33:35 -0500
day5: Refactor for 3-4x performance gain
So the single push-box and pop-box routines were conceptually nice,
but with a move like:
move 20 from 8 to 9
It would have to follow 7 pointers to get to node 8 just to modify
it.. and do this 20 times. Factor in push-box needint to do 8 traversals
20 times and you have:
7 * 20 + 8 * 20
Simply modifying the push/pop routines to handle lists means you have
to traverse the 7 only once, then traverse the 8 once:
7 + 1 + 8 + 1
This resulted in ~10x reduction in calls to push/pop, as seen in the
profiles:
reading `2022/05/single-push-pop.profile' ...
procedure calls seconds average percent
---------------------------------------------
main 1 0.180 0.180 100.000
play-move-1 9384 0.170 0.000 94.444
play-moves 1008 0.170 0.000 94.444
play-move-2 503 0.120 0.000 66.666
pop-box 52508 0.090 0.000 50.000
push-box 52474 0.050 0.000 27.777
range 360 0.010 0.000 5.555
get-mask 10 0.010 0.001 5.555
init-stacks 1 0.010 0.010 5.555
parse-boxes 1 0.010 0.010 5.555
parse-moves 514 0.000 0.000 0.000
parse-move 503 0.000 0.000 0.000
filter 370 0.000 0.000 0.000
add-layer 90 0.000 0.000 0.000
get-boxes 9 0.000 0.000 0.000
vs:
reading `2022/05/multi-push-pop.profile' ...
procedure calls seconds average percent
---------------------------------------------
main 1 0.050 0.050 100.000
play-moves 1008 0.040 0.000 80.000
push-boxes 5142 0.020 0.000 40.000
pop-boxes 5096 0.020 0.000 40.000
play-move-1 503 0.020 0.000 40.000
play-move-2 503 0.020 0.000 40.000
n-on 6256 0.010 0.000 20.000
parse-moves 514 0.010 0.000 20.000
parse-move 503 0.010 0.000 20.000
first-n 6256 0.000 0.000 0.000
filter 370 0.000 0.000 0.000
range 360 0.000 0.000 0.000
add-layer 90 0.000 0.000 0.000
get-mask 10 0.000 0.000 0.000
get-boxes 9 0.000 0.000 0.000
parse-boxes 1 0.000 0.000 0.000
init-stacks 1 0.000 0.000 0.000
push-box 0 0.000 0.000 0.000
pop-box 0 0.000 0.000 0.000
Now the real move would be to make stacks a vector
so we don't need to do the 7/8 traversals... but
this is hard to do without using mutations (is it
time to play around with clojure??)
Diffstat:
3 files changed, 72 insertions(+), 13 deletions(-)
diff --git a/2022/05/multi-push-pop.profile b/2022/05/multi-push-pop.profile
@@ -0,0 +1,20 @@
+instrumented
+(range 360 0)
+(filter 370 0)
+(first-n 6256 0)
+(n-on 6256 10)
+(get-mask 10 0)
+(get-boxes 9 0)
+(add-layer 90 0)
+(init-stacks 1 0)
+(parse-boxes 1 0)
+(parse-move 503 10)
+(parse-moves 514 10)
+(pop-box 0 0)
+(push-box 0 0)
+(pop-boxes 5096 20)
+(push-boxes 5142 20)
+(play-move-1 503 20)
+(play-move-2 503 20)
+(play-moves 1008 40)
+(main 1 50)
diff --git a/2022/05/single-push-pop.profile b/2022/05/single-push-pop.profile
@@ -0,0 +1,16 @@
+instrumented
+(range 360 10)
+(filter 370 0)
+(get-mask 10 10)
+(get-boxes 9 0)
+(add-layer 90 0)
+(init-stacks 1 10)
+(parse-boxes 1 10)
+(parse-move 503 0)
+(parse-moves 514 0)
+(pop-box 52508 90)
+(push-box 52474 50)
+(play-move-1 9384 170)
+(play-move-2 503 120)
+(play-moves 1008 170)
+(main 1 180)
diff --git a/2022/05/sol.scm b/2022/05/sol.scm
@@ -15,6 +15,16 @@
(cons (car lst) (filter pred (cdr lst)))
(filter pred (cdr lst)))))
+(define (first-n lst n)
+ (if (equal? n 0)
+ '()
+ (cons (car lst) (first-n (cdr lst) (sub1 n)))))
+
+(define (n-on lst n)
+ (if (equal? n 0)
+ lst
+ (n-on (cdr lst) (sub1 n))))
+
; [D]
; [N] [C] => ((N Z) (D C M) (P))
; [Z] [M] [P]
@@ -80,24 +90,35 @@
(cons (cons e (car stacks)) (cdr stacks))
(cons (car stacks) (push-box (cdr stacks) (sub1 k) e)))))
+(define (pop-boxes stacks k n)
+ (if (>= k (length stacks))
+ (error "Bad pop")
+ (if (equal? k 0)
+ (values (first-n (car stacks) n) (cons (n-on (car stacks) n) (cdr stacks)))
+ (let-values (((b sts) (pop-boxes (cdr stacks) (sub1 k) n)))
+ (values b (cons (car stacks) sts))))))
+
+(define (push-boxes stacks k e)
+ (if (>= k (length stacks))
+ (error "Bad push")
+ (if (equal? k 0)
+ (cons (append e (car stacks)) (cdr stacks))
+ (cons (car stacks) (push-boxes (cdr stacks) (sub1 k) e)))))
+
(define (play-move-1 move stacks)
(let ((n (car move))
(f (cadr move))
(t (caddr move)))
- (if (equal? n 0)
- stacks
- (let-values (((box sts) (pop-box stacks f)))
- (play-move-1 (cons (sub1 n) (cdr move))
- (push-box sts t box))))))
-
-;; for part 2, rather than have to redo the push/pop for
-;; multiple elements, we can just pop onto a fake tmp stack
-;; and when done pop that stack onto the original dest
+ (let-values (((boxes sts) (pop-boxes stacks f n)))
+ (push-boxes sts t (reverse boxes)))))
+
+; same as 1, but no reverse
(define (play-move-2 move stacks)
- (let* ((n (sub1 (length stacks)))
- (push-tmp (list (car move) (cadr move) n))
- (pop-tmp (list (car move) n (caddr move))))
- (play-move-1 pop-tmp (play-move-1 push-tmp stacks))))
+ (let ((n (car move))
+ (f (cadr move))
+ (t (caddr move)))
+ (let-values (((boxes sts) (pop-boxes stacks f n)))
+ (push-boxes sts t boxes))))
(define (play-moves moves stacks player)
(if (null? moves)
@@ -118,3 +139,5 @@
; test data for the REPL
(define sks '((N Z) (D C M) (P)))
+
+(main '())
