4.rkt

#lang racket
(require threading)
(require "parser.rkt")
(module+ test (require rackunit))

(define winnings '())

(define src
  (syntax->datum
   (with-input-from-file "/tmp/input"
     (λ ()
       (parse (port->string (current-input-port)))))))

(define (number? x)
  (match x
    [(cons 'number _) #t]
    [_ #f]))

(define (parse-digit digit)
  (match digit
    [`(digit ,s) s]))

(define (parse-number number)
  (match number
    [(list 'number digit ...)
     (~>> digit
          (map parse-digit)
          (apply string-append)
          string->number)]))

(define stream
  (~>>
   (second src)  
   (filter number?)
   (map parse-number)))

(define (row? r)
  (match r
    [(cons 'row _) #t]
    [_ #f]))
          

(define (parse-row row)
  (~>>
   row
   (filter number?)
   (map parse-number)
   (apply vector)))

(define (parse-table table)
  (~>>
   table
   (filter row?)
   (map parse-row)
   (apply vector)))

(define boards
  (match  (fourth src)
    [(list 'tables table ...)
     (map parse-table table)]))


(define (transpose board)
  (apply vector
         (for/list [(i (in-range 5))]
           (vector-map (λ (row) (vector-ref row i)) board))))

(define (vector/all? p v)
  (for/and [(i (in-range (vector-length v)))]
    (p (vector-ref v i))))

(define (vector/any? p v)
  (for/or [(i (in-range (vector-length v)))]
    (p (vector-ref v i))))

(define (marked? x)
  (eq? x 'marked))

(define (winning-row? row)
  (vector/all? marked? row))

(define (winning-board? board)
  (if (or
       (vector/any? winning-row? board)
       ;; Optimisation: cache this
       (vector/any? winning-row? (transpose board)))
      board
      #f))

(define (any-winning-board? boards)
  (ormap winning-board? boards)) 

(define (mark/row row drawn)
  (for [(i (in-range (vector-length row)))]
    #;(displayln (format "Check if ~a = ~a" drawn
                         (vector-ref row i)))
    (when (and
           (integer? (vector-ref row i))
           (= (vector-ref row i) drawn))
      (vector-set! row i 'marked))))
         

(define (mark board drawn)
  (for [(i (in-range (vector-length board)))]
    (mark/row (vector-ref board i) drawn)))

(define (display-winner winner drawn)
  (set! winnings (cons 
                  (* (remaining winner) drawn) winnings)))
        


(define (remaining winner)
  (apply +
         (apply append
                (for/list [(row (in-vector winner))]
                  (remaining/row row)))))

(define (remaining/row row)
  (~>> row
       vector->list
       (filter-not marked?)))

(define (play-round drawn boards)
  #;(displayln (format "Drawing ~a" drawn))
  (for [(board (in-list boards))]
    (mark board drawn))
  #;(displayln (format "Boards: ~a" boards))

  (if (any-winning-board? boards)
      (display-winner (any-winning-board? boards) drawn)
      #f))
        
        
(define (play stream boards)
  (when (empty? boards)
    (error "Done!"))
  (match stream
    ['() (error "End of stream!")]
    [(cons next rest)
     (begin
       (play-round next boards)
       (play rest (filter-not winning-board? boards)))]))
        


(play stream boards)

parser.rkt

#lang brag

file: stream eol tables

tables: table*

stream: (number comma)* number eol

table: row row row row row eol?

row: space* number space number space number space number space number eol



number: digit*



digit    : "0" | "1" | "2" | "3" | "4"
         | "5" | "6" | "7" | "8" | "9"

space: " "*

comma : ","

eol: "\n"