#lang racket

(define (build a b)
  (let* ([a (reverse a)]
         [b (reverse b)])
    (build-list (length b) (lambda (n) (build-list (length a) (lambda (m) (* (list-ref b n) (list-ref a m))))))))


(define (get-carried-value v n new-list)
  (if (= n (length new-list))
      v
      (+ v (last new-list))))


(define (carry n old-list new-list)
  (if (= (length old-list) n)
      new-list
      (let-values ([(v c) (let ([v (get-carried-value (list-ref old-list n) n new-list)])
                            (if (or (< v 10) (= (sub1 (length old-list)) n))
                                (values v 0)
                                (let ([rem (remainder v 10)])
                                  (values rem (/ (- v rem) 10)))))])
        (if (= c 0)
            (if (< n (length new-list))
                (carry (add1 n) old-list (append (reverse (rest (reverse new-list))) (list v)))
                (carry (add1 n) old-list (append new-list (list v))))
            (if (< n (length new-list))
                (carry (add1 n) old-list (append (reverse (rest (reverse new-list))) (list v c)))
                (carry (add1 n) old-list (append new-list (list v c))))))))


(define (multiply a b)
  (let ([t (build a b)])
    (build-list (length b) (lambda (n) (append (reverse (carry 0 (list-ref t n) '())) (make-list n 0))))))


(define (find-sum t i j csum sum c lf lf-i)
  (if (= j (length (first t)))
      (values sum lf)
      (let ([s (list-ref t i)])
        (if (< j (length s))
            (if (eq? s (last t))
                (let* ([total (+ csum (list-ref s j) c)]
                       [carried (let ([rem (remainder total 10)])
                                  (/ (- total rem) 10))])
                  (if (= lf-i j)
                      (find-sum t 0 (add1 j) 0 (append sum (list (- total (* carried 10)))) carried total lf-i)
                      (find-sum t 0 (add1 j) 0 (append sum (list (- total (* carried 10)))) carried lf lf-i)))
                (find-sum t (add1 i) j (+ csum (list-ref s j)) sum c lf lf-i))
            (let* ([total (+ csum c)]
                   [carried (let ([rem (remainder total 10)])
                              (/ (- total rem) 10))])
              (find-sum t 0 (add1 j) 0 (append sum (list (- total (* carried 10)))) carried lf lf-i))))))


(define (extract-next t s i max)
  (if (= i max)
      s
      (extract-next t (append s (list (list-ref (list-ref t i) (sub1 i)))) (add1 i) max)))


(define (list->integer t n i)
  (if (= i (length t))
      n
      (list->integer t (string-append n (number->string(list-ref t i))) (add1 i))))


(define (display-multiplication a b t)
  (display (make-string (max (- (length (last t)) (string-length (list->integer a "" 0))) 0)))
  (display (list->integer a "" 0))
  (display #\newline)

  (display (make-string (max (- (length (last t)) (string-length (list->integer b "" 0))) 0)))
  (display (list->integer b "" 0))
  (display #\newline)

  (display (make-string (max (- (length (last t)) (max (string-length (list->integer a "" 0)) (string-length (list->integer b "" 0)))) 0)))
  (display (make-string (max (string-length (list->integer a "" 0)) (string-length (list->integer b "" 0))) #\-))
  (display #\newline)

  (for ([s t])
    (display (make-string (max (- (length (last t)) (string-length (list->integer s "" 0))) 0)))
    (display (display (list->integer s "" 0)))
    (display #\newline))

  (display (make-string (length (last t)) #\-))
  (display #\newline)

  (let-values ([(sum last-full) (find-sum (reverse (map (lambda (s) (reverse s)) t)) 0 0 0 '() 0 0 (sub1 (string-length (list->integer b "" 0))))])
    (display (list->integer (reverse sum) "" 0)))

  (display #\newline))


(define (perform-multiplication a b d)
  (let ([t (multiply a b)])
    (if d
        (display-multiplication a b t)
        (let-values ([(sum last-full) (find-sum (reverse (map (lambda (s) (reverse s)) t)) 0 0 0 '() 0 0 (sub1 (length b)))])
          (values (reverse sum) (extract-next t '() 1 (length b)) last-full)))))

(define (solve-for-digits sum)
  (if (or (and (>= sum 2) (even? sum)) (and (>= sum 5) (odd? sum)))
      (if (= (remainder sum 5) 0)
          (values 0 (/ sum 5))
          (let ([rem (remainder sum 10)])
            (if (even? sum)
                (values (/ rem 2) (/ (- sum rem) 5))
                (if (< rem 5)
                    (let ([num-5s (quotient (- sum 5) 5)])
                      (values (/ (- sum (* 5 num-5s)) 2) num-5s))
                    (let ([num-5s (quotient sum 5)])
                      (values (/ (- sum (* 5 num-5s)) 2) num-5s))))))
      (solve-for-digits (+ sum 10))))


(define (next-digits a b n)
  (if (= n 0)
      (values a b)
      (let-values ([(sum next prev) (perform-multiplication a b #f)])
        (let* ([carried (quotient prev 10)]
               [r-sum (+ (apply + next) carried)])

          (let-values ([(p q) (solve-for-digits (- 10 r-sum))])
            (next-digits (append (list p) a) (append (list q) b) (sub1 n)))))))


(let-values ([(a b) (next-digits (list 5) (list 2) 10)])
  (display (current-process-milliseconds (current-thread)))
  (display #\newline)

  (display (list->integer a "" 0))
  (display #\newline)
  (display (list->integer b "" 0)))


;; 1   374ms
;; 5   405ms
;; 10  437ms
;; 50  468ms
;; 100 1357ms
;; 200 15831ms
;; 250 29280ms
;; 500 424412ms

;; 500 digits of a: 413011120000221120312111300434302404330330443312300424322041024442442211044244331130232320244412312443003020310421032322234130223211122013340401411342044031042124241001101332411222203112324231330303022240232410122121011221344403034044344143040221423143400130003040043113444410130431312324220130330301003030000443201122044141213120122140343442043341432221300203122233430221043142013443310301034130213240040014032301402142410244110233110010111112204020434411221203430120141320003313012421131134033203125
;;               b: 011110101222100002000001111101021010012002010000122110110201201000100100110010000011101111110011001110110202101101110110010012010001010201002110011010111211210100101111111000011011121000001111102011100101100011100001201011110021111101001100201000011000021112120211111011101011001110000100011102002011120102221010021111110010101001100112111100201001010001012111011010111101111000210101001121101102100001102101111110021010001101001100112212010010111101000111001110002012101102110100101011000000210010112