UniquenessPeriodsG.hs

{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.UniquenessPeriodsG
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization of the uniqueness-periods and uniqueness-periods-general
-- packages functionality. Uses less dependencies.
--

{-# LANGUAGE BangPatterns #-}

module Phonetic.Languages.UniquenessPeriodsG (
  -- * List functions
  uniquenessPeriodsGG
  , uniquenessPeriodsG
  , uniquenessPeriodsGI8
  , diverse2GGL
  , diverse2GL
  , diverse2GLInt8
)where

import GHC.Int
import Data.List
import Data.Maybe (mapMaybe)

diverse2GGL :: (Foldable t, Ord a) => a -> [a] -> t a -> Int16
diverse2GGL delim whspss = sum . uniquenessPeriodsGG delim whspss
{-# INLINE diverse2GGL #-}

-- | A generalization of the uniquenessPeriods function of the @uniqueness-periods@ package.
uniquenessPeriodsGG :: (Foldable t, Ord a) => a -> [a] -> t a -> [Int16]
uniquenessPeriodsGG delim whspss ws
 | null ws = []
 | otherwise = mapMaybe (helpG sum whspss) . unfoldr f $ ks
     where !ks = indexedL delim ws
           !vs = mapMaybe g ks
           g x
            | (`elem` whspss) . snd $ x = Just (fst x)
            | otherwise = Nothing
           {-# INLINE g #-}
           f !x
             | null x = Nothing
             | otherwise = 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
{-# INLINE uniquenessPeriodsGG #-}

-- | A variant of the 'diverse2GGL' function for 'Char'.
diverse2GL :: Foldable t => String -> t Char -> Int16
diverse2GL = diverse2GGL '\00'
{-# INLINE diverse2GL #-}

-- | A variant for the 'uniquenessPeriodsGG' function for 'Char'.
uniquenessPeriodsG :: Foldable t => String -> t Char -> [Int16]
uniquenessPeriodsG = uniquenessPeriodsGG '\00'
{-# INLINE uniquenessPeriodsG #-}

-- | A variant of the 'diverse2GGL' function for 'Int8'.
diverse2GLInt8 :: Foldable t => [Int8] -> t Int8 -> Int16
diverse2GLInt8 = diverse2GGL (-1::Int8)
{-# INLINE diverse2GLInt8 #-}

-- | A variant for the 'uniquenessPeriodsGG' function for 'Int8'.
uniquenessPeriodsGI8 :: Foldable t => [Int8] -> t Int8 -> [Int16]
uniquenessPeriodsGI8 = uniquenessPeriodsGG (-1::Int8)
{-# INLINE uniquenessPeriodsGI8 #-}

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