{- Generate a bitmap of primes and composites.

Example usage, generating a 480x270 PBM image:

    prime-frieze 270 0

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 qualified Primality2 as Primality;
import qualified Data.Ratio;

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

main :: IO();
main = getArgs >>= \case{
[num_rows,start_block] -> show_picture (read num_rows) (read start_block) & putStr;
["columns"] -> putStrLn $ unwords ["mod",show big_width, show columns];
["scaled",offset,scale,num_rows,start_block] -> show_scaled_picture (read offset) (read scale) (read num_rows) (read start_block) & putStr;
["unfiltered",width,height] -> unfiltered_picture (read width) (read height) & show_pbm (read width) (read height) & putStr;
_ -> undefined;
};

little_primes :: [Integer];
-- 5 = 11 primorial = width 480
little_primes = Primality.primes () & take 5;

big_width :: Integer;
big_width =  product little_primes;

relatively_prime_to_list :: [Integer] -> Integer -> Bool;
relatively_prime_to_list l x = map (\m -> 0 /= mod x m) l & and;

-- avoid columns of all composites, i.e., white vertical lines through the image
columns :: [Integer];
columns = enumFrom 0 & genericTake big_width & filter (relatively_prime_to_list little_primes);

-- length columns is OEIS A005867

off_column :: Integer -> Bool;
off_column n = elem (mod n big_width) columns & not;

-- zero-th row is off limits
test_number :: Integer -> Bool;
test_number n = if off_column n then (not $ isPrime n) else True;

number_at_position :: Integer -> Integer -> Integer;
number_at_position row column = big_width*row+column;

do_row :: Integer -> [Bool];
do_row row = map (number_at_position row >>> isPrime) columns;

color :: Bool -> String;
color True = "1";
color False = "0";

do_picture :: Integer -> Integer -> [[Bool]];
do_picture num_rows start_row = enumFrom start_row & genericTake num_rows & map do_row;

show_picture :: Integer -> Integer -> String;
show_picture num_rows start_block = do_picture num_rows (start_block * num_rows) & concat & show_pbm (genericLength columns) num_rows ;

show_pbm :: Integer -> Integer -> [Bool] -> String;
show_pbm width height bits = unlines ["P1", show width, show height] ++ (map color bits & unlines);

unfiltered_picture :: Integer -> Integer -> [Bool];
unfiltered_picture width height = do {
row <- enumFrom 0 & genericTake height;
col <- enumFrom 0 & genericTake width;
row*width + col & isPrime & return;
};

split_careful :: (Integral num) => num -> [a] -> ([a],[a]);
split_careful n l = let {(x,y) = genericSplitAt n l}
in if n == genericLength x then (x,y) else error "split_careful";

generic_n_chunk :: (Integral num) => num -> [a] -> [[a]];
generic_n_chunk n = unfoldr (\l -> if null l then Nothing else (Just $ split_careful n l));

sum_horizontal :: (Integral num, Num a) => num -> [a] -> [a];
sum_horizontal n = generic_n_chunk n >>> map sum;

sum_vertical :: (Integral num, Num a) => num -> [[a]] -> [[a]];
sum_vertical n = generic_n_chunk n >>> map (transpose >>> map sum);

sum_both_ways :: (Integral num, Num a) => num -> [[a]] -> [[a]];
sum_both_ways n = map (sum_horizontal n) >>> sum_vertical n;

bool_to_int :: Bool -> Integer;
-- also do the color transform here, which is slightly sketchy
bool_to_int True = 0; -- black
bool_to_int False = 1; -- white

promote_picture :: [[Bool]] -> [[Integer]];
promote_picture = map (map bool_to_int);

scale_color :: Integer -> Integer -> Integer;
scale_color maxrange n = (maxcolor * n) Data.Ratio.% maxrange & round;

scale_picture :: Integer -> [[Bool]] -> [[Integer]];
scale_picture scale = promote_picture >>> sum_both_ways scale >>> ( scale * scale & scale_color & map & map );

-- purpose is pnmscale does not perform optimally for scaling factors like 1/6
-- offset allows skipping the first (zeroth) row because it affects norm (simple-recolor.sh in carina-scripts)
show_scaled_picture :: Integer ->Integer -> Integer -> Integer -> String;
show_scaled_picture offset scale num_rows start_block = unlines ["P2"
, genericLength columns & div_cleanly_by scale & show
, num_rows & div_cleanly_by scale & show
, maxcolor & show
] ++ (do_picture num_rows (start_block * num_rows + offset) & scale_picture scale & concat & map show & unlines);

maxcolor :: Integer;
maxcolor = 255;

div_cleanly_by :: (Integral a) => a -> a -> a;
div_cleanly_by denominator numerator = case divMod numerator denominator of {
(q,0) -> q;
_ -> error "div_cleanly_by";
};

isPrime :: Integer -> Bool;
isPrime = Primality.isPrime_small;

} --end