Add day two

2/main.scm

@@ -0,0 +1,80 @@
+(import (scheme base)
+        (scheme cxr)
+        (scheme file)
+        (scheme inexact)
+        (scheme process-context)
+        (scheme write))
+
+(include "../common.scm")
+
+(define powers-of-ten
+  #(1 10 100 1000 10000 100000 1000000 10000000 100000000 1000000000 10000000000))
+
+(define (sum-invalid-in-range-part1 from to)
+  (let loop ((i from)
+             (acc 0))
+    (if (> i to)
+        acc
+        (let ((ndigits (exact (+ 1 (floor (log i 10))))))
+          (if (even? ndigits)
+              (let ((pow-of-ten (vector-ref powers-of-ten (exact (/ ndigits 2)))))
+                (if (= (exact (floor (/ i pow-of-ten)))
+                       (modulo i pow-of-ten))
+                    (loop (+ i 1) (+ acc i))
+                    (loop (+ i 1) acc)))
+              (loop (+ i 1) acc))))))
+
+;; i think i was on drugs when i wrote this
+(define (test-equal-sections i nd div k)
+  (and (zero? (modulo nd div))
+       (not (= nd div))
+       (let*-values (((ln) (- nd div))
+                     ((hd tl) (truncate/ i (vector-ref powers-of-ten ln))))
+         (let loop ((ln ln)
+                    (hd hd)
+                    (tl tl))
+           (if (zero? ln)
+               (k #t)
+               (let*-values (((nln) (- ln div))
+                             ((nhd ntl) (truncate/ tl (vector-ref powers-of-ten nln))))
+                 (and (= hd nhd)
+                      (loop nln nhd ntl))))))))
+
+(define (iota n)
+  (let loop ((i 1)
+             (acc '()))
+    (if (> i n)
+        (reverse acc)
+        (loop (+ i 1) (cons i acc)))))
+
+(define (sum-invalid-in-range-part2 from to)
+  (let loop ((i from)
+             (acc 0))
+    (if (> i to)
+        acc
+        (let ((nd (exact (+ 1 (floor (log i 10))))))
+          (if (call-with-current-continuation
+               (lambda (k)
+                 (for-each (lambda (div) (test-equal-sections i nd div k)) (iota (/ nd 2)))
+                 #f))
+              (loop (+ i 1) (+ acc i))
+              (loop (+ i 1) acc))))))
+
+(define (part file sumfn)
+  (let ((ranges (map (lambda (s) (string-split s (lambda (c) (char=? c #\-))))
+                     (string-split (with-input-from-file file read-line) (lambda (c) (char=? c #\,))))))
+    (let loop ((ranges ranges)
+               (sum 0))
+      (if (null? ranges)
+          (begin
+            (display (number->string sum))
+            (newline))
+          (loop (cdr ranges) (+ sum (sumfn (string->number (caar ranges)) (string->number (cadar ranges)))))))))
+
+(for-each (lambda (file) (part file sum-invalid-in-range-part1)) (command-line-arguments))
+(for-each (lambda (file) (part file sum-invalid-in-range-part2)) (command-line-arguments))
+
+
+;; (print (number->string (sum-invalid-in-range 11 22)))
+
+#;(for-each print (map part2 (command-line-arguments)))