{-# 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.MP
import AERN2.Real
type R = CReal
closestPairDist_naive ::
_ => [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. (CanSubSameType t, CanAbsSameType t) => (t, t) -> t
distance ([t] -> [(t, t)]
forall t. [t] -> [(t, t)]
distinctPairs [t]
pts)))
distance :: (CanSubSameType t, CanAbsSameType 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_run ::
_ =>
([t] -> t) ->
Integer -> t
closestPairDist_run :: ([t] -> t) -> Integer -> t
closestPairDist_run ([t] -> t
closestPairDist :: [t] -> t) Integer
n =
[t] -> t
closestPairDist [t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin (Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
i :: t) | Integer
i <- [Integer
1..Integer
n]]
closestPairDist_run_naive :: Integer -> R
closestPairDist_run_naive :: Integer -> R
closestPairDist_run_naive =
([R] -> R) -> Integer -> R
forall t.
(CanSinCos t, ConvertibleExactly Integer t, SinCosType t ~ t) =>
([t] -> t) -> Integer -> t
closestPairDist_run [R] -> R
forall t.
(CanSub t t, CanMinMaxAsymmetric t t, CanAbs t, SubType t t ~ t,
MinMaxType t t ~ t, AbsType t ~ t) =>
[t] -> t
closestPairDist_naive
closestPairDist_run_split :: Integer -> R
closestPairDist_run_split :: Integer -> R
closestPairDist_run_split =
([R] -> R) -> Integer -> R
forall t.
(CanSinCos t, ConvertibleExactly Integer t, SinCosType t ~ t) =>
([t] -> t) -> Integer -> t
closestPairDist_run (([R] -> R) -> Integer -> R) -> ([R] -> R) -> Integer -> R
forall a b. (a -> b) -> a -> b
$ (R -> R -> Bool) -> [R] -> R
forall t.
(CanAddAsymmetric t t, ConvertibleExactly Integer t,
CanDiv t Integer, CanSub t t, CanAbs t, CanMinMaxAsymmetric t t,
AddType t t ~ t, MinMaxType t t ~ t, SubType t t ~ t,
AbsType t ~ t, DivType t Integer ~ t) =>
(t -> t -> Bool) -> [t] -> t
closestPairDist_split R -> R -> Bool
compRApprox
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.
(CanSub t t, CanMinMaxAsymmetric t t, CanAbs t, SubType t t ~ t,
MinMaxType t t ~ t, AbsType t ~ 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 =
([Integer] -> Property) -> IO ()
forall prop. Testable prop => prop -> IO ()
quickCheck (([R] -> R) -> (R -> CN MPBall) -> [Integer] -> Property
forall t b r.
(Show t, Show b, HasEqAsymmetric t b,
CanTestCertainly (EqCompareType t b), CanSub b b,
CanMinMaxAsymmetric b b, CanAbs b, ConvertibleExactly b r,
SubType b b ~ b, AbsType b ~ b, MinMaxType b b ~ b) =>
([r] -> r) -> (r -> t) -> [b] -> Property
closestPairDist_spec ((R -> R -> Bool) -> [R] -> R
forall t.
(CanAddAsymmetric t t, ConvertibleExactly Integer t,
CanDiv t Integer, CanSub t t, CanAbs t, CanMinMaxAsymmetric t t,
AddType t t ~ t, MinMaxType t t ~ t, SubType t t ~ t,
AbsType t ~ t, DivType t Integer ~ t) =>
(t -> t -> Bool) -> [t] -> t
closestPairDist_split R -> R -> Bool
compRApprox) (R -> Accuracy -> ExtractedApproximation R 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)
closestPairDist_runTests2 :: IO ()
closestPairDist_runTests2 =
([Integer] -> Property) -> IO ()
forall prop. Testable prop => prop -> IO ()
quickCheck (([MPBall] -> MPBall) -> (MPBall -> MPBall) -> [Integer] -> Property
forall t b r.
(Show t, Show b, HasEqAsymmetric t b,
CanTestCertainly (EqCompareType t b), CanSub b b,
CanMinMaxAsymmetric b b, CanAbs b, ConvertibleExactly b r,
SubType b b ~ b, AbsType b ~ b, MinMaxType b b ~ b) =>
([r] -> r) -> (r -> t) -> [b] -> Property
closestPairDist_spec ((MPBall -> MPBall -> Bool) -> [MPBall] -> MPBall
forall t.
(CanAddAsymmetric t t, ConvertibleExactly Integer t,
CanDiv t Integer, CanSub t t, CanAbs t, CanMinMaxAsymmetric t t,
AddType t t ~ t, MinMaxType t t ~ t, SubType t t ~ t,
AbsType t ~ t, DivType t Integer ~ t) =>
(t -> t -> Bool) -> [t] -> t
closestPairDist_split MPBall -> MPBall -> Bool
compMPBall) MPBall -> MPBall
forall a. a -> a
id :: [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
closestPairDist_split ::
_ => (t -> t -> Bool) -> [t] -> t
closestPairDist_split :: (t -> t -> Bool) -> [t] -> t
closestPairDist_split t -> t -> Bool
(.<) [t]
pts
| [t] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
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
|| [t] -> Integer
forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
ptsR Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 =
[t] -> t
forall t.
(CanSub t t, CanMinMaxAsymmetric t t, CanAbs t, SubType t t ~ t,
MinMaxType t t ~ t, AbsType t ~ t) =>
[t] -> t
closestPairDist_naive [t]
pts
| Bool
otherwise =
t
recurseAndMerge
where
([t]
ptsL,[t]
ptsR) = (t -> Bool) -> [t] -> ([t], [t])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition t -> Bool
isCertainlyLeft [t]
pts
where
isCertainlyLeft :: t -> Bool
isCertainlyLeft t
x = t
x t -> t -> Bool
.< [t] -> t
forall t.
(HasIntegers t, CanAddSameType t, CanDivBy t Integer) =>
[t] -> t
average [t]
pts
recurseAndMerge :: t
recurseAndMerge =
(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
dL, t
dLR, t
dR]
where
dL :: t
dL = (t -> t -> Bool) -> [t] -> t
closestPairDist_split t -> t -> Bool
(.<) [t]
ptsL
dLR :: t
dLR = (t, t) -> t
forall t. (CanSubSameType t, CanAbsSameType t) => (t, t) -> t
distance ([t] -> t
forall t. CanMinMaxSameType t => [t] -> t
largest [t]
ptsL, [t] -> t
forall t. CanMinMaxSameType t => [t] -> t
smallest [t]
ptsR)
dR :: t
dR = (t -> t -> Bool) -> [t] -> t
closestPairDist_split t -> t -> Bool
(.<) [t]
ptsR
compRApprox :: R -> R -> Bool
compRApprox :: R -> R -> Bool
compRApprox R
a R
b = (R
aR -> Accuracy -> ExtractedApproximation R Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
?Accuracy
ac) CN MPBall -> CN MPBall -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! (R
bR -> Accuracy -> ExtractedApproximation R Accuracy
forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
?Accuracy
ac)
where
ac :: Accuracy
ac = Integer -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Integer
100
compMPBall :: MPBall -> MPBall -> Bool
compMPBall :: MPBall -> MPBall -> Bool
compMPBall = MPBall -> MPBall -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(!<!)
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
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