{-
  Commonly occurring N-digit sequences in the first 10^N digits of pi past the decimal point.

Usage example for 2-digit substrings in the first 100 digits of pi:
head -100c pi10billion | ./executable logmodulus 2

(download digits of pi from elsewhere.)

Copyright 2018 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 System.IO(hSetBuffering,stdout,BufferMode(LineBuffering));
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 Data.Word(Word8);
import Data.Array.MArray(MArray(newArray),readArray,writeArray,getElems,getBounds);
import Data.Array.ST(STUArray);
import Control.Monad.ST(ST,runST);
import qualified Data.ByteString.Lazy;
import Data.STRef(STRef,newSTRef,writeSTRef,readSTRef);
import qualified Data.Bifunctor as Bifunctor;

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

main :: IO();
main = getArgs >>= \case{
["logmodulus",n] -> io_go (read n);
["calc",n] -> calc (read n) & print;
["new",n] -> print (runST(do { array <- my_newArray (read n); getBounds array }));
_ -> undefined;
};

readword:: Word8 -> Integer -> Word8;
readword x 0 = mod x 16;
readword x 1 = div x 16;
readword _ _ = error "readword index not 0 or 1";

readboth :: Word8 -> [Word8];
readboth x = [readword x 0, readword x 1];

incword :: Word8 -> Integer -> Word8;
incword x pos = case divMod x 16 of {
(high, low) -> case pos of {
0 -> construct high (saturating_succ low);
1 -> construct (saturating_succ high) low;
_ -> error "incword index not 0 or 1";
}};

saturating_succ :: Word8 -> Word8;
saturating_succ 15 = 15;
saturating_succ x = succ x;

construct :: Word8 -> Word8 -> Word8;
construct high low = 16*high+low;

test1 :: (ST s (Minibytes s));
test1=do{
newArray(0,499) 0;
};

type Minibytes s = STUArray s Integer Word8;

readhalf_array :: Minibytes s -> Integer -> ST s Word8;
readhalf_array array i = case divMod i 2 of {
(q,r) -> do {
w <- readArray array q;
return $ readword w r;
}};

inc_half_array :: Minibytes s -> Integer -> ST s ();
inc_half_array array i = case divMod i 2 of {
(q,r) -> do {
w <- readArray array q;
writeArray array q (incword w r);
}};

push_digit :: Integer -> Integer -> Integer -> Integer;
push_digit modulus old x = mod (old*10 + x)modulus;

convert_from_ascii :: Word8 -> Integer;
convert_from_ascii c = fromIntegral c - (fromIntegral (fromEnum '0'));

all_substrings :: Integer -> [Word8] -> [Integer];
all_substrings logmodulus = map convert_from_ascii >>> scanl (push_digit (make_modulus logmodulus)) 0 >>> genericDrop logmodulus;

test2 :: Integer -> ST s Word8;
test2 modulus = do {
array <- newArray (0,div modulus 2 & pred) 0;
inc_half_array array 3;
inc_half_array array 3;
inc_half_array array 3;
inc_half_array array 3;
inc_half_array array 3;
readhalf_array array 3;
};

my_newArray :: Integer -> ST s (Minibytes s);
my_newArray logmodulus = newArray (0,div (make_modulus logmodulus) 2 & pred) 0;

gen_array :: Integer -> [Word8] -> ST s (Minibytes s);
gen_array logmodulus ws = do {
array <- my_newArray logmodulus;
all_substrings logmodulus ws & mapM_ (inc_half_array array);
return array;
};

largest_value :: (Minibytes s) -> ST s Word8;
largest_value array = minibytes_get_elems array >>= (maximum >>> return);

minibytes_get_assocs :: Minibytes s -> ST s [(Integer,Word8)];
minibytes_get_assocs array = getElems array >>= (concatMap readboth >>> zip (enumFrom 0) >>> return);

minibytes_get_elems :: Minibytes s -> ST s [Word8];
minibytes_get_elems array = minibytes_get_assocs array >>= (map snd >>> return);

--space leak
indices_with_largest_value_1 :: Minibytes s -> ST s (Word8,[Integer]);
indices_with_largest_value_1 array = do {
largest <- largest_value array;
assocs <- minibytes_get_assocs array;
return (largest, assocs & (filter (\(_,x) -> x==largest)) & map fst);
};

--still space leak
indices_with_largest_value_2 :: Minibytes s -> ST s (Word8,[Integer]);
indices_with_largest_value_2 array = minibytes_get_assocs array >>= (foldl' folding_largest (0,[]) >>> return);

go :: Integer -> [Word8] -> (Word8,[Integer]);
go logmodulus ws = runST (gen_array logmodulus ws >>= go_loopfold (make_modulus logmodulus));

test_string :: String -> [Word8];
test_string = map (fromEnum >>> fromIntegral);

make_modulus :: Integer -> Integer;
make_modulus x = 10^x;

io_go :: Integer -> IO ();
io_go logmodulus = Data.ByteString.Lazy.getContents >>= (Data.ByteString.Lazy.unpack >>> go logmodulus >>> Bifunctor.second reverse >>> print);

genbig :: Integer -> [Integer];
genbig n = enumFromTo 1 n;

calc :: Integer -> (Integer,Integer);
calc n = (genbig n & genericLength, genbig n & sum);

folding_largest :: (Word8,[Integer]) -> (Integer,Word8) -> (Word8,[Integer]);
folding_largest (largest,list) (index,x) = case (compare x largest) of {
LT -> (largest,list);
EQ -> (largest, (index:list));
GT -> (x, [index]);
};

loopfold :: (Monad m) => (val -> m ()) -> (Integer -> m val) -> Integer -> Integer -> m ();
loopfold f g i largest_plus1 = if i == largest_plus1 then return ()
else do {
next <- g i;
f next;
loopfold f g (succ i) largest_plus1;
};

mfolding_largest :: STRef s (Word8,[Integer])-> (Integer,Word8) -> ST s ();
mfolding_largest v x = do {
old <- readSTRef v;
let {newv = folding_largest old x};
--seq (fst newv) $ seq (snd newv) $ 
seq (fst newv) $ writeSTRef v newv;
};

gen_item :: Minibytes s -> Integer -> ST s (Integer,Word8);
gen_item array i = do {
x <- readhalf_array array i;
return (i,x);
};

go_loopfold :: Integer -> Minibytes s -> ST s (Word8,[Integer]);
go_loopfold modulus array = do{
 largest_so_far<- newSTRef (0,[]);
 loopfold (mfolding_largest largest_so_far) (gen_item array) 0 modulus;
 readSTRef largest_so_far;
};

-- space leak gone (with seq) but still uses 2x memory than expected.

} --end