Merge pull request #103 from moodmosaic/topic/shrink-towards-double

Shrink floating binary point types similar to the Haskell version
hedgehogqa · May 27, 2017 · fc96e9b · fc96e9b
2 parents 03a792a + 27fef12
commit fc96e9b
Show file tree

Hide file tree

Showing 3 changed files with 48 additions and 23 deletions.
diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs
@@ -409,7 +409,7 @@ module Gen =
 
     /// Generates a random 64-bit floating point number.
     let double : Gen<double> =
-        create Shrink.double Random.sizedDouble
+        create (Shrink.towardsDouble 0.0) Random.sizedDouble
 
     /// Generates a random 64-bit floating point number.
     let float : Gen<float> =

diff --git a/src/Hedgehog/Shrink.fs b/src/Hedgehog/Shrink.fs
@@ -139,16 +139,28 @@ module Shrink =
             LazyList.consNub destination <|
             LazyList.map (fun y -> x - y) (halves diff)
 
-    /// Shrink a floating point number.
-    let double (x : double) : LazyList<double> =
-        let positive =
-            if x < 0.0 then
-                LazyList.singleton (-x)
-            else
-                LazyList.empty
+    /// Shrink a floating-point number by edging towards a destination.
+    ///
+    /// >>> List.take 7 << LazyList.toList <| Shrink.towardsDouble 0.0 100.0
+    /// [0.0; 50.0; 75.0; 87.5; 93.75; 96.875; 98.4375]
+    ///
+    /// >>> List.take 7 << LazyList.toList <| Shrink.towardsDouble 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.
+    ///
+    let towardsDouble (destination : double) (x : double) : LazyList<double> =
+        if destination = x then
+            LazyList.empty
+        else
+            let diff =
+                x - destination
 
-        let integrals =
-            towards 0I (bigint x)
-            |> LazyList.map double
+            let go n =
+                let x' = x - n
+                if  x' <> x then
+                    Some (x', n / 2.0)
+                else
+                    None
+            LazyList.unfold go diff
 
-        LazyList.append positive integrals
diff --git a/tests/Hedgehog.Tests/ShrinkTests.fs b/tests/Hedgehog.Tests/ShrinkTests.fs
@@ -109,14 +109,27 @@ let ``towards returns empty list when run out of shrinks`` x0 destination =
     test <@ actual |> List.isEmpty @>
 
 [<Theory>]
-[<InlineData(   1.0)>]
-[<InlineData(   2.1)>]
-[<InlineData(   3.2)>]
-[<InlineData(  30.3)>]
-[<InlineData( 128.4)>]
-[<InlineData( 256.5)>]
-[<InlineData( 512.6)>]
-[<InlineData(1024.7)>]
-let ``double shrinks a floating point number`` x =
-    let actual = Shrink.double x |> LazyList.toList
-    test <@ actual |> List.forall (fun x' -> x' < x) @>
+[<InlineData(   2.0,   1.0)>]
+[<InlineData(   3.0,   1.0)>]
+[<InlineData(  30.0,   1.0)>]
+[<InlineData( 128.0,  64.0)>]
+[<InlineData( 256.0, 128.0)>]
+[<InlineData( 512.0, 256.0)>]
+[<InlineData(1024.0, 512.0)>]
+let ``towardsDouble shrinks by edging towards a destination number`` x0 destination =
+    let actual =
+        x0
+        |> Shrink.towardsDouble destination
+        |> LazyList.toList
+    test <@ actual |> List.forall (fun x1 -> x1 < x0 && x1 >= destination) @>
+
+[<Theory>]
+[<InlineData(   1.0,    1.0)>]
+[<InlineData(  30.0,   30.0)>]
+[<InlineData(1024.0, 1024.0)>]
+let ``towardsDouble returns empty list when run out of shrinks`` x0 destination =
+    let actual =
+        x0
+        |> Shrink.towards destination
+        |> LazyList.toList
+    test <@ actual |> List.isEmpty @>