phonetic-languages-basis 0.1.1.0 → 0.3.0.0
raw patch · 7 files changed
Files
- CHANGELOG.md +11/−0
- Phladiprelio/Basis.hs +48/−0
- Phladiprelio/Coeffs.hs +56/−0
- Phladiprelio/UniquenessPeriodsG.hs +104/−0
- Phonetic/Languages/Basis.hs +0/−45
- Phonetic/Languages/UniquenessPeriodsG.hs +0/−89
- phonetic-languages-basis.cabal +6/−6
CHANGELOG.md view
@@ -10,3 +10,14 @@ 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.++## 0.3.0.0 -- 2023-01-30++* Third version. Switched to NoImplicitPrelude extension. Changed the names of the modules.+Updated the dependency boundaries.+
+ Phladiprelio/Basis.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module : Phladiprelio.Basis+-- Copyright : (c) OleksandrZhabenko 2020-2023+-- License : MIT+-- Stability : Experimental+-- Maintainer : oleksandr.zhabenko@yahoo.com+--+-- Simplified version of the @phonetic-languages-common@ and @phonetic-languages-general@ packages.+-- Uses less dependencies.++{-# LANGUAGE BangPatterns, FlexibleContexts #-}++module Phladiprelio.Basis where++import GHC.Base++data Result t a b c = R {line :: !(t a), propertiesF :: !b, transPropertiesF :: !c} deriving Eq++instance (Ord (t a), Ord b, Ord c) => Ord (Result t a b c) where+ compare x y+ = case compare (transPropertiesF x) (transPropertiesF y) of+ !EQ -> case compare (propertiesF x) (propertiesF y) of+ !EQ -> compare (line x) (line y)+ !z -> z+ !z0 -> z0+ {-# INLINE compare #-}++data FuncRep2 a b c = D { getAB :: (a -> b), getBC :: (b -> c) }++getAC :: FuncRep2 a b c -> (a -> c)+getAC (D f g) = g . f+{-# INLINE getAC #-}++data Result2 a b c = R2 {line2 :: !a, propertiesF2 :: !b, transPropertiesF2 :: !c} deriving Eq++instance (Ord a, Ord b, Ord c) => Ord (Result2 a b c) where+ compare x y+ = case compare (transPropertiesF2 x) (transPropertiesF2 y) of+ !EQ -> case compare (propertiesF2 x) (propertiesF2 y) of+ !EQ -> compare (line2 x) (line2 y)+ !z -> z+ !z0 -> z0+ {-# INLINE compare #-}++
+ Phladiprelio/Coeffs.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module : Phladiprelio.Coeffs+-- Copyright : (c) OleksandrZhabenko 2020-2023+-- License : MIT+-- Stability : Experimental+-- Maintainer : oleksandr.zhabenko@yahoo.com+--+-- The coefficients functionality common for both phonetic-languages-simplified-examples-array and phonetic-languages-simplified-generalized-examples-array lines of PhLADiPreLiO.++{-# LANGUAGE BangPatterns #-}++module Phladiprelio.Coeffs (+ -- * Newtype to work with+ CoeffTwo(..)+ , Coeffs2+ , isEmpty+ , isPair+ , fstCF+ , sndCF+ , readCF+) where++import GHC.Base+import GHC.List+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
+ Phladiprelio/UniquenessPeriodsG.hs view
@@ -0,0 +1,104 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module : Phladiprelio.UniquenessPeriodsG+-- Copyright : (c) OleksandrZhabenko 2020-2023+-- License : MIT+-- Stability : Experimental+-- Maintainer : oleksandr.zhabenko@yahoo.com+--+-- Generalization of the uniqueness-periods and uniqueness-periods-general+-- packages functionality for small 'F.Foldable' data structures. Uses less dependencies.+--++{-# LANGUAGE BangPatterns #-}++module Phladiprelio.UniquenessPeriodsG (+ -- * List functions+ uniquenessPeriodsGG+ , uniquenessPeriodsG+ , uniquenessPeriodsGI8+ , diverse2GGL+ , diverse2GL+ , diverse2GLInt8+) where++import GHC.Base+import GHC.Int+import Data.List hiding (foldr)+import GHC.Num ((-))+import Data.Tuple+import Data.Maybe (mapMaybe)+import qualified Data.Foldable as F++-- | A generalization of the uniquenessPeriods function of the @uniqueness-periods@ package.+uniquenessPeriodsGG :: (F.Foldable t1, F.Foldable t2, F.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,y)+ | y `F.elem` whspss = Just x+ | otherwise = Nothing+ {-# INLINE g #-}+ 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 :: (F.Foldable t1, F.Foldable t2, F.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 :: (F.Foldable t1, F.Foldable t2) => t1 Char -> t2 Char -> Int16+diverse2GL = diverse2GGL []+{-# INLINE diverse2GL #-}+--+-- | A variant for the 'uniquenessPeriodsGG' function for 'Char'.+uniquenessPeriodsG :: (F.Foldable t1, F.Foldable t2) => t1 Char -> t2 Char -> [Int16]+uniquenessPeriodsG = uniquenessPeriodsGG []+{-# INLINE uniquenessPeriodsG #-}++-- | A variant of the 'diverse2GGL' function for 'Int8'.+diverse2GLInt8 :: (F.Foldable t1, F.Foldable t2) => t1 Int8 -> t2 Int8 -> Int16+diverse2GLInt8 = diverse2GGL []+{-# INLINE diverse2GLInt8 #-}++-- | A variant for the 'uniquenessPeriodsGG' function for 'Int8'.+uniquenessPeriodsGI8 :: (F.Foldable t1, F.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 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 :: F.Foldable t => t b -> [(Int16, b)]+indexedL = F.foldr f []+ where f x ((j,z):ys) = (j-1,x):(j,z):ys+ f x _ = [(1,x)]++helpG :: (Eq a, F.Foldable t1, F.Foldable t2) => (t1 b -> b) -> t2 a -> (t1 b, a) -> Maybe b+helpG h xs (ts, x)+ | F.null ts = Nothing+ | x `F.elem` xs = Nothing+ | otherwise = Just (h ts)+{-# INLINE helpG #-}++helpGSel :: (Eq a, F.Foldable t1, F.Foldable t2, F.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.hs
@@ -1,45 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module : Phonetic.Languages.Basis--- Copyright : (c) OleksandrZhabenko 2020-2022--- License : MIT--- Stability : Experimental--- Maintainer : olexandr543@yahoo.com------ Simplified version of the @phonetic-languages-common@ and @phonetic-languages-general@ packages.--- Uses less dependencies.--{-# LANGUAGE BangPatterns, FlexibleContexts #-}--module Phonetic.Languages.Basis where--data Result t a b c = R {line :: !(t a), propertiesF :: !b, transPropertiesF :: !c} deriving Eq--instance (Ord (t a), Ord b, Ord c) => Ord (Result t a b c) where- compare x y- = case compare (transPropertiesF x) (transPropertiesF y) of- !EQ -> case compare (propertiesF x) (propertiesF y) of- !EQ -> compare (line x) (line y)- !z -> z- !z0 -> z0- {-# INLINE compare #-}--data FuncRep2 a b c = D { getAB :: (a -> b), getBC :: (b -> c) }--getAC :: FuncRep2 a b c -> (a -> c)-getAC (D f g) = g . f-{-# INLINE getAC #-}--data Result2 a b c = R2 {line2 :: !a, propertiesF2 :: !b, transPropertiesF2 :: !c} deriving Eq--instance (Ord a, Ord b, Ord c) => Ord (Result2 a b c) where- compare x y- = case compare (transPropertiesF2 x) (transPropertiesF2 y) of- !EQ -> case compare (propertiesF2 x) (propertiesF2 y) of- !EQ -> compare (line2 x) (line2 y)- !z -> z- !z0 -> z0- {-# INLINE compare #-}--
− Phonetic/Languages/UniquenessPeriodsG.hs
@@ -1,89 +0,0 @@-{-# 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 (101::Int8)-{-# INLINE diverse2GLInt8 #-}---- | A variant for the 'uniquenessPeriodsGG' function for 'Int8'.-uniquenessPeriodsGI8 :: Foldable t => [Int8] -> t Int8 -> [Int16]-uniquenessPeriodsGI8 = uniquenessPeriodsGG (101::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 #-}
phonetic-languages-basis.cabal view
@@ -1,12 +1,12 @@ name: phonetic-languages-basis-version: 0.1.1.0-synopsis: A basics of the phonetic-languages functionality.+version: 0.3.0.0+synopsis: A basics of the phonetic-languages (PhLADiPreLiO-related) functionality. description: The common for different realizations functionality. Just the necessary one. homepage: https://hackage.haskell.org/package/phonetic-languages-basis license: MIT license-file: LICENSE author: OleksandrZhabenko-maintainer: olexandr543@yahoo.com+maintainer: oleksandr.zhabenko@yahoo.com copyright: Oleksandr Zhabenko category: Language,Math,Game build-type: Simple@@ -14,9 +14,9 @@ cabal-version: >=1.10 library- exposed-modules: Phonetic.Languages.Basis, Phonetic.Languages.UniquenessPeriodsG+ exposed-modules: Phladiprelio.Basis, Phladiprelio.UniquenessPeriodsG, Phladiprelio.Coeffs -- other-modules:- other-extensions: BangPatterns, FlexibleContexts- build-depends: base >=4.8 && <5+ other-extensions: BangPatterns, FlexibleContexts, NoImplicitPrelude+ build-depends: base >=4.13 && <5 -- hs-source-dirs: default-language: Haskell2010