module Math.SetCover.Cuboid where

import qualified Data.Set as Set

import qualified Data.Traversable as Trav
import qualified Data.Foldable as Fold
import Control.Applicative (Applicative, liftA2, liftA3, pure, (<*>))
import Data.List (sort)


data Coords a = Coords a a a
   deriving (Eq, Ord, Show)

instance Functor Coords where
   fmap f (Coords x y z) = Coords (f x) (f y) (f z)

instance Applicative Coords where
   pure x = Coords x x x
   Coords fx fy fz <*> Coords x y z = Coords (fx x) (fy y) (fz z)

instance Fold.Foldable Coords where
   foldMap = Trav.foldMapDefault

instance Trav.Traversable Coords where
   traverse f (Coords x y z) = liftA3 Coords (f x) (f y) (f z)


forNestedCoords ::
   (Enum a, Num a) =>
   ([z] -> b) ->
   ([y] -> z) ->
   ([x] -> y) ->
   (Coords a -> x) ->
   Coords a -> b
forNestedCoords fz fy fx f size =
   case fmap (\k -> [0 .. k-1]) size of
      Coords rx ry rz ->
         fz $ flip map rz $ \z ->
         fy $ flip map ry $ \y ->
         fx $ flip map rx $ \x ->
         f (Coords x y z)


newtype PackedCoords = PackedCoords Int
   deriving (Eq, Ord, Show)


dx, dy, dz :: Num a => Coords a -> Coords a
dx (Coords x y z) = Coords x (-z) y -- [1 0  0; 0 0 -1; 0 1 0]
dy (Coords x y z) = Coords (-z) y x -- [0 0 -1; 0 1 0; 1 0 0]
dz (Coords x y z) = Coords (-y) x z -- [0 -1 0; 1 0 0; 0 0 1]

rotations :: Num a => [Coords a -> Coords a]
rotations =
   liftA2 (.)
      [id, dx, dx.dx, dx.dx.dx]
      [id, dz, dz.dz, dz.dz.dz, dy, dy.dy.dy]


type Size = Coords Int

unpackCoords :: Size -> PackedCoords -> Coords Int
unpackCoords size (PackedCoords n) =
   snd $ Trav.mapAccumL divMod n size

packCoords :: Size -> Coords Int -> PackedCoords
packCoords size =
   PackedCoords . Fold.foldr (\(k,x) s -> k*s+x) 0 . liftA2 (,) size

normalForm :: (Ord a, Num a) => [Coords a] -> [Coords a]
normalForm ts = sort $ map (liftA2 subtract xyzm) ts
   where xyzm = foldl1 (liftA2 min) ts

allPositions :: Size -> [Coords Int] -> [[Coords Int]]
allPositions size ts =
   map (\displacement -> map (liftA2 (+) displacement) ts) $
   Trav.sequence $
   liftA2
      (\k r -> [0 .. k-1-r])
      size
      (foldl1 (liftA2 max) ts)

allOrientations :: (Num a, Ord a) => [Coords a] -> [[Coords a]]
allOrientations ts =
   Set.toList $ Set.fromList $
   map (normalForm . flip map ts) rotations