[Test] Improve distribution of generated integers

plutus-core/testlib/PlutusCore/Generators/QuickCheck/Builtin.hs

@@ -65,34 +65,56 @@ instance for 'Int64' does:
 For this reason we use 'Int64' when dealing with QuickCheck.
 -}
 
--- | A list of ranges: @[(0, 10), (11, 100), (101, 1000), ... (10^n + 1, high)]@ when
--- @base = 10@.
-magnitudesPositive :: Integral a => a -> a -> [(a, a)]
-magnitudesPositive base high =
+nextInterestingBound :: Integer -> Integer
+nextInterestingBound 1 = 127
+nextInterestingBound x = (x + 1) ^ (2 :: Int) * 2 - 1
+
+highInterestingBound :: Integer
+highInterestingBound = toInteger (maxBound :: Int64) * 16
+
+-- | A list of ranges.
+--
+-- >>> import Data.Int
+-- >>> magnitudesPositive (* 10) (toInteger (maxBound :: Int16))
+-- [(1,10),(11,100),(101,1000),(1001,10000),(10001,32767)]
+--
+-- >>> import Data.Int
+-- >>> magnitudesPositive nextInterestingBound (toInteger (maxBound :: Int64))
+-- [(1,127),(128,32767),(32768,2147483647),(2147483648,9223372036854775807)]
+magnitudesPositive :: (Integer -> Integer) -> Integer -> [(Integer, Integer)]
+magnitudesPositive next high =
     zipWith (\lo hi -> (lo + 1, hi)) borders (tail borders)
   where
-    preborders = tail . takeWhile (< high `div` base) $ iterate (* base) 1
-    borders = -1 : preborders ++ [last preborders * base, high]
-
--- | Like 'chooseBoundedIntegral', but doesn't require the 'Bounded' constraint (and hence is slower
--- for 'Word64' and 'Int64').
-chooseIntegral :: Integral a => (a, a) -> Gen a
-chooseIntegral (lo, hi) = fromInteger <$> chooseInteger (toInteger lo, toInteger hi)
-
--- | Generate asymptotically greater positive numbers with exponentially lower chance.
-arbitraryPositive :: Integral a => a -> a -> Gen a
-arbitraryPositive base high =
-    frequency . zip freqs . reverse . map chooseIntegral $ magnitudesPositive base high
-  where
-    freqs = map floor $ iterate (* 1.3) (2 :: Double)
+    preborders = tail . takeWhile (\x -> next x < high) $ iterate next 1
+    borders = 0 : preborders ++ [next $ last preborders, high]
+
+chooseIntegerPreferEnds :: (Integer, Integer) -> Gen Integer
+chooseIntegerPreferEnds (lo, hi)
+    | hi - lo < 20 = chooseInteger (lo, hi)
+    | otherwise    = frequency $ concat
+        [ zip (80 : [9, 8.. 1]) $ map pure [lo..]
+        , zip (80 : [9, 8.. 1]) $ map pure [hi, hi - 1]
+        , [(200, chooseInteger (lo + 10, hi - 10))]
+        ]
 
--- | Generate asymptotically greater negative numbers with exponentially lower chance.
-arbitraryNegative :: Integral a => a -> a -> Gen a
-arbitraryNegative base high = negate <$> arbitraryPositive base high
+arbitraryPositive :: (Integer -> Integer) -> Integer -> Gen Integer
+arbitraryPositive next high = frequency . zip freqs $ map chooseIntegerPreferEnds magnitudes where
+    magnitudes = magnitudesPositive next high
+    prefreqs = map floor $ iterate (* 1.1) (100 :: Double)
+    freqs = concat
+        [ reverse (take (length magnitudes `div` 2) prefreqs)
+        , map (floor . (/ (1.5 :: Double)) . fromIntegral) prefreqs
+        ]
 
--- | Generate asymptotically greater numbers with exponentially lower chance.
-arbitrarySigned :: Integral a => a -> a -> Gen a
-arbitrarySigned base high = oneof [arbitraryPositive base high, arbitraryNegative base high]
+arbitraryNegative :: (Integer -> Integer) -> Integer -> Gen Integer
+arbitraryNegative next high = negate <$> arbitraryPositive next high
+
+arbitrarySigned :: (Integer -> Integer) -> Integer -> Gen Integer
+arbitrarySigned next high = frequency
+    [ (48, arbitraryNegative next high)
+    , (4, pure 0)
+    , (48, arbitraryPositive next high)
+    ]
 
 -- | Same as 'shrinkIntegral' except includes the square root of the given number (or of its
 -- negative if the number is negative, in which case the square root is negated too). We need the
@@ -116,11 +138,8 @@ shrinkIntegralFast x = concat
     ]
 
 instance ArbitraryBuiltin Integer where
-    arbitraryBuiltin = frequency
-        [ (4, arbitrary @Integer)
-        -- See Note [QuickCheck and integral types].
-        , (1, fromIntegral <$> arbitrarySigned 10 (maxBound :: Int64))
-        ]
+    -- See Note [QuickCheck and integral types].
+    arbitraryBuiltin = arbitrarySigned nextInterestingBound highInterestingBound where
     shrinkBuiltin = shrinkIntegralFast
 
 -- |

plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Costing.hs

@@ -55,7 +55,7 @@ toExBudgetList = NonEmpty . go where
 magnitudes :: [(SatInt, SatInt)]
 magnitudes
     = map (bimap fromInteger fromInteger)
-    . magnitudesPositive 10
+    . magnitudesPositive (* 10)
     $ fromSatInt (maxBound :: SatInt)
 
 -- | Return the range (in the sense of 'magnitudes') in which the given 'SatInt' belongs. E.g.

plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Definition.hs

@@ -14,25 +14,32 @@ module Evaluation.Builtins.Definition
     ( test_definition
     ) where
 
+import PlutusPrelude
+
+import Evaluation.Builtins.Bitwise qualified as Bitwise
+import Evaluation.Builtins.BLS12_381 (test_BLS12_381)
+import Evaluation.Builtins.Common
+import Evaluation.Builtins.Conversion qualified as Conversion
+import Evaluation.Builtins.Laws qualified as Laws
+import Evaluation.Builtins.SignatureVerification (ecdsaSecp256k1Prop, ed25519_VariantAProp,
+                                                  ed25519_VariantBProp, ed25519_VariantCProp,
+                                                  schnorrSecp256k1Prop)
+
 import PlutusCore hiding (Constr)
+import PlutusCore qualified as PLC
 import PlutusCore.Builtin
 import PlutusCore.Compiler.Erase (eraseTerm)
 import PlutusCore.Data
 import PlutusCore.Default
 import PlutusCore.Evaluation.Machine.ExBudget
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
 import PlutusCore.Evaluation.Machine.MachineParameters
+import PlutusCore.Examples.Builtins
+import PlutusCore.Examples.Data.Data
 import PlutusCore.Generators.Hedgehog.Interesting
+import PlutusCore.Generators.QuickCheck.Builtin
 import PlutusCore.MkPlc hiding (error)
 import PlutusCore.Pretty
-import PlutusPrelude
-import UntypedPlutusCore.Evaluation.Machine.Cek
-
-import Evaluation.Builtins.Bitwise qualified as Bitwise
-import Hedgehog hiding (Opaque, Size, Var)
-import PlutusCore qualified as PLC
-import PlutusCore.Examples.Builtins
-import PlutusCore.Examples.Data.Data
 import PlutusCore.StdLib.Data.Bool
 import PlutusCore.StdLib.Data.Data
 import PlutusCore.StdLib.Data.Function qualified as Plc
@@ -42,27 +49,25 @@ import PlutusCore.StdLib.Data.Pair
 import PlutusCore.StdLib.Data.ScottList qualified as Scott
 import PlutusCore.StdLib.Data.ScottUnit qualified as Scott
 import PlutusCore.StdLib.Data.Unit
+import UntypedPlutusCore.Evaluation.Machine.Cek
 
 import Control.Exception
+import Data.Bifunctor (bimap)
 import Data.ByteString (ByteString, pack)
 import Data.DList qualified as DList
+import Data.List (find)
 import Data.Proxy
 import Data.String (IsString (fromString))
 import Data.Text (Text)
-import Evaluation.Builtins.BLS12_381 (test_BLS12_381)
-import Evaluation.Builtins.Common
-import Evaluation.Builtins.Conversion qualified as Conversion
-import Evaluation.Builtins.Laws qualified as Laws
-import Evaluation.Builtins.SignatureVerification (ecdsaSecp256k1Prop, ed25519_VariantAProp,
-                                                  ed25519_VariantBProp, ed25519_VariantCProp,
-                                                  schnorrSecp256k1Prop)
+import Hedgehog hiding (Opaque, Size, Var)
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
 import Prettyprinter (vsep)
 import Test.Tasty
 import Test.Tasty.Extras
 import Test.Tasty.Hedgehog
 import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck qualified as QC
 
 type DefaultFunExt = Either DefaultFun ExtensionFun
 
@@ -85,6 +90,24 @@ defaultBuiltinCostModelExt = (defaultBuiltinCostModelForTesting, ())
    semantics variant?
 -}
 
+test_IntegerDistribution :: TestTree
+test_IntegerDistribution =
+    QC.testProperty "distribution of 'Integer' constants" . QC.withMaxSuccess 10000 $
+        \(AsArbitraryBuiltin i) ->
+            let magnitudes = magnitudesPositive nextInterestingBound highInterestingBound
+                (low, high) =
+                    maybe (error $ "Panic: unknown integer") (bimap (* signum i) (* signum i)) $
+                      find ((>= abs i) . snd) magnitudes
+                bounds = map snd magnitudes
+                isInteresting = i `elem` (0 : bounds ++ map succ bounds)
+            in (if i /= 0
+                        then QC.label $ "(" ++ show low ++ ", " ++ show high ++ ")"
+                        else QC.property)
+                ((if isInteresting
+                        then QC.label $ show i
+                        else QC.property)
+                    True)
+
 -- | Check that the 'Factorial' builtin computes to the same thing as factorial defined in PLC
 -- itself.
 test_Factorial :: TestTree
@@ -1053,7 +1076,8 @@ test_Logical =
 test_definition :: TestTree
 test_definition =
     testGroup "definition"
-        [ test_Factorial
+        [ test_IntegerDistribution
+        , test_Factorial
         , test_ForallFortyTwo
         , test_Const
         , test_Id