{-
Test the Collatz conjecture on large starting numbers.

Copyright 2016 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, LambdaCase #-}
module Main where {
import System.Environment(getArgs);
import Control.Exception(assert);
import Debug.Trace(trace);
import Data.Function((&));
import Control.Category((>>>));
import Prelude hiding((.),(>>));
import Data.List;
--import Control.Monad;
--import Data.Maybe;
--import qualified Data.Map as Map;
--import Data.Map(Map);
--import qualified Data.Set as Set;
--import Data.Set(Set);
import System.Random;
import System.IO;
import Data.Time(getZonedTime);

-- to avoid the redundancy warning
trace_placeholder :: ();
trace_placeholder = (trace,assert) & (id >>> error) "trace_placeholder";

-- single and grower2 were ones used.
main :: IO();
main = do {
hSetBuffering stdout LineBuffering;
getArgs >>= \case{
[] -> go 0 0;
["grower",seed,skip] -> grower (read seed) (read skip);
["bools",seed] -> read seed & bool_list & mapM_ print;
[seed] -> go ((read seed)::Int) 0;
[seed,"skip",skip] -> go ((read seed)::Int) ((read skip)::Integer);
["grower2",seed,skip] -> do
{ putStr $ "grower2 seed " ++ seed ++ " "
; getZonedTime >>= (show >>> putStrLn)
; calc_items (read seed) & drop (read skip) & mapM_ do_calc
};
["single",seed,skip] -> do
{ putStr $ "single seed " ++ seed ++ " skip " ++ skip ++ " "
; getZonedTime >>= (show >>> putStrLn)
; (read seed & calc_items) !! read skip & do_calc
};
_ -> error "bad arguments";
};
};

lengthen_integer :: Integer -> Bool -> Integer;
lengthen_integer i False = i*2;
lengthen_integer i True = i*2+1;

bits_larger :: [Bool] -> [Integer];
bits_larger = scanl' lengthen_integer 1; -- leading zeros are silly

collatz_accum :: Int -> Integer -> Int;
collatz_accum accum 1 = accum;
collatz_accum accum n = collatz_accum (accum+1)
$ case divMod n 2 of {
(q,0) -> q;
(_,1) -> 3*n+1;
_ -> error "collatz";
};

collatz_delay :: Integer -> Int;
collatz_delay = collatz_accum 0;

collatz_mdelay :: Integer -> Maybe Int;
collatz_mdelay n = if mod n 2 == 0 then Nothing
else Just $ collatz_delay n;

answer_list :: [Bool] -> [(Integer,Maybe Int)];
answer_list = bits_larger >>> map collatz_mdelay >>> zip (enumFrom 1);

random_bools :: StdGen -> [Bool];
random_bools = randoms;

mkStdGen2 :: Int -> StdGen;
mkStdGen2 = mkStdGen >>> next >>> snd;   --discard the first sample because bad

go :: Int -> Integer -> IO ();
go seed skip = do {
 getZonedTime >>= (show >>> putStr);
 putStrLn $ " seed " ++ show seed;
 bool_list seed & answer_list & genericDrop skip & annotate_with_just_count & takeWhile (\(_,x) -> x < enough_successes) & map fst & mapM_ print_with_time;
};

bool_list :: Int -> [Bool];
bool_list = mkStdGen2 >>> randoms;

enough_successes :: Integer;
enough_successes = 20;

-- the purpose is to notice a large amount of time has gone by since the last message
print_with_time :: (Show a) => a -> IO ();
print_with_time x = do {
show x ++ " "  & putStr;
-- print the time second, because need to evaluate the x thunk first
getZonedTime >>= (show >>> putStrLn);

};

count_justs :: Integer -> (a,Maybe b) -> Integer;
count_justs n (_,Nothing) = n;
count_justs n (_,Just _) = n+1;

annotate_with_just_count :: [(a,Maybe b)] -> [((a,Maybe b),Integer)];
annotate_with_just_count l = scanl' count_justs 0 l & zip l;

grower_test :: IO ();
grower_test = iterate (*1.1) (10000::Double) & take 100 & map (floor :: Double -> Integer) & mapM_ print;

grower_func :: Integer -> [Integer];
grower_func = fromInteger >>> iterate (* growth_rate) >>> map floor;

growth_rate :: Double;
growth_rate = 1.1;

grower :: Int -> Integer -> IO ();
grower seed start = grower_func start & mapM_ (go seed);

item :: [Bool] -> Integer;
item b = 1+2*(foldl' lengthen_integer 1 b);

rbools :: Int -> Int -> [Bool];
-- let's hope different seeds are independent enough
rbools seed n = bool_list seed & take n;

int_list :: Int -> [Int];
int_list = mkStdGen2 >>> randoms;

bitlength :: Int -> Int;
bitlength x = 10000*(1.1 :: Double)**(fromIntegral x/20) & round;

all_bitlengths :: [Int];
all_bitlengths = map bitlength [0..];

seeds :: Int -> [Int];
seeds = int_list;

calc_items :: Int -> [(Int, (Int,Int))];
calc_items seed = zip [0..] $ zip (seeds seed) all_bitlengths;

do_calc :: (Int,(Int,Int)) -> IO();
do_calc (index,(seed,blength)) = do
{ putStr $ show index ++ " " ++ show blength ++ " "
; rbools seed blength & item & collatz_delay & show & putStr
; putStr " "
; getZonedTime >>= (show >>> putStrLn)
};


} --end