diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -37,3 +37,12 @@ related functionality. Added also the possibility to not only prepend needed words, but also append. This introduces breaking changes, so please, wait for update for all the dependent packages before starting the upgrade, also check the code that uses library functions afterwards. + +## 0.5.0.0 -- 2022-08-09 + +* Fifth version. Added phonetic-languages-simplified-generalized-properties-array as a +dependency. Updated the code in the Phonetic.Languages.General.DeEnCoding module +to support the 10 words long lines in the reduced set of permuations mode. Switched to the +new model of computations which supports two modes instead of just one -- PhoPaaW and SaaW. +Some code improvements. + diff --git a/Phonetic/Languages/General/DeEnCoding.hs b/Phonetic/Languages/General/DeEnCoding.hs --- a/Phonetic/Languages/General/DeEnCoding.hs +++ b/Phonetic/Languages/General/DeEnCoding.hs @@ -4,14 +4,14 @@ -- | -- Module : Phonetic.Languages.General.DeEnCoding --- Copyright : (c) OleksandrZhabenko 2020-2021 +-- Copyright : (c) OleksandrZhabenko 2020-2022 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- Functions to encode and decode 'String' -> \['Int8'\] used in the Simple/Main.hs code. --- Is taken from the @phonetic-languages-simplified-lists-examples@ package. --- Is taken from the module Phonetic.Languages.Simplified.DeEnCoding from the +-- Firstly were taken from the @phonetic-languages-simplified-lists-examples@ package. +-- Is modified from the module Phonetic.Languages.Simplified.DeEnCoding from the -- @phonetic-languages-simplified-examples-common@ package. module Phonetic.Languages.General.DeEnCoding where @@ -20,15 +20,26 @@ 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.EmphasisG +--import Melodics.Ukrainian.ArrInt8 (FlowSound) +--import Languages.Phonetic.Ukrainian.Syllable.ArrInt8 +import Data.Phonetic.Languages.Base +import Data.Phonetic.Languages.Syllables --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 #-} + -- | Is taken mostly from the Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG module from the @phonetic-languages-simplified-common@ package. indexedL :: Foldable t => b -> t b -> [(Int8, b)] indexedL y zs = foldr f v zs @@ -48,19 +59,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. +-- +decodeToReadyFCPL :: [Int8] -> ReadyForConstructionPL -> ReadyForConstructionPL +decodeToReadyFCPL ys (StrG ts) = StrG . unwords . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort . words $ ts +decodeToReadyFCPL ys (FSLG tsss) = FSLG . map snd . sortBy (\x y -> compare (fst x) (fst y)) . zip ys . sort $ tsss +{-# INLINE decodeToReadyFCPL #-} + -- | Every 'String' consists of words with whitespace symbols in between. toHeap :: [String] -> Heap Int toHeap yss@(xs:xss) @@ -69,21 +87,89 @@ 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 :: [ReadyForConstructionPL] -> Heap Int +toHeapR yss@(xs@(StrG ts):xss) + | null xss = Heap.singleton . encodeToInt . words $ ts + | otherwise = Heap.fromList . map (encodeToInt . words . fromJust . fromReadyFCPLS) $ yss +toHeapR yss@(xs@(FSLG tsss):xss) + | null xss = Heap.singleton . encodeToInt $ tsss + | otherwise = Heap.fromList . map (encodeToInt . fromJust . fromReadyFCPLF) $ 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 #-} +fromHeapReadyFCPL :: ReadyForConstructionPL -> Heap Int -> [ReadyForConstructionPL] +fromHeapReadyFCPL ys heap + | Heap.null heap = [] + | otherwise = map (flip decodeToReadyFCPL ys . int2l) . Heap.toUnsortedList $ heap +{-# INLINE fromHeapReadyFCPL #-} + 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. +intersectInterReadyFCPL :: (String -> [[[Int8]]]) -> [ReadyForConstructionPL] -> [ReadyForConstructionPL] -> [ReadyForConstructionPL] +intersectInterReadyFCPL convF zss tss + | null zss = [] + | null tss = [] + | (isStr . head $ tss) && (isStr . head $ zss) = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss + | (isFSL . head $ tss) && (isFSL . head $ zss) = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR $ tss + | isStr . head $ tss = fromHeapReadyFCPL (head zss) . Heap.intersect (toHeapR zss) . toHeapR . map (FSLG . convF . fromJust . fromReadyFCPLS) $ tss + | otherwise = fromHeapReadyFCPL (head tss) . Heap.intersect (toHeapR . map (FSLG . convF . fromJust . fromReadyFCPLS) $ zss) . toHeapR $ tss +{-# INLINE intersectInterReadyFCPL #-} + +intersectInterReadyFCPL2 + :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text. + -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon + -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly. + -> SegmentRulesG + -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package. + -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package. + -> String + -> [ReadyForConstructionPL] + -> [ReadyForConstructionPL] + -> [ReadyForConstructionPL] +intersectInterReadyFCPL2 wrs ks arr hs us vs ts = intersectInterReadyFCPL (convFI wrs ks arr hs us vs ts) +{-# INLINE intersectInterReadyFCPL2 #-} + -- | 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 + :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text. + -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon + -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly. + -> SegmentRulesG + -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package. + -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package. + -> String + -> [[ReadyForConstructionPL]] + -> [ReadyForConstructionPL] +foldlI wrs ks arr hs us vs ts jss@((!xs):ys:xss) + | null pss = foldlI' wrs ks arr hs us vs ts qss + | null qss = foldlI' wrs ks arr hs us vs ts pss + | otherwise = intersectInterReadyFCPL2 wrs ks arr hs us vs ts (foldlI' wrs ks arr hs us vs ts pss) (foldlI' wrs ks arr hs us vs ts qss) + where (pss,qss) = partition (< [FSLG []]) jss + foldlI' wrs ks arr hs us vs ts rss@(rs:ps:yss) = foldlI' wrs ks arr hs us vs ts (intersectInterReadyFCPL2 wrs ks arr hs us vs ts rs ps : yss) + foldlI' wrs ks arr hs us vs ts ((!xs):_) = xs + foldlI' _ _ _ _ _ _ _ _ = [] +foldlI _ _ _ _ _ _ _ ((!xs):_) = xs +foldlI _ _ _ _ _ _ _ _ = [] + diff --git a/phonetic-languages-simplified-generalized-examples-common.cabal b/phonetic-languages-simplified-generalized-examples-common.cabal --- a/phonetic-languages-simplified-generalized-examples-common.cabal +++ b/phonetic-languages-simplified-generalized-examples-common.cabal @@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/ name: phonetic-languages-simplified-generalized-examples-common -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Some common code for phonetic languages generalized functionality. description: Is intended to be used in the phonetic-languages-simplified-generalized-examples-array package. homepage: https://hackage.haskell.org/package/phonetic-languages-simplified-generalized-examples-common @@ -11,7 +11,7 @@ license-file: LICENSE author: Oleksandr Zhabenko maintainer: olexandr543@yahoo.com -copyright: Oleksandr Zhabenko 2020-2021 +copyright: Oleksandr Zhabenko 2020-2022 category: Language, Math, Game build-type: Simple extra-source-files: ChangeLog.md @@ -21,6 +21,6 @@ exposed-modules: Phonetic.Languages.General.SimpleConstraints, Phonetic.Languages.General.Common, Phonetic.Languages.General.DeEnCoding -- other-modules: other-extensions: BangPatterns, FlexibleContexts - build-depends: base >=4.8 && <5, phonetic-languages-phonetics-basics >=0.9 && <1, heaps >=0.3.6.1 && <1 + build-depends: base >=4.8 && <5, phonetic-languages-phonetics-basics ==0.9.0.0, phonetic-languages-simplified-generalized-properties-array ==0.11.0.0, heaps >=0.3.6.1 && <1 -- hs-source-dirs: default-language: Haskell2010