{-# LANGUAGE ScopedTypeVariables,GeneralizedNewtypeDeriving #-}

{-
Copyright 2010 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/>.
-}
module Main (main) where{
import Array;
import System;
import Char;
import IO;
import Control.Monad.State;
import Random;
import Data.List;
import qualified Data.Set as Set;
import qualified Data.Map as Map;
import Data.Maybe;
import Debug.Trace;

main :: IO(());
main = show_many_done;
enum_from_count :: (Enum (a)) => a -> Int -> [](a);
enum_from_count start count = (take count (enumFrom start));
show_list :: (Show (a)) => [](a) -> IO(());
show_list l = (putStr(unlines((map show)(l))));
data Position  = Off | On((Int, Int)) deriving (Show, Ord, Eq);
position_range :: Side_position;
position_range = ((:) Off (do{
  x :: Int <- (enum_from_count 0 size);
  y :: Int <- (enum_from_count 0 size);
  (return (On (x, y)));
}));
overlaps :: Position -> Position -> Bool;
overlaps a b = (case a of {
  (Off)-> False;
  (On(ax))-> (case b of {
  (Off)-> False;
  (On(bx))-> ((==) ax bx)
})
});
side_list :: []([](Position));
side_list = (do{
  foo :: [](Position) <- (replicateM (pred size) position_range);
  (guard (is_sorted foo));
  (return foo);
});
bad_overlap :: [](Position) -> [](Position) -> Bool;
bad_overlap x y = (or (do{
  p :: Position <- x;
  q :: Position <- y;
  (return (overlaps p q));
}));
is_sorted :: [](Position) -> Bool;
is_sorted l = (case l of {
  ([])-> True;
  ((:)(_) ([]))-> True;
  ((:)(x) ((:)(y) (_)))-> ((&&) (pos_sort x y) (is_sorted (tail l)))
});
pos_sort :: Position -> Position -> Bool;
pos_sort x y = (case x of {
  (Off)-> True;
  (On(_))-> ((<) x y)
});
type Side_position  = [](Position);
type Two_position  = (Side_position, Side_position);
two_positions :: () -> [](Two_position);
two_positions _ = (do{
  a :: Side_position <- side_list;
  b :: Side_position <- side_list;
  (guard(not((bad_overlap a b))));
  (return (a, b));
});
all_game_positions :: () -> [](Game_position);
all_game_positions _ = (do{
  x :: Two_position <- (two_positions ());
  y :: Side_to_move <- [First, Second];
  (return (y, x));
});
first_moves :: Int -> Int -> [](Position);
first_moves x y = (catMaybes([(do{
  (guard ((<) 0 y));
  (return(On((x, (pred y)))));
}), (do{
  (guard ((<) y (pred size)));
  (return(On((x, (succ y)))));
}), (do{
  (guard ((<) x (pred size)));
  (return(On(((succ x), y))));
}), (do{
  (guard ((==) x (pred size)));
  (return Off);
})]));
second_moves :: Int -> Int -> [](Position);
second_moves x y = (catMaybes([(do{
  (guard ((<) 0 x));
  (return(On(((pred x), y))));
}), (do{
  (guard ((<) x (pred size)));
  (return(On(((succ x), y))));
}), (do{
  (guard ((<) y (pred size)));
  (return(On((x, (succ y)))));
}), (do{
  (guard ((==) y (pred size)));
  (return Off);
})]));
initial_position :: Game_position;
initial_position = (First, ((do{
  i :: Int <- (enumFromTo 1 (pred size));
  (return(On((0, i))));
}), (do{
  i :: Int <- (enumFromTo 1 (pred size));
  (return(On((i, 0))));
})));
size :: Int;
size = 3;
type Move_generator  = (Int -> Int -> [](Position));
generate_moves_for_piece :: Int -> Int -> [](Position) -> Move_generator -> [](Position);
generate_moves_for_piece x y others generator = (do{
  p :: Position <- (generator x y);
  (guard(not(or((map (overlaps p) others)))));
  (return p);
});
first_and_rest :: [](a) -> []([](a));
first_and_rest l = (do{
  pq :: ([](a), [](a)) <- (init (zip (inits l) (tails l)));
  (return ((:) (head (snd pq)) ((++) (fst pq) (tail (snd pq)))));
});
generate_moves_for_side :: Side_position -> Side_position -> Move_generator -> [](Side_position);
generate_moves_for_side me you gen = (let {
allpieces :: [](Position);
allpieces = ((++) me you)
}
 in (do{
  fpos :: Side_position <- (first_and_rest me);
  (guard ((/=) Off (head fpos)));
  let {
hpos :: (Int, Int);
hpos = (case (head fpos) of {
  (On(x))-> x
})
};
  newpos :: Position <- (generate_moves_for_piece (fst hpos) (snd hpos) allpieces gen);
  (return(sort(((:) newpos (tail fpos)))));
}));
data Side_to_move  = First | Second deriving (Show, Eq, Ord);
type Game_position  = (Side_to_move, Two_position);
get_generator :: Side_to_move -> Move_generator;
get_generator s = (case s of {
  (First)-> first_moves;
  (Second)-> second_moves
});
flip_side :: Side_to_move -> Side_to_move;
flip_side s = (case s of {
  (First)-> Second;
  (Second)-> First
});
flip_according_to_side :: Side_to_move -> (a, a) -> (a, a);
flip_according_to_side s xy = (case s of {
  (First)-> xy;
  (Second)-> ((snd xy), (fst xy))
});
children :: Game_position -> [](Game_position);
children g = (let {
perspective :: Two_position;
perspective = (flip_according_to_side (fst g) (snd g));
next_player :: Side_to_move;
next_player = (flip_side(fst(g)))
}
 in (do{
  new_me :: Side_position <- (generate_moves_for_side (fst perspective) (snd perspective) (get_generator (fst g)));
  (return (next_player, (flip_according_to_side (fst g) (new_me, (snd(perspective))))));
}));
data Outcome  = Loss | Win deriving (Eq, Ord, Show);
type Value  = (Outcome, Int);
type Table  = Map.Map(Game_position)(Value);
is_terminal :: Game_position -> Bool;
is_terminal g = (null(children(g)));
get_value :: Table -> Game_position -> Maybe(Value);
get_value table p = (case (is_terminal p) of {
  (True)-> (Just (Win, 0));
  (False)-> (Map.lookup p table)
});
evaluate :: Table -> Game_position -> Maybe(Value);
evaluate table p = (let {
child_values :: [](Maybe(Value));
child_values = (sort((map (get_value table))(children(p))))
}
 in (case (dropWhile isNothing child_values) of {
  ((:)(Just(x@((Loss), (_)))) (_))-> (Just (increment_value x));
  (_)-> (case (head child_values) of {
  (Just(x))-> (Just (increment_value x));
  (Nothing)-> Nothing
})
}));
increment_value :: Value -> Value;
increment_value x = (case x of {
  ((Win), (n))-> (Loss, (succ (negate n)));
  ((Loss), (n))-> (Win, (negate (succ n)))
});
run_through_all :: Table -> []((Game_position, Value));
run_through_all table = (do{
  g :: Game_position <- (all_game_positions ());
  (guard(not(is_terminal(g))));
  (guard(isNothing((Map.lookup g table))));
  v :: Value <- (maybeToList (evaluate table g));
  (return (g, v));
});
all_off :: Side_position -> Bool;
all_off s = (null (filter ((/=) Off) s));
trivially_terminal :: Game_position -> Bool;
trivially_terminal g = (case g of {
  ((First), ((x), (_)))-> (all_off x);
  ((Second), ((_), (x)))-> (all_off x)
});
table_table :: Table -> Table;
table_table table = (let {
adds :: []((Game_position, Value));
adds = (run_through_all table)
}
 in ((trace(show(Map.size(table))))((Map.union (Map.fromList adds) table))));
pairs :: [](a) -> []((a, a));
pairs x = (zip x (tail x));
done_map :: (Table, Table) -> Bool;
done_map xy = ((/=) (Map.size (fst xy)) (Map.size (snd xy)));
many_done :: Table;
many_done = (snd(last((takeWhile done_map)(pairs((iterate table_table Map.empty))))));
show_many_done :: IO(());
show_many_done = ((mapM_ putStrLn)((map show_table_entry)(Map.toList(many_done))));
count_many_done :: IO(());
count_many_done = (show_list((map Map.size)((iterate table_table Map.empty))));
empty_run :: IO(());
empty_run = (print(table_table(Map.empty)));
mkdisplay :: Two_position -> String;
mkdisplay xy = (concat (do{
  x :: Int <- [2, 1, 0];
  y :: Int <- [0, 1, 2];
  (return (findxy x y xy));
}));
findxy :: Int -> Int -> Two_position -> String;
findxy x y xy = (case (findxyin x y (fst xy)) of {
  (True)-> "1";
  (_)-> (case (findxyin x y (snd xy)) of {
  (True)-> "2";
  (_)-> "0"
})
});
findxyin :: Int -> Int -> Side_position -> Bool;
findxyin x y s = (elem (On (x, y)) s);
show_table_entry :: (Game_position, Value) -> String;
show_table_entry e = (case e of {
  (((side), (xy)), (val))-> ((show side) ++ " " ++ (mkdisplay xy) ++ " " ++ (show val))
})
}