{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base -- Copyright : (c) OleksandrZhabenko 2020-2021 -- 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.Simplified.Lists.UniquenessPeriodsG.Base ( -- * 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 #-}