-- |
-- Module      :  Languages.UniquenessPeriods.Vector.PropertiesG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package.

{-# LANGUAGE BangPatterns #-}

module Languages.UniquenessPeriods.Vector.PropertiesG where

import GHC.Int
import qualified Data.Vector as VB
import String.Languages.UniquenessPeriods.VectorG

-- | The function is inteded to be used after 'uniquenessPeriodsVector2' application to obtain the first argument. So generally, it is used as follows:
--
-- > diverse . uniquenessPeriodsVector2 y whspss $ v
--
-- The maximum value of the function corresponds to possibly more smoothly changing and mixing elements in the list. If they are used to represent
-- sounds (especially some text, may be poetic) then the resulting maximum possible 'diverse' value corresponds to more \"diverse\" (phonetically) text intervals.
-- Is somewhat similar to the @norm4@ function from the DobutokO.Poetry.Norms module from @dobutokO-poetry@ package
-- See: https://hackage.haskell.org/package/dobutokO-poetry-general-0.1.0.0/docs/DobutokO-Poetry-Norms.html.
diverse ::
  Eq a => UniquenessGeneral2 a -- ^ Is gotten after the application of the 'uniquenessPeriodsVector2'.
  -> Int16  -- ^ The resulting value.
diverse :: UniquenessGeneral2 a -> Int16
diverse UniquenessGeneral2 a
v
  | UniquenessGeneral2 a -> Bool
forall a. Vector a -> Bool
VB.null UniquenessGeneral2 a
v = Int16
0
  | Bool
otherwise = Vector Int16 -> Int16
forall a. Num a => Vector a -> a
VB.sum (Vector Int16 -> Int16)
-> (UniquenessGeneral2 a -> Vector Int16)
-> UniquenessGeneral2 a
-> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Int16], a) -> Int16) -> UniquenessGeneral2 a -> Vector Int16
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\([Int16]
xs,a
_) -> if [Int16] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int16]
xs then Int16
0::Int16 else [Int16] -> Int16
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int16]
xs) (UniquenessGeneral2 a -> Int16) -> UniquenessGeneral2 a -> Int16
forall a b. (a -> b) -> a -> b
$ UniquenessGeneral2 a
v

-- | The function is inteded to be used after 'uniquenessPeriodsVector2' application to obtain the first argument. So generally, it is used as follows:
--
-- > diverse1 . uniquenessPeriodsVector2 y whspss $ v
--
-- The maximum value of the function corresponds to possibly more smoothly changing and mixing elements in the list. If they are used to represent
-- sounds (especially some text, may be poetic) then the resulting maximum possible 'diverse' value corresponds to more \"diverse\" (phonetically) text intervals.
-- Is somewhat similar to the @norm4@ function from the DobutokO.Poetry.Norms module from @dobutokO-poetry@ package. Unlike the 'diverse' function 'diverse1'
-- takes into account that in the word possibly there can be doubled or prolonged sounds that can be represented by repetition of the same sound
-- representation (in some cases). These repetitions do not depend on the words order and, therefore, do not change with it so are not informative on the possible
-- words order rearrangement that is essential to the phonetic languages as the one important application.
-- See: https://hackage.haskell.org/package/dobutokO-poetry-general-0.1.0.0/docs/DobutokO-Poetry-Norms.html.
diverse1 ::
  Eq a => UniquenessGeneral2 a -- ^ Is gotten after the application of the 'uniquenessPeriodsVector2'.
  -> Int16  -- ^ The resulting value.
diverse1 :: UniquenessGeneral2 a -> Int16
diverse1 UniquenessGeneral2 a
v
  | UniquenessGeneral2 a -> Bool
forall a. Vector a -> Bool
VB.null UniquenessGeneral2 a
v = Int16
0
  | Bool
otherwise = Vector Int16 -> Int16
forall a. Num a => Vector a -> a
VB.sum (Vector Int16 -> Int16)
-> (UniquenessGeneral2 a -> Vector Int16)
-> UniquenessGeneral2 a
-> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Int16], a) -> Int16) -> UniquenessGeneral2 a -> Vector Int16
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\([Int16]
xs,a
_) -> if [Int16] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Int16 -> Bool) -> [Int16] -> [Int16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int16
1) [Int16]
xs) then Int16
0::Int16 else [Int16] -> Int16
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((Int16 -> Bool) -> [Int16] -> [Int16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int16
1) [Int16]
xs)) (UniquenessGeneral2 a -> Int16) -> UniquenessGeneral2 a -> Int16
forall a b. (a -> b) -> a -> b
$ UniquenessGeneral2 a
v

-- | Is used similarly to 'diverse1', but uses another approach based on the 'sumPositiveWithoutMax' application, so generally can give another result.
-- It computes sum of the lists of 'Int' where each one is without the maximum value respectively and is without the elements that equal to 1.
diverse1s ::
  Eq a => UniquenessGeneral2 a -- ^ Is gotten after the application of the 'uniquenessPeriodsVector2'.
  -> Int16  -- ^ The resulting value.
diverse1s :: UniquenessGeneral2 a -> Int16
diverse1s UniquenessGeneral2 a
v
  | UniquenessGeneral2 a -> Bool
forall a. Vector a -> Bool
VB.null UniquenessGeneral2 a
v = Int16
0
  | Bool
otherwise = Vector Int16 -> Int16
forall a. Num a => Vector a -> a
VB.sum (Vector Int16 -> Int16)
-> (UniquenessGeneral2 a -> Vector Int16)
-> UniquenessGeneral2 a
-> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Int16], a) -> Int16) -> UniquenessGeneral2 a -> Vector Int16
forall a b. (a -> b) -> Vector a -> Vector b
VB.map (\([Int16]
xs,a
_) -> if [Int16] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Int16 -> Bool) -> [Int16] -> [Int16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int16
1) [Int16]
xs) then Int16
0::Int16 else [Int16] -> Int16
forall a. (Num a, Ord a) => [a] -> a
sumPositiveWithoutMax ((Int16 -> Bool) -> [Int16] -> [Int16]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int16
1) [Int16]
xs)) (UniquenessGeneral2 a -> Int16) -> UniquenessGeneral2 a -> Int16
forall a b. (a -> b) -> a -> b
$ UniquenessGeneral2 a
v

-- | For the list of positive 'Num' elements (this is not checked so it is up to the user to check positiveness) finds out the sum of the list
-- and the maximum value if the first argument is in the form (0, 0). For the empty list returns (0, 0) in such a case. For another first
-- argument has more complex behaviour. Tries to be tail-recursive.
sumPositiveAndMaxTuple :: (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple :: (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple (a
x1,a
x2) (a
x:[a]
xs)
  | a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x2 a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = (a, a) -> [a] -> (a, a)
forall a. (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x, a
x2) [a]
xs
  | Bool
otherwise = (a, a) -> [a] -> (a, a)
forall a. (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x, a
x) [a]
xs
sumPositiveAndMaxTuple (a
x1, a
x2) [] = (a
x1, a
x2)

-- | Unlike 'sumPositiveAndMaxTuple', it is strict by its first argument's inner elements (by both of them).
sumPositiveAndMaxTuple' :: (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple' :: (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple' (!a
x1,!a
x2) (a
x:[a]
xs)
  | a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x2 a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = (a, a) -> [a] -> (a, a)
forall a. (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple' (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x, a
x2) [a]
xs
  | Bool
otherwise = (a, a) -> [a] -> (a, a)
forall a. (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple' (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x, a
x) [a]
xs
sumPositiveAndMaxTuple' (!a
x1, !a
x2) [] = (a
x1, a
x2)

-- | For the list of positive 'Num' elements (this is not checked so it is up to the user to check positiveness) finds out the sum of the list
-- without the maximum value.
sumPositiveWithoutMax :: (Num a, Ord a) => [a] -> a
sumPositiveWithoutMax :: [a] -> a
sumPositiveWithoutMax = (a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((a, a) -> a) -> ([a] -> (a, a)) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> [a] -> (a, a)
forall a. (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple (a
0, a
0)

-- | The strict variant the of the 'sumPositiveWithoutMax' function.
sumPositiveWithoutMax' :: (Num a, Ord a) => [a] -> a
sumPositiveWithoutMax' :: [a] -> a
sumPositiveWithoutMax' = (a -> a -> a) -> (a, a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (-) ((a, a) -> a) -> ([a] -> (a, a)) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> [a] -> (a, a)
forall a. (Num a, Ord a) => (a, a) -> [a] -> (a, a)
sumPositiveAndMaxTuple' (a
0, a
0)

-- | The function is inteded to be used after 'uniquenessPeriodsVector3' application to obtain the first argument. So generally, it is used as follows:
--
-- > diverse2 . uniquenessPeriodsVector3 whspss $ v
--
-- The maximum value of the function corresponds to possibly more smoothly changing and mixing elements in the list. If they are used to represent
-- sounds (especially some text, may be poetic) then the resulting maximum possible 'diverse2' value corresponds to more \"diverse\" (phonetically) text intervals.
-- Is somewhat similar to the @norm4@ function from the DobutokO.Poetry.Norms module from @dobutokO-poetry@ package. Unlike the 'diverse' and 'diverse1' and
-- 'diverse1s' functions 'diverse2' depends much more significantly on the words order. Possibly, the most accurate among \"diverse\" functions in the module.
-- See: https://hackage.haskell.org/package/dobutokO-poetry-general-0.1.0.0/docs/DobutokO-Poetry-Norms.html.
diverse2 ::
  Eq a => UniquenessGeneral2 a -- ^ Is gotten after the application of the 'uniquenessPeriodsVector3'.
  -> Int16  -- ^ The resulting value.
diverse2 :: UniquenessGeneral2 a -> Int16
diverse2 UniquenessGeneral2 a
v
  | UniquenessGeneral2 a -> Bool
forall a. Vector a -> Bool
VB.null UniquenessGeneral2 a
v = Int16
0
  | Bool
otherwise = Vector Int16 -> Int16
forall a. Num a => Vector a -> a
VB.sum (Vector Int16 -> Int16)
-> (UniquenessGeneral2 a -> Vector Int16)
-> UniquenessGeneral2 a
-> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Int16], a) -> Int16) -> UniquenessGeneral2 a -> Vector Int16
forall a b. (a -> b) -> Vector a -> Vector b
VB.map ([Int16] -> Int16
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int16] -> Int16)
-> (([Int16], a) -> [Int16]) -> ([Int16], a) -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int16], a) -> [Int16]
forall a b. (a, b) -> a
fst) (UniquenessGeneral2 a -> Int16) -> UniquenessGeneral2 a -> Int16
forall a b. (a -> b) -> a -> b
$ UniquenessGeneral2 a
v
{-# INLINE diverse2 #-}

-- | Is intended to be used in the 'VB.Vector' @([b] -> b)@ where just the first value in the list is used. The simplest case among all possible ones. For an empty
-- list returns 'error' with an informative message.
oneProperty :: Ord b => [b] -> b
oneProperty :: [b] -> b
oneProperty [b]
xs
 | [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
xs = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"Languages.UniquenessPeriods.Vector.PropertiesG.oneProperty: empty list. "
 | Bool
otherwise = [b] -> b
forall a. [a] -> a
head [b]
xs
{-# INLINE oneProperty #-}

-- | Converts just one value to the needed list to be used as a \"property\". Is provided here for explanation purposes (just as a meaningful alias). Therefore, it is
-- an auxiliary function.
justOneValue2Property :: Ord b => b -> [b]
justOneValue2Property :: b -> [b]
justOneValue2Property = (b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[])
{-# INLINE justOneValue2Property #-}