module TestCycles where

import Algebra.Graph (Graph, circuit, edges, overlays)
import Data.List (nub, permutations, sort)
import qualified Data.Vector as V
import qualified Data.Vector.Algorithms.Merge as VA
import GHC.Natural
import qualified RandomCycle.List as RL
import qualified RandomCycle.Vector as RV
import System.Random.Stateful (mkStdGen, runSTGen_)
import Test.Tasty
import Test.Tasty.HUnit (assertBool, testCase)
import Test.Tasty.QuickCheck

{- Top-level -}

testCycles :: TestTree
testCycles = testGroup "Cycles" [cpTest 5, cpThinProp]
  where
    cpTest m =
      testGroup "Cycle partition isomorphism" $
        map
          ( \n ->
              testCase (show n) $
                assertBool "Cycle partition isomorphism check failed" $
                  cyclePartitionIsomorphism n
          )
          [0 .. m]
    cpThinProp = testProperty "Cycle partition with thinning" prop_cyclePartitionThin

{- PROPERTIES -}

-- | Utility to directly create the cycle partition graph from a given partition.
-- This is just for testing and is blatantly inefficient as written here.
cyclePartitionGraph :: [[Int]] -> Graph Int
cyclePartitionGraph = overlays . map circuit

-- | Test validating the claim underlying the sampling scheme that cycle partitions
-- are isomorphic with the permutations, which the reader could also prove directly.
-- This is very inefficient, so it should be run on only a small 'n'.
-- Should serve as a stand-in for a property test of 'uniformCyclePartition',
-- which just applies this fact to claim uniformity in sampling.
cyclePartitionIsomorphism :: Int -> Bool
cyclePartitionIsomorphism n = and $ zipWith (==) cps gps
  where
    n' = abs n
    ids = [0 .. n']
    perms = permutations ids
    cps = sort $ map (edges . zip ids) perms
    gps =
      sort $
        nub $
          concatMap (\n -> map (cyclePartitionGraph . RL.partitionFromBits n) perms) [0 :: Natural .. 2 ^ n' - 1]

-- | Property test checking that sampling subject to a simple set of rules produces the correct result.
prop_cyclePartitionThin :: NonNegative Int -> Property
prop_cyclePartitionThin (NonNegative n) = True === chk (V.all simpleEdgeRules <$> v)
  where
    -- Min number for there to exist a solution with given rules
    nmin = n + 3
    v = runSTGen_ (mkStdGen 1305) $ RV.uniformCyclePartitionThin 1000 simpleEdgeRules nmin
    chk Nothing = False
    chk (Just b) = b

{- UTILITIES -}

-- | Some simple rules to check.
-- You must ensure the predicate check 'all' of them has non-empty support.
--
-- NOTE: This list requires the number of vertices to be > 2
-- for there to exist a solution.
simpleEdgeRules :: (Int, Int) -> Bool
simpleEdgeRules e = all ($ e) [noSelf, no12]
  where
    noSelf = uncurry (/=)
    no12 (1, 2) = False
    no12 _ = True