Distance.hs

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

module Aftovolio.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,Integer)
import GHC.Word
import GHC.Int

-- | '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 xs ys 
  | null xs = ([],[],0,0,0)
  | null ys = ([],[],0,0,0)
  | otherwise = (ts, vs, lx * ly `quot` dc,lx,ly) 
       where lx = length xs
             ly = length ys
             dc = gcd lx ly
             ts = concatMap (replicate (ly `quot` dc)) $ xs
             vs = concatMap (replicate (lx `quot` dc)) $ 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 lx ly xs ys 
  | lx == 0 = ([],[],0,0,0)
  | ly == 0 = ([],[],0,0,0)
  | otherwise = (ts, vs, lx * ly `quot` dc,lx,ly) 
       where dc = gcd lx ly
             ts = concatMap (replicate (ly `quot` dc)) $ xs
             vs = concatMap (replicate (lx `quot` dc)) $ ys

-- | Is also a simplified distance between the lists. Intended to be used with 'Word8'.
sumAbsDistNorm :: (Integral a, Ord a) => [a] -> [a] -> Integer
sumAbsDistNorm xs ys 
 | lc == 0 = 0
 | otherwise = sum . zipWith (\x y -> toInteger (if x > y then x-y else y-x)) ts $ vs
     where (ts, vs, lc, lx, ly) = toEqLength xs 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 x1s@(C1 xs) y1s@(C1 ys) 
 | lc == 0 = 0
 | otherwise = sum . zipWith (\x y -> toInteger (if x > y then x-y else y-x)) ts $ vs
     where (ts, vs, lc, lx, ly) = toEqLength xs ys 
sumAbsDistNormComp x1s@(C2 xs) y1s@(C2 ys) 
 | lc == 0 = 0
 | otherwise = sum . zipWith (\x y -> toInteger (if x > y then x-y else y-x)) ts $ vs
     where (ts, vs, lc, lx, ly) = toEqLength xs ys 
sumAbsDistNormComp _ _ = -1

sumSqrDistNorm :: (Real a, Fractional a) => [a] -> [a] -> a
sumSqrDistNorm xs ys 
 | lc == 0 = 0
 | otherwise = sum (zipWith (\x y -> (x - y) * (x - y)) ts vs) / fromIntegral lc
     where (ts, vs, lc, lx, ly) = toEqLength xs 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 xs ys = sqrt s
   where s = sumSqrDistNorm xs 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 xs ys = distanceSqr qs rs
   where mx = maximum xs
         my = maximum ys
         qs = map (/ mx) xs
         rs = map (/ my) 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 lc xs ys = sqrt (sum (zipWith (\x y -> (x - y) * (x - y)) xs qs) / fromIntegral lc)
   where my = maximum ys
         rs = map (/ my) ys
         lr = length rs
         dc = lc `quot` lr
         qs = concatMap (replicate dc) rs
{-# INLINE distanceSqrG2 #-}

data Compards = C1 [Word8] | C2 [Int8] deriving (Eq)

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

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

{-| The elements in  the first argument must not be greater than 127 though it is not checked. -}
fromSmallWord8toInt8Diff :: [Word8] -> [Int8]
fromSmallWord8toInt8Diff xs@(_:ys) = zipWith (\t u -> fromIntegral u - fromIntegral t) xs 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 f g (C1 xs) = f xs
  doubleFunc f g (C2 ys) = g ys

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

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

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