From 60b0586ddc42cd8060e796e61267fc63a4397712 Mon Sep 17 00:00:00 2001
From: Mistivia <i@mistivia.com>
Date: Tue, 13 Feb 2024 14:44:03 +0800
Subject: refactor scheme to racket

---
 advent-of-code/2023/05/part1.rkt |  71 +++++++++++++++++++++++++
 advent-of-code/2023/05/part1.scm |  75 --------------------------
 advent-of-code/2023/05/part2.rkt | 109 +++++++++++++++++++++++++++++++++++++
 advent-of-code/2023/05/part2.scm | 112 ---------------------------------------
 4 files changed, 180 insertions(+), 187 deletions(-)
 create mode 100755 advent-of-code/2023/05/part1.rkt
 delete mode 100755 advent-of-code/2023/05/part1.scm
 create mode 100755 advent-of-code/2023/05/part2.rkt
 delete mode 100755 advent-of-code/2023/05/part2.scm

diff --git a/advent-of-code/2023/05/part1.rkt b/advent-of-code/2023/05/part1.rkt
new file mode 100755
index 0000000..64b8f84
--- /dev/null
+++ b/advent-of-code/2023/05/part1.rkt
@@ -0,0 +1,71 @@
+#lang racket
+
+(define port (open-input-file "input"))
+
+(define seed 
+  (let ()
+    (define nums-str 
+      (string-trim
+          (list-ref (string-split (read-line port) ":") 1)))
+    (map string->number (string-split nums-str " "))))
+
+(define _ (read-line port))
+
+(define (read-line-convert-eof port)
+  (define line (read-line port))
+  (if (eof-object? line) "" line))
+
+(define (read-map)
+  (define (loop ret)
+    (define line (string-trim (read-line-convert-eof port)))
+    (if (= 0 (string-length line))
+      (reverse ret)
+      (loop (cons (map string->number (string-split line " "))
+                  ret))))
+  (read-line port)
+  (loop '()))
+
+(define s2s (read-map))
+(define s2f (read-map))
+(define f2w (read-map))
+(define w2l (read-map))
+(define l2t (read-map))
+(define t2h (read-map))
+(define h2l (read-map))
+(define maps (list s2s s2f f2w w2l l2t t2h h2l))
+
+(define (gen-mapper the-map)
+  (define (mapper x)
+    (define (loop the-map)
+      (if (null? the-map)
+        x
+        (let ()
+          (define cur-map (car the-map))
+          (define target (car cur-map))
+          (define start (cadr cur-map))
+          (define len (caddr cur-map))
+          (if (and (>= x start)
+                   (<= x (+ start len)))
+            (+ target (- x start))
+            (loop (cdr the-map))))))
+    (loop the-map))
+  mapper)
+
+(define mappers (map gen-mapper maps))
+
+
+(define (comp-func funcs)
+  (define procs (reverse funcs))
+  (define (comp-rec arg)
+    (if (null? procs)
+        arg
+        (let ((proc (car procs))
+              (rest (cdr procs)))
+          (set! procs rest)
+          (proc (comp-rec arg)))))
+  comp-rec)
+
+(define (find-location x)
+  ((comp-func mappers) x))
+
+(display (apply min (map find-location seed)))
diff --git a/advent-of-code/2023/05/part1.scm b/advent-of-code/2023/05/part1.scm
deleted file mode 100755
index 5413bf0..0000000
--- a/advent-of-code/2023/05/part1.scm
+++ /dev/null
@@ -1,75 +0,0 @@
-#!/usr/bin/env guile
-!#
-
-(use-modules (ice-9 rdelim))
-
-(define port (open-input-file "input"))
-
-(define seed 
-  (let ()
-    (define nums-str 
-      (string-trim
-          (list-ref (string-split (read-line port) #\:) 1)))
-    (map string->number (string-split nums-str #\space))))
-
-(read-line port)
-
-(define (read-line-convert-eof port)
-  (define line (read-line port))
-  (if (eof-object? line) "" line))
-
-(define (read-map)
-  (define (loop ret)
-    (define line (string-trim (read-line-convert-eof port)))
-    (if (= 0 (string-length line))
-      (reverse ret)
-      (loop (cons (map string->number (string-split line #\space))
-                  ret))))
-  (read-line port)
-  (loop '()))
-
-(define s2s (read-map))
-(define s2f (read-map))
-(define f2w (read-map))
-(define w2l (read-map))
-(define l2t (read-map))
-(define t2h (read-map))
-(define h2l (read-map))
-(define maps (list s2s s2f f2w w2l l2t t2h h2l))
-
-
-(define (gen-mapper the-map)
-  (define (mapper x)
-    (define (loop the-map)
-      (if (nil? the-map)
-        x
-        (let ()
-          (define cur-map (car the-map))
-          (define target (car cur-map))
-          (define start (cadr cur-map))
-          (define len (caddr cur-map))
-          (if (and (>= x start)
-                   (<= x (+ start len)))
-            (+ target (- x start))
-            (loop (cdr the-map))))))
-    (loop the-map))
-  mapper)
-
-(define mappers (map gen-mapper maps))
-
-
-(define (comp-func funcs)
-  (define procs (reverse funcs))
-  (define (comp-rec arg)
-    (if (null? procs)
-        arg
-        (let ((proc (car procs))
-              (rest (cdr procs)))
-          (set! procs rest)
-          (proc (comp-rec arg)))))
-  comp-rec)
-
-(define (find-location x)
-  ((comp-func mappers) x))
-
-(display (apply min (map find-location seed)))
diff --git a/advent-of-code/2023/05/part2.rkt b/advent-of-code/2023/05/part2.rkt
new file mode 100755
index 0000000..97d07e1
--- /dev/null
+++ b/advent-of-code/2023/05/part2.rkt
@@ -0,0 +1,109 @@
+#lang racket
+
+(define port (open-input-file "input"))
+
+(define seed 
+  (let ()
+    (define nums-str 
+      (string-trim
+          (list-ref (string-split (read-line port) ":") 1)))
+    (define (pairing l)
+      (define (loop ret l)
+        (if (null? l)
+          ret
+          (loop
+            (cons (cons 
+                    (car l) 
+                    (+ (car l) (cadr l)))
+                  ret)
+            (cddr l))))
+      (loop '() l))
+    (reverse 
+      (pairing (map string->number (string-split nums-str " "))))))
+
+(define _ (read-line port))
+
+(define (read-line-convert-eof port)
+  (define line (read-line port))
+  (if (eof-object? line) "" line))
+
+(define (read-map)
+  (define (loop ret)
+    (define line (string-trim (read-line-convert-eof port)))
+    (if (= 0 (string-length line))
+      (sort (reverse ret) (lambda (x y) (< (cadr x) (cadr y))))
+      (loop (cons (map string->number (string-split line " "))
+                  ret))))
+  (read-line port)
+  (loop '()))
+
+(define s2s (read-map))
+(define s2f (read-map))
+(define f2w (read-map))
+(define w2l (read-map))
+(define l2t (read-map))
+(define t2h (read-map))
+(define h2l (read-map))
+(define maps (list s2s s2f f2w w2l l2t t2h h2l))
+
+(define (range-map mlist r)
+  ;; r :: Range :: (start . end)
+  ;; mlist :: List of (Map :: (dest, src, len))
+  (define (loop result mlist r)
+    (define start (car r))
+    (define end (cdr r))
+    (if (null? mlist)
+      (cons r result)
+      (let ()
+        (define cur-map (car mlist))
+        (define map-target (car cur-map))
+        (define map-start (cadr cur-map))
+        (define map-end (+ map-start (caddr cur-map)))
+        (define offset (- map-target map-start))
+        (define (pair-offset p) (cons (+ offset (car p)) (+ offset (cdr p))))
+        (cond ((<= end start)
+                    result)
+              ((>= start map-end)
+                    (loop result (cdr mlist) r))
+              ((>= start map-start)
+                    (loop
+                      (cons (pair-offset (cons start (min end map-end)))
+                            result)
+                      (cdr mlist)
+                      (cons (min end map-end) end)))
+              ((<= end map-start)
+                    (cons r result))
+              ((< start map-start)
+                    (loop
+                      (cons (cons start map-start) result)
+                      mlist
+                      (cons map-start end)))
+              (else (error "unhandled cond in range-map"))))))
+  (reverse (loop '() mlist r)))
+
+(define (gen-range-mapper the-map)
+  (define (mapper range-list)
+    (apply append
+        (map 
+            (lambda (range)
+              (range-map the-map range)) 
+            range-list)))
+  mapper)
+
+(define mappers (map gen-range-mapper maps))
+
+(define (comp-func funcs)
+  (define procs (reverse funcs))
+  (define (comp-rec arg)
+    (if (null? procs)
+        arg
+        (let ((proc (car procs))
+              (rest (cdr procs)))
+          (set! procs rest)
+          (proc (comp-rec arg)))))
+  comp-rec)
+
+(define (find-location x)
+  ((comp-func mappers) x))
+
+(display (apply min (map car (find-location seed))))
diff --git a/advent-of-code/2023/05/part2.scm b/advent-of-code/2023/05/part2.scm
deleted file mode 100755
index 87ad5e9..0000000
--- a/advent-of-code/2023/05/part2.scm
+++ /dev/null
@@ -1,112 +0,0 @@
-#!/usr/bin/env guile
-!#
-
-(use-modules (ice-9 rdelim))
-
-(define port (open-input-file "input"))
-
-(define seed 
-  (let ()
-    (define nums-str 
-      (string-trim
-          (list-ref (string-split (read-line port) #\:) 1)))
-    (define (pairing l)
-      (define (loop ret l)
-        (if (null? l)
-          ret
-          (loop
-            (cons (cons 
-                    (car l) 
-                    (+ (car l) (cadr l)))
-                  ret)
-            (cddr l))))
-      (loop '() l))
-    (reverse 
-      (pairing (map string->number (string-split nums-str #\space))))))
-
-(read-line port)
-
-(define (read-line-convert-eof port)
-  (define line (read-line port))
-  (if (eof-object? line) "" line))
-
-(define (read-map)
-  (define (loop ret)
-    (define line (string-trim (read-line-convert-eof port)))
-    (if (= 0 (string-length line))
-      (sort (reverse ret) (lambda (x y) (< (cadr x) (cadr y))))
-      (loop (cons (map string->number (string-split line #\space))
-                  ret))))
-  (read-line port)
-  (loop '()))
-
-(define s2s (read-map))
-(define s2f (read-map))
-(define f2w (read-map))
-(define w2l (read-map))
-(define l2t (read-map))
-(define t2h (read-map))
-(define h2l (read-map))
-(define maps (list s2s s2f f2w w2l l2t t2h h2l))
-
-(define (range-map mlist r)
-  ;; r :: Range :: (start . end)
-  ;; mlist :: List of (Map :: (dest, src, len))
-  (define (loop result mlist r)
-    (define start (car r))
-    (define end (cdr r))
-    (if (null? mlist)
-      (cons r result)
-      (let ()
-        (define cur-map (car mlist))
-        (define map-target (car cur-map))
-        (define map-start (cadr cur-map))
-        (define map-end (+ map-start (caddr cur-map)))
-        (define offset (- map-target map-start))
-        (define (pair-offset p) (cons (+ offset (car p)) (+ offset (cdr p))))
-        (cond ((<= end start)
-                    result)
-              ((>= start map-end)
-                    (loop result (cdr mlist) r))
-              ((>= start map-start)
-                    (loop
-                      (cons (pair-offset (cons start (min end map-end)))
-                            result)
-                      (cdr mlist)
-                      (cons (min end map-end) end)))
-              ((<= end map-start)
-                    (cons r result))
-              ((< start map-start)
-                    (loop
-                      (cons (cons start map-start) result)
-                      mlist
-                      (cons map-start end)))
-              (else (error "unhandled cond in range-map"))))))
-  (reverse (loop '() mlist r)))
-
-(define (gen-range-mapper the-map)
-  (define (mapper range-list)
-    (apply append
-        (map 
-            (lambda (range)
-              (range-map the-map range)) 
-            range-list)))
-  mapper)
-
-(define mappers (map gen-range-mapper maps))
-
-(define (comp-func funcs)
-  (define procs (reverse funcs))
-  (define (comp-rec arg)
-    (if (null? procs)
-        arg
-        (let ((proc (car procs))
-              (rest (cdr procs)))
-          (set! procs rest)
-          (proc (comp-rec arg)))))
-  comp-rec)
-
-(define (find-location x)
-  ((comp-func mappers) x))
-
-(display (apply min (map car (find-location seed))))
-- 
cgit v1.0