phonetic-languages-constraints-array 0.4.1.0 → 0.5.0.0
raw patch · 4 files changed
+62/−87 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Phladiprelio.ConstraintsEncoded: readMaybeEC :: Int -> String -> Maybe EncodedCnstrs
- Phladiprelio.ConstraintsEncoded: E :: a -> EncodedContraints a b
+ Phladiprelio.ConstraintsEncoded: E :: EncodedContraints a b
Files
- CHANGELOG.md +5/−0
- Phladiprelio/Constraints.hs +8/−8
- Phladiprelio/ConstraintsEncoded.hs +48/−78
- phonetic-languages-constraints-array.cabal +1/−1
CHANGELOG.md view
@@ -32,3 +32,8 @@ * Fourth version revised. Changed the number of parameters for the new constructors added. Added isM function to the export from the module. +## 0.5.0.0 -- 2023-05-17++* Fifth version. Changed representation in the EncodedCnstr data type. Removed the readMaybeEC+function. Reduced code duplication. Switched the way of counting -- moved all to one natural base+of 1 and more.
Phladiprelio/Constraints.hs view
@@ -9,8 +9,8 @@ -- -- Provides several the most important variants of constraints for the -- permutations. All the 'Array'--- here must consists of unique 'Int' starting from 0 to n and the 'Int'--- arguments must be in the range [0..n] though these inner constraints are+-- here must consists of unique 'Int' starting from 0 to n-1 and the 'Int'+-- arguments must be in the range [0..n-1] though these inner constraints are -- not checked. It is up to user to check them. -- Uses arrays instead of vectors. -- The word \"unsafe\" in the names means that there is no checking whether the arguments are @@ -120,7 +120,7 @@ filterMixedDistanceIJK3 i j k d1 d2 = filterG (\arr -> unsafeSignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr) -- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of--- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication if the+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication if the -- arguments are the indeces of the duplicated words or their concatenated combinations in the corresponding line. -- The first three arguments -- are the indices of the the triple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).@@ -128,7 +128,7 @@ unsafeTriples i j k = filterG (\v -> unsafeOrderIJ i j v && unsafeOrderIJ j k v) -- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of--- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication if the+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication if the -- arguments are the indeces of the duplicated words or their concatenated combinations in the corresponding line. -- The first four arguments -- are the indices of the the quadruple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).@@ -136,20 +136,20 @@ unsafeQuadruples i j k l = filterG (\v -> unsafeOrderIJ i j v && unsafeOrderIJ j k v && unsafeOrderIJ k l v) -- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of--- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication.+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication. -- The first argument -- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument--- is 'Array' 'Int' of indices that are in the range [0..n]. Filters (and reduces further complex computations) the permutations so that only the+-- is 'Array' 'Int' of indices that are in the range [0..n-1]. Filters (and reduces further complex computations) the permutations so that only the -- variants with the indices in the second argument all stand AFTER the element with the index equal to the first argument. unsafeSeveralA :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int) unsafeSeveralA !i0 arr x = filterG (g i0 arr) x where g !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ i0 k arr2) arr1 -- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of--- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication.+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication. -- The first argument -- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument--- is 'Array' of indices that are in the range [0..n]. Filters (and reduces further complex computations) the permutations so that only the+-- is 'Array' of indices that are in the range [0..n-1]. Filters (and reduces further complex computations) the permutations so that only the -- variants with the indices in the second argument all stand BEFORE the element with the index equal to the first argument. unsafeSeveralB :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int) unsafeSeveralB !i0 arr x = filterG (g i0 arr) x
Phladiprelio/ConstraintsEncoded.hs view
@@ -18,8 +18,7 @@ , EncodedCnstrs -- * Functions to work with them -- ** Read functions- , readMaybeEC- , readMaybeECG+ , readMaybeECG -- ** Process-encoding functions , decodeConstraint1 , decodeLConstraints@@ -47,98 +46,69 @@ import Text.Show (show) import Text.Read (readMaybe) import Data.Maybe+import Data.List (nub) import GHC.Arr import Phladiprelio.Constraints import Data.SubG (InsertLeft(..)) -data EncodedContraints a b = E a | P a b | Q a a a a a | T a a a a | SA a a b | SB a a b | F a a a | V a a a | W a a a | H a a a a | R a a a a | M a a a a deriving (Eq, Ord)+data EncodedContraints a b = E + | P a b + | Q a a a a a + | T a a a a + | SA a a b + | SB a a b + | F a a a + | V a a a + | W a a a + | H a a a a + | R a a a a + | M a a a a + deriving (Eq, Ord) -- | Inspired by the: https://hackage.haskell.org/package/base-4.14.0.0/docs/Data-Maybe.html--- Is provided here as a more general way to read the 'String' into a 'EncodedCnstrs' than more restricted--- but safer 'readMaybeECG'. It is up to user to check whether the parameters are in the correct form, the function does--- not do the full checking. For phonetic-languages applications, it is better to use 'readMaybeECG' function instead.-readMaybeEC :: Int -> String -> Maybe EncodedCnstrs-readMaybeEC n xs+-- Is provided here as a more general way to read the 'String' into a 'EncodedCnstrs'. +-- It is up to user to check whether the parameters are in the correct form, the function does+-- not do the full checking.+readMaybeECG :: Int -> String -> Maybe EncodedCnstrs+readMaybeECG n xs | null xs = Nothing | n >=0 && n <= 9 = let h = head xs ts = filter (\x -> x >= '0' && [x] <= show n) . tail $ xs in case h of- 'E' -> Just (E (fromMaybe 0 (readMaybe (take 1 . tail $ xs)::Maybe Int)))- 'F' -> let (y,z) = (readMaybe (take 1 ts)::Maybe Int, readMaybe (take 1 . drop 1 $ ts)) in- case (y,z) of- (Nothing,_) -> Nothing- (_,Nothing) -> Nothing- ~(Just x1, Just x2) -> Just (F undefined x1 x2)- 'T' -> let (y,z,u) = (readMaybe (take 1 ts)::Maybe Int, readMaybe (take 1 . drop 1 $ ts)::Maybe Int, readMaybe (take 1 . drop 2 $ ts)::Maybe Int) in- case (y,z,u) of- (Nothing,_,_) -> Nothing- (_,Nothing,_) -> Nothing- (_,_,Nothing) -> Nothing- ~(Just x1, Just x2, Just x3) -> Just (T undefined x1 x2 x3)- 'A' -> let y = readMaybe (take 1 ts)::Maybe Int in- if isJust y then- let y0 = fromJust y- zs = filter (/= y0) . catMaybes . map (\t -> readMaybe [t]::Maybe Int) . drop 1 $ ts in- case zs of- [] -> Nothing- ~x2 -> Just (SA undefined y0 (listArray (0,length x2 - 1) x2))- else Nothing- 'B' -> let y = readMaybe (take 1 ts)::Maybe Int in- if isJust y then- let y0 = fromJust y- zs = filter (/= y0) . catMaybes . map (\t -> readMaybe [t]::Maybe Int) . drop 1 $ ts in- case zs of- [] -> Nothing- ~x2 -> Just (SB undefined y0 (listArray (0,length x2 - 1) x2))- else Nothing- 'Q' -> let (y,z,u,w) = (readMaybe (take 1 ts)::Maybe Int, readMaybe (take 1 . drop 1 $ ts)::Maybe Int, readMaybe (take 1 . drop 2 $ ts)::Maybe Int,- readMaybe (take 1 . drop 3 $ ts)::Maybe Int) in- case (y,z,u,w) of- (Nothing,_,_,_) -> Nothing- (_,Nothing,_,_) -> Nothing- (_,_,Nothing,_) -> Nothing- (_,_,_,Nothing) -> Nothing- ~(Just x1, Just x2, Just x3, Just x4) -> Just (Q undefined x1 x2 x3 x4)- 'P' -> if null ts then Just (E 0) else let l = length ts in Just . P n . listArray (0,l-1) . map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts- 'W' -> if length ts /= 2 then Just (E 0) else let [k,t] = map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts in Just . W n k $ t- 'V' -> if length ts /= 2 then Just (E 0) else let [k,t] = map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts in Just . V n k $ t- 'H' -> if length ts /= 3 then Just (E 0) else let [k,t,w] = map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts in Just . H n k t $ w - 'R' -> if length ts /= 3 then Just (E 0) else let [k,t,w] = map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts in Just . R n k t $ w - 'M' -> if length ts /= 3 then Just (E 0) else let [k,t,w] = map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts in Just . M n k t $ w - _ -> Nothing+ 'E' -> Just E+ _ -> f n h ts | otherwise = Nothing---- | Is used inside 'readMaybeECG' to remove the 'undefined' inside the 'EncodedCnstrs'.-setWordsN :: Int -> Maybe EncodedCnstrs -> Maybe EncodedCnstrs-setWordsN _ Nothing = Nothing-setWordsN _ (Just (E x)) = Just (E x)-setWordsN n (Just (P _ v)) = Just (P n v)-setWordsN n (Just (T _ i j k)) = Just (T n i j k)-setWordsN n (Just (Q _ i j k l)) = Just (Q n i j k l)-setWordsN n (Just (SA _ i v)) = Just (SA n i v)-setWordsN n (Just (SB _ i v)) = Just (SB n i v)-setWordsN n (Just (F _ i j)) = Just (F n i j)-setWordsN n (Just (V _ i j)) = Just (V n i j)-setWordsN n (Just (W _ i j)) = Just (W n i j)-setWordsN n (Just (H _ i j k)) = Just (H n i j k)-setWordsN n (Just (R _ i j k)) = Just (R n i j k)-setWordsN n (Just (M _ i j k)) = Just (M n i j k)+ where f n c ts + | c `elem` "HFMRQTVW" = let ys = nub . catMaybes . map (\t -> readMaybe [t]::Maybe Int) $ ts+ res + | length ys /= g c = Nothing+ | c == 'Q' = let [y,z,u,w] = map (\rr -> if rr == 0 then 9 else rr - 1) ys in Just (Q n y z u w)+ | c `elem` "FVW" = let [y,z] = map (\rr -> if rr == 0 then 9 else rr - 1) ys in Just ((case c of {'F' -> F; 'V'-> V; ~ww -> W}) n y z)+ | otherwise = let [y,z,u] = map (\rr -> if rr == 0 then 9 else rr - 1) ys in Just ((case c of {'T' -> T; 'H' -> H; 'M' -> M; ~rr -> R}) n y z u) in res+ | c `elem` "AB" = let y = readMaybe (take 1 ts)::Maybe Int in+ if isJust y then+ let y0 = fromJust y+ zs = map (\rr -> if rr == 0 then 9 else rr - 1) . filter (/= y0) . nub . catMaybes . map (\t -> readMaybe [t]::Maybe Int) . drop 1 $ ts in+ case zs of+ [] -> Nothing+ ~x2 -> Just ((if c == 'A' then SA else SB) n (if y0 == 0 then 9 else y0 - 1) (listArray (0,length x2 - 1) x2))+ else Nothing + | c == 'P' = if null ts then Just E else Just . P n . listArray (0,length ts - 1) . map (\r -> case (fromJust (readMaybe [r]::Maybe Int)) of {0 -> 9; n -> n-1}) $ ts+ | otherwise = Nothing+ g c + | c `elem` "FVW" = 2+ | c == 'Q' = 4+ | otherwise = 3 --- | A safer variant of the 'readMaybeEC' more suitable for applications, e. g. for phonetic-languages series of packages.-readMaybeECG :: Int -> String -> Maybe EncodedCnstrs-readMaybeECG n xs- | n <= 9 && n >=0 = setWordsN n . readMaybeEC n $ xs- | otherwise = Nothing- type EncodedCnstrs = EncodedContraints Int (Array Int Int) -- | Must be applied to the correct array of permutation indeces. Otherwise, it gives runtime error (exception). All the integers inside the -- 'EncodedCnstrs' must be in the range [0..n] where @n@ corresponds to the maximum element in the permutation 'Array' 'Int' 'Int'. Besides, -- @n@ is (probably must be) not greater than 6. decodeConstraint1 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)-decodeConstraint1 (E _) = id+decodeConstraint1 E = id decodeConstraint1 (P _ v) = fixedPointsS v decodeConstraint1 (Q _ i j k l) = unsafeQuadruples i j k l decodeConstraint1 (T _ i j k) = unsafeTriples i j k@@ -158,7 +128,7 @@ decodeLConstraints (x:xs) = decodeLConstraints' ys . decodeConstraint1 y where y = minimum (x:xs) ys = filter (/= y) . g $ (x:xs)- g ((E _):zs) = g zs+ g (E:zs) = g zs g (z:zs) = z : g zs g _ = [] decodeLConstraints' (z:zs) = decodeLConstraints' zs . decodeConstraint1 z@@ -166,7 +136,7 @@ decodeLConstraints _ = id isE :: EncodedCnstrs -> Bool-isE (E _) = True+isE E = True isE _ = False isP :: EncodedCnstrs -> Bool@@ -217,7 +187,7 @@ {-| Works only with the correctly defined argument though it is not checked. Use with this caution. -} getIEl :: EncodedCnstrs -> Int-getIEl (E i) = i+getIEl E = -1 getIEl (P _ arr) = unsafeAt arr 0 getIEl (Q _ i _ _ _) = i getIEl (T _ i _ _) = i@@ -233,7 +203,7 @@ {-| Works only with the correctly defined arguments though it is not checked. Use with this caution. -} setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs-setIEl i (E _) = E i+setIEl _ E = E setIEl i (P n arr) = P n (arr // [(0,i)]) setIEl i (Q n _ j k l) = Q n i j k l setIEl i (T n _ j k) = T n i j k
phonetic-languages-constraints-array.cabal view
@@ -2,7 +2,7 @@ -- For further documentation, see http://haskell.org/cabal/users-guide/ name: phonetic-languages-constraints-array-version: 0.4.1.0+version: 0.5.0.0 synopsis: Constraints to filter the needed permutations description: Provides several the most important variants of constraints. Can be used with the phonetic-languages-common series of package. Instead of vectors, uses arrays. homepage: https://hackage.haskell.org/package/phonetic-languages-constraints-array