quantizer (empty) → 0.1.0.0

raw patch · 5 files changed

+241/−0 lines, 5 filesdep +basedep +subGdep +uniqueness-periods-vector-stats

Dependencies added: base, subG, uniqueness-periods-vector-stats

Files

• CHANGELOG.md +5/−0
• FoldableQuantizer.hs +66/−0
• LICENSE +20/−0
• TwoQuantizer.hs +128/−0
• quantizer.cabal +22/−0

@@ -0,0 +1,5 @@+# Revision history for quantizer++## 0.1.0.0 -- 2022-09-13++* First version. Released on an unsuspecting world.

@@ -0,0 +1,66 @@+module FoldableQuantizer where++import Data.Maybe+import qualified Data.Foldable as F+import qualified TwoQuantizer as Q (meanF2)+import Data.MinMax (minMax11)+import qualified Data.SubG as S++round2G + :: (Ord a, S.InsertLeft t a, Monoid (t a)) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (t a -> a -> Ordering) + -> t a + -> a + -> Maybe a -- ^ The @a@ value (in 'Just' case) can be equal just to the one of the two first @a@ arguments.+round2G bool f xs z + | z `F.elem` xs = Just z+ | F.length xs < 2 = Nothing+ | z < x || z > y = Nothing+ | F.null ts = Just u+ | F.null us = Just t+ | otherwise = Just (case f xs z of { GT -> u; LT -> t; EQ -> if bool then u else t })+   where (x, y) = fromJust . minMax11 $ xs+         (ts,us) = S.span (<z) xs+         t = fromJust . S.safeLastG $ ts+         u = fromJust . S.safeHeadG $ us++foldableQuantizerG + :: (Ord a, Floating a, Integral a, S.InsertLeft t1 a, Monoid (t1 a), Foldable t2) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value.+ -> (t1 a -> a -> Ordering) + -> t1 a + -> t2 a+ -> [a]+foldableQuantizerG ctrl f needs xs = map (fromJust . round2G ctrl f needs) ys+  where k = Q.meanF2 (F.toList needs) 0 0 / Q.meanF2 (F.toList xs) 0 0+        ys = F.foldr (\t ts -> t * k : ts) [] xs++round2GM + :: (Ord a, Monad m, S.InsertLeft t1 a, Monoid (t1 a)) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (t1 a -> a -> m Ordering) + -> t1 a + -> a + -> m (Maybe a)+round2GM bool f xs z + | z `F.elem` xs = return . Just $ z+ | F.length xs < 2 = return Nothing+ | z < x || z > y = return Nothing+ | F.null ts = return u+ | F.null us = return t+ | otherwise = do+     q <- f xs z+     case q of { GT -> return u; LT -> return t; EQ -> return (if bool then u else t)}+   where (x, y) = fromJust . minMax11 $ xs+         (ts,us) = S.span (<z) xs+         t = S.safeLastG ts+         u = S.safeHeadG us++foldableQuantizerGM + :: (Ord a, Floating a, Integral a, Monad m, S.InsertLeft t1 a, Monoid (t1 a), Foldable t2) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (t1 a -> a -> m Ordering) + -> t1 a + -> t2 a + -> m [a]+foldableQuantizerGM ctrl f needs xs = mapM (fmap fromJust . round2GM ctrl f needs) ys+  where k = Q.meanF2 (F.toList needs) 0 0  / Q.meanF2 (F.toList xs) 0 0+        ys = F.foldr (\u us -> u * k : us) [] xs+

@@ -0,0 +1,20 @@+Copyright (c) 2022 Oleksandr Zhabenko++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.

@@ -0,0 +1,128 @@+module TwoQuantizer where++import Data.Maybe+import Numeric.Stats (meanD)++round2 +  :: Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. +  -> Double +  -> Double +  -> Double +  -> Maybe Double -- ^ The numeric value (in 'Just' case) can be equal just to the one of the two first arguments.+round2 bool x y z + | x <= 0 || y <= 0 || z <= 0 = Nothing+ | (x - z) * (y - z) <= 0 = Just (case compare (z*z) (x*y) of { GT -> max x y; LT -> min x y; EQ -> (if bool then max else min) x y })+ | otherwise = Nothing++round2L + :: Bool  -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> [Double] + -> Double + -> Double+round2L ctrl ts x + | null ts = x+ | null ks = y+ | null us = y0+ | x < y = fromJust . round2 ctrl y0 y $ x+ | otherwise = y+  where (ks, us) = span (<x) ts+        y = head us+        y0 = last ks++twoQuantizer + :: Bool  -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> [Double] + -> [Double] + -> [Double]+twoQuantizer ctrl needs xs = map (round2L ctrl needs) ys+  where k = meanD needs / meanD xs+        ys = map (*k) xs++round2G + :: (Ord a) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (a -> a -> a -> Ordering) + -> a + -> a + -> a + -> Maybe a -- ^ The @a@ value (in 'Just' case) can be equal just to the one of the two first @a@ arguments.+round2G bool f x y z + | z == x = Just x+ | z == y = Just y+ | (x < z && y > z) || (x > z && y < z) = Just (case f x y z of { GT -> max x y; LT -> min x y; EQ -> (if bool then max else min) x y })+ | otherwise = Nothing++round2GL + :: (Ord a) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (a -> a -> a -> Ordering) + -> [a] + -> a + -> a+round2GL ctrl f ts x + | null ts = x+ | null ks = y+ | null us = y0+ | x < y = fromJust . round2G ctrl f y0 y $ x+ | otherwise = y+  where (ks, us) = span (<x) ts+        y = head us+        y0 = last ks++twoQuantizerG + :: (Ord a, Floating a, Integral a) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (a -> a -> a -> Ordering) + -> [a] + -> [a] + -> [a]+twoQuantizerG ctrl f needs xs = map (round2GL ctrl f needs) ys+  where k = meanF2 needs 0 0 / meanF2 xs 0 0+        ys = map (*k) xs++round2GM + :: (Ord a, Monad m) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (a -> a -> a -> m Ordering) + -> a + -> a + -> a + -> m (Maybe a)+round2GM bool f x y z + | z == x = return . Just $ x+ | z == y = return . Just $ y+ | (x < z && y > z) || (x > z && y < z) = do+     t <- f x y z+     case t of { GT -> return . Just . max x $ y; LT -> return . Just . min x $ y; EQ -> return. Just $ (if bool then max else min) x y }+ | otherwise = return Nothing++round2GLM + :: (Ord a, Monad m) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (a -> a -> a -> m Ordering) + -> [a] + -> a + -> m a+round2GLM ctrl f ts x + | null ts = return x+ | null ks = return y+ | null us = return y0+ | x < y = fmap fromJust . round2GM ctrl f y0 y $ x + | otherwise = return y+  where (ks, us) = span (<x) ts+        y = head us+        y0 = last ks++meanF2 + :: (Floating a, Integral a) => [a] + -> a + -> a + -> a+meanF2 (t:ts) s l = meanF2 ts (s + t) (l + 1) +meanF2 _ s l = s / fromIntegral l++twoQuantizerGM + :: (Ord a, Floating a, Integral a, Monad m) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. + -> (a -> a -> a -> m Ordering) + -> [a] + -> [a] + -> m [a]+twoQuantizerGM ctrl f needs xs = mapM (round2GLM ctrl f needs) ys+  where k = meanF2 needs 0 0  / meanF2 xs 0 0+        ys = map (*k) xs+

@@ -0,0 +1,22 @@+name:                quantizer+version:             0.1.0.0+synopsis:            Library to provide the behaviour similar to quantum states superposition. +description:         Has two modules with similar functionality. The functions provide the somewhat generalized way to round the numbers based on some data.+homepage:            https://hackage.haskell.org/package/quantizer+license:             MIT+license-file:        LICENSE+author:              OleksandrZhabenko+maintainer:          olexandr543@yahoo.com+copyright:           Oleksandr Zhabenko+category:            Math+build-type:          Simple+extra-source-files:  CHANGELOG.md+cabal-version:       >=1.10++library+  exposed-modules:     TwoQuantizer, FoldableQuantizer+  -- other-modules:+  -- other-extensions: +  build-depends:       base >=4.8 && <5, subG == 0.5.3.0, uniqueness-periods-vector-stats == 0.3.0.0+  -- hs-source-dirs:+  default-language:    Haskell2010