{-
Prints out a list of numbers whose binary representation, when
truncated by right shift yields many prime numbers or prime numbers
minus 1.
Copyright 2022 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 .
-}
{-# LANGUAGE ScopedTypeVariables, LambdaCase, PackageImports #-}
module Main(main) where {
import System.Environment(getArgs);
import Data.Function((&));
import Control.Category((>>>));
import Prelude hiding((.),(>>));
import System.IO(hSetBuffering,stdout,BufferMode(LineBuffering));
import qualified Control.Monad as Monad;
import Control.Monad(MonadPlus);
import Primality2(isPrime_small);
import System.CPUTime(getCPUTime); -- picosecond
main :: IO();
main = getArgs >>= \case{
[goal, len] -> keepfinding (read goal) (read len);
[] -> keepfinding 1 0;
_ -> undefined;
};
type Ii = Integer;
-- little endian
binarytointeger :: [Bool] -> Ii;
binarytointeger = let {
pow2s :: [Ii];
pow2s = 1:map(\x -> x*2)pow2s;
multbool :: Ii -> Bool -> Ii;
multbool x True = x;
multbool _ False = 0;
} in zipWith multbool pow2s >>> sum;
-- branch and bound
dosearch :: forall m . (MonadPlus m) => Ii -> ([Bool],Ii) -> Ii -> m[Bool];
dosearch goal (_,primessofar) numleft | primessofar+numleft < goal = Monad.mzero; -- this handles this case when numleft is negative
dosearch _ (pathsofar,_) 0 = return pathsofar;
dosearch goal (pathsofar,primessofar) numleft = let {
nextodd :: [Bool] = True:pathsofar;
nextprimesofar :: Ii = if isPrime_small $ binarytointeger nextodd
then 1+primessofar
else primessofar;
nextsearch :: [Bool] -> m [Bool];
nextsearch path = dosearch goal (path, nextprimesofar) (pred numleft);
} in nextsearch (False:pathsofar) `Monad.mplus` nextsearch nextodd;
-- (mplus Just Just) prefers the left one.
-- searching the False branch first prefers smaller numbers.
emptytreestart :: (MonadPlus m) => Ii -> Ii -> m [Bool];
emptytreestart goal numleft = dosearch goal ([True],0) (numleft-1); -- MSB must be 1
printcpu :: IO ();
printcpu = do {
cpu :: Integer <- getCPUTime ;
putStrLn $ " @ " ++ show cpu ++ "e-12 second";
};
keepfinding1 :: Ii -> Ii -> IO();
keepfinding1 goal width = case emptytreestart goal width of {
Nothing -> do {
putStr $ "done " ++ show width;
printcpu;
keepfinding1 goal (1+width);
};
Just bb -> do {
putStr "found ";
reverse bb & map (\case {True -> '1';False ->'0'}) & putStr; -- write as big endian binary
putStr " ";
[binarytointeger bb,goal,width] & map show & unwords & putStr;
printcpu;
keepfinding1 (1+goal) (1+width)
{- continuing at 1+width instead of width is a nontrivial optimization. if 1+startgoal were to exist at the current width (width), then startgoal would have existed at width-1 so we wouldn't be here. -}
}};
keepfinding :: Ii -> Ii -> IO();
keepfinding goal len = do {
hSetBuffering stdout LineBuffering;
keepfinding1 goal len;
};
} --end