{-
 Game values for the game of Chomp

 Copyright 2017 Ken Takusagawa

 This program is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 the Free Software Foundation, either version 3 of the License, or (at
 your option) any later version.

 This program is distributed in the hope that it will be useful, but
 WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 General Public License for more details.

 You should have received a copy of the GNU General Public License
 along with this program.  If not, see <http://www.gnu.org/licenses/>.

  -}
{-# LANGUAGE ScopedTypeVariables #-}
module Main  where{
import Control.Exception;
import System.IO.Unsafe;
import Control.Monad;
import Control.Monad.ST;
import qualified Data.Map as Map;
import Data.Array.ST;
import Data.Maybe;
import System.Random;
import System.Environment;
import Data.STRef;
import Data.Array.IArray;
import Data.Ord;
import Control.Parallel.Strategies;
import Data.List;
import System.IO;

main :: IO(());
main = (do{
  (hPutStrLn stderr rcs_code);
  (getArgs >>= (\lambda_case_var ->case lambda_case_var of {
  ["nothing"]-> (return ());
  ["go", (num)]-> (go (read num));
  ["pnumslow", (num)]-> (print(length(positions_with_n_pieces_slow(read(num)))));
  ["pnumfast", (num)]-> (print(length(positions_with_n_pieces_fast(read(num)))))
}));
});
show_list :: (Show (a)) => [](a) -> String;
show_list l = (unlines (map show l));
quiet :: Bool;
quiet = False;
cerr :: [](String) -> a -> a;
cerr message x = (case quiet of {
  (True)-> x;
  (_)-> (unsafePerformIO (do{
  (hPutStrLn stderr (concat message));
  (return x);
}))
});
cerr0 :: String -> a -> a;
cerr0 message x = (case quiet of {
  (True)-> x;
  (_)-> (unsafePerformIO (do{
  (hPutStrLn stderr message);
  (return x);
}))
});
cerr_x :: [](String) -> a -> a;
cerr_x _ x = x;
peek :: (Show (a)) => a -> a;
peek x = (seq x (cerr [(show x)] x));
peek_more_x :: (a -> [](String)) -> a -> a;
peek_more_x _ x = x;
zip_map :: (a -> b) -> [](a) -> []((a, b));
zip_map f l = (zip l (map f l));
zip_map_parallel :: Strategy(b) -> (a -> b) -> [](a) -> []((a, b));
zip_map_parallel strat f l = (zip l (using (map f l) (parList strat)));
show_and :: (Show (a), Show (b)) => (a -> b) -> [](a) -> IO(());
show_and f l = (putStr(show_list((zip_map f l))));
ntakes :: Int -> [](a) -> []([](a));
ntakes n l = ((:) (take n l) (ntakes n (tail l)));
enum_from_count :: (Enum (a)) => a -> Int -> [](a);
enum_from_count start count = (take count (enumFrom start));
map_tuple :: (a -> b) -> (a, a) -> (b, b);
map_tuple fn x = ((fn (fst x)), (fn (snd x)));
reverse_comparison :: Ordering -> Ordering;
reverse_comparison o = (case o of {
  (LT)-> GT;
  (EQ)-> EQ;
  (GT)-> LT
});
reverse_comparison_function :: (a -> a -> Ordering) -> (a -> a -> Ordering);
reverse_comparison_function f = (curry((reverse_comparison . (uncurry f))));
n_chunk :: Int -> [](a) -> []([](a));
n_chunk n l = (case l of {
  ([])-> [];
  (_)-> ((:) (take_enough n l) (n_chunk n (drop n l)))
});
take_enough :: Int -> [](a) -> [](a);
take_enough n l = (case (compare 0 n) of {
  (EQ)-> [];
  (LT)-> (case l of {
  ((:)(head) (tail))-> ((:) head (take_enough (pred n) (tail )))
})
});
zip_check_same_length :: [](a) -> [](b) -> []((a, b));
zip_check_same_length x1 x2 = (case (x1, x2) of {
  (([]), ([]))-> [];
  (((:)(a) (arest)), ((:)(b) (brest)))-> ((:) (a, b) (zip_check_same_length arest brest))
});
zipWith_check_same_length :: (a -> b -> c) -> [](a) -> [](b) -> [](c);
zipWith_check_same_length f x1 x2 = (case (x1, x2) of {
  (([]), ([]))-> [];
  (((:)(a) (arest)), ((:)(b) (brest)))-> ((:) (f a b) (zipWith_check_same_length f arest brest))
});
powers_of_two = ((:) 1 (map ((*) 2) powers_of_two));
binary_to_decimal bits = (sum (zipWith (*) (reverse bits) powers_of_two));
apply_first :: (a -> b) -> (a, c) -> (b, c);
apply_first fn x = ((fn (fst x)), (snd x));
apply_second :: (a -> b) -> (c, a) -> (c, b);
apply_second fn x = ((fst x), (fn (snd x)));
type RLE a = ([](a), [](Int));
diffs l = (case l of {
  ([])-> Nothing;
  ((:)(h) (t))-> (Just ((:) h (zipWith (-) t l)))
});
undiff l = (case l of {
  (Nothing)-> [];
  (Just(l))-> (scanl1 (+) l)
});
every_n :: Int -> [](a) -> [](a);
every_n n l = (let {
is_mult :: Int -> Bool;
is_mult i = ((==) 0 (mod i n))
}
 in (map snd (filter (is_mult . fst) (zip (enumFrom 0) l))));
tab_split :: String -> [](String);
tab_split s = (let {
br :: (String, String);
br = (break ((==) '\t') s)
}
 in ((:) (fst br) (case (snd br) of {
  ([])-> [];
  ((:)('\t') (rest))-> (tab_split rest)
})));
second_is_longer :: [](a) -> [](a) -> Bool;
second_is_longer small big = (case (small, big) of {
  (([]), (_))-> True;
  ((_), ([]))-> False;
  (((:)(_) (r1)), ((:)(_) (r2)))-> (second_is_longer r1 r2)
});
is_prefix :: (Eq (a)) => [](a) -> [](a) -> Bool;
is_prefix prefix l = ((&&) (second_is_longer prefix l) (and (zipWith (==) prefix l)));
is_suffix :: (Eq (a)) => [](a) -> [](a) -> Bool;
is_suffix suffix l = (is_prefix (reverse suffix) (reverse l));
concatenate_many_files :: [](String) -> IO(String);
concatenate_many_files files = ((mapM readFile files) >>= (return . concat));
put_in_order :: (Ord (a)) => (a, a) -> (a, a);
put_in_order x = (case ((>) (fst x) (snd x)) of {
  (True)-> ((snd x), (fst x));
  (_)-> x
});
punch_array :: (Ix (a)) => (a, a) -> [](a) -> Array(a)(Bool);
punch_array bounds l = (let {
set_true :: Bool -> Bool -> Bool;
set_true _ _ = True
}
 in (accumArray set_true False bounds (zip l (repeat (error "fnord")))));
build_array_from_list :: (Ix (a)) => (a, a) -> []((a, b)) -> Array(a)([](b));
build_array_from_list bounds l = (accumArray snoc [] bounds l);
snoc :: [](a) -> a -> [](a);
snoc rest h = ((:) h rest);
filter_trues :: []((a, Bool)) -> [](a);
filter_trues xb = ((map fst)((filter snd)(xb)));
compare_length_lists :: [](a) -> [](a) -> Ordering;
compare_length_lists x y = (case (x, y) of {
  (([]), ([]))-> EQ;
  (([]), (_))-> LT;
  ((_), ([]))-> GT;
  (_)-> (compare_length_lists (tail x) (tail y))
});
ordering_to_equality :: forall a . (a -> a -> Ordering) -> (a -> a -> Bool);
ordering_to_equality compare_function = (let {
ret_val :: a -> a -> Bool;
ret_val x y = (case (compare_function x y) of {
  (EQ)-> True;
  (_)-> False
})
}
 in ret_val);
sort_and_group_by :: (a -> a -> Ordering) -> [](a) -> []([](a));
sort_and_group_by compare_function l = ((groupBy (ordering_to_equality compare_function))((sortBy compare_function)(l)));
compare_list_length_with_unity :: [](a) -> Ordering;
compare_list_length_with_unity l = (case l of {
  ([])-> LT;
  ((:)(_) ([]))-> EQ;
  (_)-> GT
});
choose_from_list_randomly :: [](a) -> IO(a);
choose_from_list_randomly l = (case l of {
  ([])-> (error "choose-from-list-randomly called on empty list");
  (_)-> ((randomRIO (0, (pred (length l)))) >>= (return . ((!!) l)))
});
uniform_random_IO :: IO(Float);
uniform_random_IO = (randomRIO (0, 1));
random_permutation_IO :: [](a) -> IO([](a));
random_permutation_IO l = ((sequence (replicate (length l) uniform_random_IO)) >>= (return . (map fst) . (sortBy (comparing snd)) . (zip_check_same_length l)));
combine_maybes_in_io :: (Monad (io)) => [](io(Maybe(a))) -> io(Maybe(a));
combine_maybes_in_io l_to_do = (case l_to_do of {
  ([])-> (return Nothing);
  ((:)(h) (rest))-> (h >>= (\lambda_case_var ->case lambda_case_var of {
  (Just(_))-> h;
  (_)-> (combine_maybes_in_io rest)
}))
});
is_singleton_list :: [](a) -> Bool;
is_singleton_list l = (case l of {
  ((:)(_) ([]))-> True;
  (_)-> False
});
first_last :: [](a) -> (a, a);
first_last l = ((head l), (last l));
list_change_at_index :: [](a) -> Int -> a -> [](a);
list_change_at_index l n new_value = (case l of {
  ((:)(head) (tail))-> (case (compare 0 n) of {
  (EQ)-> ((:) new_value tail);
  (LT)-> ((:) head (list_change_at_index tail (pred n) new_value))
})
});
backwards_tuple :: (a, b) -> (b, a);
backwards_tuple x = (case x of {
  ((i), (j))-> (j, i)
});
mk_1_map_array :: (a -> b) -> [](a) -> Array(Int)(b);
mk_1_map_array fn la = (listArray (1, (length la)) (map fn la));
filter_justs :: ([](Maybe(a)) -> [](a));
filter_justs = ((map fromJust) . (filter isJust));
head_only :: [](a) -> a;
head_only l = (case l of {
  [(x)]-> x
});
tail_assert :: (Eq (a)) => a -> [](a) -> [](a);
tail_assert x l = (assert ((==) x (head l)) (tail l));
singleton :: a -> [](a);
singleton x = [x];
rcs_code :: String;
rcs_code = "$Id: chomp-trainer.ll,v 1.86 2017/12/05 23:27:00 kenta Exp $";
type Table  = Map.Map(Key_position)(Gamevalue);
data Gamevalue  = Lose_in(Int) | Win_in(Int) deriving (Eq, Show);
table_lookup :: Table -> Position -> Maybe(Gamevalue);
table_lookup t p = (Map.lookup p t);
newtype Position  = Position([](Int)) deriving (Eq, Ord, Show);
type Key_position  = Position;
best :: Bool -> [](Gamevalue) -> Gamevalue;
best _direction vals = (flip_gamevalue (minimum vals));
flip_gamevalue :: Gamevalue -> Gamevalue;
flip_gamevalue g = (case g of {
  (Lose_in(i))-> (Win_in (succ i));
  (Win_in(i))-> (Lose_in (succ i))
});
game_value_generate :: STRef(s)(Table) -> Bool -> Position -> ST(s)(Bool);
game_value_generate ptable direction position = (do{
  table :: Table <- (readSTRef ptable);
  (case (table_lookup table position) of {
  (Just(_))-> (return True);
  (_)-> (let {
moves :: [](Position);
moves = (moves_from position)
}
 in (case (sequence (map (table_lookup table) moves)) of {
  (Just(vals))-> (do{
  (write ptable position (best direction vals));
  (return True);
});
  (Nothing)-> (do{
  (mapM_ (game_value_generate ptable (not direction)) moves);
  (return False);
})
}))
});
});
instance Ord (Gamevalue) where {
compare x y = (case x of {
  (Lose_in(xx))-> (case y of {
  (Lose_in(yy))-> (compare xx yy);
  (Win_in(_))-> LT
});
  (Win_in(xx))-> (case y of {
  (Lose_in(_))-> GT;
  (Win_in(yy))-> (compare yy xx)
})
})
}
;
extract_Position :: Position -> [](Int);
extract_Position p = (case p of {
  (Position(x))-> x
});
moves_from :: Position -> [](Position);
moves_from p = ((map Position)(one_only((map count_position)((map canonicalize)(clean_m2(bit_create_position(extract_Position(p))))))));
count_line :: [](Bool) -> Int;
count_line l = (length((takeWhile id)(l)));
count_position :: []([](Bool)) -> [](Int);
count_position l = (takeWhile ((<) 0) (map count_line l));
bit_create_position_padded :: Int -> Int -> [](Bool);
bit_create_position_padded width this = (take width ((++) (replicate this True) (repeat False)));
bit_create_position :: [](Int) -> []([](Bool));
bit_create_position l = (case l of {
  ((:)(h) (t))-> ((:) (replicate h True) (map (bit_create_position_padded h) t))
});
canonicalize :: []([](Bool)) -> []([](Bool));
canonicalize p = (max p (transpose p));
m1 :: [](Bool) -> []([](Bool));
m1 x = (case x of {
  ([])-> [];
  ((:)(True) (rest))-> ((:) (map (const False) x) (do{
  m2 :: [](Bool) <- (m1 rest);
  (return ((:) True m2));
}));
  ((:)(False) (rest))-> (do{
  m2 :: [](Bool) <- (m1 rest);
  (return ((:) (error "True after False") m2));
})
});
m2 :: []([](Bool)) -> []([]([](Bool)));
m2 x = (case x of {
  ([])-> [];
  ((:)(line) (rest))-> ((++) (do{
  mask :: [](Bool) <- (m1 line);
  (return (map (zipWith (&&) mask) x));
}) (do{
  do_rest :: []([](Bool)) <- (m2 rest);
  (return ((:) line do_rest));
}))
});
clean_m2 :: []([](Bool)) -> []([]([](Bool)));
clean_m2 x = (do{
  r :: []([](Bool)) <- (m2 x);
  (guard (head (head r)));
  (return r);
});
show_position :: Position -> String;
show_position x = (unlines((map (map show_pos_char))(bit_create_position(extract_Position(x)))));
show_pos_char :: Bool -> Char;
show_pos_char x = ((case x of {
  (True)-> (head "X");
  (_)-> (head ".")
}) );
one_only :: (Ord (a)) => [](a) -> [](a);
one_only x = ((map head)(group(sort(x))));
l_positions :: [](Position);
l_positions = (map Position (do{
  x :: Int <- (enumFrom 1);
  (return ((:) ((+) 1 x) (replicate x 1)));
}));
two_positions :: [](Position);
two_positions = (map Position (do{
  x :: Int <- (enumFrom 3);
  (return [x, (pred x)]);
}));
three_positions :: [](Position);
three_positions = (map Position (do{
  x :: Int <- (enumFrom 4);
  (return [x, ((-) x 2), 2]);
}));
lost_positions :: Int -> [](Position);
lost_positions limit = (let {
within_size :: Position -> Bool;
within_size p = (case p of {
  (Position((:)(s) (_)))-> ((<=) s limit)
})
}
 in (concat [(takeWhile within_size l_positions), (takeWhile within_size two_positions), (takeWhile within_size three_positions)]));
initial_scores :: Int -> Table;
initial_scores limit = (Map.fromList ((:) ((Position [1]), (Lose_in 0)) (do{
  p :: Position <- (lost_positions limit);
  (return (p, (Lose_in 0)));
})));
write :: STRef(s)(Table) -> Position -> Gamevalue -> ST(s)(());
write ptable p v = (modifySTRef ptable (let {modify :: Table -> Table;
modify t = (Map.insert p v t)} in modify));
untilST :: (ST(s)(Bool)) -> ST(s)(());
untilST body = (do{
  done :: Bool <- body;
  (case done of {
  (True)-> (return ());
  (_)-> (untilST body)
});
});
solve_game_st :: Int -> ST(s)(Table);
solve_game_st limit = (do{
  ptable :: STRef(s)(Table) <- (newSTRef (initial_scores limit));
  (untilST (game_value_generate ptable True (Position (replicate limit limit))));
  (readSTRef ptable);
});
solve_game :: Int -> Table;
solve_game limit = (runST (solve_game_st limit));
go :: Int -> IO(());
go limit = (putStr(show_list((Map.toList )(solve_game(limit)))));
find_move :: Table -> [](Int) -> IO(());
find_move t f = (putStrLn(show_list((sortBy (comparing snd))((zip_map (table_lookup t))(moves_from(Position(f)))))));
positions_with_n_pieces_1 :: Int -> Int -> []([](Int));
positions_with_n_pieces_1 maxwidth n = ((:) [] (case ((||) ((==) 0 n) ((==) 0 maxwidth)) of {
  (True)-> mzero;
  (_)-> (do{
  x :: Int <- (enumFromTo 1 (min maxwidth n));
  l :: [](Int) <- (positions_with_n_pieces_1 x ((-) n x));
  (return ((:) x l));
})
}));
positions_with_n_pieces_slow :: Int -> [](Position);
positions_with_n_pieces_slow n = ((filter is_canonical)((map Position)(tail((positions_with_n_pieces_1 n n)))));
is_canonical :: Position -> Bool;
is_canonical p = (((==) p)(Position(count_position(canonicalize(bit_create_position(extract_Position(p)))))));
positions_with_n_pieces :: Int -> Int -> Int -> []([](Int));
positions_with_n_pieces maxwidth maxheight n = ((:) [] (case (or [((==) 0 n), ((==) 0 maxwidth), ((==) 0 maxheight)]) of {
  (True)-> mzero;
  (_)-> (do{
  x :: Int <- (enumFromTo 1 (min maxwidth n));
  l :: [](Int) <- (positions_with_n_pieces x (pred maxheight) ((-) n x));
  (return ((:) x l));
})
}));
positions_with_n_pieces_fast :: Int -> [](Position);
positions_with_n_pieces_fast n = (do{
  x :: Int <- (enumFromTo 1 n);
  l :: [](Int) <- (positions_with_n_pieces x (pred x) ((-) n x));
  (let {
p :: Position;
p = (Position ((:) x l))
}
 in (do{
  (guard (is_canonical p));
  (return p);
}));
})
}