-- | Augmented depth-limited search
-- | over a randomization of the hamiltonian cycle search space.
-- | Returns the first valid hamiltonian cycle found during the random search
-- | /Ω(n)/ & /O(n!)/
-- | Best Case Complexity:
-- |   Linear time to generate a valid solution in the first few attempts
-- | Worst Case Complexity:
-- |   Factorial time to generate all possible solutions
-- |   and deterimine none satisfy constraints

selectCyclicArrangement :: ConstraintMap -> IO (Maybe CyclicArrangement)
selectCyclicArrangement originalConstraints =
  newStdGen >>= return . selectCyclicArrangement' originalConstraints 0 root
  where
    -- The height of the expanded tree iff it
    -- contains a path representing a hamiltonian cycle
    height = pred . length $ keys originalConstraints

    -- Without loss of generality, we can arbitrarily fix the root node
    -- We choose for complexity sake, to select the key with
    -- the most constrainted value set.
    root = mostConstraintedKey originalConstraints

    -- Recursive Definition
    selectCyclicArrangement' :: RandomGen gen => ConstraintMap -> Int -> Name -> gen -> Maybe CyclicArrangement
    selectCyclicArrangement' constraints depth key gen
      |  constraints == empty
      || not atTerminalDepth
      && null branches
      || atTerminalDepth
      && not validTerminalNode = Nothing
      |  atTerminalDepth
      &&     validTerminalNode = Just [key]
      | otherwise = prependKey
                  . coalesce
                  . map branchMay
                  $ zip branches' branchGens
      where
        atTerminalDepth         = depth == height
        validTerminalNode       = root `elem` originalRecipients
        originalRecipients      = originalConstraints ! key
        prependKey              = fmap (key:)
        branchMay               = uncurry $ selectCyclicArrangement' constraints' (depth + 1)
        branches                = constraints ! key
        branches'               = shuffle' branches branchCount shuffleGen
        branchCount             = length branches
        constraints'            = reduceReceipiants key constraints
        (branchGens,shuffleGen) = runState (replicateM branchCount (state split >> get)) gen

selectCyclicArrangement :: ConstraintMap -> IO (Maybe CyclicArrangement)
selectCyclicArrangement originalConstraints =
  newStdGen >>= return . selectCyclicArrangement' originalConstraints 0 root
  where
    -- The height of the expanded tree iff it
    -- contains a path representing a hamiltonian cycle
    height = pred . length $ keys originalConstraints

    -- Without loss of generality, we can arbitrarily fix the root node
    -- We choose for complexity sake, to select the key with
    -- the most constrainted value set.
    root = mostConstraintedKey originalConstraints

    -- Recursive Definition
    selectCyclicArrangement' :: RandomGen gen => ConstraintMap -> Int -> Name -> gen -> Maybe CyclicArrangement
    selectCyclicArrangement' constraints depth key gen
      |  constraints == empty
      || not atTerminalDepth
      && null branches
      || atTerminalDepth
      && not validTerminalNode = Nothing
      |  atTerminalDepth
      &&     validTerminalNode = Just [key]
      | otherwise = prependKey
                  . coalesce
                  . map branchMay
                  $ zip branches' branchGens
      where
        atTerminalDepth         = depth == height
        validTerminalNode       = root `elem` originalRecipients
        originalRecipients      = originalConstraints ! key
        prependKey              = fmap (key:)
        branchMay               = uncurry $ selectCyclicArrangement' constraints' (depth + 1)
        branches                = constraints ! key
        branches'               = shuffle' branches branchCount shuffleGen
        branchCount             = length branches
        constraints'            = reduceReceipiants key constraints
        (branchGens,shuffleGen) = runState (replicateM branchCount (state split >> get)) gen
selectCyclicArrangement originalConstraints =
  newStdGen >>= return . selectCyclicArrangement' originalConstraints 0 root
  where
    -- The height of the expanded tree iff it
    -- contains a path representing a hamiltonian cycle
    height = pred . length $ keys originalConstraints

    -- Without loss of generality, we can arbitrarily fix the root node
    -- We choose for complexity sake, to select the key with
    -- the most constrainted value set.
    root = mostConstraintedKey originalConstraints

    -- Recursive Definition
    selectCyclicArrangement' :: RandomGen gen => ConstraintMap -> Int -> Name -> gen -> Maybe CyclicArrangement
    selectCyclicArrangement' constraints depth key gen
      |  constraints == empty
      || not atTerminalDepth
      && null branches
      || atTerminalDepth
      && not validTerminalNode = Nothing
      |  atTerminalDepth
      &&     validTerminalNode = Just [key]
      | otherwise = prependKey
                  . coalesce
                  . map branchMay
                  $ zip branches' branchGens
      where
        atTerminalDepth         = depth == height
        validTerminalNode       = root `elem` originalRecipients
        originalRecipients      = originalConstraints ! key
        prependKey              = fmap (key:)
        branchMay               = uncurry $ selectCyclicArrangement' constraints' (depth + 1)
        branches                = constraints ! key
        branches'               = shuffle' branches branchCount shuffleGen
        branchCount             = length branches
        constraints'            = reduceReceipiants key constraints
        (branchGens,shuffleGen) = runState (replicateM branchCount (state split >> get)) gen