phonetic-languages-simplified-base 0.4.6.0 → 0.5.0.0

raw patch · 6 files changed

+86/−113 lines, 6 filesdep +phonetic-languages-basisPVP ok

version bump matches the API change (PVP)

Dependencies added: phonetic-languages-basis

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Phonetic/Languages/Simplified/DataG/Base.hs +13/−19
• Phonetic/Languages/Simplified/DataG/Partir.hs +64/−0
• Phonetic/Languages/Simplified/Lists/UniquenessPeriodsG/Base.hs +0/−89
• Phonetic/Languages/Simplified/StrictVG/Base.hs +0/−1
• phonetic-languages-simplified-base.cabal +4/−4

@@ -45,3 +45,8 @@ ## 0.4.6.0 -- 2022-03-24  * Fourth version revised F. Updated the dependency boundaries to support the latest GHC and Cabal.++## 0.5.0.0 -- 2022-05-31++* Fifth version. Added functionality to find more straightforward (and probably thus more efficient) partitioning schemes. Added for this also a new module+Phonetic.Languages.Simplified.DataG.Partir. Changed the dependencies schemes to make the development process for phonetic languages simpler.

@@ -2,7 +2,7 @@  -- | -- Module      :  Phonetic.Languages.Simplified.DataG.Base--- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- Copyright   :  (c) OleksandrZhabenko 2020-2022 -- License     :  MIT -- Stability   :  Experimental -- Maintainer  :  olexandr543@yahoo.com@@ -18,23 +18,7 @@ import Data.Monoid import Data.SubG import Data.MinMax.Preconditions--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 #-}+import Phonetic.Languages.Basis  maximumEl   :: (Foldable t2, Ord c) => FuncRep2 (t a) b c@@ -81,7 +65,7 @@   let !l = F.maximum . mapG (toTransPropertiesF' frep2) $ data0 in partitionG ((== l) . getAC frep2) data0 {-# INLINE innerPartitioning #-} --- | The second argument must be not empty for the function to work correctly.+-- | The first argument must be not empty for the function to work correctly. innerPartitioningR   :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), InsertLeft t2 c, Monoid (t2 c), Ord c) => t2 (Result t a b c)   -> (t2 (Result t a b c), t2 (Result t a b c))@@ -155,3 +139,13 @@   -> c toTransPropertiesF' !frep2 !ys = getAC frep2 ys {-# INLINE toTransPropertiesF' #-}++-- | The second argument must be not empty for the function to work correctly.+partiR+  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), InsertLeft t2 c) => (c -> Bool)+  -> t2 (Result t a b c)+  -> (t2 (Result t a b c), t2 (Result t a b c))+partiR p dataR = partitionG (p . transPropertiesF) dataR+{-# INLINE partiR #-}++

@@ -0,0 +1,64 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phonetic.Languages.Simplified.DataG.Partir+-- Copyright   :  (c) OleksandrZhabenko 2022+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- ++{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses #-}++module Phonetic.Languages.Simplified.DataG.Partir where++import qualified Data.Foldable as F+import Data.Monoid+import Data.SubG+import Data.MinMax.Preconditions+import Phonetic.Languages.Simplified.DataG.Base+import Phonetic.Languages.Basis+import Data.Char (isDigit)+import Data.List (uncons)+import Data.Maybe (fromJust, fromMaybe)+import Text.Read (readMaybe)++class Foldable t => ConstraintsG t a where+  decodeCDouble :: t a -> Double -> Bool++instance ConstraintsG [] Char where+  decodeCDouble xs !y+    | null xxs = True+    | t < '2' = (if t == '0' then (>) else (<)) y (fromIntegral . fromMaybe 1 $ (readMaybe ts :: Maybe Integer))+    | otherwise = getScale c cs t y+       where xxs = filter isDigit xs+             (t,ts) = fromJust . uncons $ xxs+             (c,cs) = fromMaybe ('0',"1") . uncons $ ts+             getScale c0 ws t0 y0  +               | c0 == '1' = (ords t0) (logBase 10 y0) base+               | c0 == '2' = (ords t0) (637.0 * atan y0) base -- atan Infinity * 637.0 \approx 1000.0+               | c0 == '3' = (ords t0) (sin (k * y0)) (0.01 * base1)+               | c0 == '4' = (ords t0) (cos (k * y0)) (0.01 * base1)+               | c0 == '5' = (ords t0) (sin (k * y0)) (0.001 * base2)+               | c0 == '6' = (ords t0) (cos (k * y0)) (0.001 * base2)+               | c0 == '7' = (ords t0) (sin (k * y0)) (-0.01 * base1)+               | c0 == '8' = (ords t0) (cos (k * y0)) (-0.01 * base1)+               | otherwise = (ords t0) (y0 ** k) base1+                  where base = fromIntegral . fromMaybe 1 $ (readMaybe ws :: Maybe Integer)+                        ords t0+                          | t0 == '2' = (>)+                          | otherwise = (<)+                        (w,wws) = fromMaybe ('2',"") . uncons $ ws+                        base1 = fromIntegral . fromMaybe 50 $ (readMaybe wws :: Maybe Integer)+                        base2 = fromIntegral . fromMaybe 500 $ (readMaybe wws :: Maybe Integer)+                        k = fromIntegral . fromMaybe 2 $ (readMaybe [w] :: Maybe Integer)+             +partitioningR+  :: (InsertLeft t2 (Result [] Char b Double), Monoid (t2 (Result [] Char b Double)), InsertLeft t2 Double, Monoid (t2 Double)) => String+  -> t2 (Result [] Char b Double)+  -> (t2 (Result [] Char b Double), t2 (Result [] Char b Double))+partitioningR !xs dataR+ | F.null dataR = (mempty,mempty)+ | otherwise = partiR (decodeCDouble xs) dataR+{-# INLINABLE partitioningR #-}

@@ -1,89 +0,0 @@-{-# 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 #-}

@@ -19,7 +19,6 @@ ) where  import Phonetic.Languages.Permutations.Arr-import Phonetic.Languages.Simplified.DataG.Base import qualified Data.Foldable as F import Data.SubG import GHC.Arr

@@ -3,8 +3,8 @@ -- http://haskell.org/cabal/users-guide/  name:                phonetic-languages-simplified-base-version:             0.4.6.0-synopsis:            A basics of the phonetic-languages functionality.+version:             0.5.0.0+synopsis:            A basics of the phonetic-languages functionality that can be groupped. description:         The  common for different realizations functionality. Just the necessary one. homepage:            https://hackage.haskell.org/package/phonetic-languages-simlified-base license:             MIT@@ -18,9 +18,9 @@ cabal-version:       >=1.10  library-  exposed-modules:     Phonetic.Languages.Simplified.DataG.Base, Phonetic.Languages.Simplified.StrictVG.Base, Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base+  exposed-modules:     Phonetic.Languages.Simplified.DataG.Base, Phonetic.Languages.Simplified.StrictVG.Base, Phonetic.Languages.Simplified.DataG.Partir   -- other-modules:   other-extensions:    BangPatterns, FlexibleContexts, MultiParamTypeClasses-  build-depends:       base >=4.8 && <5, subG ==0.5.3.0, phonetic-languages-permutations-array ==0.3.4.0+  build-depends:       base >=4.8 && <5, subG ==0.5.3.0, phonetic-languages-permutations-array ==0.3.4.0, phonetic-languages-basis ==0.1.0.0   -- hs-source-dirs:   default-language:    Haskell2010