Solver for PlaidCTF 2021: Plaid Party Planning IV

pppiv_solver.ml

open! Core_kernel
open Pppiv_lib

module Element = struct
  type t =
    { person_id : Person_id.t
    ; game_id : Game_id.t
    ; score : float
    }
  [@@deriving sexp_of, compare]

  let compare =
    Comparable.lexicographic
      [ Comparable.lift Float.compare ~f:(fun x -> x.score); compare ]
  ;;

  include (val Comparator.make ~sexp_of_t ~compare)

  let create ~num_people game person =
    let score = Evaluate.evaluate_person_on_game ~num_people game person in
    { person_id = Person.id person; game_id = Game.id game; score }
  ;;
end

module Side = struct
  type t =
    | Left
    | Right
  [@@deriving equal]
end

module Selection = struct
  type t =
    { game : Game_id.t
    ; people : Person_id.t list
    ; score : float
    }
  [@@deriving compare, sexp_of]

  let create game people =
    { game = Game.id game
    ; people = List.map ~f:Person.id people
    ; score =
        Evaluate.evaluate_game
          ~num_people:(Float.of_int (List.length people))
          game
          (Person_id.Map.of_alist_exn (List.map people ~f:(fun p -> Person.id p, p)))
    }
  ;;

  let compare =
    Comparable.lexicographic
      [ Comparable.lift Float.compare ~f:(fun x -> x.score); compare ]
  ;;

  include (val Comparator.make ~sexp_of_t ~compare)
end

let min_possible games people =
  let plist = Map.data people in
  Map.fold games ~init:[] ~f:(fun ~key:_ ~data:game best ->
      List.fold
        (List.range 1 (Map.length people) ~stop:`inclusive)
        ~init:best
        ~f:(fun best count ->
          let num_people = Float.of_int count in
          let with_scores =
            List.map plist ~f:(fun p -> Element.create ~num_people game p)
          in
          let current =
            List.take (List.sort with_scores ~compare:Element.compare) count
            |> List.map ~f:(fun el -> Map.find_exn people el.person_id)
            |> Selection.create game
          in
          current :: best))
  |> List.sort ~compare:Selection.compare
;;

let () =
  let scenario = Scenario.default in
  let results = min_possible scenario.games scenario.people |> Fn.flip List.take 20 in
  List.iter results ~f:(fun sel ->
      print_s
        [%message
          ""
            ~score:(sel.score : float)
            ~game:(sel.game : Game_id.t)
            ~people:(sel.people : Person_id.t list)])
;;