Day 22: Some refactoring, especially to use math/number-theory.
This commit is contained in:
parent
e89bbf14b9
commit
ab1a1ce9bf
3
lib.rkt
3
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)
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
151
src/22.rkt
151
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)
|
Loading…
Reference in New Issue