From 8ebadd2ee24a5bd27c3ded704c5c0c162f344705 Mon Sep 17 00:00:00 2001
From: Jonathan Chan <jonathanhwchan@gmail.com>
Date: Sun, 22 Dec 2019 11:27:27 -0800
Subject: [PATCH] Day 22: Some refactoring, especially to use
 math/number-theory.

---
 lib.rkt    |   3 +-
 src/16.rkt |   2 +-
 src/22.rkt | 151 +++++++++++++++++++++++++----------------------------
 3 files changed, 72 insertions(+), 84 deletions(-)

diff --git a/lib.rkt b/lib.rkt
index 52fe4f1..2eea065 100644
--- a/lib.rkt
+++ b/lib.rkt
@@ -152,8 +152,7 @@
   (if (negative? n) 0 n))
 
 ;; % : number -> number -> number
-(define %
-  (∂ (λ (d n) (remainder n d))))
+(define % modulo)
 
 ;; number->digits-reverse : number -> (listof number)
 ;; Return the digits of the given number in reverse order (i.e. RTL)
diff --git a/src/16.rkt b/src/16.rkt
index 6e2ae1a..aa85b23 100644
--- a/src/16.rkt
+++ b/src/16.rkt
@@ -38,7 +38,7 @@
   (second
    (foldr (λ (v acc)
             (match-let ([(list sum lst) acc])
-              (let ([sum (% 10 (+ v sum))])
+              (let ([sum (% (+ v sum) 10)])
                 (list sum (cons (abs sum) lst)))))
           (list 0 '(0)) ns)))
 
diff --git a/src/22.rkt b/src/22.rkt
index de638af..cb0b868 100644
--- a/src/22.rkt
+++ b/src/22.rkt
@@ -1,114 +1,103 @@
 #lang racket
 
 (require match-string
+         math/number-theory
          "../lib.rkt")
 
 (define input
   (problem-input 22))
 
-(define (parse-technique technique)
-  (match technique
-    ["deal into new stack" deal-into-new-stack]
-    [(string-append "cut " s) (∂ cut-N-cards (string->number s))]
-    [(string-append "deal with increment " s) (∂ deal-with-increment-N (string->number s))]))
+;; A shuffle operation (technique) is
+;; an affine transformation on a card's index.
+;; Applying the transformation (m, o) to i yields (m*i + o).
+;; We can compose transformations and only keep track
+;; of the multiple and offset factors (modulo some len).
+;; The identity transformation is I = (1, 0).
 
-(define (deal-into-new-stack cards)
-  (reverse cards))
+(struct affine (multiple offset) #:transparent)
 
-(define (cut-N-cards n cards)
-  (if (negative? n)
-      (cut-N-cards (+ (length cards) n) cards)
-      (append (drop cards n) (take cards n))))
+(define (apply-affine len mo i)
+  (match-let ([(affine m o) mo])
+    (% (+ (* m i) o) len)))
 
-(define (deal-with-increment-N n cards)
-  (let* ([len (length cards)]
-         [vec (make-vector len)])
-    (for ([index (range 0 len)]
-          [card cards])
-      (vector-set! vec (modulo (* index n) len) card))
-    (vector->list vec)))
+(define I (affine 1 0))
 
-(define part1
-  (let loop ([cards (range 0 10007)]
-             [shuffle input])
-    (if (empty? shuffle)
-        (index-of cards 2019)
-        (loop ((parse-technique (first shuffle)) cards) (rest shuffle)))))
+;; Applying the transformation (m, o) n times is the same as
+;; applying the transformation (m^n + o*(m^n - 1)/(m - 1)),
+;; modulo some len.
+(define (affine-expt mo n len)
+  (match-let* ([(affine m o) mo]
+               [m^n (modular-expt m n len)]
+               [o* (% (* o (sub1 m^n) (modular-inverse (sub1 m) len)) len)])
+    (affine m^n o*)))
 
-;; egcd : number -> number -> (list number number number)
-;; Extended Euclidean algorithm for computing GCD
-;; Given integers a and b, return gcd(a, b), x, and y, where
-;; ax + by = gcd(a, b).
-(define (egcd a b)
-  (if (zero? a)
-      (list b 0 1)
-      (match-let ([(list g x y) (egcd (remainder b a) a)])
-        (list g (- y (* x (quotient b a))) x))))
+;; All shuffling transformation techniques are modulo the number of cards.
+;; deal into new stack: reversing the order of the cards,
+;;   corresponding to the transformation i → -1*i + (length - 1)
+;; cut N cards: rotating the cards to the left by n,
+;;   corresponding to the transformation i → i - n
+;; deal with increment N: placing a card every n steps,
+;;   corresponding to the transformation i → n*i
 
-;; mmi : number -> number -> number
-;; Modular multiplicative inverse
-;; Given an integer n and a modulus m, return x such that
-;; nx ≡ 1 (mod m), i.e. nx + my = 1 for some x, y.
-;; We therefore require that n and m are coprime.
-(define (mmi n m)
-  (match-let ([(list g x y) (egcd n m)])
-    x))
+(define (DINS len mo)
+  (match-let ([(affine m o) mo])
+    (affine (% (* m -1) len)
+            (% (- (sub1 len) o) len))))
 
-;; mexp : number -> number -> number
-;; Modular exponentiation
-;; Given a base b, an exponent e, and a modulus m,
-;; compute b^e mod m.
-;; This uses the identity ab mod b = (a mod m)(b mod m) mod m
-(define (mexp b e m)
-  (let loop ([e e] [result 1])
-    (if (= e 0) result
-        (loop (sub1 e) (modulo (* b result) m)))))
+(define (CNC len n mo)
+  (match-let ([(affine m o) mo])
+    (affine m (% (- o n) len))))
+
+(define (DWIN len n mo)
+  (match-let ([(affine m o) mo])
+    (affine (% (* m n) len)
+            (% (* o n) len))))
+
+;; The corresponding inverse transformations are:
+;;   DINS: -1*i + (length - 1) ← i
+;;   CNC: i + n ← i
+;;   DWIN: n^-1*i ← i
+;; where ·^-1 is the modular multiplicative inverse
 
-;; i -> -i + (len - 1)
 (define (inverse-DINS len mo)
-  (match-let ([(list m o) mo])
-    (list (modulo (* m -1) len)
-          (modulo (+ (* o -1) (sub1 len)) len))))
+  (DINS len mo))
 
-;; i -> i + n
 (define (inverse-CNC len n mo)
-  (match-let ([(list m o) mo])
-    (list m (modulo (+ o n) len))))
+  (CNC len (* n -1) mo))
 
-;; i -> i * n^-1
 (define (inverse-DWIN len n mo)
-  (match-let ([(list m o) mo]
-              [ninv (mmi n len)])
-    (list (modulo (* ninv m) len)
-          (modulo (* ninv o) len))))
+  (DWIN len (modular-inverse n len) mo))
 
-(define (inverse-parse len technique mo)
-  (match technique
+;; Shuffling combines all transformations in order.
+;; Inverse shuffling combines all inverse transformations in reverse order.
+;; We begin with the identity transformation, I = (1, 0).
+
+(define (parse len T mo)
+  (match T
+    ["deal into new stack" (DINS len mo)]
+    [(string-append "cut " s) (CNC len (string->number s) mo)]
+    [(string-append "deal with increment " s) (DWIN len (string->number s) mo)]))
+
+(define (inverse-parse len T mo)
+  (match T
     ["deal into new stack" (inverse-DINS len mo)]
     [(string-append "cut " s) (inverse-CNC len (string->number s) mo)]
     [(string-append "deal with increment " s) (inverse-DWIN len (string->number s) mo)]))
 
-;; This gives m = 90109821400559, o = 119199174489885 for len = 119315717514047
+(define (shuffle len)
+  (foldl (∂ parse len) I input))
+
 (define (inverse-shuffle len)
-  (foldr (∂ inverse-parse len) '(1 0) input))
+  (foldr (∂ inverse-parse len) I input))
 
-;; mexp was taking too long, so I asked WolframAlpha for mn:
-;; 90109821400559^101741582076661 % 119315717514047 = 20096240743059
-(define (inverse-shuffle-N-times len n)
-  (match-let* ([(list m o) (inverse-shuffle len)]
-               [mn 20096240743059 #;(mexp m n len)]
-               [on (modulo (* o (sub1 mn) (mmi (sub1 m) len)) len)])
-    (list mn on)))
-
-;; Given a modulus len, a multiple-offset pair mo, and a number i,
-;; compute (m*i + o) % len
-(define (apply-mo len mo i)
-  (match-let ([(list m o) mo])
-    (modulo (+ (* m i) o) len)))
+(define part1
+  (let ([len 10007])
+    (apply-affine len (shuffle len) 2019)))
 
 (define part2
   (let* ([len 119315717514047]
-         [mo (inverse-shuffle-N-times len 101741582076661)])
-    (apply-mo len mo 2020)))
+         [mo (inverse-shuffle len)]
+         [mo^n (affine-expt mo 101741582076661 len)])
+    (apply-affine len mo^n 2020)))
 
 (show-solution part1 part2)
\ No newline at end of file