rando-0.0.0.2: test/Test.hs

-- | It's obviously difficult to test nondeterministic functions.
--   Some of these methods are \"uncommon\" but they do the job.

{-# LANGUAGE ViewPatterns #-}

import Control.Monad
import qualified Data.List as L
import Data.Set (Set)
import qualified Data.Set as Set
import Test.Microspec hiding (shuffle)

import Rando

main :: IO ()
main = microspec $ do
   describe "shuffle" $ do

      -- This tests that there's no position in the list (e.g. first or last
      --   element) that's "stuck" (never changes position):
      it "at least sometimes, all elements change position" $ \(NonEmpty l) ->
         length (L.nub l) > 1 ==>
            monadicIO $ prop_sometimesAllElemsChange $ NonEmpty l

      -- This is apparently a very common symptom of off-by-one errors with
      --   this algorithm:
      it "sometimes has elements which don't change position" $
         monadicIO . prop_sometimesElemsDontChange

      it "produces roughly equal distributions" $
         monadicIO $ prop_roughlyEqualShuffleDistributions

   describe "pickOne" $ do
      it "draws from all elements of the list" $
         monadicIO . prop_pickOne_picksFromAllElems

-- L.nub so we're not confused by dupes:
prop_sometimesAllElemsChange :: NonEmptyList Int -> PropertyM IO Bool
prop_sometimesAllElemsChange (NonEmpty (L.nub -> l_u)) = do
   l_s <- run $ shuffle l_u
   if (and::[Bool]->Bool) $ zipWith (/=) l_s l_u
      then pure True
      else prop_sometimesAllElemsChange $ NonEmpty l_u

prop_sometimesElemsDontChange :: NonEmptyList Int -> PropertyM IO Bool
prop_sometimesElemsDontChange (NonEmpty (L.nub -> l_u)) = do
   l_s <- run $ shuffle l_u
   if (or::[Bool]->Bool) $ zipWith (==) l_s l_u
      then pure True
      else prop_sometimesElemsDontChange $ NonEmpty l_u

prop_roughlyEqualShuffleDistributions :: PropertyM IO Bool
prop_roughlyEqualShuffleDistributions = do
   allRuns <- run $ replicateM numRuns (shuffle ([1..9] :: [Int]))
   -- TODO: this weirdly passed when 'shuffle' was undefined! Why??
   let thingWereReallyTesting = (and::[Bool]->Bool) $
          map (closeTo5 . average) $
             L.transpose allRuns
       -- TODO: it passes even with this!!:
       forceMore =
          let (a:b:_) = allRuns
          in a /= b
   -- run $ print $ take 2 allRuns
   pure $ thingWereReallyTesting && forceMore
 where
   numRuns :: Int
   numRuns = 10000

   average :: [Int] -> Double
   average l = toEnum (sum l) / toEnum numRuns

   closeTo5 :: Double -> Bool
   closeTo5 n = abs (n - 5) < 0.02

prop_pickOne_picksFromAllElems :: Set Int -> PropertyM IO Bool
prop_pickOne_picksFromAllElems ourList =
   pickFromTest' Set.empty
 where
   pickFromTest' :: Set Int -> PropertyM IO Bool
   pickFromTest' onesWeveSeenSoFar = do
      if ourList == onesWeveSeenSoFar
         then pure True
         else do
            nextVal <- run $ pickOne $ Set.toList ourList
            pickFromTest' (Set.insert nextVal onesWeveSeenSoFar)