-- |
-- Module      :  Data.DoubleZip
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Some special functions to work with lists (with zip).

{-# OPTIONS_GHC -threaded #-}

module Data.DoubleZip (
  normFst
  , normSnd
  , evalFstFV
  , evalFstFVM
  , evalSndFV
  , evalSndFVM
  , double42Float4
  , float42Double4
) where

import GHC.Float (double2Float,float2Double)
import qualified Data.List as L
import Data.Foldable.Ix (s2L)

-- | Norms a tuples in a list by their first elements so that the greatest by an absolute value first element is equal to 1 (or -1). If all the first 
-- elements are zeros then prints a warning message and exits successfully.
normFst :: (Fractional a, Ord a) => [(a, b)] -> IO [(a, b)]
normFst :: [(a, b)] -> IO [(a, b)]
normFst [(a, b)]
v 
 | ((a, b) -> Bool) -> [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(a
x,b
_) -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) [(a, b)]
v = String -> IO ()
putStrLn String
"Warning: Data.DoubleZip.normFst: List with all zero first parts of the elements." IO () -> IO [(a, b)] -> IO [(a, b)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(a, b)] -> IO [(a, b)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(a, b)]
v
 | Bool
otherwise = ((a, b) -> IO (a, b)) -> [(a, b)] -> IO [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(a
x,b
y) -> (a, b) -> IO (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Num a => a -> a
abs ((a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.maximumBy (\a
t a
u -> a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> a
forall a. Num a => a -> a
abs a
t) (a -> a
forall a. Num a => a -> a
abs a
u)) ([a] -> a) -> ([(a, b)] -> [a]) -> [(a, b)] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst ([(a, b)] -> a) -> [(a, b)] -> a
forall a b. (a -> b) -> a -> b
$ [(a, b)]
v),b
y)) [(a, b)]
v

-- | Norms a tuples in a list by their second elements so that the greatest by an absolute value second element is equal to 1 (or -1). If all the second 
-- elements are zeros then prints a warning message and exits successfully.
normSnd :: (Fractional b, Ord b) => [(a, b)] -> IO [(a, b)]
normSnd :: [(a, b)] -> IO [(a, b)]
normSnd [(a, b)]
v 
 | ((a, b) -> Bool) -> [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(a
_,b
y) -> b
y b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0) [(a, b)]
v = String -> IO ()
putStrLn String
"Warning: Data.DoubleZip.normSnd: List with all zero second parts of the elements." IO () -> IO [(a, b)] -> IO [(a, b)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(a, b)] -> IO [(a, b)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(a, b)]
v
 | Bool
otherwise = ((a, b) -> IO (a, b)) -> [(a, b)] -> IO [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(a
x,b
y) -> (a, b) -> IO (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,b
y b -> b -> b
forall a. Fractional a => a -> a -> a
/ b -> b
forall a. Num a => a -> a
abs ((b -> b -> Ordering) -> [b] -> b
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
L.maximumBy (\b
t b
u -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b
forall a. Num a => a -> a
abs b
t) (b -> b
forall a. Num a => a -> a
abs b
u)) ([b] -> b) -> ([(a, b)] -> [b]) -> [(a, b)] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd ([(a, b)] -> b) -> [(a, b)] -> b
forall a b. (a -> b) -> a -> b
$ [(a, b)]
v))) [(a, b)]
v

-- | A special function transformation to obtain the resulting list so that its first elements in the inner tuples are in a special way 
-- normed to 1 (or -1) by 'normFst' and the inner tuples are sequenced one by another as a 2D points of the generating function @f :: a -> b@. 
-- To obtain non-empty result the given second argument must have at least two elements.
evalFstFV :: (Fractional a, Ord a, Eq b) => (a -> b) -> [a] -> IO [((a, b), (a, b))]
evalFstFV :: (a -> b) -> [a] -> IO [((a, b), (a, b))]
evalFstFV a -> b
f [a]
v 
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = do
     [(a, b)]
zipped <- [(a, b)] -> IO [(a, b)]
forall a b. (Fractional a, Ord a) => [(a, b)] -> IO [(a, b)]
normFst ([(a, b)] -> IO [(a, b)])
-> ([a] -> [(a, b)]) -> [a] -> IO [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
v ([b] -> [(a, b)]) -> ([a] -> [b]) -> [a] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> IO [(a, b)]) -> [a] -> IO [(a, b)]
forall a b. (a -> b) -> a -> b
$ [a]
v
     [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([((a, b), (a, b))] -> IO [((a, b), (a, b))])
-> ([(a, b)] -> [((a, b), (a, b))])
-> [(a, b)]
-> IO [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(a, b)] -> [((a, b), (a, b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(a, b)]
zipped ([(a, b)] -> [((a, b), (a, b))])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [(a, b)] -> [(a, b)]
forall a. Eq a => Int -> Int -> [a] -> [a]
s2L Int
1 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([(a, b)] -> IO [((a, b), (a, b))])
-> [(a, b)] -> IO [((a, b), (a, b))]
forall a b. (a -> b) -> a -> b
$ [(a, b)]
zipped
  | Bool
otherwise = [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | The same as 'evalFstFV' but uses a monadic IO function f.
evalFstFVM :: (Fractional a, Ord a, Eq b) => (a -> IO b) -> [a] -> IO [((a, b), (a, b))]
evalFstFVM :: (a -> IO b) -> [a] -> IO [((a, b), (a, b))]
evalFstFVM a -> IO b
f [a]
v 
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = do
     [b]
v1 <- (a -> IO b) -> [a] -> IO [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO b
f [a]
v
     [(a, b)]
zipped <- [(a, b)] -> IO [(a, b)]
forall a b. (Fractional a, Ord a) => [(a, b)] -> IO [(a, b)]
normFst ([(a, b)] -> IO [(a, b)])
-> ([b] -> [(a, b)]) -> [b] -> IO [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
v ([b] -> IO [(a, b)]) -> [b] -> IO [(a, b)]
forall a b. (a -> b) -> a -> b
$ [b]
v1
     [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([((a, b), (a, b))] -> IO [((a, b), (a, b))])
-> ([(a, b)] -> [((a, b), (a, b))])
-> [(a, b)]
-> IO [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(a, b)] -> [((a, b), (a, b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(a, b)]
zipped ([(a, b)] -> [((a, b), (a, b))])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [(a, b)] -> [(a, b)]
forall a. Eq a => Int -> Int -> [a] -> [a]
s2L Int
1 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([(a, b)] -> IO [((a, b), (a, b))])
-> [(a, b)] -> IO [((a, b), (a, b))]
forall a b. (a -> b) -> a -> b
$ [(a, b)]
zipped
  | Bool
otherwise = [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | A special function transformation to obtain the resulting list so that its second elements in the inner tuples are in a special way 
-- normed to 1 (or -1) by 'normSnd' and the inner tuples are sequenced one by another as a 2D points of the generating function @f :: a -> b@. 
-- To obtain non-empty result the given second argument must have at least two elements. Is similar to 'evalFstFV'.
evalSndFV :: (Fractional b, Ord b, Eq a) => (a -> b) -> [a] -> IO [((a, b), (a, b))]
evalSndFV :: (a -> b) -> [a] -> IO [((a, b), (a, b))]
evalSndFV a -> b
f [a]
v 
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = do
     [(a, b)]
zipped <- [(a, b)] -> IO [(a, b)]
forall b a. (Fractional b, Ord b) => [(a, b)] -> IO [(a, b)]
normSnd ([(a, b)] -> IO [(a, b)])
-> ([a] -> [(a, b)]) -> [a] -> IO [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
v ([b] -> [(a, b)]) -> ([a] -> [b]) -> [a] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f ([a] -> IO [(a, b)]) -> [a] -> IO [(a, b)]
forall a b. (a -> b) -> a -> b
$ [a]
v
     [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([((a, b), (a, b))] -> IO [((a, b), (a, b))])
-> ([(a, b)] -> [((a, b), (a, b))])
-> [(a, b)]
-> IO [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(a, b)] -> [((a, b), (a, b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(a, b)]
zipped ([(a, b)] -> [((a, b), (a, b))])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [(a, b)] -> [(a, b)]
forall a. Eq a => Int -> Int -> [a] -> [a]
s2L Int
1 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([(a, b)] -> IO [((a, b), (a, b))])
-> [(a, b)] -> IO [((a, b), (a, b))]
forall a b. (a -> b) -> a -> b
$ [(a, b)]
zipped
  | Bool
otherwise = [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | The same as 'evalSndFV' but uses a monadic IO function f.
evalSndFVM :: (Fractional b, Ord b, Eq a) => (a -> IO b) -> [a] -> IO [((a, b), (a, b))]
evalSndFVM :: (a -> IO b) -> [a] -> IO [((a, b), (a, b))]
evalSndFVM a -> IO b
f [a]
v 
  | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = do
     [b]
v1 <- (a -> IO b) -> [a] -> IO [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO b
f [a]
v
     [(a, b)]
zipped <- [(a, b)] -> IO [(a, b)]
forall b a. (Fractional b, Ord b) => [(a, b)] -> IO [(a, b)]
normSnd ([(a, b)] -> IO [(a, b)])
-> ([b] -> [(a, b)]) -> [b] -> IO [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
v ([b] -> IO [(a, b)]) -> [b] -> IO [(a, b)]
forall a b. (a -> b) -> a -> b
$ [b]
v1
     [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([((a, b), (a, b))] -> IO [((a, b), (a, b))])
-> ([(a, b)] -> [((a, b), (a, b))])
-> [(a, b)]
-> IO [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(a, b)] -> [((a, b), (a, b))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(a, b)]
zipped ([(a, b)] -> [((a, b), (a, b))])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [((a, b), (a, b))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> [(a, b)] -> [(a, b)]
forall a. Eq a => Int -> Int -> [a] -> [a]
s2L Int
1 ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([(a, b)] -> IO [((a, b), (a, b))])
-> [(a, b)] -> IO [((a, b), (a, b))]
forall a b. (a -> b) -> a -> b
$ [(a, b)]
zipped
  | Bool
otherwise = [((a, b), (a, b))] -> IO [((a, b), (a, b))]
forall (m :: * -> *) a. Monad m => a -> m a
return []

double42Float4 :: ((Double,Double), (Double,Double)) -> ((Float,Float), (Float,Float))
double42Float4 :: ((Double, Double), (Double, Double))
-> ((Float, Float), (Float, Float))
double42Float4 ((Double
x,Double
y),(Double
z,Double
t)) = ((Double -> Float
double2Float Double
x,Double -> Float
double2Float Double
y),(Double -> Float
double2Float Double
z,Double -> Float
double2Float Double
t))

float42Double4 :: ((Float,Float), (Float,Float)) -> ((Double,Double), (Double,Double))
float42Double4 :: ((Float, Float), (Float, Float))
-> ((Double, Double), (Double, Double))
float42Double4 ((Float
x,Float
y),(Float
z,Float
t)) = ((Float -> Double
float2Double Float
x,Float -> Double
float2Double Float
y),(Float -> Double
float2Double Float
z,Float -> Double
float2Double Float
t))