#lang racket
(require math/number-theory)
;; Players are either good or evil, and have a history of plays made.
;; Each play is either 'none, 'success, or 'failure, depending on whether
;; that player was not on the team, was on a successful team,
;; or was on a failing team.
(struct player (idx good? history) #:transparent)
(define player-bad? (compose not player-good?))
(struct game (players sizes))
(struct parameters (good evil sizes))
(define all-parameters
(list (parameters 3 2 '(2 3 2 3 3))
(parameters 3 2 '(2 3 3 3 3))
(parameters 3 2 '(3 3 3 2 2))
(parameters 3 2 '(3 2 3 2 3))
(parameters 3 2 '(3 3 3 3 2))
(parameters 3 2 '(3 3 3 3 3))
(parameters 3 2 '(4 3 3 3 3))
(parameters 3 2 '(3 4 3 3 3))
(parameters 3 2 '(3 3 4 3 3))
(parameters 3 2 '(3 3 3 4 3))
(parameters 3 2 '(3 3 3 3 4))
(parameters 3 2 '(2 3 4 3 3))
(parameters 3 2 '(4 3 2 3 2))
(parameters 3 2 '(2 3 2 3 4))
(parameters 3 2 '(3 3 2 3 2))
(parameters 3 2 '(2 2 2 2 5))
(parameters 3 2 '(2 2 2 5 5))
(parameters 4 2 '(2 3 4 3 4))
(parameters 4 3 '(2 3 3 (4) 4))
(parameters 5 3 '(3 4 4 (5) 4))
(parameters 6 3 '(3 4 4 (5) 4))
(parameters 6 4 '(3 4 4 (5) 4))))
;; Games are just a list of players
(define (make-game p)
(define good (parameters-good p))
(define evil (parameters-evil p))
(define sizes (parameters-sizes p))
(game
(for/list ([n (in-range (+ good evil))])
(player n (< n good) '()))
sizes))
(define (team-outcome team)
(if (ormap player-bad? team)
'failure
'success))
(define (team-outcome* team)
(if (> (count player-bad? team) 1) 'failure 'success))
(define (step-game-team g team outcome)
(game
(for/list ([pl (game-players g)])
(match-define (player idx good? history) pl)
(if (member pl team)
(player idx good? (cons outcome history))
(player idx good? (cons 'none history))))
(game-sizes g)))
(define (game-length g) (length (player-history (car (game-players g)))))
(define (game-next-size g) (list-ref (game-sizes g) (game-length g)))
(define (game-history game)
(define vetos
(map (curry count (curry equal? 'failure))
(apply (curry map list) (map player-history (game-players game)))))
(for/list ([num (in-list vetos)] [size (in-list (game-sizes game))])
(< num (if (list? size) 2 1))))
(define (game-over? history)
(or (> (count identity history) 2) (> (count not history) 2)))
(define (game-won? history)
(> (count identity history) 2))
;; Players with the same history cannot be distinguished externally,
;; but can be distinguished internally
(define (external-players game)
(group-by player-history (game-players game)))
(define (internal-players game)
(group-by
(match-lambda [(player n good? history) (cons good? history)])
(game-players game)))
(define (same-externally? p1 p2)
(equal? (player-history p1) (player-history p2)))
(define (same-internally? p1 p2)
(and (equal? (player-good? p1) (player-good? p2))
(same-externally? p1 p2)))
;; The good guys pick a team by selecting equivalence classes of players.
;; Then the valid teams for a strategy are any valid selection from those
;; equivalence classes.
(define (all-choices-replacement №total №choices #:min [min 0])
(if (zero? №choices)
'(())
(for*/list ([head (in-range min №total)]
[choice (all-choices-replacement №total (- №choices 1) #:min head)])
(cons head choice))))
(define (game-strategies game)
(define next-size (game-next-size game))
(define № (match next-size [(? number?) next-size] [(list (? number? n)) n]))
(let* ([eqclass (external-players game)]
[strategies (all-choices-replacement (length eqclass) №)])
(for/list ([strategy strategies]
#:when (for/and ([x (in-range (length eqclass))])
(<= (count (curry equal? x) strategy) (length (list-ref eqclass x)))))
(map (curry list-ref eqclass) strategy))))
(define (strategy-teams game strategy)
;; Split the strategy into groups of e-indistinguishable players
(define classes (group-by identity strategy))
;; For each class, there is a collection of outcomes for that class
(define class-outcomes
(for/list ([class classes])
(define №players (length (car class)))
(define №choices (length class))
(define total-combinations (binomial №players №choices))
;; Each player is either good or bad
(define-values (good-ps bad-ps)
(partition player-good? (car class)))
(filter (compose not zero? car)
(for/list ([№bad (in-range (+ 1 (min (length bad-ps) (length class))))])
(define №good (- (length class) №bad))
(define combinations
(* (binomial (length good-ps) №good)
(binomial (length bad-ps) №bad)))
(cons (/ combinations total-combinations)
(if (not (zero? combinations))
(append (take bad-ps №bad) (take good-ps №good))
'()))))))
;; Now the final team just chooses one thing from each class
(for/list ([class-groups (apply cartesian-product class-outcomes)])
(cons (apply * (map car class-groups))
(apply append (map cdr class-groups)))))
(define (strategy-all-teams game strategy)
(match strategy
['() '(())]
[(cons head tail)
(for*/list ([rest (strategy-all-teams game tail)]
[fst (set-subtract head rest)])
(cons fst rest))]))
;; Now we can backwards induct
(define (optimal-strategy game)
(define strategies (game-strategies game))
(define probs (map (curry probability-of-winning game) strategies))
(argmax car (map cons probs strategies)))
(define (probability-of-winning game strategy)
(define l
(for/list ([(weight team) (in-dict (strategy-teams game strategy))])
(define outcome
(match (game-next-size game)
[(? number?) (team-outcome team)]
[(list (? number?)) (team-outcome* team)]))
(define game* (step-game-team game team outcome))
(define history (game-history game*))
(if (game-over? history)
(if (game-won? history) weight 0)
(* weight
(probability-of-winning game* (cdr (optimal-strategy game*)))))))
(apply + l))
(define (probability-of-victory game)
(if (game-over? (game-history game))
(if (game-won? (game-history game)) 1 0)
(car (optimal-strategy game))))
(define (check-assumptions game)
(match-define (cons prob strat) (optimal-strategy game))
(define teams (map cdr (strategy-teams game strat)))
(for ([team (in-list teams)] #:unless (andmap player-good? team))
(define pfail (probability-of-victory (step-game-team game team 'failure)))
(define ppass (probability-of-victory (step-game-team game team 'success)))
(when (> pfail ppass)
(eprintf "\nProblem with team: ~a\n" (map player-idx team))))
(for ([team (in-list teams)])
(define game* (step-game-team game team (team-outcome team)))
(unless (game-over? (game-history game*))
(check-assumptions game*))))
(module+ main
(for ([v (in-list all-parameters)])
(define g (make-game v))
(check-assumptions g)
(printf "~a players ~a: ~a\n" (+ (parameters-good v) (parameters-evil v))
(game-sizes g) (car (optimal-strategy g)))))
;; Some example games
(define (do-something game)
(define s (last (game-strategies game)))
(do-somehow game s))
(define (do-somehow game s)
(define t (cdr (last (strategy-teams game s))))
(step-game-team game t (team-outcome t)))
(module+ test
(define g0 (make-game (dict-ref all-parameters 5)))
(define g1 (do-something g0))
(define g2 (do-something g1))
(define g3 (do-something g2))
(define g4 (do-something g3)))