packages feed

phonetic-languages-simplified-base (empty) → 0.1.0.0

raw patch · 7 files changed

+315/−0 lines, 7 filesdep +basedep +phonetic-languages-permutations-arraydep +subGsetup-changed

Dependencies added: base, phonetic-languages-permutations-array, subG

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for phonetic-languages-simplified-base++## 0.1.0.0 -- 2020-12-31++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 OleksandrZhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Phonetic/Languages/Simplified/DataG/Base.hs view
@@ -0,0 +1,148 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phonetic.Languages.Simplified.DataG.Base+-- Copyright   :  (c) OleksandrZhabenko 2020+-- 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.Simplified.DataG.Base where++import qualified Data.Foldable as F+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++data FuncRep2 a b c = D (a -> b) (b -> c)++getAC :: FuncRep2 a b c -> (a -> c)+getAC (D f g) = g . f++getAB :: FuncRep2 a b c -> (a -> b)+getAB (D f _) = f++getBC :: FuncRep2 a b c -> (b -> c)+getBC (D _ g) = g++maximumEl+  :: (Foldable t2, Ord c) => FuncRep2 (t a) b c+  -> t2 (t a)+  -> Result t a b c+maximumEl !frep2 data0 =+  let !l = F.maximumBy (\x y -> compare (getAC frep2 x) (getAC frep2 y)) data0+      !m = getAB frep2 l+      !tm = getBC frep2 m in R {line = l, propertiesF = m, transPropertiesF = tm}++minMaximumEls+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord (t a), Ord c) => FuncRep2 (t a) b c+  -> t2 (t a)+  -> (Result t a b c,Result t a b c)+minMaximumEls !frep2 data0 =+  let (!ln,!lx) = minMax11ByC (\x y -> compare (getAC frep2 x) (getAC frep2 y)) data0+      !mn = getAB frep2 ln+      !mx = getAB frep2 lx+      !tmn = getBC frep2 mn+      !tmx = getBC frep2 mx in (R {line = ln, propertiesF = mn, transPropertiesF = tmn}, R {line = lx, propertiesF = mx, transPropertiesF = tmx})++maximumElR+  :: (Foldable t2, Ord c) => t2 (Result t a b c)+  -> Result t a b c+maximumElR = F.maximumBy (\x y -> compare (transPropertiesF x) (transPropertiesF y))++minMaximumElRs+  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), Ord (t a), Ord b, Ord c) => t2 (Result t a b c)+  -> (Result t a b c,Result t a b c)+minMaximumElRs = minMax11ByC (\x y -> compare (transPropertiesF x) (transPropertiesF y))++-----------------------------------------------------------------------------------++-- | The second argument must be not empty for the function to work correctly.+innerPartitioning+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), InsertLeft t2 c, Monoid (t2 c), Ord c) => FuncRep2 (t a) b c+  -> t2 (t a)+  -> (t2 (t a), t2 (t a))+innerPartitioning !frep2 data0 =+  let !l = F.maximum . mapG (toTransPropertiesF' frep2) $ data0 in partitionG ((== l) . getAC frep2) data0++-- | The second 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))+innerPartitioningR dataR =+  let !l = F.maximum . mapG transPropertiesF $ dataR in partitionG ((== l) . transPropertiesF) dataR++maximumGroupsClassification+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> FuncRep2 (t a) b c+  -> (t2 (t a), t2 (t a))+  -> (t2 (t a), t2 (t a))+maximumGroupsClassification !nGroups !frep2 (dataT,dataF)+ | F.null dataF = (dataT,mempty)+ | nGroups <= 0 = (dataT,dataF)+ | otherwise = maximumGroupsClassification (nGroups - 1) frep2 (dataT `mappend` partT,partF)+     where (!partT,!partF) = innerPartitioning frep2 dataF++maximumGroupsClassification1+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> FuncRep2 (t a) b c+  -> t2 (t a)+  -> (t2 (t a), t2 (t a))+maximumGroupsClassification1 !nGroups !frep2 data0+ | F.null data0 = (mempty,mempty)+ | nGroups <= 0 = innerPartitioning frep2 data0+ | otherwise = maximumGroupsClassification (nGroups - 1) frep2 . innerPartitioning frep2 $ data0++maximumGroupsClassificationR2+  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> (t2 (Result t a b c), t2 (Result t a b c))+  -> (t2 (Result t a b c), t2 (Result t a b c))+maximumGroupsClassificationR2 !nGroups (dataT,dataF)+ | F.null dataF = (dataT,mempty)+ | nGroups <= 0 = (dataT,dataF)+ | otherwise = maximumGroupsClassificationR2 (nGroups - 1) (dataT `mappend` partT,partF)+     where (!partT,!partF) = innerPartitioningR dataF++maximumGroupsClassificationR+  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), InsertLeft t2 c, Monoid (t2 c), Ord c, Integral d) => d+  -> t2 (Result t a b c)+  -> (t2 (Result t a b c), t2 (Result t a b c))+maximumGroupsClassificationR !nGroups dataR+ | F.null dataR = (mempty,mempty)+ | nGroups <= 0 = innerPartitioningR dataR+ | otherwise = maximumGroupsClassificationR2 (nGroups - 1) . innerPartitioningR $ dataR++toResultR+  :: FuncRep2 (t a) b c+  -> t a+  -> Result t a b c+toResultR !frep2 !ys = R { line = ys, propertiesF = m, transPropertiesF = tm}+  where !m = getAB frep2 ys+        !tm = getBC frep2 m++toPropertiesF'+  :: FuncRep2 (t a) b c+  -> t a+  -> b+toPropertiesF' !frep2 !ys = getAB frep2 ys++toTransPropertiesF'+  :: FuncRep2 (t a) b c+  -> t a+  -> c+toTransPropertiesF' !frep2 !ys = getAC frep2 ys
+ Phonetic/Languages/Simplified/Lists/UniquenessPeriodsG/Base.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base+-- Copyright   :  (c) OleksandrZhabenko 2020+-- 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+  diverse2GL+)where++import GHC.Int+import Data.List+import Data.Maybe (mapMaybe)++-- | A lists variant of the diverse2 metrics from the @phonetic-languages-properties@ package.+diverse2GL :: Foldable t => String -> t Char -> Int16+diverse2GL whspss ws+ | null ws = 0+ | otherwise = sum . mapMaybe (helpG sum whspss) . unfoldr f $ ks+     where !ks = indexedL '\00' ws+           !vs = mapMaybe g ks+           g x+            | (`elem` whspss) . snd $ x = Just (fst x)+            | otherwise = Nothing+           {-# INLINE g #-}+           f !x = if null x then Nothing else 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++-- | 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/Simplified/StrictVG/Base.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phonetic.Languages.Simplified.StrictVG.Base+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Simplified version of the @phonetic-languages-common@ package.+-- Uses less dependencies.++{-# LANGUAGE BangPatterns #-}++module Phonetic.Languages.Simplified.StrictVG.Base (+  -- * Working with lists+  uniquenessVariants2GNBL+  , uniquenessVariants2GNPBL+) where++import Phonetic.Languages.Permutations.Arr+import Phonetic.Languages.Simplified.DataG.Base+import qualified Data.Foldable as F+import Data.SubG+import GHC.Arr+import Data.Monoid++uniquenessVariants2GNBL ::+  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) => a -- ^ The first most common element in the \"whitespace symbols\" structure+  -> (t a -> [a]) -- ^ The function that is used internally to convert to the @[a]@ so that the function can process further the permutations+  -> ((t (t a)) -> [[a]]) -- ^ The function that is used internally to convert to the @[[a]]@ so that the function can process further+  -> ([a] -> t a) -- ^ The function that is used internally to convert to the needed representation so that the function can process further+  -> [Array Int Int] -- ^ The permutations of 'Int' indices starting from 0 and up to n (n is probably less than 8).+  -> t (t a) -- ^ Must be obtained as 'subG' @whspss xs@+  -> [t a]+uniquenessVariants2GNBL !hd f1 f2 f3 perms !subs = uniquenessVariants2GNPBL mempty mempty hd f1 f2 f3 perms subs+{-# INLINE uniquenessVariants2GNBL #-}++uniquenessVariants2GNPBL ::+  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) => t a+  -> t a+  ->  a -- ^ The first most common element in the whitespace symbols structure+  -> (t a -> [a]) -- ^ The function that is used internally to convert to the @[a]@ so that the function can process further the permutations+  -> ((t (t a)) -> [[a]]) -- ^ The function that is used internally to convert to the @[[a]]@ so that the function can process further+  -> ([a] -> t a) -- ^ The function that is used internally to convert to the needed representation that the function can process further+  -> [Array Int Int] -- ^ The permutations of 'Int' indices starting from 0 and up to n (n is probably less than 7).+  -> t (t a) -- ^ Must be obtained as @subG whspss xs@+  -> [t a]+uniquenessVariants2GNPBL !ts !us !hd f1 f2 f3 perms !subs+  | F.null subs = mempty+  | otherwise =+     let !uss = (hd %@ us) %^ mempty+         !base0 = map (hd %@) . f2 $ subs+         !l = length base0+         !baseArr = listArray (0,l - 1) base0+         !ns = universalSetGL ts uss f1 f2 perms baseArr in map f3 ns+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ phonetic-languages-simplified-base.cabal view
@@ -0,0 +1,26 @@+-- Initial phonetic-languages-simplified-base.cabal generated by cabal+-- init.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                phonetic-languages-simplified-base+version:             0.1.0.0+synopsis:            A simplified version of the phonetic-languages functionality common for some different realizations.+description:         A simplified version of the phonetic-languages functionality. Tries to use only necessary functionality and reduce the other ones.+homepage:            https://hackage.haskell.org/package/phonetic-languages-simlified-base+license:             MIT+license-file:        LICENSE+author:              OleksandrZhabenko+maintainer:          olexandr543@yahoo.com+copyright:           Oleksandr Zhabenko+category:            Language,Math,Game+build-type:          Simple+extra-source-files:  CHANGELOG.md+cabal-version:       >=1.10++library+  exposed-modules:     Phonetic.Languages.Simplified.DataG.Base, Phonetic.Languages.Simplified.StrictVG.Base, Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base+  -- other-modules:+  other-extensions:    BangPatterns, FlexibleContexts, MultiParamTypeClasses+  build-depends:       base >=4.8 && <4.15, subG >=0.4.2 && <1, phonetic-languages-permutations-array >=0.1 && <1+  -- hs-source-dirs:+  default-language:    Haskell2010