```{-# OPTIONS_HADDOCK not-home #-}
module Hedgehog.Internal.Shrink (
towards
, towardsFloat
, list

, halves
, removes
, consNub
) where

-- | Shrink an integral number by edging towards a destination.
--
--   >>> towards 0 100
--   [0,50,75,88,94,97,99]
--
--   >>> towards 500 1000
--   [500,750,875,938,969,985,993,997,999]
--
--   >>> towards (-50) (-26)
--   [-50,-38,-32,-29,-27]
--
--   /Note we always try the destination first, as that is the optimal shrink./
--
towards :: Integral a => a -> a -> [a]
towards :: a -> a -> [a]
towards a
destination a
x =
if a
destination a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then
[]
-- special case for 1-bit numbers
else if a
destination a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 then
[a
0]
else
let
-- Halve the operands before subtracting them so they don't overflow.
-- Consider 'minBound' and 'maxBound' for a fixed sized type like 'Int64'.
diff :: a
diff =
(a
x a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2) a -> a -> a
forall a. Num a => a -> a -> a
- (a
destination a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2)
in
a
destination a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
`consNub` (a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x a -> a -> a
forall a. Num a => a -> a -> a
-) (a -> [a]
forall a. Integral a => a -> [a]
halves a
diff)

-- | Shrink a floating-point number by edging towards a destination.
--
--   >>> take 7 (towardsFloat 0.0 100)
--   [0.0,50.0,75.0,87.5,93.75,96.875,98.4375]
--
--   >>> take 7 (towardsFloat 1.0 0.5)
--   [1.0,0.75,0.625,0.5625,0.53125,0.515625,0.5078125]
--
--   /Note we always try the destination first, as that is the optimal shrink./
--
towardsFloat :: RealFloat a => a -> a -> [a]
towardsFloat :: a -> a -> [a]
towardsFloat a
destination a
x =
if a
destination a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then
[]
else
let
diff :: a
diff =
a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
destination

ok :: a -> Bool
ok a
y =
a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
y) Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
y)
in
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
ok ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(a -> a) -> [a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a
x a -> a -> a
forall a. Num a => a -> a -> a
-) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
\$
(a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2) a
diff

-- | Shrink a list by edging towards the empty list.
--
--   >>> list [1,2,3]
--   [[],[2,3],[1,3],[1,2]]
--
--   >>> list "abcd"
--   ["","cd","ab","bcd","acd","abd","abc"]
--
--   /Note we always try the empty list first, as that is the optimal shrink./
--
list :: [a] -> [[a]]
list :: [a] -> [[a]]
list [a]
xs =
(Int -> [[a]]) -> [Int] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\Int
k -> Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
removes Int
k [a]
xs)
(Int -> [Int]
forall a. Integral a => a -> [a]
halves (Int -> [Int]) -> Int -> [Int]
forall a b. (a -> b) -> a -> b
\$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)

-- | Produce all permutations of removing 'k' elements from a list.
--
--   >>> removes 2 "abcdef"
--   ["cdef","abef","abcd"]
--
removes :: Int -> [a] -> [[a]]
removes :: Int -> [a] -> [[a]]
removes Int
k0 [a]
xs0 =
let
loop :: Int -> Int -> [a] -> [[a]]
loop Int
k Int
n [a]
xs =
let
([a]
hd, [a]
tl) =
Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
k [a]
xs
in
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n then
[]
else if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
tl then
[[]]
else
[a]
tl [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: ([a] -> [a]) -> [[a]] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
hd [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) (Int -> Int -> [a] -> [[a]]
loop Int
k (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) [a]
tl)
in
Int -> Int -> [a] -> [[a]]
forall a. Int -> Int -> [a] -> [[a]]
loop Int
k0 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs0) [a]
xs0

-- | Produce a list containing the progressive halving of an integral.
--
--   >>> halves 15
--   [15,7,3,1]
--
--   >>> halves 100
--   [100,50,25,12,6,3,1]
--
--   >>> halves (-26)
--   [-26,-13,-6,-3,-1]
--
halves :: Integral a => a -> [a]
halves :: a -> [a]
halves =
(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0) ([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2)

-- | Cons an element on to the front of a list unless it is already there.
--
consNub :: Eq a => a -> [a] -> [a]
consNub :: a -> [a] -> [a]
consNub a
x [a]
ys0 =
case [a]
ys0 of
[] ->
a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: []
a
y : [a]
ys ->
if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then
a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
else
a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
```