{-# LANGUAGE ScopedTypeVariables, LambdaCase #-}
{-
   Copyright 2014 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 where {
import qualified Data.Sequence as Seq;
import Data.Sequence(ViewL(..),ViewR(..),(|>),Seq);
import Data.Int(Int64);
import System.Environment(getArgs);
import System.CPUTime(getCPUTime);
import Control.DeepSeq(deepseq);
import Data.List(unfoldr, genericLength);
import Control.Monad(foldM);
floyd_cycle_detect1 :: forall a ct . (Eq a, Enum ct) => (a -> a) -> a -> ct;
floyd_cycle_detect1 f start = next start start $ toEnum 0 where {
next :: a -> a -> ct -> ct;
next slow fast count = seq count $ check (f slow) (f $ f fast) $ succ count;
-- the seq or BangPatterns is critical for avoiding a giant space leak.

check :: a -> a -> ct -> ct;
check slow fast count = if slow==fast then count
else next slow fast count;
};

floydshow :: forall a . (Eq a) => (a -> a) -> a -> [a];
floydshow f start = start:next start start where {
next :: a -> a -> [a];
next slow fast = check (f slow) (f $ f fast);
check :: a -> a -> [a];
check slow fast = if slow==fast then []
else slow:next slow fast;
};

floyd_cycle_detect :: (Eq a, Num ct) => (a -> a) -> a -> ct;
floyd_cycle_detect f = genericLength . floydshow f;

-- alternate implementation
floyd_cycle_detect2 :: forall a ct . (Eq a, Enum ct) => (a -> a) -> a -> ct;
floyd_cycle_detect2 f start = inner start start $ toEnum 0 where {
inner :: a -> a -> ct -> ct;
-- the seq or BangPatterns is critical for avoiding a giant space leak.
-- inner slow fast !count =
inner slow fast count = let {
slow2 :: a;
slow2 = f slow;
fast2 :: a;
fast2 = f $ f fast;
count2 :: ct;
count2 = succ count;
} in seq count2 $ if slow2==fast2 then count2
 else inner slow2 fast2 count2;
};



type S = Seq Int;
modulus :: Int;
modulus = 10;

lagged_fibo :: S -> S;
lagged_fibo = lagged_fibo2;

-- Part 2
lagged_fibo1 :: S -> S;
lagged_fibo1 s = case (Seq.viewl s, Seq.viewr s) of{
(l :< rest, _ :> r) -> rest |> (mod (l+r) modulus);
-- if mod 2 then oeis a046932
_ -> error "Empty";
};
{-
(1,4)
(2,60)
(3,217)
(4,1560)
(5,168)
(6,196812)
(7,2480437)
(8,15624)
(9,28515260)
(10,1736327236)
(11,249032784)
(12,203450520)
(13,482322341820)
after 2500 minutes or so.
Seq Int and Counter Int64 only speeds things up by 10% or so.
-}

-- Part 3
lagged_fibo2 :: S -> S;
lagged_fibo2 s = case Seq.viewl s of {
x :< rest -> case Seq.viewl rest of {
y :< _ -> rest |> (mod (x+y) modulus);
_ -> error "l error y";
};
_ -> error "l error x";
};

{-
(2,60)
0
(3,168)
0
(4,1560)
0
(5,16401)
4000000000
(6,196812)
60003000000
(7,661416)
244015000000
(8,15624)
248015000000
(9,8894028)
2996186000000
(10,1736327236)
544938056000000
(11,3712686852)
1686329388000000
(12,203450520)
1750193380000000
(13,25732419240)
9773850827000000

-}

zstart :: Int -> S;
zstart n = Seq.replicate n 0 |> 1;
ioz :: Int -> IO ();
ioz n = printWithCPU (n+1, (floyd_cycle_detect lagged_fibo $ zstart n)::Int64);

printWithCPU :: Show a => a -> IO ();
printWithCPU x = do {
let {
s :: String;
s = show x;
};
cpu :: Integer <- deepseq s getCPUTime;
putStrLn $ show cpu ++ "ps: " ++ s;
};

view_whole_period :: [Int] -> (Int,Integer,[Int]);
view_whole_period start = let {
fl :: [Int];
fl = map shead $ floydshow lagged_fibo $ Seq.fromList start;
len :: Integer;
-- this causes a space leak.
-- len = length fl;
-- avoid the space leak by performing the computation twice.
len = floyd_cycle_detect lagged_fibo $ Seq.fromList start;
} in (length start, len, fl );

shead :: Seq a -> a;
shead s = case Seq.viewl s of {
l :< _ -> l;
_ -> error "shead";
};

nchunk :: Int -> [a] -> [[a]];
nchunk n = unfoldr $ \l -> if null l then Nothing else Just $ splitAt n l;

-- This could be made way faster.
find_max :: Int -> Int64;
find_max n = maximum $ do {
s :: [Int] <- sequence $ replicate n $ take modulus $ enumFrom 0;
return $ floyd_cycle_detect lagged_fibo $ Seq.fromList s;
};

tableau :: (Int,a,[Int]) -> IO();
tableau (columns, _len, s) = do {
-- taking advantage of lazy computation here.
-- avoid using _len to save time.
len2 :: Int <- foldM print_and_length 0 $ nchunk columns s;
print len2;
};

print_and_length :: (Show a) => Int -> [a] -> IO Int;
print_and_length old l = do {
print l;
-- lazy evaluation with $ causes a space leak
return $! old + length l;
};

main :: IO();
main = getArgs >>= \case {
"view":sl -> print $ view_whole_period $ map read sl;
"tableau":sl -> tableau $ view_whole_period $ map read sl;
"period":sl -> print ((floyd_cycle_detect lagged_fibo $ Seq.fromList $ map read sl)::Int64);
["max",n] -> print $ find_max $ read n;
["all",n] -> mapM_ ioz [(read n)..];
_ -> mapM_ ioz [1..]
};

}