-- |
-- Module : Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Generalization of the uniqueness-periods and uniqueness-periods-general
-- packages functionality.
--
{-# LANGUAGE BangPatterns #-}
module Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG (
-- * Vector functions
diverse2G
-- * List functions
, diverse2GL
)where
import GHC.Int
import qualified Data.Vector as VB
import Data.List
import Data.Maybe (mapMaybe)
-- | A vectors simplified variant of the diverse2 metrics from the @phonetic-languages-properties@ package.
diverse2G whspss v
| VB.null v = 0
| otherwise = VB.sum . VB.mapMaybe (helpG sum whspss) . VB.unfoldr f . VB.map (\(j,t) -> (toEnum j,t)) $ v1
where !v1 = VB.indexed v
!vs = VB.toList . VB.map toEnum . VB.findIndices (`elem` whspss) $ v
f !x = if VB.null x then Nothing else let !idX0 = snd . VB.unsafeIndex x $ 0 in Just . (\vws (v2,v3) -> ((helpUPV3 vws [] . VB.toList .
VB.map fst $ v2,snd . VB.unsafeIndex v2 $ 0),v3)) vs . VB.partition (\(_,xs) -> xs == idX0) $ x
-- | A lists variant of the diverse2 metrics from the @phonetic-languages-properties@ package.
diverse2GL whspss ws
| null ws = 0
| otherwise = sum . mapMaybe (helpG sum whspss) . unfoldr f $ ks
where !ks = indexedL '\00' ws
!vs = mapMaybe g ks
g x
| (`elem` whspss) . snd $ x = Just (fst x)
| otherwise = Nothing
{-# INLINE g #-}
f !x = if null x then Nothing else let !idX0 = snd . head $ x in Just . (\vws (v2,v3) -> ((helpUPV3 vws [] .
map fst $ v2,snd . head $ v2),v3)) vs . partition (\(_,xs) -> xs == idX0) $ x
-- | The first and the third list arguments of numbers (if not empty) must be sorted in the ascending order.
helpUPV3 :: [Int16] -> [Int16] -> [Int16] -> [Int16]
helpUPV3 (z:zs) !acc (x:y:xs)
| compare ((x - z) * (y - z)) 0 == LT = helpUPV3 zs ((y - x):acc) (y:xs)
| compare y z == GT = helpUPV3 zs acc (x:y:xs)
| otherwise = helpUPV3 (z:zs) acc (y:xs)
helpUPV3 _ !acc _ = acc
indexedL :: Foldable t => b -> t b -> [(Int16, b)]
indexedL y = foldr f v
where v = [(1::Int16,y)]
f x ((j,z):ys) = (j-1,x):(j,z):ys
helpG :: (Eq a) => ([b] -> b) -> [a] -> ([b], a) -> Maybe b
helpG h xs (ts, x)
| null ts = Nothing
| x `elem` xs = Nothing
| otherwise = Just (h ts)
{-# INLINE helpG #-}