From 70e09a5d4a3135fd10cb070bef80dc8d3fcc524c Mon Sep 17 00:00:00 2001 From: Alex Karle Date: Mon, 5 Dec 2022 23:33:35 -0500 Subject: [PATCH] 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??) --- 2022/05/multi-push-pop.profile | 20 ++++++++++++++++++++ 2022/05/single-push-pop.profile | 16 ++++++++++++++++ 2022/05/sol.scm | 49 ++++++++++++++++++++++++++++++++++++------------- 3 files changed, 72 insertions(+), 13 deletions(-) create mode 100644 2022/05/multi-push-pop.profile create mode 100644 2022/05/single-push-pop.profile diff --git a/2022/05/multi-push-pop.profile b/2022/05/multi-push-pop.profile new file mode 100644 index 0000000..ef03fd1 --- /dev/null +++ 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 new file mode 100644 index 0000000..72cee95 --- /dev/null +++ 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 index 6e8fcd1..9311a78 100755 --- 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 '()) -- libgit2 1.8.1