{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-|
    Module      :  AERN2.Real.Introduction
    Description :  aern2-real introductory examples
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    You can run the examples in 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.MP
import AERN2.Real

-- import Debug.Trace

-- define a short name for the type of real numbers:
type R = CReal

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

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

{- Example runs:

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

*AERN2.Real.Examples.ClosestPairDist> closestPairDist_run_split 1000 ? (prec 1000)
[0.00000013295546744391165086... ± ~0.0000 ~2^(-1221)]
(4.95 secs, 9,979,768,504 bytes)

-}

{- specification and randomised tests -}

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

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

{- auxiliary functions -}

-- hull :: MPBall -> MPBall -> MPBall
-- hull = hullMPBall

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]

{-| 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