{-# LANGUAGE ScopedTypeVariables #-}
{-
One dimensional puzzle generator, creating one-dimensional instances of the exact set cover problem.

For generation purposes, the one-dimensional field is divided into n blocks each of size b.  Each of the n pieces is roughly centered on a unique block and spans at most p blocks.  The arguments to the program are b p n.

Each generated piece is specified by a list of coordinates offset from its leftmost coordinate.  Each individual piece is typically not contiguous; that would make the puzzle trivial to solve.

There is a "edge effect" flaw such that pieces near the edge tend to span less than p blocks.

Motivation is to generate random inputs to Knuth's Dancing Links DLX algorithm.  What puzzle parameters generate difficult puzzles?
-}

{-
   Copyright 2014 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/>.

-}

module Main where {
import Control.Monad.Random(MonadRandom, getRandomR, evalRandIO);
import System.Random(randomIO);
import System.Environment(getArgs);
import Data.List(genericTake);
import Data.Map(Map);
import qualified Data.Map as Map;
-- import Data.Set(Set);
-- import qualified Data.Set as Set;
fix_range :: (Ord a, Ord b) => (a,b) -> (a,b) -> (a,b);
fix_range (xmin,ymax) (x,y) = (max x xmin, min y ymax);

newtype Block_size = Block_size Int;
newtype Piece_range = Piece_range Integer;
newtype Block_number = Block_number Integer;

random_block :: (MonadRandom m) => Block_size -> Piece_range -> (Block_number, Block_number) -> Block_number -> m [Integer];
random_block (Block_size size) (Piece_range prange) (Block_number bmin, Block_number bmax) (Block_number n) = sequence $ replicate size $ getRandomR $ fix_range (bmin,bmax) (n, n+prange);

many_random_blocks :: (MonadRandom m) => Block_size -> Piece_range -> Block_number -> m [[Integer]];
many_random_blocks size p@(Piece_range prange) (Block_number num_blocks) = mapM (random_block size p (Block_number 0, Block_number $ pred num_blocks)) $ map Block_number $ genericTake num_blocks $ enumFrom $ negate $ div prange 2;

-- This operation seems a very imperative, sequentially updating a data structure.
-- This function is similar to Data.List.find and Data.List.findIndices
found_map :: forall a. (Ord a) => [a] -> Map a [Int];
found_map l =
-- A bit sad we have to constantly do Set.union on singletons.
-- fmap Set.toList $ Map.fromListWith Set.union $ zip l $ map Set.singleton $ enumFrom 0;

-- The "flip" gets the list elements in ascending order.
-- We would still prefer something like fromListWithZero.
-- Map.fromListWith (flip (++)) $ zip l $ map return $ enumFrom 0;

-- the "reverse" is because the combining function is called f new_value old_value
fmap reverse $ Map.fromListWith lcombine $ zip l $ map return $ enumFrom 0;

-- for want of
-- insertWithKey0 :: Ord k => (k -> a -> b -> b) -> b -> k -> a -> Map k b -> Map k b
-- similar to foldr versus foldr1
-- insertWithKey0 f zero key new_value old_map
-- inserts (f key new_value zero) if key is not present in old_map
-- and inserts (f key new_value old_value) if key is already present

lcombine :: [a] -> [a] -> [a];
lcombine [x] y = x:y;
lcombine _ _ = error "first list not singleton";
-- though flip (++) is not any worse, given the implementation of (++)

sub_minimum :: forall n . (Num n, Ord n) => [n] -> [n];
sub_minimum l = let { mm :: n ; mm = minimum l } in map (\x -> x-mm) l;

main :: IO ();
main = do {
args :: [String] <- getArgs;
_ :: Bool <- randomIO;  -- avoid the poorly distributed first sample
case args of {
[b, p, n] -> do {
-- This ought to use a cryptographically secure pseudorandom number generator.
-- As it stands, one can backdoor solve the puzzle by testing all possible StdGen random number seeds.
l :: [[Integer]] <- evalRandIO $ many_random_blocks (Block_size $ read b)
 (Piece_range $ pred $ read p)  -- pred because 0..(p-1) has size p.
 (Block_number $ read n) ;
putStrLn "Pieces are:";
mapM_ print $ Map.toList $ fmap sub_minimum $ found_map $ concat l;
putStrLn "";
putStrLn "Solution is the concatenation of:";
mapM_ print l;
};
_ -> error "block_size max_piece_width_in_blocks puzzle_size_in_blocks\ne.g., 10 5 10";
}
}
}