gistfile1.hs

-- | This is more aggressive than shrinkList in the sense that when
--   shrinkList is faced with a 1000 elements, it first tries removing
--   1000, 500, 250.. elements
--
--   This version instead goes down to
--   1000, 998, 994, 984, 968.., 512 (and then resumes the basic behaviour)
shrinkList2 :: (a -> [a]) -> [a] -> [[a]]
shrinkList2 shr xs =
      concat [ removes k n xs | k <- ks ]
   ++ shrinkOne xs
 where
  n      = length xs
  ks     = n : newks ++ drop 2 oldks
  newks  = [ n - (2 ^ p) | p <- [0 .. log2_n - 1] ]
  oldks  = [ k | k <- takeWhile (>0) (iterate (`div`2) n) ]
  log2_n = floor . logBase 2 . fromIntegral $ n
  
  shrinkOne []     = []
  shrinkOne (x:xs) = [ x':xs | x'  <- shr x ]
                  ++ [ x:xs' | xs' <- shrinkOne xs ] 
  
  removes k n xs
      | k > n     = []
      | null xs2  = [[]]
      | otherwise = xs2 : map (xs1 ++) (removes k (n-k) xs2)
   where
      xs1 = take k xs
      xs2 = drop k xs