phonetic-languages-simplified-examples-common 0.4.6.0 → 0.5.0.0

raw patch · 3 files changed

+78/−9 lines, 3 filesdep +phonetic-languages-simplified-properties-arraydep +ukrainian-phonetics-basic-arrayPVP ok

version bump matches the API change (PVP)

Dependencies added: phonetic-languages-simplified-properties-array, ukrainian-phonetics-basic-array

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Phonetic/Languages/Simplified/DeEnCoding.hs +69/−7
• phonetic-languages-simplified-examples-common.cabal +2/−2

@@ -60,3 +60,10 @@ ## 0.4.6.0 -- 2022-04-25  * Fourth version revised F. Fixed unneeded dependency.++## 0.5.0.0 -- 2022-08-09++* Fifth version. Fixed issue with the module Phonetic.Languages.Simplified.DeEnCoding for the+encoding and decoding of the values of 10. Switched for this to the 16-based (hexadecimal) +representation. Added the new functionality to deal with the Phonetic.Languages.Emphasis+functionality.

@@ -4,7 +4,7 @@  -- | -- Module      :  Phonetic.Languages.Simplified.DeEnCoding--- Copyright   :  (c) OleksandrZhabenko 2020+-- Copyright   :  (c) OleksandrZhabenko 2020-2022 -- License     :  MIT -- Stability   :  Experimental -- Maintainer  :  olexandr543@yahoo.com@@ -18,13 +18,21 @@ import qualified Data.Heap as Heap import GHC.Int import Data.Foldable (foldl')-import Data.List (sortBy,sort)+import Data.List (sortBy,sort,partition) import System.IO+import Data.Maybe (fromJust)+import Numeric+import Phonetic.Languages.Emphasis+import Melodics.Ukrainian.ArrInt8 (FlowSound)+import Languages.Phonetic.Ukrainian.Syllable.ArrInt8  --default (Int, Double) -encodeToInt :: [String] -> Int-encodeToInt yss = foldl' (\x y -> x * 10 + y) 0 . map (\(j,_) -> fromEnum j) . sortBy (\x y -> compare (snd x) (snd y)) . trans2 $ yss+encodeToInt :: Ord a => [[a]] -> Int+encodeToInt yss+ | null ks = -1+ | otherwise = fst . head $ ks+  where ks = readHex (showHex (foldl' (\x y -> x * 16 + y) 0 . map (\(j,_) -> fromEnum j) . sortBy (\x y -> compare (snd x) (snd y)) . trans2 $ yss) $ "") {-# INLINABLE encodeToInt #-}  @@ -47,19 +55,26 @@  int2l :: Int -> [Int8] int2l n- | n < 10 = [toEnum n]+ | n < 16 = [toEnum n]  | otherwise = int2l n1 `mappend` [l]-     where (!n1,!l0) = quotRem n 10+     where (!n1,!l0) = quotRem n 16            !l = toEnum l0 {-# INLINABLE int2l #-} --- | So:+-- | So for the strings consisting of no more than 10 words: -- > decodeToStr (int2l . encodeToInt . words $ xs) xs == unwords . words $ xs -- decodeToStr :: [Int8] -> String -> String decodeToStr ys = unwords . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort . words {-# INLINE decodeToStr #-} +-- | For the 'ReadyForConstructionUkr' that corresponds to the 'String' consisting of no more than 10 words.+--+decodeToReadyFCUkr :: [Int8] -> ReadyForConstructionUkr -> ReadyForConstructionUkr+decodeToReadyFCUkr ys (Str ts) = Str . unwords . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort . words $ ts+decodeToReadyFCUkr ys (FSL tsss) = FSL . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort $ tsss+{-# INLINE decodeToReadyFCUkr #-}+ -- | Every 'String' consists of words with whitespace symbols in between. toHeap :: [String] -> Heap Int toHeap yss@(xs:xss)@@ -68,21 +83,68 @@ toHeap _ = Heap.empty {-# INLINE toHeap #-} +-- | Every 'ReadyForConstructionUkr' corresponds to the 'String' that consists of words with whitespace symbols in between.+-- The list must be consistent -- either 'FSL'-constructed or 'Str'-constructed.+toHeapR :: [ReadyForConstructionUkr] -> Heap Int+toHeapR yss@(xs@(Str ts):xss)+  | null xss = Heap.singleton . encodeToInt . words $ ts+  | otherwise = Heap.fromList . map (encodeToInt . words . fromJust . fromReadyFCUkrS) $ yss+toHeapR yss@(xs@(FSL tsss):xss)+  | null xss = Heap.singleton . encodeToInt $ tsss+  | otherwise = Heap.fromList . map (encodeToInt . fromJust . fromReadyFCUkrF) $ yss  +toHeapR _ = Heap.empty+{-# INLINE toHeapR #-}+ fromHeap :: String -> Heap Int -> [String] fromHeap ys heap  | Heap.null heap = []  | otherwise = map (flip decodeToStr ys . int2l) . Heap.toUnsortedList $ heap {-# INLINE fromHeap #-} +fromHeapReadyFCUkr :: ReadyForConstructionUkr -> Heap Int -> [ReadyForConstructionUkr]+fromHeapReadyFCUkr ys heap+ | Heap.null heap = []+ | otherwise = map (flip decodeToReadyFCUkr ys . int2l) . Heap.toUnsortedList $ heap+{-# INLINE fromHeapReadyFCUkr #-}+ intersectInterResults :: [String] -> [String] -> [String] intersectInterResults zss  | null zss = const []  | otherwise = fromHeap (head zss) . Heap.intersect (toHeap zss) . toHeap {-# INLINE intersectInterResults #-} +-- | It seems like it works, but it isn't. (??). The main reason is the hardness with defining convF to work properly.+intersectInterReadyFCUkr :: (String -> [[FlowSound]]) -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]+intersectInterReadyFCUkr convF zss tss+ | null zss = []+ | null tss = []+ | (isStr . head $ tss) && (isStr . head $ zss) = fromHeapReadyFCUkr (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss+ | (isFSL . head $ tss) && (isFSL . head $ zss) = fromHeapReadyFCUkr (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss+ | isStr . head $ tss = fromHeapReadyFCUkr (head zss) . Heap.intersect (toHeapR zss) . toHeapR . map (FSL . convF . fromJust . fromReadyFCUkrS) $ tss+ | otherwise = fromHeapReadyFCUkr (head tss) . Heap.intersect (toHeapR . map (FSL . convF . fromJust . fromReadyFCUkrS) $ zss) . toHeapR $ tss+{-# INLINE intersectInterReadyFCUkr #-}++intersectInterReadyFCUkr2 :: String -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr] -> [ReadyForConstructionUkr]+intersectInterReadyFCUkr2 ts = intersectInterReadyFCUkr (convFI ts)+{-# INLINE intersectInterReadyFCUkr2 #-}+ -- | Auxiliary printing function to define the line ending in some cases. Is taken from the -- Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package newLineEnding :: String newLineEnding   | nativeNewline == LF = "\n"   | otherwise = "\r\n"++  +foldlI :: String -> [[ReadyForConstructionUkr]] -> [ReadyForConstructionUkr]+foldlI ts jss@((!xs):ys:xss) + | null pss = foldlI' ts qss+ | null qss = foldlI' ts pss+ | otherwise = intersectInterReadyFCUkr2 ts (foldlI' ts pss) (foldlI' ts qss) +  where (pss,qss) = partition (< [FSL []]) jss+        foldlI' ts rss@(rs:ps:yss) = foldlI' ts (intersectInterReadyFCUkr2 ts rs ps : yss)+        foldlI' ts ((!xs):_) = xs+        foldlI' _ _ = []+foldlI _ ((!xs):_) = xs+foldlI _ _ = []+

@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/  name:                phonetic-languages-simplified-examples-common-version:             0.4.6.0+version:             0.5.0.0 synopsis:            Some commonly used by phonetic-languages-simplified* series functions. description:         Are intended to be used by the phonetic-languages-simplified-lists-examples and phonetic-languages-simplified-examples-array packages. homepage:            https://hackage.haskell.org/package/phonetic-languages-simplified-examples-common@@ -20,6 +20,6 @@   exposed-modules:     Phonetic.Languages.Simplified.DeEnCoding, Phonetic.Languages.Simplified.SimpleConstraints, Phonetic.Languages.Common   -- other-modules:   other-extensions:    BangPatterns-  build-depends:       base >=4.8 && <5, heaps >= 0.3.6.1 && <1, phonetic-languages-ukrainian-array ==0.9.3.0+  build-depends:       base >=4.8 && <5, heaps >= 0.3.6.1 && <1, phonetic-languages-ukrainian-array ==0.9.3.0, phonetic-languages-simplified-properties-array ==0.15.0.0, ukrainian-phonetics-basic-array ==0.6.0.0   -- hs-source-dirs:   default-language:    Haskell2010