{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Aftovolio.General.Distance where

import Data.List (replicate)
import GHC.Base
import GHC.Float (Floating (..), sqrt)
import GHC.Int
import GHC.List
import GHC.Num (Integer, abs, subtract, (*), (-))
import GHC.Real (
    Fractional (..),
    Integral,
    Real (..),
    fromIntegral,
    gcd,
    quot,
    toInteger,
    (/),
 )
import GHC.Word

{- | 'toEqLength' changes two given lists into two lists of equal
minimal lengths and also returs its new length and initial lengths of the lists given.
-}
toEqLength :: [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLength :: forall a. [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLength [a]
xs [a]
ys
    | [a] -> Bool
forall a. [a] -> Bool
null [a]
xs = ([], [], Int
0, Int
0, Int
0)
    | [a] -> Bool
forall a. [a] -> Bool
null [a]
ys = ([], [], Int
0, Int
0, Int
0)
    | Bool
otherwise = ([a]
ts, [a]
vs, Int
lx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ly Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
dc, Int
lx, Int
ly)
  where
    lx :: Int
lx = [a] -> Int
forall a. [a] -> Int
length [a]
xs
    ly :: Int
ly = [a] -> Int
forall a. [a] -> Int
length [a]
ys
    dc :: Int
dc = Int -> Int -> Int
forall a. Integral a => a -> a -> a
gcd Int
lx Int
ly
    ts :: [a]
ts = (a -> [a]) -> [a] -> [a]
forall a b. (a -> [b]) -> [a] -> [b]
concatMap (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
ly Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
dc)) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs
    vs :: [a]
vs = (a -> [a]) -> [a] -> [a]
forall a b. (a -> [b]) -> [a] -> [b]
concatMap (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
lx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
dc)) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
ys

{- | 'toEqLengthL' changes two given lists into two lists of equal
minimal lengths and also returs its new length and initial lengths of the lists given. Is
intended to be used when the length of the lists are known and given as the first and the second parameters
here respectively.
-}
toEqLengthL :: Int -> Int -> [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLengthL :: forall a. Int -> Int -> [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLengthL Int
lx Int
ly [a]
xs [a]
ys
    | Int
lx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ([], [], Int
0, Int
0, Int
0)
    | Int
ly Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ([], [], Int
0, Int
0, Int
0)
    | Bool
otherwise = ([a]
ts, [a]
vs, Int
lx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ly Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
dc, Int
lx, Int
ly)
  where
    dc :: Int
dc = Int -> Int -> Int
forall a. Integral a => a -> a -> a
gcd Int
lx Int
ly
    ts :: [a]
ts = (a -> [a]) -> [a] -> [a]
forall a b. (a -> [b]) -> [a] -> [b]
concatMap (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
ly Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
dc)) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
xs
    vs :: [a]
vs = (a -> [a]) -> [a] -> [a]
forall a b. (a -> [b]) -> [a] -> [b]
concatMap (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
lx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
dc)) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a]
ys

-- | Is also a simplified distance between the lists. Intended to be used with 'Word8'.
sumAbsDistNorm :: (Integral a, Ord a) => [a] -> [a] -> Integer
sumAbsDistNorm :: forall a. (Integral a, Ord a) => [a] -> [a] -> Integer
sumAbsDistNorm [a]
xs [a]
ys
    | Int
lc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer
0
    | Bool
otherwise =
        [Integer] -> Integer
forall a. Num a => [a] -> a
sum ([Integer] -> Integer) -> ([a] -> [Integer]) -> [a] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Integer) -> [a] -> [a] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> a -> Integer
forall a. Integral a => a -> Integer
toInteger (if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y then a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y else a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
x)) [a]
ts ([a] -> Integer) -> [a] -> Integer
forall a b. (a -> b) -> a -> b
$ [a]
vs
  where
    ([a]
ts, [a]
vs, Int
lc, Int
lx, Int
ly) = [a] -> [a] -> ([a], [a], Int, Int, Int)
forall a. [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLength [a]
xs [a]
ys

-- | Intended to be used with 'Compards' of the same constructor in both arguments of the function. Otherwise returns -1.
sumAbsDistNormComp :: Compards -> Compards -> Integer
sumAbsDistNormComp :: Compards -> Compards -> Integer
sumAbsDistNormComp x1s :: Compards
x1s@(C1 [Word8]
xs) y1s :: Compards
y1s@(C1 [Word8]
ys)
    | Int
lc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer
0
    | Bool
otherwise =
        [Integer] -> Integer
forall a. Num a => [a] -> a
sum ([Integer] -> Integer)
-> ([Word8] -> [Integer]) -> [Word8] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Integer) -> [Word8] -> [Word8] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Word8
x Word8
y -> Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (if Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
y then Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
y else Word8
y Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
x)) [Word8]
ts ([Word8] -> Integer) -> [Word8] -> Integer
forall a b. (a -> b) -> a -> b
$ [Word8]
vs
  where
    ([Word8]
ts, [Word8]
vs, Int
lc, Int
lx, Int
ly) = [Word8] -> [Word8] -> ([Word8], [Word8], Int, Int, Int)
forall a. [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLength [Word8]
xs [Word8]
ys
sumAbsDistNormComp x1s :: Compards
x1s@(C2 [Int8]
xs) y1s :: Compards
y1s@(C2 [Int8]
ys)
    | Int
lc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer
0
    | Bool
otherwise =
        [Integer] -> Integer
forall a. Num a => [a] -> a
sum ([Integer] -> Integer)
-> ([Int8] -> [Integer]) -> [Int8] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Int8 -> Integer) -> [Int8] -> [Int8] -> [Integer]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int8
x Int8
y -> Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger (if Int8
x Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
> Int8
y then Int8
x Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
y else Int8
y Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
x)) [Int8]
ts ([Int8] -> Integer) -> [Int8] -> Integer
forall a b. (a -> b) -> a -> b
$ [Int8]
vs
  where
    ([Int8]
ts, [Int8]
vs, Int
lc, Int
lx, Int
ly) = [Int8] -> [Int8] -> ([Int8], [Int8], Int, Int, Int)
forall a. [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLength [Int8]
xs [Int8]
ys
sumAbsDistNormComp Compards
_ Compards
_ = -Integer
1

sumSqrDistNorm :: (Real a, Fractional a) => [a] -> [a] -> a
sumSqrDistNorm :: forall a. (Real a, Fractional a) => [a] -> [a] -> a
sumSqrDistNorm [a]
xs [a]
ys
    | Int
lc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a
0
    | Bool
otherwise = [a] -> a
forall a. Num a => [a] -> a
sum ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y) a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y)) [a]
ts [a]
vs) a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lc
  where
    ([a]
ts, [a]
vs, Int
lc, Int
lx, Int
ly) = [a] -> [a] -> ([a], [a], Int, Int, Int)
forall a. [a] -> [a] -> ([a], [a], Int, Int, Int)
toEqLength [a]
xs [a]
ys

{- | 'distanceSqr' is applied on two lists of non-negative 'Real' numbers (preferably, of type
'Double') and returns a special kind of distance that is similar to the statistical distance used
in the regression analysis. Is intended to be used e. g. for the AFTOVolio approach. The less
is the resulting number, the more \'similar\' are the two lists of non-negative numbers in their
distributions. Here, in contrast to the more general 'distanceSqrG', the numbers must be normed
to 1.0, so that the largest ones in both listn must be 1.0.
-}
distanceSqr :: (Real a, Floating a, Fractional a) => [a] -> [a] -> a
distanceSqr :: forall a. (Real a, Floating a, Fractional a) => [a] -> [a] -> a
distanceSqr [a]
xs [a]
ys = a -> a
forall a. Floating a => a -> a
sqrt a
s
  where
    s :: a
s = [a] -> [a] -> a
forall a. (Real a, Fractional a) => [a] -> [a] -> a
sumSqrDistNorm [a]
xs [a]
ys
{-# INLINE distanceSqr #-}

{- | 'distanceSqrG' is applied on two lists of non-negative 'Real' numbers (preferably, of type
'Double') and returns a special kind of distance that is similar to the statistical distance used
in the regression analysis. Is intended to be used e. g. for the AFTOVolio approach. The less
is the resulting number, the more \'similar\' are the two lists of non-negative numbers in their
distributions.
-}
distanceSqrG :: (Real a, Floating a, Fractional a) => [a] -> [a] -> a
distanceSqrG :: forall a. (Real a, Floating a, Fractional a) => [a] -> [a] -> a
distanceSqrG [a]
xs [a]
ys = [a] -> [a] -> a
forall a. (Real a, Floating a, Fractional a) => [a] -> [a] -> a
distanceSqr [a]
qs [a]
rs
  where
    mx :: a
mx = [a] -> a
forall a. (Ord a, HasCallStack) => [a] -> a
maximum [a]
xs
    my :: a
my = [a] -> a
forall a. (Ord a, HasCallStack) => [a] -> a
maximum [a]
ys
    qs :: [a]
qs = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
mx) [a]
xs
    rs :: [a]
rs = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
my) [a]
ys
{-# INLINE distanceSqrG #-}

{- | 'distanceSqrG2' is an partially optimized variant of the 'distanceSqrG' if length of the least
common multiplier of the two lists is known and provided as the first argument, besides if it is
equal to the length of the second argument, and if maximum element of the second argument here is
equal to 1.0.
-}
distanceSqrG2 :: (Real a, Floating a, Fractional a) => Int -> [a] -> [a] -> a
distanceSqrG2 :: forall a.
(Real a, Floating a, Fractional a) =>
Int -> [a] -> [a] -> a
distanceSqrG2 Int
lc [a]
xs [a]
ys = a -> a
forall a. Floating a => a -> a
sqrt ([a] -> a
forall a. Num a => [a] -> a
sum ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y) a -> a -> a
forall a. Num a => a -> a -> a
* (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y)) [a]
xs [a]
qs) a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lc)
  where
    my :: a
my = [a] -> a
forall a. (Ord a, HasCallStack) => [a] -> a
maximum [a]
ys
    rs :: [a]
rs = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
my) [a]
ys
    lr :: Int
lr = [a] -> Int
forall a. [a] -> Int
length [a]
rs
    dc :: Int
dc = Int
lc Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
lr
    qs :: [a]
qs = (a -> [a]) -> [a] -> [a]
forall a b. (a -> [b]) -> [a] -> [b]
concatMap (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
dc) [a]
rs
{-# INLINE distanceSqrG2 #-}

data Compards = C1 [Word8] | C2 [Int8] deriving (Compards -> Compards -> Bool
(Compards -> Compards -> Bool)
-> (Compards -> Compards -> Bool) -> Eq Compards
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Compards -> Compards -> Bool
== :: Compards -> Compards -> Bool
$c/= :: Compards -> Compards -> Bool
/= :: Compards -> Compards -> Bool
Eq)

isWord8Based :: Compards -> Bool
isWord8Based :: Compards -> Bool
isWord8Based (C1 [Word8]
_) = Bool
True
isWord8Based Compards
_ = Bool
False

isInt8Based :: Compards -> Bool
isInt8Based :: Compards -> Bool
isInt8Based (C2 [Int8]
_) = Bool
True
isInt8Based Compards
_ = Bool
False

-- | The elements in  the first argument must not be greater than 127 though it is not checked.
fromSmallWord8toInt8Diff :: [Word8] -> [Int8]
fromSmallWord8toInt8Diff :: [Word8] -> [Int8]
fromSmallWord8toInt8Diff xs :: [Word8]
xs@(Word8
_ : [Word8]
ys) = (Word8 -> Word8 -> Int8) -> [Word8] -> [Word8] -> [Int8]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Word8
t Word8
u -> Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
u Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
t) [Word8]
xs [Word8]
ys
fromSmallWord8toInt8Diff [] = []
{-# INLINE fromSmallWord8toInt8Diff #-}

class DoubleFunc a b c d where
    doubleFunc :: (a -> c) -> (b -> c) -> d -> c

instance (DoubleFunc [Word8] [Int8] Int) Compards where
    doubleFunc :: ([Word8] -> Int) -> ([Int8] -> Int) -> Compards -> Int
doubleFunc [Word8] -> Int
f [Int8] -> Int
g (C1 [Word8]
xs) = [Word8] -> Int
f [Word8]
xs
    doubleFunc [Word8] -> Int
f [Int8] -> Int
g (C2 [Int8]
ys) = [Int8] -> Int
g [Int8]
ys

instance (DoubleFunc [Word8] [Int8] Compards) Compards where
    doubleFunc :: ([Word8] -> Compards)
-> ([Int8] -> Compards) -> Compards -> Compards
doubleFunc [Word8] -> Compards
f [Int8] -> Compards
g (C1 [Word8]
xs) = [Word8] -> Compards
f [Word8]
xs
    doubleFunc [Word8] -> Compards
f [Int8] -> Compards
g (C2 [Int8]
ys) = [Int8] -> Compards
g [Int8]
ys

instance (DoubleFunc [Word8] [Int8] Bool) Compards where
    doubleFunc :: ([Word8] -> Bool) -> ([Int8] -> Bool) -> Compards -> Bool
doubleFunc [Word8] -> Bool
f [Int8] -> Bool
g (C1 [Word8]
xs) = [Word8] -> Bool
f [Word8]
xs
    doubleFunc [Word8] -> Bool
f [Int8] -> Bool
g (C2 [Int8]
ys) = [Int8] -> Bool
g [Int8]
ys

instance (DoubleFunc [Word8] [Int8] Integer) Compards where
    doubleFunc :: ([Word8] -> Integer) -> ([Int8] -> Integer) -> Compards -> Integer
doubleFunc [Word8] -> Integer
f [Int8] -> Integer
g (C1 [Word8]
xs) = [Word8] -> Integer
f [Word8]
xs
    doubleFunc [Word8] -> Integer
f [Int8] -> Integer
g (C2 [Int8]
ys) = [Int8] -> Integer
g [Int8]
ys