{-# LANGUAGE NoImplicitPrelude #-}

module Phladiprelio.General.Distance where

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

-- | '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] -> a
sumAbsDistNorm :: forall a. (Integral a, Ord a) => [a] -> [a] -> a
sumAbsDistNorm [a]
xs [a]
ys 
 | Int
lc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = a
0
 | Bool
otherwise = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> ([a] -> Integer) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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
xa -> a -> a
forall a. Num a => a -> a -> a
-a
y else a
ya -> a -> a
forall a. Num a => a -> a -> a
-a
x)) [a]
ts ([a] -> a) -> [a] -> a
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 

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 PhLADiPreLiO 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 PhLADiPreLiO 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 #-}