packages feed

phonetic-languages-basis 0.1.1.0 → 0.2.0.0

raw patch · 4 files changed

+109/−39 lines, 4 files

Files

CHANGELOG.md view
@@ -10,3 +10,9 @@ Changed the structure of the non-sound Ukraninian symbols representation (now they are converted to one of the [100,101,102]). Added Result2 data type to the module Phonetic.Languages.Basis. +## 0.2.0.0 -- 2022-09-13++* Second version. Moved the duplicated functionality to form the unified module Phonetic.Languages.Coeffs. +Added new functionality related to computation for just selected elements diversity to the module Phonetic.Languages.UniquenessPeriodsG. Some code improvements there. +Please, check the definitions, the semantics has changed.+
+ Phonetic/Languages/Coeffs.hs view
@@ -0,0 +1,53 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phonetic.Languages.Coeffs+-- Copyright   :  (c) OleksandrZhabenko 2020-2022+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- The coefficients functionality common for both phonetic-languages-simplified-examples-array and phonetic-languages-simplified-generalized-examples-array lines of PhLADiPreLiO.++{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-}++module Phonetic.Languages.Coeffs (+    -- * Newtype to work with+  CoeffTwo(..)+  , Coeffs2+  , isEmpty+  , isPair+  , fstCF+  , sndCF+  , readCF+) where++import Data.Maybe (isNothing,fromMaybe,fromJust)+import Text.Read (readMaybe)++data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (Eq)++isEmpty :: CoeffTwo a -> Bool+isEmpty CF0 = True+isEmpty _ = False++isPair :: CoeffTwo a -> Bool+isPair CF0 = False+isPair _ = True++fstCF :: CoeffTwo a -> Maybe a+fstCF (CF2 x _) = x+fstCF _ = Nothing++sndCF :: CoeffTwo a -> Maybe a+sndCF (CF2 _ y) = y+sndCF _ = Nothing++readCF :: String -> Coeffs2+readCF xs+  | any (== '_') xs = let (!ys,!zs) = (\(ks,ts) -> (readMaybe ks::Maybe Double,readMaybe (drop 1 ts)::Maybe Double)) . break (== '_') $ xs in+     if (isNothing ys && isNothing zs) then CF0 else CF2 ys zs+  | otherwise = CF0++-- | A data type that is used to represent the coefficients of the rhythmicity functions as a one argument value.+type Coeffs2 = CoeffTwo Double
Phonetic/Languages/UniquenessPeriodsG.hs view
@@ -8,7 +8,7 @@ -- Maintainer  :  olexandr543@yahoo.com -- -- Generalization of the uniqueness-periods and uniqueness-periods-general--- packages functionality. Uses less dependencies.+-- packages functionality for small 'F.Foldable' data structures. Uses less dependencies. --  {-# LANGUAGE BangPatterns #-}@@ -21,69 +21,80 @@   , diverse2GGL   , diverse2GL   , diverse2GLInt8-)where+)  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 #-}+import qualified Data.Foldable as F  -- | 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+uniquenessPeriodsGG :: (Foldable t1, Foldable t2, Foldable t3, Ord a) => t3 a -> t1 a -> t2 a -> [Int16]+uniquenessPeriodsGG sels whspss ws+ | F.null ws = []+ | otherwise = mapMaybe (helpGSel sels F.sum whspss) . unfoldr f $ ks+     where !ks = indexedL ws            !vs = mapMaybe g ks-           g x-            | (`elem` whspss) . snd $ x = Just (fst x)+           g (x,y)+            | y `F.elem` whspss = Just 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+           f ys@(y:_) = let !idX0 = snd y in Just . (\(v2,v3) -> ((helpUPV3 vs [] .+                    map fst $ v2,snd . head $ v2),v3)) . partition (\(_,xs) -> xs == idX0) $ ys+           f _ = Nothing {-# INLINE uniquenessPeriodsGG #-} +-- | A general variant of the diversity property. Use it in general case.+diverse2GGL :: (Foldable t1, Foldable t2, Foldable t3, Ord a) => t3 a -> t1 a -> t2 a -> Int16+diverse2GGL sels whspss = sum . uniquenessPeriodsGG sels whspss+{-# INLINE diverse2GGL #-}+ -- | A variant of the 'diverse2GGL' function for 'Char'.-diverse2GL :: Foldable t => String -> t Char -> Int16-diverse2GL = diverse2GGL '\00'+diverse2GL :: (Foldable t1, Foldable t2) => t1 Char -> t2 Char -> Int16+diverse2GL = diverse2GGL [] {-# INLINE diverse2GL #-}-+-- -- | A variant for the 'uniquenessPeriodsGG' function for 'Char'.-uniquenessPeriodsG :: Foldable t => String -> t Char -> [Int16]-uniquenessPeriodsG = uniquenessPeriodsGG '\00'+uniquenessPeriodsG :: (Foldable t1, Foldable t2) => t1 Char -> t2 Char -> [Int16]+uniquenessPeriodsG = uniquenessPeriodsGG [] {-# INLINE uniquenessPeriodsG #-}  -- | A variant of the 'diverse2GGL' function for 'Int8'.-diverse2GLInt8 :: Foldable t => [Int8] -> t Int8 -> Int16-diverse2GLInt8 = diverse2GGL (101::Int8)+diverse2GLInt8 :: (Foldable t1, Foldable t2) => t1 Int8 -> t2 Int8 -> Int16+diverse2GLInt8 = diverse2GGL [] {-# INLINE diverse2GLInt8 #-}  -- | A variant for the 'uniquenessPeriodsGG' function for 'Int8'.-uniquenessPeriodsGI8 :: Foldable t => [Int8] -> t Int8 -> [Int16]-uniquenessPeriodsGI8 = uniquenessPeriodsGG (101::Int8)+uniquenessPeriodsGI8 :: (Foldable t1, Foldable t2) => t1 Int8 -> t2 Int8 -> [Int16]+uniquenessPeriodsGI8 = uniquenessPeriodsGG [] {-# 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 ks@(!z:zs) !acc ps@(!x:qs@(!y:_))+ | z < y && z > x = helpUPV3 zs ((y - x):acc) qs + | z < y = helpUPV3 zs acc ps+ | otherwise = helpUPV3 ks acc qs 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+indexedL :: Foldable t => t b -> [(Int16, b)]+indexedL = foldr f []+  where f x ((j,z):ys) = (j-1,x):(j,z):ys+        f x _ = [(1,x)] -helpG :: (Eq a) => ([b] -> b) -> [a] -> ([b], a) -> Maybe b+helpG :: (Eq a, Foldable t1, Foldable t2) => (t1 b -> b) -> t2 a -> (t1 b, a) -> Maybe b helpG h xs (ts, x)-  | null ts = Nothing-  | x `elem` xs = Nothing+  | F.null ts = Nothing+  | x `F.elem` xs = Nothing   | otherwise = Just (h ts) {-# INLINE helpG #-}++helpGSel :: (Eq a, Foldable t1, Foldable t2, Foldable t3) => t3 a -> (t1 b -> b) -> t2 a -> (t1 b, a) -> Maybe b+helpGSel sels h xs (ts, x)+  | F.null sels = helpG h xs (ts,x)+  | F.null ts = Nothing+  | x `F.elem` xs = Nothing+  | x `F.elem` sels = Just (h ts)+  | otherwise = Nothing+{-# INLINE helpGSel #-}+
phonetic-languages-basis.cabal view
@@ -1,5 +1,5 @@ name:                phonetic-languages-basis-version:             0.1.1.0+version:             0.2.0.0 synopsis:            A basics of the phonetic-languages functionality. description:         The  common for different realizations functionality. Just the necessary one. homepage:            https://hackage.haskell.org/package/phonetic-languages-basis@@ -14,7 +14,7 @@ cabal-version:       >=1.10  library-  exposed-modules:     Phonetic.Languages.Basis, Phonetic.Languages.UniquenessPeriodsG+  exposed-modules:     Phonetic.Languages.Basis, Phonetic.Languages.UniquenessPeriodsG, Phonetic.Languages.Coeffs   -- other-modules:   other-extensions:    BangPatterns, FlexibleContexts   build-depends:       base >=4.8 && <5