{- Optimal cuts on a 2x2 mirror cube. Answer: 1/7, 2/7 ...

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(RandomGen,Random,StdGen,mkStdGen,random,randoms);
import Data.Ord(comparing);
import Control.Monad.Random(getRandomR,evalRand);
import HillClimb(randomized_hill_climb);

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

main :: IO();
main = getArgs >>= \case{
["big",seed] -> sorted_ntuples (better_mkStdGen $ read seed) 3 & zip_map worst_multiplicative & running_maximum (undefined,1) (comparing snd) & mapM_ print;
["smallview",thresh] -> sorted_ntuples (better_mkStdGen 1) 3 & zip_map worst_multiplicative & filter (\x -> snd x>read thresh) & mapM_ print;
["small",thresh] -> sorted_ntuples (better_mkStdGen 1) 3 & zip_map worst_multiplicative & filter (\x -> snd x>read thresh) & map fst & many_ranges & zip (enumFrom (0::Integer)) & mapM_ print;
["ranged",srange,thresh] -> ranged_ntuples (better_mkStdGen 1) (read srange) & zip_map worst_multiplicative & filter (\x -> snd x>read thresh) & map fst & map (take 3) & many_ranges & zip (enumFrom (0::Integer)) & mapM_ print;
["bigranged",srange,seed] -> ranged_ntuples (better_mkStdGen $ read seed) (read srange) & zip_map worst_multiplicative & running_maximum (undefined,1) (comparing snd) & mapM_ print;
["hill",seed] -> read seed & better_mkStdGen & go_hill & mapM_ print;
_ -> undefined;
};

small_randoms :: RandomGen g => g -> [Double];
small_randoms gen = do {
x :: Double <- randoms gen;
x/2 & return;
};

n_chunk :: Integral i => i -> [a] -> [[a]];
n_chunk n = unfoldr $ genericSplitAt n >>> Just;

sorted_ntuples :: RandomGen g => g -> Integer -> [[Double]];
sorted_ntuples gen size = small_randoms gen & n_chunk size & map sort & map append_unity_minus ;

append_unity_minus :: [Double] -> [Double];
append_unity_minus x = x ++ (reverse $ map (1-) x);

pair_indices :: Integer -> [(Integer,Integer)];
pair_indices size = do {
x <- enumFromTo 1 $ pred size;
return (x-1,x);
};

all_pairs_analyze :: (a -> a -> b) -> [a] -> [b];
all_pairs_analyze op l = do {
(small, large) <- pair_indices $ genericLength l;
return $ op (genericIndex l large) (genericIndex l small);
};

worst_subtractive :: [Double] -> Double;
-- bounding below by zero keeps the smallest dimension large
worst_subtractive = (0:) >>> all_pairs_analyze (-) >>> minimum;

zip_map :: (a -> b) -> [a] -> [(a,b)];
zip_map f l = zip l $ map f l;

type GenericRandom g a = g -> (a,g);
type RandomSG a = GenericRandom StdGen a;

better_mkStdGen :: Int -> StdGen;
-- discard first random sample, see rzzllapd
better_mkStdGen = mkStdGen >>> (random::RandomSG Bool) >>> snd;

-- this program has a space leak!

worst_multiplicative :: [Double] -> Double;
worst_multiplicative = (++[1]) >>> all_pairs_analyze (/) >>> minimum;

running_maximum :: a -> (a -> a -> Ordering) -> [a] -> [a];
running_maximum _ _ [] = [];
running_maximum start f (h:t) = case f start h of {
LT -> h:running_maximum h f t;
_ -> running_maximum start f t;
};

range_update :: (Ord a) => (a,a) -> a -> (a,a);
range_update (low,hi) x = (if x<low then x else low, if hi<x then x else hi);

many_ranges :: [[Double]] -> [[(Double,Double)]];
many_ranges = scanl (zipWith range_update) (repeat (1,0)) >>> tail;

random_in_ranges_forever :: (Random a, RandomGen g) => [(a,a)] -> g -> [[a]];
random_in_ranges_forever = mapM getRandomR >>> repeat >>> sequence >>> evalRand;

ranged_ntuples :: RandomGen g => g -> [(Double,Double)] -> [[Double]];
ranged_ntuples gen ranges = random_in_ranges_forever ranges gen & map append_unity_minus;


go_hill :: (RandomGen g) => g -> [([Double],Double)];
go_hill = randomized_hill_climb scorefunc 0.001 gstart;

gstart :: [Double];
gstart = [0.2, 0.3, 0.45];

scorefunc :: [Double] -> Double;
scorefunc = append_unity_minus >>> worst_multiplicative;

} --end