#lang racket

(define n 3)

;; If @term contains at least n r's in the front,
;; return (#f . rest-of-term).
;; If @term does not contain that many r's in the front,
;; return (#t . (r-part . rest-of-term)).
(define (seperate-adjacent-r term)
  (define (helper count r-list term)
    (if (null? term)
        (cons #t (cons r-list term))
        (if (eq? (car term) 'r)
            (if (= count (- n 1))
                (cons #f (cdr term))
                (helper (+ count 1) (cons 'r r-list) (cdr term)))
            (cons #t (cons r-list term)))))
  (helper 0 '() term))

(define (term-changed? term)
  (car term))
(define (get-term term)
  (cdr term))

(define (reduce-term term)
  (if (null? term)
      (cons #f '())
      ;; Term is not null
      (if (eq? (car term) 's)
          ;; First element is s
          (if (null? (cdr term))
              ;; Only element is s
              (cons #f term)
              ;; There is more to reduce after the s
              (if (eq? (cadr term) 's)
                  ;; First two elements are s's, cancel them
                  (cons #t (get-term (reduce-term (cddr term))))
                  ;; There is an s followed by an r
                  (let ([rest-reduced (reduce-term (cdr term))])
                    (if (term-changed? rest-reduced)
                        ;; If the following code after the s has changed, reduce some more
                        (cons #t (get-term (reduce-term (cons 's (get-term rest-reduced)))))
                        ;; Nothing changed, return result
                        (cons #f term)))))
          ;; First element is not s
          (let ([result (seperate-adjacent-r term)])
            (if (car result)
                ;; Not enough r's are present to cancel, look ahead of them
                (let ([rest-reduced (reduce-term (cddr result))])
                  (if (null? (get-term rest-reduced))
                      ;; Nothing is after the r's, return the result
                      (cons #f (cadr result))
                      (if (eq? (car (get-term rest-reduced)) 's)
                          ;; There is an s after the r, perform the sr transformation
                          (cons #t
                                (get-term (reduce-term (append (reverse (cdr (reverse (cadr result))))
                                                               (cons 's (build-list (- n 1) (lambda (x) 'r)))
                                                               (cdr (get-term rest-reduced))))))
                          ;; Only r's after the r, reduce some more
                          (cons (term-changed? rest-reduced)
                                (get-term
                                 (reduce-term
                                  (append (cadr result)
                                          (get-term rest-reduced))))))))
                ;; We cancelled n r's, reduce the rest of the term
                (cons #t (get-term (reduce-term (cdr result)))))))))

(define (make-term x y)
  (define (helper x y result)
    (if (= y 0)
        (if (= x 0)
            result
            (helper (- x 1) y (cons 's result)))
        (helper x (- y 1) (cons 'r result))))
  (helper x y '()))

;; Given an @n encoding a sum of terms, generate the actual list of terms in the sum
(define (number->term-sum num)
  (define (helper num result shift-count)
    (if (= num 0)
        result
        (if (= (modulo num 2) 1)
            (helper (/ (- num 1) 2)
                    (cons (let ([x (if (< shift-count n)
                                       0
                                       1)]
                                [y (if (< shift-count n)
                                       shift-count
                                       (- shift-count n))])
                            (get-term (reduce-term (make-term x y))))
                          result)
                    (+ shift-count 1))
            (helper (/ num 2) result (+ shift-count 1)))))
  (helper num '() 0))

;; Given two number @x and @y that encode two sums of terms,
;; multiply the sums together
(define (multiply-sums-of-terms x y)
  (let ([sumA (number->term-sum x)]
        [sumB (number->term-sum y)])
    (define (helper sum0 sum1 result)
      (if (null? sum0)
          result
          (if (null? sum1)
              (helper (cdr sum0) sumB result)
              (helper sum0
                      (cdr sum1)
                      (cons (get-term
                             (reduce-term
                              (append (car sum0)
                                      (car sum1))))
                            result)))))
    (helper sumA sumB '())))

;; Given a @sum, encode the elements into numbers for easy use
(define (encode-sum sum)
  (define (encode-element e result)
    (if (null? e)
        result
        (if (eq? (car e) 's)
            (encode-element (cdr e) (+ result n))
            (encode-element (cdr e) (+ result 1)))))
  (define (helper sum result)
    (if (null? sum)
        result
        (helper (cdr sum)
                (cons (encode-element (car sum) 0)
                      result))))
  (helper sum '()))

;; Given an encoded sum of terms, tally up the terms
(define (tally-sum-terms sum)
  (define (helper result-table sum)
    (if (null? sum)
        result-table
        (let ([num (car sum)])
          (vector-set! result-table
                       num
                       (+ (vector-ref result-table num) 1))
          (helper result-table (cdr sum)))))
  (helper (make-vector (* 2 n) 0) sum))

;; Given a tally table, reduce that table
(define (reduce-tally-table table)
  (for ([i (in-range 0 (* 2 n))])
    (vector-set! table
                 i
                 (modulo (vector-ref table i)
                         2)))
  table)

(define (product-equals-1? x y)
  (let ([product (multiply-sums-of-terms x y)])
    (let ([encoded-product (encode-sum product)])
      (let ([tally-table (tally-sum-terms encoded-product)])
        (let ([reduced-table (reduce-tally-table tally-table)])
          (define (scan-table table index)
            (if (= index (* 2 n))
                (if (= (vector-ref table 0) 1)
                    #t
                    #f)
                (if (= (vector-ref table index) 1)
                    #f
                    (scan-table table (+ index 1)))))
          (scan-table reduced-table 1))))))

;(read)
;(product-equals-1? #b1011100 #b111)

(define count 0)
(for ([x (in-range 0 (expt 2 (* 2 n)))])
  (for ([y (in-range 0 (expt 2 (* 2 n)))])
    (if (product-equals-1? x y)
        (begin (printf "~x, ~x~n"
                       x
                       y)
               (set! count (+ count 1)))
        (void))))
(display count)