{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module AERN2.Real.Examples.ClosestPairDist where
import MixedTypesNumPrelude
import Test.QuickCheck
import qualified Data.List as List
import AERN2.Real
distance ::
(CanAbsSameType t, CanSubSameType t)
=>
(t, t) -> t
distance :: (t, t) -> t
distance (t
a,t
b) = t -> AbsType t
forall t. CanAbs t => t -> AbsType t
abs (t
at -> t -> SubType t t
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-t
b)
closestPairDist_naive ::
(CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t)
=>
[t] -> t
closestPairDist_naive :: [t] -> t
closestPairDist_naive [t]
pts
| [t] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
pts Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 = [Char] -> t
forall a. HasCallStack => [Char] -> a
error [Char]
"closestPairDist_naive: too few points"
| Bool
otherwise =
((t -> t -> t) -> [t] -> t
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 t -> t -> t
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (((t, t) -> t) -> [(t, t)] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (t, t) -> t
forall t. (CanAbsSameType t, CanSubSameType t) => (t, t) -> t
distance ([t] -> [(t, t)]
forall t. [t] -> [(t, t)]
distinctPairs [t]
pts)))
where
distinctPairs :: [t] -> [(t,t)]
distinctPairs :: [t] -> [(t, t)]
distinctPairs [t]
xs = [(t
x,t
y) | (t
x:[t]
rest) <- [t] -> [[t]]
forall t. [t] -> [[t]]
tails1 [t]
xs, t
y <- [t]
rest]
tails1 :: [t] -> [[t]]
tails1 :: [t] -> [[t]]
tails1 [t]
list =
Integer -> [[t]] -> [[t]]
forall n a. CanBeInteger n => n -> [a] -> [a]
take ([t] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
list Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1) ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ [t] -> [[t]]
forall t. [t] -> [[t]]
List.tails [t]
list
closestPairDist_split ::
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r)
=>
[r] -> r
closestPairDist_split :: [r] -> r
closestPairDist_split [r]
pts
| [r] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [r]
ptsL Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
|| [r] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [r]
ptsR Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 =
[r] -> r
forall t.
(CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t) =>
[t] -> t
closestPairDist_naive [r]
pts
| Bool
otherwise =
r
recurseAndMerge
where
([r]
ptsL,[r]
ptsR) = (r -> Bool) -> [r] -> ([r], [r])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition r -> Bool
isCertainlyLeft [r]
pts
where
isCertainlyLeft :: r -> Bool
isCertainlyLeft r
x =
SelectType (OrderCompareType r r) -> Bool
forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (SelectType (OrderCompareType r r) -> Bool)
-> SelectType (OrderCompareType r r) -> Bool
forall a b. (a -> b) -> a -> b
$ OrderCompareType r r
-> OrderCompareType r r -> SelectType (OrderCompareType r r)
forall k. CanSelect k => k -> k -> SelectType k
select (r
x r -> r -> OrderCompareType r r
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< r
a) (r
x r -> r -> OrderCompareType r r
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> r
a r -> Rational -> SubType r Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Rational
0.5Rational -> Integer -> PowType Rational Integer
forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
100)
a :: r
a = [r] -> r
forall t.
(HasIntegers t, CanAddSameType t, CanDivBy t Integer) =>
[t] -> t
average [r]
pts
recurseAndMerge :: r
recurseAndMerge =
(r -> r -> r) -> [r] -> r
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 r -> r -> r
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min [r
dL, r
dLR, r
dR]
where
dL :: r
dL = [r] -> r
forall r.
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r) =>
[r] -> r
closestPairDist_split [r]
ptsL
dLR :: r
dLR = (r, r) -> r
forall t. (CanAbsSameType t, CanSubSameType t) => (t, t) -> t
distance ([r] -> r
forall t. CanMinMaxSameType t => [t] -> t
largest [r]
ptsL, [r] -> r
forall t. CanMinMaxSameType t => [t] -> t
smallest [r]
ptsR)
dR :: r
dR = [r] -> r
forall r.
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r) =>
[r] -> r
closestPairDist_split [r]
ptsR
average :: (HasIntegers t, CanAddSameType t, CanDivBy t Integer) => [t] -> t
average :: [t] -> t
average [t]
xs = ([t] -> t
forall t.
(CanAddSameType t, ConvertibleExactly Integer t) =>
[t] -> t
sum [t]
xs) t -> Integer -> DivType t Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ ([t] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
xs)
largest :: (CanMinMaxSameType t) => [t] -> t
largest :: [t] -> t
largest [t]
pts = (t -> t -> t) -> [t] -> t
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 t -> t -> t
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max [t]
pts
smallest :: (CanMinMaxSameType t) => [t] -> t
smallest :: [t] -> t
smallest [t]
pts = (t -> t -> t) -> [t] -> t
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 t -> t -> t
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min [t]
pts
closestPairDist_run ::
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r, CanAbsSameType r)
=>
([r] -> r) ->
Integer -> r
closestPairDist_run :: ([r] -> r) -> Integer -> r
closestPairDist_run ([r] -> r
closestPairDist :: [t] -> t) Integer
n =
[r] -> r
closestPairDist [r -> SinCosType r
forall t. CanSinCos t => t -> SinCosType t
sin (Integer -> r
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
i :: t) | Integer
i <- [Integer
1..Integer
n]]
closestPairDist_run_naive ::
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r, CanAbsSameType r)
=>
Integer -> r
closestPairDist_run_naive :: Integer -> r
closestPairDist_run_naive =
([r] -> r) -> Integer -> r
forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
CanAbsSameType r) =>
([r] -> r) -> Integer -> r
closestPairDist_run [r] -> r
forall t.
(CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t) =>
[t] -> t
closestPairDist_naive
closestPairDist_run_split ::
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r, CanAbsSameType r)
=>
Integer -> r
closestPairDist_run_split :: Integer -> r
closestPairDist_run_split =
([r] -> r) -> Integer -> r
forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
CanAbsSameType r) =>
([r] -> r) -> Integer -> r
closestPairDist_run (([r] -> r) -> Integer -> r) -> ([r] -> r) -> Integer -> r
forall a b. (a -> b) -> a -> b
$ [r] -> r
forall r.
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r) =>
[r] -> r
closestPairDist_split
closestPairDist_run_naive_CReal :: Integer -> CReal
closestPairDist_run_naive_CReal :: Integer -> CReal
closestPairDist_run_naive_CReal = Integer -> CReal
forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
CanAbsSameType r) =>
Integer -> r
closestPairDist_run_naive
closestPairDist_run_naive_WCP :: Integer -> CReal
closestPairDist_run_naive_WCP :: Integer -> CReal
closestPairDist_run_naive_WCP Integer
n = (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CReal
crealFromWithCurrentPrec ((forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CReal)
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CReal
forall a b. (a -> b) -> a -> b
$ Integer -> WithCurrentPrec p (CN MPBall)
forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
CanAbsSameType r) =>
Integer -> r
closestPairDist_run_naive Integer
n
closestPairDist_run_split_CReal :: Integer -> CReal
closestPairDist_run_split_CReal :: Integer -> CReal
closestPairDist_run_split_CReal = Integer -> CReal
forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
CanAbsSameType r) =>
Integer -> r
closestPairDist_run_split
closestPairDist_run_split_WCP :: Integer -> CReal
closestPairDist_run_split_WCP :: Integer -> CReal
closestPairDist_run_split_WCP Integer
n = (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CReal
crealFromWithCurrentPrec ((forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CReal)
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CReal
forall a b. (a -> b) -> a -> b
$ Integer -> WithCurrentPrec p (CN MPBall)
forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
CanAbsSameType r) =>
Integer -> r
closestPairDist_run_split Integer
n
closestPairDist_spec ::
_ =>
([r] -> r) -> (r -> t) -> [b] -> Property
closestPairDist_spec :: ([r] -> r) -> (r -> t) -> [b] -> Property
closestPairDist_spec [r] -> r
closestPairDist (r -> t
getFinite :: r -> t) [b]
numbers =
([b] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [b]
numbers) Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2
Bool -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||.
(r -> t
getFinite ([r] -> r
closestPairDist [r]
numbersR)) t -> b -> Property
forall a b.
(Show a, Show b, HasEqAsymmetric a b,
CanTestCertainly (EqCompareType a b)) =>
a -> b -> Property
?==?$ ([b] -> b
forall t.
(CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t) =>
[t] -> t
closestPairDist_naive [b]
numbers)
where
numbersR :: [r]
numbersR = (b -> r) -> [b] -> [r]
forall a b. (a -> b) -> [a] -> [b]
map b -> r
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly [b]
numbers :: [r]
a
a ?==?$ :: a -> b -> Property
?==?$ b
b = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?) a
a b
b
closestPairDist_runTests1 :: IO ()
closestPairDist_runTests1 :: IO ()
closestPairDist_runTests1 =
([Integer] -> Property) -> IO ()
forall prop. Testable prop => prop -> IO ()
quickCheck (([CReal] -> CReal) -> (CReal -> CN MPBall) -> [Integer] -> Property
forall r t b.
(CanAbs b, CanTestCertainly (EqCompareType t b),
HasEqAsymmetric t b, Show b, Show t, CanMinMaxAsymmetric b b,
CanSub b b, ConvertibleExactly b r, MinMaxType b b ~ b,
AbsType b ~ b, SubType b b ~ b) =>
([r] -> r) -> (r -> t) -> [b] -> Property
closestPairDist_spec ([CReal] -> CReal
forall r.
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r) =>
[r] -> r
closestPairDist_split :: [CReal] -> CReal) (CReal -> Accuracy -> ExtractedApproximation CReal Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
?Integer -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Integer
100) :: [Integer] -> Property)
sample_integers :: IO ()
sample_integers = Gen [Integer] -> IO [[Integer]]
forall a. Gen a -> IO [a]
sample' (Gen [Integer]
forall a. Arbitrary a => Gen a
arbitrary :: Gen [Integer]) IO [[Integer]] -> ([[Integer]] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Integer] -> IO ()) -> [[Integer]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Integer] -> IO ()
forall a. Show a => a -> IO ()
print
sample_rationals :: IO ()
sample_rationals = Gen [Rational] -> IO [[Rational]]
forall a. Gen a -> IO [a]
sample' (Gen [Rational]
forall a. Arbitrary a => Gen a
arbitrary :: Gen [Rational]) IO [[Rational]] -> ([[Rational]] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Rational] -> IO ()) -> [[Rational]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Rational] -> IO ()
forall a. Show a => a -> IO ()
print