(load "../common.scm")

(define (read-starting-positions filename)
  (call-with-input-file
    filename
    (lambda (file)
      (let* [(player-1 (begin
			 (get-string-n file (string-length "Player 1 starting position: "))
			 (get-number file)))
	     (player-2 (begin
			 (get-string-n file (string-length "Player 2 starting position: "))
			 (get-number file)))]
	; subtracting one to play with a board numbered 0..9 instead of 1..10, just easier
	(values (- player-1 1) (- player-2 1))))))

(define (deterministic-dice)
  (let [(value -1)]
    (lambda ()
      (set! value (mod (+ value 1) 100))
      (+ value 1))))

(define (roll! position-score dice)
  (set-car! position-score (mod (+ (car position-score) (dice) (dice) (dice)) 10))
  (set-cdr! position-score (+ (car position-score) (cdr position-score) 1)))

(define (play-deterministic position-1 position-2)
  (let [(player-1 (cons position-1 0))
	(player-2 (cons position-2 0))
	(dice (deterministic-dice))
	(rolls 0)]
    (let loop ()
      (roll! player-1 dice)
      (set! rolls (+ rolls 3))
      (if (>= (cdr player-1) 1000)
	(* (cdr player-2) rolls)
	(begin
	  (roll! player-2 dice)
	  (set! rolls (+ rolls 3))
	  (if (>= (cdr player-1) 1000)
	    (* (cdr player-1) rolls)
	    (loop)))))))

(define (dirac-dice outcome)
  (let [(next outcome)]
    (lambda ()
      (if (null? next)
	#f
	(let [(value (car next))]
	  (set! next (cdr next))
	  value)))))

(define (vector-sum vec start end)
  (vector-fold
    (lambda (i a x)
      (if (and (>= i start)
	       (< i end))
	(+ a x)
	a))
    0 vec))

;;; TODO: handle not playing if opponent already won
;;;       not loose winning games in the process x_x
(define (dirac-roll! ongoings)
  (let [(new (make-vector 220 0))]
    ; keep the ones that already won
    (vector-copy! new 210 ongoings 210) ; this should keep winning games, why do I loose some?
    ; for each possible combination of 3 rolls of 3-sided dice
    (for-each
      (lambda (dice-1)
	(for-each
	  (lambda (dice-2)
	    (for-each
	      (lambda (dice-3)
		; increase scores of ongoing games
		(vector-for-each
		  (lambda (index ongoing)
		    (when (and (> ongoing 0) (< index 210))
		      (let* [(position (mod index 10))
			     (score (div index 10))
			     (new-position (mod (+ position dice-1 dice-2 dice-3) 10))
			     (new-score (min 21 (+ score new-position 1)))
			     (new-index (+ new-position (* new-score 10)))]
			(vector-set! new new-index
				     (+ ongoing (vector-ref new new-index))))))
		  ongoings))
	      '(1 2 3)))
	  '(1 2 3)))
      '(1 2 3))
    (vector-copy! ongoings 0 new)))

(define (print-ongoing vec)
  (vector-for-each
    (lambda (index ongoing)
      (when (> ongoing 0)
	(printf "  ~12a games with score ~a at position ~a~%"
		ongoing (div index 10) (+ (mod index 10) 1))))
    vec))

(define (play-dirac position-1 position-2)
  ; the vectors track the number of games going on at given position and score,
  ; where position = index % 10 and score = index / 10
  ; 10 because there are 10 positions on board
  ; max score is 21 so 22 entries total accounting for starting zero
  ; => 10 * 22 = 220 entries
  (let [(player-1 (make-vector 220 0))
	(player-2 (make-vector 220 0))]
    (vector-set! player-1 position-1 1)
    (vector-set! player-2 position-2 1)
    (printf "Player 1 starting at ~a, player 2 at ~a~%" position-1 position-2)
    (let loop ()
      (set! wins-1 (dirac-roll! player-1))
      (set! wins-2 (dirac-roll! player-2))
      (printf "P1:~%") (print-ongoing player-1)
      (printf "P2:~%") (print-ongoing player-2)
      ; compute how many games are still going (not reached 21)
      (if (= (+ (vector-sum player-1 0 210) (vector-sum player-2 0 210)) 0)
	; sum how many winning games (the ones that reached 21)
	; and return biggest
	(max (vector-sum player-1 210 220)
	     (vector-sum player-2 210 220))
	(loop)))))

(let-values [((position-1 position-2) (read-starting-positions "input"))]
  (printf "part 1:~% Rolls * Opponent Score = ~a~%"
	  (play-deterministic position-1 position-2))
  (printf "part 2:~% Max Winning Universes: ~a~%"
	  (play-dirac position-1 position-2)))