{-

Searches for numbers with a large number of divisors, smoother than a
given threshold (numprimes).

Copyright 2021 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, PackageImports #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
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 qualified Prelude;
import System.IO(hSetBuffering,stdout,BufferMode(LineBuffering));
--import System.IO(stderr,hPutStrLn);
--import qualified Data.List as List;
import qualified Control.Monad as Monad;
--import Control.Monad(guard);
import qualified Data.Maybe as Maybe;
--import qualified Data.Map as Map; import Data.Map(Map);
--import qualified Data.Set as Set; import Data.Set(Set);
--import Data.Tuple(swap);
--import Control.Monad.GenericReplicate(genericReplicateM); -- igenericReplicateM
import Data.Ord(comparing);
--import qualified Data.Bifunctor as Bifunctor;  -- (first, second)
import Primality2(primes);
import Safe.Exact(zipWithExact, splitAtExact);
import qualified Data.List.Ordered as Ordered;

-- need to use Lazy state because Strict state cannot process an infinite list.
import qualified Control.Monad.State.Lazy as State;
import Control.Monad.State.Lazy(State);
import Data.List.HT(takeUntil);

main :: IO();
main = getArgs >>= \case{
[] -> themanydivisors & takeUntil (\(N x) -> last x>0) &
  map(\x -> unwords[show $ value x, show $ numdivisors x, show x]) & printlines;
["dump"] -> showlines smoothlist;
_ -> undefined;
};

numprimes :: Int;
--numprimes = primes () & takeWhile (\x -> x<=41) & length;
numprimes = 16; -- stymied at 17

-- numtokeep==2 means print numbers whose number of divisors equals or
-- exceeds second (2) place so far.
numtokeep :: Int;
numtokeep = 2;

type Ii = Integer;

-- Endomorphism. useful for (id :: Endo Integer) to assert a type in a pipeline
type Endo a = a->a;

-- to avoid the redundancy warning
trace_placeholder :: ();
trace_placeholder = (trace,assert,printlines,showlines :: [()]->IO(),id :: Endo Integer) & (id >>> error) "trace_placeholder";
-- ghc -O2 -fno-ignore-asserts

printlines :: [String] -> IO();
printlines l = do {
hSetBuffering stdout LineBuffering;
mapM_ putStrLn l;
};

showlines :: (Show a) => [a] -> IO();
showlines = map show >>> printlines;

myprimes :: [Ii];
myprimes = take numprimes $ primes();

type Exponent = Int; -- conserve memory over Integer

{-
Integer for numprimes = 15
779.76user 4.20system 13:03.96elapsed 99%CPU (0avgtext+0avgdata 4028860maxresident)k

Int
621.71user 3.68system 10:25.39elapsed 100%CPU (0avgtext+0avgdata 3511540maxresident)k

-}

-- exponents for the prime factorization
data N = N [Exponent] deriving (Show,Eq);

value :: N -> Ii;
value (N x) = zipWithExact (^) myprimes x & product;

-- should be a library typeclass?
-- the functional dependency is necessary to compile
class Modifiable t a | t -> a where {
internalmodify :: (a -> a) -> t -> t;
};

-- FlexibleInstances
instance Modifiable N [Exponent] where {
internalmodify f (N x) = N (f x);
};

-- increment the nth element of a list
succnth :: forall a . (Enum a) => Int -> [a] -> [a];
succnth n l = let {
  before :: [a];
  subject :: [a];
  (before,subject) = splitAtExact n l;
} in before ++ ((succ$ head subject):tail subject );

-- this optimization avoids constructing a number many times through many routes.  however, it ends up neither saving time nor memory.
bettersuccnth :: Int -> N -> Maybe N;
bettersuccnth i (N l) = let {
  before :: [Exponent];
  x :: Exponent;
  xrest :: [Exponent];
  (before,(x:xrest)) = splitAtExact i l;
} in if all ((==)0) xrest
then before ++ (succ x:xrest) & N & Just
else Nothing;

applybetter :: [N] -> Int -> [N];
applybetter l i = map (bettersuccnth i) l & Maybe.catMaybes;

succfunctions :: [N -> N];
succfunctions = map (succnth >>> internalmodify) (take numprimes $ enumFrom 0);

myzero :: N;
myzero = N $ replicate numprimes 0;

-- list of all numbers smooth numbers, in order.
smoothlist :: [N];
smoothlist = myzero : merged1;

manylists1 :: [[N]];
manylists1 = map (flip map smoothlist) succfunctions;
-- manylists = map (\i -> flip map smoothlist (internalmodify (succnth i))) $ take numprimes $ enumFrom 0;
-- manylists = enumFrom 0 & take numprimes & map (succnth >>> internalmodify >>> flip map smoothlist);

-- surprisingly manylists2 uses 2x memory of manylists1, run time about the same
manylists2 :: [[N]];
manylists2 = enumFrom 0 & take numprimes & map (applybetter smoothlist);

merged1 :: [N];
merged1 = foldr (Ordered.unionBy mycompare) [] manylists1;

-- mergeBy is acceptable for manylists2 because it does not construct the same number multiple times
merged2 :: [N];
merged2 = foldr (Ordered.mergeBy mycompare) [] manylists2;

mycompare :: N -> N -> Ordering;
mycompare x y = if x==y then EQ else comparing value x y;

numdivisors :: N -> Ii;
numdivisors (N x) = map (succ >>> toInteger) x & product;

compareandreplace :: Ii -> State [Ii] Bool;
compareandreplace x = do {
  old :: [Ii] <- State.get;
  Ordered.insertSet x old & reverse & take numtokeep & reverse & State.put;
  return$ head old <= x;
};

startstate :: [Ii];
startstate = replicate numtokeep 0;

themanydivisors :: [N];
--themanydivisors = State.evalState (Monad.filterM (numdivisors >>> compareandreplace ) smoothlist) startstate;

themanydivisors = flip State.evalState startstate $ flip Monad.filterM smoothlist (numdivisors >>> compareandreplace );

} --end