commit d4332cf816b68e9b846890609192b336531df460 (patch)
parent c4a72dd0f20dafb5fc857de6746cad406ab9acd4
Author: Alex Karle <alex@alexkarle.com>
Date: Mon, 5 Dec 2022 22:39:15 -0500
day5: Add part 2 solution
Diffstat:
1 file changed, 19 insertions(+), 7 deletions(-)
diff --git a/2022/05/sol.scm b/2022/05/sol.scm
@@ -80,20 +80,29 @@
(cons (cons e (car stacks)) (cdr stacks))
(cons (car stacks) (push-box (cdr stacks) (sub1 k) e)))))
-(define (play-move move stacks)
+(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 (cons (sub1 n) (cdr move))
- (push-box sts t box))))))
-
-(define (play-moves moves stacks)
+ (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
+(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))))
+
+(define (play-moves moves stacks player)
(if (null? moves)
stacks
- (play-moves (cdr moves) (play-move (car moves) stacks))))
+ (play-moves (cdr moves) (player (car moves) stacks) player)))
; TODO: add1/sub1 on stack nums, iterate, profit
(define (main args)
@@ -101,7 +110,10 @@
(stacks (parse-boxes lines))
(moves (parse-moves lines)))
(for-each (lambda (s) (display (car s)))
- (play-moves moves stacks))
+ (play-moves moves stacks play-move-1))
+ (newline)
+ (for-each (lambda (s) (if (not (eq? 'tmp (car s))) (display (car s))))
+ (play-moves moves (append stacks '((tmp))) play-move-2))
(newline)))
; test data for the REPL
