diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -135,3 +135,9 @@ allow to specify whether to add
html tag to each line in the two-column output and to what file print additionally two-column output. +## 0.12.0.0 -- 2023-11-11 + +* Twelfth version. Added a new functionality related to the comparison of similarity of two + lists. Use for this +l2 ... -l2 group of command line options. This leads to changes in functions +signatures, too. + diff --git a/Phladiprelio/General/Simple.hs b/Phladiprelio/General/Simple.hs --- a/Phladiprelio/General/Simple.hs +++ b/Phladiprelio/General/Simple.hs @@ -4,7 +4,7 @@ import GHC.Base import GHC.Enum (fromEnum,toEnum) -import GHC.Real (fromIntegral,(/),quot,rem,quotRem) +import GHC.Real (fromIntegral,(/),quot,rem,quotRem,round,gcd) import Text.Show (Show(..)) import Phladiprelio.General.PrepareText import Phladiprelio.General.Syllables @@ -35,10 +35,13 @@ import Control.Concurrent.Async (mapConcurrently) import Phladiprelio.Tests import Phladiprelio.General.Datatype (readBasic3, readBasic4, readBasic1G) +import Phladiprelio.General.Distance import Phladiprelio.UniquenessPeriodsG generalF - :: Bool -- ^ If 'True' then adds \"
\" to line endings for double column output + :: Int -- ^ A 'length' of the next argument here. + -> [Double] -- ^ A list of non-negative values normed by 1.0 (the greatest of which is 1.0) that the line options are compared with. If null, then the program works as for version 0.12.1.0 without this newly-introduced argument since the version 0.13.0.0. The length of it must be a least common multiplier of the (number of syllables plus number of \'_digits\' groups) to work correctly. Is not used when the next 'FilePath' and 'String' arguments are not null. + -> Bool -- ^ If 'True' then adds \"
\" to line endings for double column output -> FilePath -- ^ A path to the file to save double columns output to. If empty then just prints to 'stdout'. -> String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types' -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#selectSounds. Use just small 'Char' if they are letters, do not use \'.\' and spaces. @@ -63,30 +66,30 @@ -> String -- ^ An initial string to be analyzed. -> [String] -> IO [String] -generalF html dcfile selStr selFun (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (fs, code) concurrently initstr universalSet +generalF ldc compards html dcfile selStr selFun (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (fs, code) concurrently initstr universalSet | null universalSet = let strOutput = ["You have specified the data and constraints on it that lead to no further possible options.", "Please, specify another data and constraints."] in mapM putStrLn strOutput >> return strOutput | length universalSet == 1 = mapM putStrLn universalSet >> return universalSet | otherwise = do let syllN = countSyll wrs arr us vs initstr -- universalSet = map unwords . permutations $ rss - f grps mxms - | null selStr = sum . countHashes2G hashStep hc grps mxms . readBasic3 (h . createSyllablesPL wrs ks arr gs us vs) (mconcat) + f ldc compards grps mxms + | null selStr = (if null compards then (sum . countHashes2G hashStep hc grps mxms) else (round . (*10000) . distanceSqrG2 ldc compards)) . readBasic3 (h . createSyllablesPL wrs ks arr gs us vs) (mconcat) | otherwise = fromIntegral . diverse2GGL (selectSounds selFun selStr) (us `mappend` vs) . concatMap string1 . stringToXG wrs . filter (\c -> not (isDigit c) && c /= '_') hSetNewlineMode stdout universalNewlineMode - if numTest >= 0 && numTest <= 179 && numTest /= 1 then do + if numTest >= 0 && numTest <= 179 && numTest /= 1 && null compards then do putStrLn "Feet Val Stat Proxim" (if concurrently then mapConcurrently else mapM) (\(q,qs) -> let m = stat1 syllN (q,qs) - (min1,max1) = minMax11ByCList (comparing (f q qs)) universalSet - mx = f q qs max1 + (min1,max1) = minMax11ByCList (comparing (f ldc [] q qs)) universalSet + mx = f ldc [] q qs max1 strTest = (show (fromEnum q) `mappend` " | " `mappend` show mx `mappend` " " `mappend` show m `mappend` " -> " `mappend` showFFloat (Just 3) (100 * fromIntegral mx / fromIntegral m) "%" `mappend` (if rem numTest 10 >= 4 - then let min1 = minimumBy (comparing (f q qs)) universalSet in ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n") + then let min1 = minimumBy (comparing (f ldc [] q qs)) universalSet in ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n") else "")) in putStrLn strTest >> return strTest) . zip (sel2 numTest) $ (sel numTest) else let sRepresent = zipWith (\k (x, ys) -> S k x ys) [1..] . - (let h1 = if descending then (\(u,w) -> ((-1)*u,w)) else id in sortOn h1) . map (\xss -> (f grps mxms xss, xss)) $ universalSet + (let h1 = if descending then (\(u,w) -> ((-1)*u,w)) else id in sortOn h1) . map (\xss -> (f ldc compards grps mxms xss, xss)) $ universalSet strOutput = (:[]) . halfsplit1G (\(S _ y _) -> y) (if html then "
" else "") (jjj splitting) $ sRepresent in do - _ <- (if null dcfile then mapM putStrLn strOutput else do {mapM putStrLn strOutput >> doesFileExist dcfile >>= \exist -> if exist then do {getPermissions dcfile >>= \perms -> if writable perms then mapM (writeFile dcfile) strOutput else error $ "Phladiprelio.Ukrainian.IO.generalF: File " `mappend` dcfile `mappend` " is not writable!"} else do {getCurrentDirectory >>= \currdir -> do {getPermissions currdir >>= \perms -> if writable perms then mapM (writeFile dcfile) strOutput else error $ "Phladiprelio.Ukrainian.IO.generalF: Directory of the file " `mappend` dcfile `mappend` " is not writable!"}}}) + _ <- (if null dcfile then mapM putStrLn strOutput else do {mapM putStrLn strOutput >> doesFileExist dcfile >>= \exist -> if exist then do {getPermissions dcfile >>= \perms -> if writable perms then mapM (writeFile dcfile) strOutput else error $ "Phladiprelio.General.IO.generalF: File " `mappend` dcfile `mappend` " is not writable!"} else do {getCurrentDirectory >>= \currdir -> do {getPermissions currdir >>= \perms -> if writable perms then mapM (writeFile dcfile) strOutput else error $ "Phladiprelio.General.IO.generalF: Directory of the file " `mappend` dcfile `mappend` " is not writable!"}}}) let l1 = length sRepresent if code == -1 then if lineNmb == -1 then return strOutput @@ -100,7 +103,7 @@ let writ = writable permiss readab = readable permiss if writ && readab then do - if null selStr then do + if null selStr && null compards then do let lineOption = head . filter (\(S k _ ts) -> k == num) $ sRepresent textP = (\(S _ _ ts) -> ts) lineOption sylls = createSyllablesPL wrs ks arr gs us vs textP @@ -173,14 +176,23 @@ mind. -} argsProcessing - :: [[String]] + :: 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 + -> SegmentRulesG + -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package. + -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package. + -> ([[[PRS]]] -> [[Double]]) -> [[String]] + -> [[String]] -> String - -> IO (Bool, FilePath, String, String, String, Int, Bool, Int8, FilePath, Int, Bool, String, [String]) -- ^ These ones are intended to be used inside 'generalF'. -argsProcessing ysss zsss xs = do + -> IO (Int, [Double], Bool, FilePath, String, String, String, Int, Bool, Int8, FilePath, Int, Bool, String, [String]) -- ^ These ones are intended to be used inside 'generalF'. +argsProcessing wrs ks arr gs us vs h ysss zsss xs = do args0 <- getArgs let (argsC, args) = takeCs1R ('+','-') cSpecs args0 (argsB, args11) = takeBsR bSpecs args + line2comparewith = unwords . getC "+l2" $ argsC + basecomp = readBasic3 (h . createSyllablesPL wrs ks arr gs us vs) (mconcat) line2comparewith prepare = any (== "-p") args11 emptyline = any (== "+l") args11 splitting = fromMaybe 50 (readMaybe (concat . getB "+w" $ argsB)::Maybe Int8) @@ -229,8 +241,16 @@ | null argCs = genPermutationsL l | otherwise = decodeLConstraints argCs . genPermutationsL $ l basiclineoption = unwords arg3s + example = readBasic3 (h . createSyllablesPL wrs ks arr gs us vs) (mconcat) (unwords arg3s) + le = length example + lb = length basecomp + gcd1 = gcd le lb + ldc = le * lb `quot` gcd1 + mulp = ldc `quot` lb + max2 = maximum basecomp + compards = concatMap (replicate mulp . (/ max2)) basecomp variants1 = uniquenessVariants2GNBL ' ' id id id perms ll - return (html, dcfile, selStr, prestr, poststr, lineNmb, emptyline, splitting, filesave, codesave, concurrently, basiclineoption, variants1) + return (ldc, compards, html, dcfile, selStr, prestr, poststr, lineNmb, emptyline, splitting, filesave, codesave, concurrently, basiclineoption, variants1) processingF :: (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces. @@ -250,14 +270,14 @@ -> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12. -> String -> IO () -processingF selFun wrs ks arr gs us vs h numTest hc (grps,mxms) ysss zsss descending hashStep xs = argsProcessing ysss zsss xs >>= \(html, dcfile, selStr, prestr, poststr, lineNmb, emptyline, splitting, filesave, codesave, concurrently, basiclineoption, variants1) -> generalF html dcfile selStr selFun (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (filesave, codesave) concurrently basiclineoption variants1 >> return () +processingF selFun wrs ks arr gs us vs h numTest hc (grps,mxms) ysss zsss descending hashStep xs = argsProcessing wrs ks arr gs us vs h ysss zsss xs >>= \(ldc, compards, html, dcfile, selStr, prestr, poststr, lineNmb, emptyline, splitting, filesave, codesave, concurrently, basiclineoption, variants1) -> generalF ldc compards html dcfile selStr selFun (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (filesave, codesave) concurrently basiclineoption variants1 >> return () {-# INLINE processingF #-} -- | Specifies the group of the command line arguments for 'processingF', which specifies the -- PhLADiPreLiO constraints. For more information, see: -- https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints cSpecs :: CLSpecifications -cSpecs = zip ["+a","+b"] . cycle $ [-1] +cSpecs = zip ["+a","+b","+l2"] . cycle $ [-1] bSpecs :: CLSpecifications bSpecs = [("+f",2),("+m",2),("+ul",1),("+w",1),("+dc",2)] diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -54,6 +54,10 @@ of the parallel project usage: [https://www.youtube.com/watch?v=zapAPpQ-fc4](https://www.youtube.com/watch?v=zapAPpQ-fc4) +Since the version 0.12.0.0 there is a possibility to compare the distances (opposite to the +similarity measure) for the line options using the +l2 ... -l2 command line group of options. It is +generally a completely new functionality for the package. + For the list of bash aliases a few of which are used in the videos, see: https://github.com/Oleksandr-Zhabenko/phladiprelio-alias/blob/main/.bashrc @@ -102,6 +106,8 @@ celebrations — Intercession of the Holy Theotokos (Pokrova), Cossacks' Day, Day of Defenders of Ukraine (especially relevant during the Russian war against Ukraine). On the 01/11/2023 there is All Saints Solemnity for Roman Catholics. + +On the 11/11/2023 there is St. Martin of Tours Day for Roman Catholics and Poland Independence Day. All support is welcome, including donations for the needs of the Ukrainian army, IDPs and refugees. diff --git a/phladiprelio-general-simple.cabal b/phladiprelio-general-simple.cabal --- a/phladiprelio-general-simple.cabal +++ b/phladiprelio-general-simple.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: phladiprelio-general-simple -version: 0.11.1.0 +version: 0.12.0.0 -- A short (one-line) description of the package. synopsis: A generalized functionality of PhLADiPreLiO for different languages that uses hash algorithms. @@ -28,7 +28,7 @@ -- LANGUAGE extensions used by modules in this package. other-extensions: NoImplicitPrelude, BangPatterns - build-depends: base >=4.13 && <5, rhythmic-sequences ==0.4.1.0, phonetic-languages-phonetics-basics ==0.10.1.0, phladiprelio-general-shared ==0.1.1.0, cli-arguments ==0.7.0.0, phonetic-languages-permutations-array ==0.4.0.0, phonetic-languages-constraints-array ==0.7.3.0, phonetic-languages-simplified-base ==0.7.1.0, halfsplit ==0.4.1.0, directory >=1.3.4.0 && <2, rev-scientific ==0.2.1.0, async >=2.2.2 && <3, phladiprelio-tests ==0.1.0.0, phladiprelio-general-datatype ==0.3.1.0, phonetic-languages-basis ==0.3.0.0 + build-depends: base >=4.13 && <5, rhythmic-sequences ==0.4.1.0, phonetic-languages-phonetics-basics ==0.10.1.0, phladiprelio-general-shared ==0.1.1.0, cli-arguments ==0.7.0.0, phonetic-languages-permutations-array ==0.4.0.0, phonetic-languages-constraints-array ==0.7.3.0, phonetic-languages-simplified-base ==0.7.1.0, halfsplit ==0.4.1.0, directory >=1.3.4.0 && <2, rev-scientific ==0.2.1.0, async >=2.2.2 && <3, phladiprelio-tests ==0.1.0.0, phladiprelio-general-datatype ==0.4.1.0, phonetic-languages-basis ==0.3.0.0 hs-source-dirs: . default-language: Haskell2010