Add day two

2/GNUmakefile

@@ -0,0 +1,2 @@
+# -*- makefile-gmake -*-
+include ../gnu.mk

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)))

2/makefile

@@ -0,0 +1,4 @@
+# -*- makefile-bsdmake -*-
+# Disable Skint because no numerical tower
+SCHEMES=chibi chicken gauche guile racket sagittarius
+.include "../common.mk"

common.mk

@@ -1,27 +1,27 @@
 # -*- makefile-bsdmake -*-
 INPUTS=sample.txt input.txt
-SCHEMES=chibi chicken gauche guile loko racket skint
+SCHEMES?=chibi chicken gauche guile racket sagittarius skint
 all: ${SCHEMES}
 benchmark:
 	@i=0; \
 	for scheme in ${SCHEMES}; do \
-		tput setaf $$i; \
+		tput setaf $$((i%6+1)); \
-		printf %8s $$scheme; \
+		printf %12s $$scheme; \
 		tput sgr0; \
 		: $$((i+=1)); \
 		time ${MAKE} $$scheme >/dev/null; \
 	done
-chicken: main.scm
-	csi -script main.scm ${INPUTS}
-guile: main.scm
-	guile --no-auto-compile main.scm ${INPUTS} 2>/dev/null
 chibi: main.scm
 	chibi-scheme main.scm ${INPUTS}
-racket: main.scm
+chicken: main.scm
-	racket -I r7rs --script main.scm ${INPUTS}
+	/opt/chicken/bin/csi -script main.scm ${INPUTS}
 gauche: main.scm
 	gosh main.scm ${INPUTS}
-loko: main.scm
+guile: main.scm
-	loko --script main.scm ${INPUTS}
+	guile --no-auto-compile main.scm ${INPUTS} 2>/dev/null
+racket: main.scm
+	racket -I r7rs --script main.scm ${INPUTS}
+sagittarius: main.scm
+	sagittarius --standard=7 main.scm ${INPUTS}
 skint: main.scm
 	skint --script main.scm ${INPUTS}

common.scm

@@ -1,6 +1,28 @@
+;; Shitty print for convenience
 (define (print . args)
   (display (apply string-append args))
   (newline))
 
+;; Chicken command-line-arguments for no reason at all
 (define (command-line-arguments)
   (cdr (command-line)))
+
+;; Guile string-split
+(define (string-split str delim?)
+  (let ((in (open-input-string str)))
+    (let loop ((acc '())
+               (out (open-output-string)))
+      (let ((c (read-char in)))
+        (cond
+         ((eof-object? c)
+          (reverse (cons (get-output-string out) acc)))
+         ((delim? c)
+          (loop (cons (get-output-string out) acc)
+                (open-output-string)))
+         (else
+          (write-char c out)
+          (loop acc out)))))))
+
+;; Reverse for-each, for convenience
+(define (xfor-each1 lst fn)
+  (for-each fn lst))