5.scm

(import
  (srfi srfi-1)
  (srfi srfi-11)
  (srfi srfi-13)
  (srfi srfi-14)
  (srfi srfi-27)
  (srfi srfi-43)
  (rnrs lists (6))
  (rnrs io ports (6))
  (rnrs io simple (6))
  (rnrs records syntactic (6))
  (rnrs sorting (6)))

(define rules #f)
(define pages #f)

(define (read-rules)
  (let loop ((line (get-line (current-input-port)))
             (rs '()))
    (if (string-null? line)
      (set! rules (list->vector rs))
      (loop (get-line (current-input-port))
	    (cons (map string->number (string-tokenize line char-set:digit))
		   rs)))))

(define (read-pages)
  (let loop ((line (get-line (current-input-port)))
             (rs '()))
    (if (eof-object? line)
      (set! pages (list->vector rs))
      (loop (get-line (current-input-port))
	    (cons (list->vector
		   (map string->number (string-tokenize line char-set:digit)))
		  rs)))))

(with-input-from-file "in.txt"
  (lambda ()
    (read-rules)
    (read-pages)))

(define (is-printable? ps)
  (define len (vector-length ps))
  (let loop ((i 0))
    (if (= i len)
      (vector-ref ps (/ (- len 1) 2))
      (let inner ((j (+ 1 i)))
	(if (>= j len)
	  (loop (+ 1 i))
	  (if (vector-index (lambda (e)
			      (equal? (list (vector-ref ps j)
					    (vector-ref ps i))
				      e))
			    rules)
	    0
	    (inner (+ 1 j))))))))

(define (go1)
  (define sum 0)
  (vector-map (lambda (_ x) (set! sum (+ sum (is-printable? x)))) pages)
  sum)

(define (rearrange! ps)
  (define correct? #t)
  (define len (vector-length ps))
  (define (vec-find x) (vector-index (lambda (y) (= x y)) ps))
  (vector-map
   (lambda (_ rule)
     (let ((li (vec-find (car rule)))
	   (ri (vec-find (cadr rule))))
       (if (and li ri (< ri li))
	 (let ((new (make-vector len)))
	   (if (> ri 0)
	     (vector-copy! new 0 ps 0 ri))
	   (vector-set! new ri (vector-ref ps li))
	   (vector-set! new (+ 1 ri) (vector-ref ps ri))
	   (if (< (+ 2 ri) len)
	     (vector-copy! new (+ 2 ri) ps (+ 1 ri) li))
           (if (< (+ 1 li) len)
	     (vector-copy! new (+ 1 li) ps (+ 1 li)))
	   (set! ps new)
	   (set! correct? #f)))))
   rules)
  (if correct?
    0
    (vector-ref ps (/ (- len 1) 2))))

(define (go2)
  (define sum 0)
  (vector-sort! (lambda (l r) (< (car l) (car r))) rules)
  (vector-map (lambda (_ x) (set! sum (+ sum (rearrange! x)))) pages)
  sum)

(display "Sum: ")
(display (go2))
(newline)