{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-|
    Module      :  AERN2.Real.Examples..ClosestPairDist
    Description :  Example: Computing shortest distance among a set of 1D points
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    Example: Computing shortest distance among a set of 1D points.

    You can run this file in ghci.
    If you installed AERN2 using the official instructions,
    you can start ghci using the following command in the base
    folder:

    @
    stack repl aern2-real/examples/AERN2/Real/Examples/ClosestPairDist.hs
    @
-}
module AERN2.Real.Examples.ClosestPairDist where

import MixedTypesNumPrelude
-- import qualified Prelude as P
-- import Text.Printf

import Test.QuickCheck
import qualified Data.List as List

import AERN2.Real

----------------------------------
-- Finding the smallest distance within a set of real numbers
----------------------------------

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]

  {-| non-empty tails -}
  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

{- a version that splits, recurses and merges the results -}
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

{-
  Helper functions for running tests by hand.
  -}

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


{- Example runs:

*AERN2.Real.Examples.ClosestPairDist> closestPairDist_run_naive_CReal 1000 ? (prec 1000)
[0.00000013295546744391165086... ± ~0.0000 ~2^(-1221)]
(13.80 secs, 12,017,593,904 bytes)

*AERN2.Real.Examples.ClosestPairDist> closestPairDist_run_naive_WCP 1000 ? (prec 1000)
[0.00000013295546744391165086... ± ~0.0000 ~2^(-1221)]
(7.12 secs, 9,187,727,688 bytes)

*AERN2.Real.Examples.ClosestPairDist> closestPairDist_run_split_CReal 1000 ? (prec 1000)
[0.00000013295546744391165086... ± ~0.0000 ~2^(-1221)]
(2.59 secs, 4,659,949,752 bytes)

*AERN2.Real.Examples.ClosestPairDist> closestPairDist_run_split_WCP 1000 ? (prec 1000)
[0.00000013295546744391165086... ± ~0.0000 ~2^(-1221)]
(1.11 secs, 2,245,453,016 bytes)

-}

{- specification and randomised tests -}

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