-- | Larry Polansky. \"Morphological Metrics\".
-- Journal of New Music Research, 25(4):289-368, 1996.
module Music.Theory.Metric.Polansky_1996 where

import Data.List {- base -}
import Data.Maybe {- base -}
import Data.Ratio {- base -}

import qualified Music.Theory.List as L {- hmt-base -}

import qualified Music.Theory.Contour.Polansky_1992 as C {- hmt -}

-- | Distance function, ordinarily /n/ below is in 'Num', 'Fractional' or 'Real'.
type Interval a n = (a -> a -> n)

-- | 'fromIntegral' '.' '-'.
dif_i :: (Integral a,Num b) => a -> a -> b
dif_i :: forall a b. (Integral a, Num b) => a -> a -> b
dif_i a
i a
j = forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
i forall a. Num a => a -> a -> a
- a
j)

-- | 'realToFrac' '.' '-'.
dif_r :: (Real a,Fractional b) => a -> a -> b
dif_r :: forall a b. (Real a, Fractional b) => a -> a -> b
dif_r a
i a
j = forall a b. (Real a, Fractional b) => a -> b
realToFrac (a
i forall a. Num a => a -> a -> a
- a
j)

-- | 'abs' '.' /f/.
abs_of :: Num n => Interval a n -> a -> a -> n
abs_of :: forall n a. Num n => Interval a n -> Interval a n
abs_of Interval a n
f a
i a
j = forall a. Num a => a -> a
abs (a
i Interval a n
`f` a
j)

-- | Square.
sqr :: Num a => a -> a
sqr :: forall a. Num a => a -> a
sqr a
n = a
n forall a. Num a => a -> a -> a
* a
n

-- | 'sqr' '.' /f/.
sqr_of :: Num n => Interval a n -> a -> a -> n
sqr_of :: forall n a. Num n => Interval a n -> Interval a n
sqr_of Interval a n
f a
i a
j = forall a. Num a => a -> a
sqr (a
i Interval a n
`f` a
j)

-- | 'sqr' '.' 'abs' '.' /f/.
sqr_abs_of :: Num n => Interval a n -> a -> a -> n
sqr_abs_of :: forall n a. Num n => Interval a n -> Interval a n
sqr_abs_of Interval a n
f a
i = forall a. Num a => a -> a
sqr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a. Num n => Interval a n -> Interval a n
abs_of Interval a n
f a
i

-- | 'sqrt' '.' 'abs' '.' /f/.
sqrt_abs_of :: Floating c => Interval a c -> a -> a -> c
sqrt_abs_of :: forall c a. Floating c => Interval a c -> Interval a c
sqrt_abs_of Interval a c
f a
i = forall a. Floating a => a -> a
sqrt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n a. Num n => Interval a n -> Interval a n
abs_of Interval a c
f a
i

-- | City block metric, p.296
--
-- > city_block_metric (-) (1,2) (3,5) == 2+3
city_block_metric :: Num n => Interval a n -> (a,a) -> (a,a) -> n
city_block_metric :: forall n a. Num n => Interval a n -> (a, a) -> (a, a) -> n
city_block_metric Interval a n
f (a
x1,a
x2) (a
y1,a
y2) = forall n a. Num n => Interval a n -> Interval a n
abs_of Interval a n
f a
x1 a
y1 forall a. Num a => a -> a -> a
+ forall n a. Num n => Interval a n -> Interval a n
abs_of Interval a n
f a
x2 a
y2

-- | Two-dimensional euclidean metric, p.297.
--
-- > euclidean_metric_2 (-) (1,2) (3,5) == sqrt (4+9)
euclidean_metric_2 :: Floating n => Interval a n -> (a,a) -> (a,a) -> n
euclidean_metric_2 :: forall n a. Floating n => Interval a n -> (a, a) -> (a, a) -> n
euclidean_metric_2 Interval a n
f (a
x1,a
x2) (a
y1,a
y2) = forall a. Floating a => a -> a
sqrt (forall n a. Num n => Interval a n -> Interval a n
sqr_of Interval a n
f a
x1 a
y1 forall a. Num a => a -> a -> a
+ forall n a. Num n => Interval a n -> Interval a n
sqr_of Interval a n
f a
x2 a
y2)

-- | /n/-dimensional euclidean metric
--
-- > euclidean_metric_l (-) [1,2] [3,5] == sqrt (4+9)
-- > euclidean_metric_l (-) [1,2,3] [2,4,6] == sqrt (1+4+9)
euclidean_metric_l :: Floating c => Interval b c -> [b] -> [b] -> c
euclidean_metric_l :: forall c b. Floating c => Interval b c -> [b] -> [b] -> c
euclidean_metric_l Interval b c
f [b]
p = forall a. Floating a => a -> a
sqrt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall n a. Num n => Interval a n -> Interval a n
sqr_of Interval b c
f) [b]
p

-- | Cube root.
--
-- > map cbrt [1,8,27] == [1,2,3]
cbrt :: Floating a => a -> a
cbrt :: forall a. Floating a => a -> a
cbrt a
n = a
n forall a. Floating a => a -> a -> a
** (a
1forall a. Fractional a => a -> a -> a
/a
3)

-- | /n/-th root
--
-- > map (nthrt 4) [1,16,81] == [1,2,3]
nthrt :: Floating a => a -> a -> a
nthrt :: forall a. Floating a => a -> a -> a
nthrt a
r a
n = a
n forall a. Floating a => a -> a -> a
** forall a. Fractional a => a -> a
recip a
r

-- | Two-dimensional Minkowski metric, p.297
--
-- > minkowski_metric_2 (-) 1 (1,2) (3,5) == 5
-- > minkowski_metric_2 (-) 2 (1,2) (3,5) == sqrt (4+9)
-- > minkowski_metric_2 (-) 3 (1,2) (3,5) == cbrt (8+27)
minkowski_metric_2 :: Floating a => Interval t a -> a -> (t,t) -> (t,t) -> a
minkowski_metric_2 :: forall a t.
Floating a =>
Interval t a -> a -> (t, t) -> (t, t) -> a
minkowski_metric_2 Interval t a
f a
n (t
x1,t
x2) (t
y1,t
y2) =
    ((forall a. Num a => a -> a
abs (t
x1 Interval t a
`f` t
y1) forall a. Floating a => a -> a -> a
** a
n) forall a. Num a => a -> a -> a
+ (forall a. Num a => a -> a
abs (t
x2 Interval t a
`f` t
y2) forall a. Floating a => a -> a -> a
** a
n)) forall a. Floating a => a -> a -> a
** (a
1forall a. Fractional a => a -> a -> a
/a
n)

-- | /n/-dimensional Minkowski metric
--
-- > minkowski_metric_l (-) 2 [1,2,3] [2,4,6] == sqrt (1+4+9)
-- > minkowski_metric_l (-) 3 [1,2,3] [2,4,6] == cbrt (1+8+27)
minkowski_metric_l :: Floating a => Interval t a -> a -> [t] -> [t] -> a
minkowski_metric_l :: forall a t. Floating a => Interval t a -> a -> [t] -> [t] -> a
minkowski_metric_l Interval t a
f a
n [t]
p [t]
q =
    let g :: Interval t a
g t
i t
j = forall a. Num a => a -> a
abs (t
i Interval t a
`f` t
j) forall a. Floating a => a -> a -> a
** a
n
    in forall a. Floating a => a -> a -> a
nthrt a
n (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Interval t a
g [t]
p [t]
q))

-- | 'map' 'abs' '.' 'L.d_dx_by'.
--
-- > d_dx_abs (-) [0,2,4,1,0] == [2,2,3,1]
-- > d_dx_abs (-) [2,3,0,4,1] == [1,3,4,3]
d_dx_abs :: Num n => Interval a n -> [a] -> [n]
d_dx_abs :: forall n a. Num n => Interval a n -> [a] -> [n]
d_dx_abs Interval a n
f = forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t u. (t -> t -> u) -> [t] -> [u]
L.d_dx_by Interval a n
f

-- | Ordered linear magnitude (no delta), p.300
--
-- > olm_no_delta' [0,2,4,1,0] [2,3,0,4,1] == 1.25
olm_no_delta' :: Fractional a => [a] -> [a] -> a
olm_no_delta' :: forall a. Fractional a => [a] -> [a] -> a
olm_no_delta' [a]
p [a]
q =
    let r :: [a]
r = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall n a. Num n => Interval a n -> [a] -> [n]
d_dx_abs (-) [a]
p) (forall n a. Num n => Interval a n -> [a] -> [n]
d_dx_abs (-) [a]
q)
        z :: a
z = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
abs [a]
r)
    in a
z forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p) forall a. Num a => a -> a -> a
- a
1)

-- | Ordered linear magintude (general form) p.302
--
-- > olm_general (abs_of (-)) [0,2,4,1,0] [2,3,0,4,1] == 1.25
-- > olm_general (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
olm_general :: Fractional n => Interval a n -> [a] -> [a] -> n
olm_general :: forall n a. Fractional n => Interval a n -> [a] -> [a] -> n
olm_general Interval a n
f [a]
p [a]
q =
    let r :: [n]
r = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall t u. (t -> t -> u) -> [t] -> [u]
L.d_dx_by Interval a n
f [a]
p) (forall t u. (t -> t -> u) -> [t] -> [u]
L.d_dx_by Interval a n
f [a]
q)
        z :: n
z = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
abs [n]
r)
    in n
z forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p) forall a. Num a => a -> a -> a
- n
1)

-- | 'Delta' (Δ) determines an interval given a sequence and an index.
type Delta n a = ([n] -> Int -> a)

-- | /f/ at indices /i/ and /i+1/ of /x/.
--
-- > map (ix_dif (-) [0,1,3,6,10]) [0..3] == [-1,-2,-3,-4]
ix_dif :: Interval a t -> Delta a t
ix_dif :: forall a t. Interval a t -> Delta a t
ix_dif Interval a t
f [a]
x Int
i = ([a]
x forall a. [a] -> Int -> a
!! Int
i) Interval a t
`f` ([a]
x forall a. [a] -> Int -> a
!! (Int
i forall a. Num a => a -> a -> a
+ Int
1))

-- | 'abs' '.' 'ix_dif'
--
-- > map (abs_ix_dif (-) [0,2,4,1,0]) [0..3] == [2,2,3,1]
abs_ix_dif :: Num n => Interval a n -> Delta a n
abs_ix_dif :: forall n a. Num n => Interval a n -> Delta a n
abs_ix_dif Interval a n
f [a]
x Int
i = forall a. Num a => a -> a
abs (forall a t. Interval a t -> Delta a t
ix_dif Interval a n
f [a]
x Int
i)

-- | 'sqr' '.' 'abs_ix_dif'
--
-- > map (sqr_abs_ix_dif (-) [0,2,4,1,0]) [0..3] == [4,4,9,1]
-- > map (sqr_abs_ix_dif (-) [2,3,0,4,1]) [0..3] == [1,9,16,9]
sqr_abs_ix_dif :: Num n => Interval a n -> Delta a n
sqr_abs_ix_dif :: forall n a. Num n => Interval a n -> Delta a n
sqr_abs_ix_dif Interval a n
f [a]
x Int
i = forall a. Num a => a -> a
sqr (forall n a. Num n => Interval a n -> Delta a n
abs_ix_dif Interval a n
f [a]
x Int
i)

-- | 'Psi' (Ψ) joins 'Delta' equivalent intervals from morphologies /m/ and /n/.
type Psi a = (a -> a -> a)

-- | Ordered linear magintude (generalised-interval form) p.305
--
-- > olm (abs_of dif_r) (abs_ix_dif dif_r) (const 1) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
-- > olm (abs_of dif_r) (abs_ix_dif dif_r) maximum [1,5,12,2,9,6] [7,6,4,9,8,1] == 0.46
olm :: Fractional a => Psi a -> Delta n a  -> ([a] -> a) -> [n] -> [n] -> a
olm :: forall a n.
Fractional a =>
Psi a -> Delta n a -> ([a] -> a) -> [n] -> [n] -> a
olm Psi a
psi Delta n a
delta [a] -> a
maxint [n]
m [n]
n =
    let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [n]
m
        l' :: a
l' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l forall a. Num a => a -> a -> a
- a
1
        k :: [Int]
k = [Int
0..Int
lforall a. Num a => a -> a -> a
-Int
2]
        m' :: [a]
m' = forall a b. (a -> b) -> [a] -> [b]
map (Delta n a
delta [n]
m) [Int]
k
        n' :: [a]
n' = forall a b. (a -> b) -> [a] -> [b]
map (Delta n a
delta [n]
n) [Int]
k
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Psi a
psi [a]
m' [a]
n') forall a. Fractional a => a -> a -> a
/ (a
l' forall a. Num a => a -> a -> a
* [a] -> a
maxint ([a]
m' forall a. [a] -> [a] -> [a]
++ [a]
n'))

-- > olm_no_delta [0,2,4,1,0] [2,3,0,4,1] == 1.25
-- > olm_no_delta [1,6,2,5,11] [3,15,13,2,9] == 4.5
olm_no_delta :: (Real a,Real n,Fractional n) => [a] -> [a] -> n
olm_no_delta :: forall a n. (Real a, Real n, Fractional n) => [a] -> [a] -> n
olm_no_delta = forall a n.
Fractional a =>
Psi a -> Delta n a -> ([a] -> a) -> [n] -> [n] -> a
olm (forall n a. Num n => Interval a n -> Interval a n
abs_of forall a b. (Real a, Fractional b) => a -> a -> b
dif_r) (forall n a. Num n => Interval a n -> Delta a n
abs_ix_dif forall a b. (Real a, Fractional b) => a -> a -> b
dif_r) (forall a b. a -> b -> a
const n
1)

-- > olm_no_delta_squared [0,2,4,1,0] [2,3,0,4,1] == sum (map sqrt [3,5,7,8]) / 4
olm_no_delta_squared :: Floating a => [a] -> [a] -> a
olm_no_delta_squared :: forall a. Floating a => [a] -> [a] -> a
olm_no_delta_squared = forall a n.
Fractional a =>
Psi a -> Delta n a -> ([a] -> a) -> [n] -> [n] -> a
olm (forall c a. Floating c => Interval a c -> Interval a c
sqrt_abs_of (-)) (forall n a. Num n => Interval a n -> Delta a n
sqr_abs_ix_dif (-)) (forall a b. a -> b -> a
const a
1)

second_order :: (Num n) => ([n] -> [n] -> t) -> [n] -> [n] -> t
second_order :: forall n t. Num n => ([n] -> [n] -> t) -> [n] -> [n] -> t
second_order [n] -> [n] -> t
f [n]
p [n]
q = [n] -> [n] -> t
f (forall n a. Num n => Interval a n -> [a] -> [n]
d_dx_abs (-) [n]
p) (forall n a. Num n => Interval a n -> [a] -> [n]
d_dx_abs (-) [n]
q)

-- > olm_no_delta_second_order [0,2,4,1,0] [2,3,0,4,1] == 1.0
olm_no_delta_second_order :: (Real a,Fractional a) => [a] -> [a] -> a
olm_no_delta_second_order :: forall a. (Real a, Fractional a) => [a] -> [a] -> a
olm_no_delta_second_order = forall n t. Num n => ([n] -> [n] -> t) -> [n] -> [n] -> t
second_order forall a n. (Real a, Real n, Fractional n) => [a] -> [a] -> n
olm_no_delta

-- p.301 erroneously gives this as sum (map sqrt [2,0,1]) / 3
-- > olm_no_delta_squared_second_order [0,2,4,1,0] [2,3,0,4,1] == sum (map sqrt [4,0,3]) / 3
olm_no_delta_squared_second_order :: Floating a => [a] -> [a] -> a
olm_no_delta_squared_second_order :: forall a. Floating a => [a] -> [a] -> a
olm_no_delta_squared_second_order = forall n t. Num n => ([n] -> [n] -> t) -> [n] -> [n] -> t
second_order forall a. Floating a => [a] -> [a] -> a
olm_no_delta_squared

-- | Second order binomial coefficient, p.307
--
-- > map second_order_binonial_coefficient [2..10] == [1,3,6,10,15,21,28,36,45]
second_order_binonial_coefficient :: Fractional a => a -> a
second_order_binonial_coefficient :: forall a. Fractional a => a -> a
second_order_binonial_coefficient a
n = ((a
n forall a. Num a => a -> a -> a
* a
n) forall a. Num a => a -> a -> a
- a
n) forall a. Fractional a => a -> a -> a
/ a
2

-- | 'L.d_dx_by' of 'flip' 'compare'.
--
-- > direction_interval [5,9,3,2] == [LT,GT,GT]
-- > direction_interval [2,5,6,6] == [LT,LT,EQ]
direction_interval :: Ord i => [i] -> [Ordering]
direction_interval :: forall i. Ord i => [i] -> [Ordering]
direction_interval = forall t u. (t -> t -> u) -> [t] -> [u]
L.d_dx_by (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare)

-- | Histogram of list of 'Ordering's.
--
-- > ord_hist [LT,GT,GT] == (1,0,2)
ord_hist :: Integral t => [Ordering] -> (t,t,t)
ord_hist :: forall t. Integral t => [Ordering] -> (t, t, t)
ord_hist [Ordering]
x =
    let h :: [(Ordering, t)]
h = forall a i. (Ord a, Integral i) => [a] -> [(a, i)]
L.generic_histogram [Ordering]
x
        f :: Ordering -> t
f Ordering
n = forall a. a -> Maybe a -> a
fromMaybe t
0 (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Ordering
n [(Ordering, t)]
h)
    in (Ordering -> t
f Ordering
LT,Ordering -> t
f Ordering
EQ,Ordering -> t
f Ordering
GT)

-- | Histogram of /directions/ of adjacent elements, p.312.
--
-- > direction_vector [5,9,3,2] == (1,0,2)
-- > direction_vector [2,5,6,6] == (2,1,0)
direction_vector :: Integral i => (Ord a) => [a] -> (i,i,i)
direction_vector :: forall i a. (Integral i, Ord a) => [a] -> (i, i, i)
direction_vector = forall t. Integral t => [Ordering] -> (t, t, t)
ord_hist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Ord i => [i] -> [Ordering]
direction_interval

-- | Unordered linear direction, p.311 (Fig. 5)
--
-- > uld [5,9,3,2] [2,5,6,6] == 2/3
-- > uld [5,3,6,1,4] [3,6,1,4,2] == 0
uld :: (Integral n,Ord a) => [a] -> [a] -> Ratio n
uld :: forall n a. (Integral n, Ord a) => [a] -> [a] -> Ratio n
uld [a]
m [a]
n =
    let (n
i,n
j,n
k) = forall i a. (Integral i, Ord a) => [a] -> (i, i, i)
direction_vector [a]
m
        (n
p,n
q,n
r) = forall i a. (Integral i, Ord a) => [a] -> (i, i, i)
direction_vector [a]
n
        z :: n
z = (n
i forall a. Num a => a -> a -> a
+ n
j forall a. Num a => a -> a -> a
+ n
k) forall a. Num a => a -> a -> a
* n
2
    in (forall n a. Num n => Interval a n -> Interval a n
abs_of (-) n
i n
p forall a. Num a => a -> a -> a
+ forall n a. Num n => Interval a n -> Interval a n
abs_of (-) n
j n
q forall a. Num a => a -> a -> a
+ forall n a. Num n => Interval a n -> Interval a n
abs_of (-) n
k n
r) forall a. Integral a => a -> a -> Ratio a
% n
z

-- | Ordered linear direction, p.312
--
-- > direction_interval [5,3,6,1,4] == [GT,LT,GT,LT]
-- > direction_interval [3,6,1,4,2] == [LT,GT,LT,GT]
-- > old [5,3,6,1,4] [3,6,1,4,2] == 1
old :: (Ord i, Integral a) => [i] -> [i] -> Ratio a
old :: forall i a. (Ord i, Integral a) => [i] -> [i] -> Ratio a
old [i]
m [i]
n =
    let p :: [Ordering]
p = forall i. Ord i => [i] -> [Ordering]
direction_interval [i]
m
        q :: [Ordering]
q = forall i. Ord i => [i] -> [Ordering]
direction_interval [i]
n
        f :: a -> a -> a
f a
i a
j = if a
i forall a. Eq a => a -> a -> Bool
== a
j then a
0 else a
1
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. (Eq a, Num a) => a -> a -> a
f [Ordering]
p [Ordering]
q) forall a. Integral a => a -> a -> Ratio a
% (forall i a. Num i => [a] -> i
genericLength [i]
m forall a. Num a => a -> a -> a
- a
1)

-- | Ordered combinatorial direction, p.314
--
-- > ocd [5,9,3,2] [2,5,6,6] == 5/6
-- > ocd [5,3,6,1,4] [3,6,1,4,2] == 4/5
ocd :: (Ord a,Integral i) => [a] -> [a] -> Ratio i
ocd :: forall i a. (Ord i, Integral a) => [i] -> [i] -> Ratio a
ocd [a]
m [a]
n =
    let p :: [Ordering]
p = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> a -> b) -> [a] -> Matrix b
C.half_matrix_f forall a. Ord a => a -> a -> Ordering
compare [a]
m)
        q :: [Ordering]
q = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> a -> b) -> [a] -> Matrix b
C.half_matrix_f forall a. Ord a => a -> a -> Ordering
compare [a]
n)
        f :: a -> a -> a
f a
i a
j = if a
i forall a. Eq a => a -> a -> Bool
== a
j then a
0 else a
1
    in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a} {a}. (Eq a, Num a) => a -> a -> a
f [Ordering]
p [Ordering]
q) forall a. Integral a => a -> a -> Ratio a
% forall i a. Num i => [a] -> i
genericLength [Ordering]
p

-- | Unordered combinatorial direction, p.314
--
-- > ucd [5,9,3,2] [2,5,6,6] == 5/6
-- > ucd [5,3,6,1,4] [3,6,1,4,2] == 0
-- > ucd [5,3,7,6] [2,1,2,1] == 1/2
-- > ucd [2,1,2,1] [8,3,5,4] == 1/3
-- > ucd [5,3,7,6] [8,3,5,4] == 1/3
ucd :: (Integral n,Ord a) => [a] -> [a] -> Ratio n
ucd :: forall n a. (Integral n, Ord a) => [a] -> [a] -> Ratio n
ucd [a]
m [a]
n =
    let (n
i,n
j,n
k) = forall t. Integral t => [Ordering] -> (t, t, t)
ord_hist (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> a -> b) -> [a] -> Matrix b
C.half_matrix_f forall a. Ord a => a -> a -> Ordering
compare [a]
m))
        (n
p,n
q,n
r) = forall t. Integral t => [Ordering] -> (t, t, t)
ord_hist (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> a -> b) -> [a] -> Matrix b
C.half_matrix_f forall a. Ord a => a -> a -> Ordering
compare [a]
n))
        z :: n
z = (n
i forall a. Num a => a -> a -> a
+ n
j forall a. Num a => a -> a -> a
+ n
k) forall a. Num a => a -> a -> a
* n
2
    in (forall n a. Num n => Interval a n -> Interval a n
abs_of (-) n
i n
p forall a. Num a => a -> a -> a
+ forall n a. Num n => Interval a n -> Interval a n
abs_of (-) n
j n
q forall a. Num a => a -> a -> a
+ forall n a. Num n => Interval a n -> Interval a n
abs_of (-) n
k n
r) forall a. Integral a => a -> a -> Ratio a
% n
z

-- | 'C.half_matrix_f', Fig.9, p.318
--
-- > let r = [[2,3,1,4],[1,3,6],[4,7],[3]]
-- > combinatorial_magnitude_matrix (abs_of (-)) [5,3,2,6,9] == r
combinatorial_magnitude_matrix :: Interval a n -> [a] -> [[n]]
combinatorial_magnitude_matrix :: forall a b. (a -> a -> b) -> [a] -> Matrix b
combinatorial_magnitude_matrix = forall a b. (a -> a -> b) -> [a] -> Matrix b
C.half_matrix_f

-- | Unordered linear magnitude (simplified), p.320-321
--
-- > let r = abs (sum [5,4,3,6] - sum [12,2,11,7]) / 4
-- > ulm_simplified (abs_of (-)) [1,6,2,5,11] [3,15,13,2,9] == r
--
-- > ulm_simplified (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3
ulm_simplified :: Fractional n => Interval a n -> [a] -> [a] -> n
ulm_simplified :: forall n a. Fractional n => Interval a n -> [a] -> [a] -> n
ulm_simplified Interval a n
f [a]
p [a]
q =
    let g :: [a] -> n
g = forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t u. (t -> t -> u) -> [t] -> [u]
L.d_dx_by Interval a n
f
    in forall a. Num a => a -> a
abs ([a] -> n
g [a]
p forall a. Num a => a -> a -> a
- [a] -> n
g [a]
q) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p forall a. Num a => a -> a -> a
- Int
1)

ocm_zcm :: Fractional n => Interval a n -> [a] -> [a] -> (n, n, [n])
ocm_zcm :: forall n a.
Fractional n =>
Interval a n -> [a] -> [a] -> (n, n, [n])
ocm_zcm Interval a n
f [a]
p [a]
q =
    let p' :: [n]
p' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> a -> b) -> [a] -> Matrix b
C.half_matrix_f Interval a n
f [a]
p)
        q' :: [n]
q' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall a b. (a -> a -> b) -> [a] -> Matrix b
C.half_matrix_f Interval a n
f [a]
q)
        r :: [n]
r = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [n]
p' [n]
q'
        z :: n
z = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map forall a. Num a => a -> a
abs [n]
r)
        c :: n
c = forall a. Fractional a => a -> a
second_order_binonial_coefficient (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p))
        m :: [n]
m = [n]
p' forall a. [a] -> [a] -> [a]
++ [n]
q'
    in (n
z,n
c,[n]
m)

-- | Ordered combinatorial magnitude (OCM), p.323
--
-- > ocm (abs_of (-)) [1,6,2,5,11] [3,15,13,2,9] == 5.2
-- > ocm (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3.6
ocm :: Fractional n => Interval a n -> [a] -> [a] -> n
ocm :: forall n a. Fractional n => Interval a n -> [a] -> [a] -> n
ocm Interval a n
f [a]
p [a]
q =
    let (n
z,n
c,[n]
_) = forall n a.
Fractional n =>
Interval a n -> [a] -> [a] -> (n, n, [n])
ocm_zcm Interval a n
f [a]
p [a]
q
    in n
z forall a. Fractional a => a -> a -> a
/ n
c

-- | Ordered combinatorial magnitude (OCM), p.323
--
-- > ocm_absolute_scaled (abs_of (-)) [1,6,2,5,11] [3,15,13,2,9] == 0.4
-- > ocm_absolute_scaled (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 54/(15*11)
ocm_absolute_scaled :: (Ord n,Fractional n) => Interval a n -> [a] -> [a] -> n
ocm_absolute_scaled :: forall n a.
(Ord n, Fractional n) =>
Interval a n -> [a] -> [a] -> n
ocm_absolute_scaled Interval a n
f [a]
p [a]
q =
    let (n
z,n
c,[n]
m) = forall n a.
Fractional n =>
Interval a n -> [a] -> [a] -> (n, n, [n])
ocm_zcm Interval a n
f [a]
p [a]
q
    in n
z forall a. Fractional a => a -> a -> a
/ (n
c forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [n]
m)