Day 22: Some refactoring, especially to use math/number-theory.

lib.rkt

@@ -152,8 +152,7 @@
   (if (negative? n) 0 n))
 
 ;; % : number -> number -> number
-(define %
+(define % modulo)
-  (∂ (λ (d n) (remainder n d))))
 
 ;; number->digits-reverse : number -> (listof number)
 ;; Return the digits of the given number in reverse order (i.e. RTL)

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

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)
+;; A shuffle operation (technique) is
-  (match technique
+;; an affine transformation on a card's index.
-    ["deal into new stack" deal-into-new-stack]
+;; Applying the transformation (m, o) to i yields (m*i + o).
-    [(string-append "cut " s) (∂ cut-N-cards (string->number s))]
+;; We can compose transformations and only keep track
-    [(string-append "deal with increment " s) (∂ deal-with-increment-N (string->number s))]))
+;; of the multiple and offset factors (modulo some len).
+;; The identity transformation is I = (1, 0).
 
-(define (deal-into-new-stack cards)
+(struct affine (multiple offset) #:transparent)
-  (reverse cards))
 
-(define (cut-N-cards n cards)
+(define (apply-affine len mo i)
-  (if (negative? n)
+  (match-let ([(affine m o) mo])
-      (cut-N-cards (+ (length cards) n) cards)
+    (% (+ (* m i) o) len)))
-      (append (drop cards n) (take cards n))))
 
-(define (deal-with-increment-N n cards)
+(define I (affine 1 0))
-  (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 part1
+;; Applying the transformation (m, o) n times is the same as
-  (let loop ([cards (range 0 10007)]
+;; applying the transformation (m^n + o*(m^n - 1)/(m - 1)),
-             [shuffle input])
+;; modulo some len.
-    (if (empty? shuffle)
+(define (affine-expt mo n len)
-        (index-of cards 2019)
+  (match-let* ([(affine m o) mo]
-        (loop ((parse-technique (first shuffle)) cards) (rest shuffle)))))
+               [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)
+;; All shuffling transformation techniques are modulo the number of cards.
-;; Extended Euclidean algorithm for computing GCD
+;; deal into new stack: reversing the order of the cards,
-;; Given integers a and b, return gcd(a, b), x, and y, where
+;;   corresponding to the transformation i → -1*i + (length - 1)
-;; ax + by = gcd(a, b).
+;; cut N cards: rotating the cards to the left by n,
-(define (egcd a b)
+;;   corresponding to the transformation i → i - n
-  (if (zero? a)
+;; deal with increment N: placing a card every n steps,
-      (list b 0 1)
+;;   corresponding to the transformation i → n*i
-      (match-let ([(list g x y) (egcd (remainder b a) a)])
-        (list g (- y (* x (quotient b a))) x))))
 
-;; mmi : number -> number -> number
+(define (DINS len mo)
-;; Modular multiplicative inverse
+  (match-let ([(affine m o) mo])
-;; Given an integer n and a modulus m, return x such that
+    (affine (% (* m -1) len)
-;; nx ≡ 1 (mod m), i.e. nx + my = 1 for some x, y.
+            (% (- (sub1 len) o) len))))
-;; We therefore require that n and m are coprime.
-(define (mmi n m)
-  (match-let ([(list g x y) (egcd n m)])
-    x))
 
-;; mexp : number -> number -> number
+(define (CNC len n mo)
-;; Modular exponentiation
+  (match-let ([(affine m o) mo])
-;; Given a base b, an exponent e, and a modulus m,
+    (affine m (% (- o n) len))))
-;; compute b^e mod m.
+
-;; This uses the identity ab mod b = (a mod m)(b mod m) mod m
+(define (DWIN len n mo)
-(define (mexp b e m)
+  (match-let ([(affine m o) mo])
-  (let loop ([e e] [result 1])
+    (affine (% (* m n) len)
-    (if (= e 0) result
+            (% (* o n) len))))
-        (loop (sub1 e) (modulo (* b result) m)))))
+
+;; 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])
+  (DINS len mo))
-    (list (modulo (* m -1) len)
-          (modulo (+ (* o -1) (sub1 len)) len))))
 
-;; i -> i + n
 (define (inverse-CNC len n mo)
-  (match-let ([(list m o) mo])
+  (CNC len (* n -1) mo))
-    (list m (modulo (+ o n) len))))
 
-;; i -> i * n^-1
 (define (inverse-DWIN len n mo)
-  (match-let ([(list m o) mo]
+  (DWIN len (modular-inverse n len) mo))
-              [ninv (mmi n len)])
-    (list (modulo (* ninv m) len)
-          (modulo (* ninv o) len))))
 
-(define (inverse-parse len technique mo)
+;; Shuffling combines all transformations in order.
-  (match technique
+;; 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:
+(define part1
-;; 90109821400559^101741582076661 % 119315717514047 = 20096240743059
+  (let ([len 10007])
-(define (inverse-shuffle-N-times len n)
+    (apply-affine len (shuffle len) 2019)))
-  (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 part2
   (let* ([len 119315717514047]
-         [mo (inverse-shuffle-N-times len 101741582076661)])
+         [mo (inverse-shuffle len)]
-    (apply-mo len mo 2020)))
+         [mo^n (affine-expt mo 101741582076661 len)])
+    (apply-affine len mo^n 2020)))
 
 (show-solution part1 part2)