assocMultiset a := matcher | [] as () with | [] -> [()] | _ -> [] | #\$x :: \$ as assocMultiset a with | \$tgt -> match tgt as list (a, integer) with | \$hs ++ (#x, #1) :: \$ts -> hs ++ ts | \$hs ++ (#x, \$n) :: \$ts -> hs ++ (x, n - 1) :: ts | \$ :: \$ as (a, assocMultiset a) with | \$tgt -> matchAll tgt as list (a, integer) with | \$hs ++ (\$x, #1) :: \$ts -> (x, hs ++ ts) | \$hs ++ (\$x, !#1 & \$n) :: \$ts -> (x, hs ++ (x, n - 1) :: ts) | \$ as something with | \$tgt -> [tgt] assertEqual "assocMultiset" (matchAll [(1,2),(2,1),(3,3)] as assocMultiset integer with | #1 :: \$rs -> rs) [(1, 1), (2, 1), (3, 3)] assertEqual "assocMultiset" (matchAll [(1,2),(2,1),(3,3)] as assocMultiset integer with | #2 :: \$rs -> rs) [(1, 2), (3, 3)] assertEqual "assocMultiset" (matchAll [(1,2),(2,1),(3,3)] as assocMultiset integer with | \$x :: \$rs -> (x,rs)) [(2, [(1, 2), (3, 3)]), (1, [(1, 1), (2, 1), (3, 3)]), (3, [(1, 2), (2, 1), (3, 2)])] assocToList xs := concat (matchAllDFS xs as list (something, integer) with | _ ++ (\$x, \$n) :: _ -> take n (repeat1 x)) assertEqual "assocToList" (assocToList [(1,2),(2,1),(3,3)]) [1, 1, 2, 3, 3, 3] N := 5 tree a := matcher | node \$ \$ as (a, multiset (tree a)) with | Node \$x \$ts -> [(x, ts)] | \$ as something with | \$tgt -> [tgt] state := (integer, assocMultiset integer, assocMultiset integer) fOrS s := match s as state with | (\$h, _, _) -> h transformState s := match s as state with | (\$h, \$x, \$y) -> (h, assocToList x, assocToList y) move s := matchAllDFS s as state with -- equal or less than N | (#1, (\$s1 & \$x :: _), (?(\y -> x + y < N + 1) & \$y) :: \$rs') -> (2, s1, add (x + y) rs') -- the single hand becomes more than N | (#1, (\$s1 & \$x :: _), ?(\y -> x + y > N) :: []) -> (-1, s1, []) -- a hand becomes more than N | (#1, (\$s1 & \$x :: _), (?(\y -> x + y > N) & \$y) :: (![] & \$rs')) -> (2, s1, rs') -- equal or less than N | (#2, \$x :: \$rs', (?(\y -> x + y < N + 1) & \$y) :: _ & \$s2) -> (1, add (x + y) rs', s2) -- the single hand becomes more than N | (#2, \$x :: [], (?(\y -> x + y > N) :: _) & \$s2) -> (-2, [], s2) -- a hand becomes more than N | (#2, \$x :: (![] & \$rs'), (?(\y -> x + y > N) :: _) & \$s2) -> (1, rs', s2) add x xs := matchDFS xs as list (integer, integer) with | \$hs ++ (#x, \$n) :: \$ts -> hs ++ (x, n + 1) :: ts | \$hs ++ (!((?(\y -> x > y), _) :: _) & \$ts) -> hs ++ (x, 1) :: ts | _ -> (x, 1) :: xs "move" move (1, [(2,1)], [(1,1), (5,1)]) -- [(2, [(2, 1)], [(3, 1), (5, 1)]), (2, [(2, 1)], [(1, 1)])] move (2, [(1,1), (5,1)], [(2,1)]) -- [(1, [(3, 1), (5, 1)], [(2, 1)])] assertEqual "add" (add 1 [(1,3),(3,1)]) [(1, 4), (3, 1)] assertEqual "add" (add 2 [(1,3),(3,1)]) [(1, 3), (2, 1), (3, 1)] init := (1, [(1,2)], [(1,2)]) assertEqual "move" (move init) [(2, [(1, 2)], [(1, 1), (2, 1)])] makeTree x := Node x (map makeTree (move x)) assertEqual "makeTree" (makeTree (1, [(2, 1)], [(1, 1)])) (Node (1, [(2, 1)], [(1, 1)]) [Node (2, [(2, 1)], [(3, 1)]) [Node (1, [(5, 1)], [(3, 1)]) [Node (-1, [(5, 1)], []) []]]]) topTree s n := matchAllDFS makeTree s as tree state with | loop \$i (1, [1..n], \$m) (node \$x_i (... :: _)) _ -> map (\i -> x_i) [1..m] paths := matchAllDFS makeTree init as tree state with | loop \$i (1, \$n) (node \$x_i (... :: _)) (node \$x_(n + 1) []) -> map (\i -> x_i) [1..(n + 1)] --io (each (compose show print) (head paths)) winningRec s := matchAll makeTree s as tree state with | (node (\$h, _, _) ((node (\$t & ((#(neg h), _, _) | ?(\t -> (empty? (winningRec t))))) _) :: _)) -> t winningNot s := matchAllDFS makeTree s as tree state with | node (\$h, _, _) (loop \$i (1, [1..], _) (node \$t !(node _ !... :: _) :: _) (node (#(neg h), _, _) _ :: _)) -> t winning c := matchAllDFS makeTree c as tree state with | node (\$h, _, _) (loop \$i (1, \$n) (node \$f_i (forall (@ :: _) (node \$s_i ...)) :: _) (node ((#(neg h), _, _) & \$l) _ :: _)) -> c :: concat (map (\i -> [f_i, s_i]) [1..n]) ++ [l] "winning (first)" io (each (compose (\l -> (map transformState l)) (compose show print)) (winning init)) "winning (second)" winning (2, [(1, 2)], [(2, 1), (1, 1)]) "winning" winning (1, [(5, 2)], [(5, 1)]) "winning" winning (1, [(2, 1)], [(1, 1)]) assertEqual "winningNot (first)" (winningNot init) [(2, [(1, 2)], [(2, 1), (1, 1)])] assertEqual "winningNot (second)" (winningNot (2, [(1, 2)], [(2, 1), (1, 1)])) []