DailyProgrammer 342 in Hasksell

Main.hs

{-# OPTIONS_GHC -funbox-strict-fields #-}

module Main where

import Data.Maybe (catMaybes)
import Data.List (splitAt)
import qualified Data.Bits as B
import qualified Data.IntSet as S
import System.Environment (getArgs)

main :: IO ()
main = do
  d <- read . head <$> getArgs
  let l = maxPathLength d
  putStrLn
    $ "Max snake path of " ++ show d
    ++ "D hyercube: " ++ show l

maxPathLength :: Int -> Int
maxPathLength d
  = maximum
  . map traversalLength
  $ allFullTraversals d

type Corner = Int

data Traversal
  = Traversal
  { traversalLength :: !Int
  , nextD :: !Int
  , currentCorner :: !Corner
  , unusableCorners :: !S.IntSet
  }

-- Starting at an arbitrary corner and no traversals.
initialTraversal :: Int -> Traversal
initialTraversal d = Traversal 0 0 0 S.empty

usedDims :: Traversal -> [Int]
usedDims Traversal { nextD = n } = [0..n-1]

allFullTraversals :: Int -> [Traversal]
allFullTraversals d = traverse (initialTraversal d)
  where
    traverse t = let nextTs = nextTraversals d t in
      if null nextTs
        then [t]
        else concatMap traverse nextTs

nextTraversals :: Int -> Traversal -> [Traversal]
nextTraversals d t = let
  onNextDim = tryTraverseNextD d t
  onUsedDim = [tryTraverseUsedD d i t | i <- usedDims t]
  in onNextDim : onUsedDim

-- Traverse down the next available dimention
tryTraverseNextD :: Int -> Traversal -> Maybe Traversal
tryTraverseNextD d t
  | traversalD >= d = Nothing
  | nextCorner `S.member` unusableCorners t = Nothing
  | otherwise
    = Just Traversal
        { traversalLength = traversalLength t + 1
        , nextD = traversalD + 1
        , currentCorner = nextCorner
        , unusableCorners = unusableCorners t `S.union` newUnusableCorners
        }
  where
    traversalD = nextD t
    nextCorner = traverseCorner traversalD (currentCorner t)
    newUnusableCorners
      = S.insert (currentCorner t)
      . S.fromList
      $ neighbors d (currentCorner t)

-- Traverse an already used dimention
tryTraverseUsedD :: Int -> Int -> Traversal -> Maybe Traversal
tryTraverseUsedD d traversalD t
  | traversalD >= nextD t = error "The dimention is not already used!"
  | nextCorner `S.member` unusableCorners t = Nothing
  | otherwise
    = Just Traversal
        { traversalLength = traversalLength t + 1
        , nextD = nextD t
        , currentCorner = nextCorner
        , unusableCorners = unusableCorners t `S.union` newUnusableCorners
        }
  where
    nextCorner = traverseCorner traversalD (currentCorner t)
    newUnusableCorners
      = S.insert (currentCorner t)
      . S.fromList
      $ neighbors d (currentCorner t)

traverseCorner :: Int -> Corner -> Corner
traverseCorner traversalD corner = B.complementBit corner traversalD

neighbors :: Int -> Corner -> [Corner]
neighbors d c = [ traverseCorner i c | i <- [0..d - 1] ]