{-# 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 :: forall t. (CanAbsSameType t, CanSubSameType t) => (t, t) -> t
distance (t
a,t
b) = forall t. CanAbs t => t -> AbsType t
abs (t
aforall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-t
b)

closestPairDist_naive :: 
  (CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t) 
  =>
  [t] -> t
closestPairDist_naive :: forall t.
(CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t) =>
[t] -> t
closestPairDist_naive [t]
pts
  | forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
pts forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 = forall a. HasCallStack => [Char] -> a
error [Char]
"closestPairDist_naive: too few points"
  | Bool
otherwise =
      (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min (forall a b. (a -> b) -> [a] -> [b]
map forall t. (CanAbsSameType t, CanSubSameType t) => (t, t) -> t
distance (forall t. [t] -> [(t, t)]
distinctPairs [t]
pts)))
  where
  distinctPairs :: [t] -> [(t,t)]
  distinctPairs :: forall t. [t] -> [(t, t)]
distinctPairs [t]
xs = [(t
x,t
y) | (t
x:[t]
rest) <- forall t. [t] -> [[t]]
tails1 [t]
xs, t
y <- [t]
rest]

  {-| non-empty tails -}
  tails1 :: [t] -> [[t]]
  tails1 :: forall t. [t] -> [[t]]
tails1 [t]
list =
    forall n a. CanBeInteger n => n -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
list forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1) forall a b. (a -> b) -> a -> b
$ 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 :: forall r.
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r) =>
[r] -> r
closestPairDist_split [r]
pts
  | forall (t :: * -> *) a. Foldable t => t a -> Integer
length [r]
ptsL forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
|| forall (t :: * -> *) a. Foldable t => t a -> Integer
length [r]
ptsR forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 =
      forall t.
(CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t) =>
[t] -> t
closestPairDist_naive [r]
pts
  | Bool
otherwise =
      r
recurseAndMerge
  where
  ([r]
ptsL,[r]
ptsR) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition r -> Bool
isCertainlyLeft [r]
pts
    where
    isCertainlyLeft :: r -> Bool
isCertainlyLeft r
x = 
      forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ forall k. CanSelect k => k -> k -> SelectType k
select (r
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< r
a) (r
x forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> r
a forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Rational
0.5forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Integer
100)
    a :: r
a = forall t.
(HasIntegers t, CanAddSameType t, CanDivBy t Integer) =>
[t] -> t
average [r]
pts
  recurseAndMerge :: r
recurseAndMerge =
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min [r
dL, r
dLR, r
dR]
    where
    dL :: r
dL = forall r.
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r) =>
[r] -> r
closestPairDist_split [r]
ptsL
    dLR :: r
dLR = forall t. (CanAbsSameType t, CanSubSameType t) => (t, t) -> t
distance (forall t. CanMinMaxSameType t => [t] -> t
largest [r]
ptsL, forall t. CanMinMaxSameType t => [t] -> t
smallest [r]
ptsR)
    dR :: r
dR = 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 :: forall t.
(HasIntegers t, CanAddSameType t, CanDivBy t Integer) =>
[t] -> t
average [t]
xs = (forall t.
(CanAddSameType t, ConvertibleExactly Integer t) =>
[t] -> t
sum [t]
xs) forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ (forall (t :: * -> *) a. Foldable t => t a -> Integer
length [t]
xs)

largest :: (CanMinMaxSameType t) => [t] -> t
largest :: forall t. CanMinMaxSameType t => [t] -> t
largest [t]
pts = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max [t]
pts

smallest :: (CanMinMaxSameType t) => [t] -> t
smallest :: forall t. CanMinMaxSameType t => [t] -> t
smallest [t]
pts = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 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 :: forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
 CanAbsSameType r) =>
([r] -> r) -> Integer -> r
closestPairDist_run ([r] -> r
closestPairDist :: [t] -> t) Integer
n =
  [r] -> r
closestPairDist [forall t. CanSinCos t => t -> SinCosType t
sin (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 :: forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
 CanAbsSameType r) =>
Integer -> r
closestPairDist_run_naive =
  forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
 CanAbsSameType r) =>
([r] -> r) -> Integer -> r
closestPairDist_run 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 :: forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
 CanAbsSameType r) =>
Integer -> r
closestPairDist_run_split =
  forall r.
(RealNumber r, CanSinCosSameType r, CanMinMaxSameType r,
 CanAbsSameType r) =>
([r] -> r) -> Integer -> r
closestPairDist_run forall a b. (a -> b) -> a -> b
$ 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 = 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 a b. (a -> b) -> a -> b
$ 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 = 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 a b. (a -> b) -> a -> b
$ 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 =
  (forall (t :: * -> *) a. Foldable t => t a -> Integer
length [b]
numbers) forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2
  forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||.
  (r -> t
getFinite ([r] -> r
closestPairDist [r]
numbersR)) forall {a} {b}.
(Show a, Show b, HasEqAsymmetric a b,
 CanTestCertainly (EqCompareType a b)) =>
a -> b -> Property
?==?$ (forall t.
(CanMinMaxSameType t, CanAbsSameType t, CanSubSameType t) =>
[t] -> t
closestPairDist_naive [b]
numbers)
  where
  numbersR :: [r]
numbersR = forall a b. (a -> b) -> [a] -> [b]
map forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly [b]
numbers :: [r]
  a
a ?==?$ :: a -> b -> Property
?==?$ b
b = forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?==?" forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?) a
a b
b

closestPairDist_runTests1 :: IO ()
closestPairDist_runTests1 :: IO ()
closestPairDist_runTests1 =
  forall prop. Testable prop => prop -> IO ()
quickCheck (forall r t b.
(MinMaxType b b ~ b, AbsType b ~ b, SubType b b ~ b, CanAbs b,
 CanTestCertainly (EqCompareType t b), HasEqAsymmetric t b, Show b,
 Show t, CanMinMaxAsymmetric b b, CanSub b b,
 ConvertibleExactly b r) =>
([r] -> r) -> (r -> t) -> [b] -> Property
closestPairDist_spec (forall r.
(RealNumber r, CanMinMaxSameType r, CanAbsSameType r) =>
[r] -> r
closestPairDist_split :: [CReal] -> CReal) (forall e q.
CanExtractApproximation e q =>
e -> q -> ExtractedApproximation e q
?forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Integer
100) :: [Integer] -> Property)

sample_integers :: IO ()
sample_integers = forall a. Gen a -> IO [a]
sample' (forall a. Arbitrary a => Gen a
arbitrary :: Gen [Integer]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Show a => a -> IO ()
print
sample_rationals :: IO ()
sample_rationals = forall a. Gen a -> IO [a]
sample' (forall a. Arbitrary a => Gen a
arbitrary :: Gen [Rational]) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Show a => a -> IO ()
print