-- |
-- Module : DobutokO.Poetry.Norms
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Helps to order the 7 or less (in the first version the Ukrainian) words (or their concatenations)
-- to obtain (to some extent) suitable for poetry or music text. This module
-- provides several different norms that allow to research the text and
-- to create interesting sequences.
module DobutokO.Poetry.Norms (
-- * Different norms
norm1
, norm2
, norm3
, norm4
, norm5
, norm51
, norm513
, norm54
, norm6
, norm6r
, norm8
-- * Norms combining
, splitNorm
-- ** More complex combining
, combineNorms
, flSplitNorms
, normSplit
, normSplitWeighted
, normSplitShifted
, normSplitWeightedG
) where
import qualified Data.Vector as V
import Data.List ((\\))
-- | The first norm for the list of non-negative 'Int'. For not empty lists equals to the maximum element.
norm1 :: [Int] -> Int
norm1 xs
| null xs = 0
| otherwise = maximum xs
{-# INLINE norm1 #-}
-- | The second norm for the list of non-negative 'Int'. For not empty lists equals to the sum of the elements.
norm2 :: [Int] -> Int
norm2 xs = sum xs
{-# INLINE norm2 #-}
-- | The third norm for the list of non-negative 'Int'. For not empty lists equals to the sum of the doubled maximum element and the rest elements of the list.
norm3 :: [Int] -> Int
norm3 xs
| null xs = 0
| otherwise = maximum xs + sum xs
{-# INLINE norm3 #-}
-- | The fourth norm for the list of non-negative 'Int'. Equals to the sum of the 'norm3' and 'norm2'.
norm4 :: [Int] -> Int
norm4 xs
| null xs = 0
| length xs == 1 = head xs
| otherwise = maximum xs + sum xs + maximum (xs \\ [maximum xs])
{-# INLINE norm4 #-}
-- | The fifth norm for the list of non-negative 'Int'. For not empty lists equals to the sum of the elements quoted with sum of the two most minimum elements.
norm5 :: [Int] -> Int
norm5 xs
| null xs = 0
| length xs == 1 = head xs
| minimum xs == 0 = norm5 . filter (/= 0) $ xs
| otherwise = sum xs `quot` (minimum xs + minimum (xs \\ [minimum xs]))
{-# INLINE norm5 #-}
-- | The fifth modified norm for the list of non-negative 'Int'. Tries to take into account doubled and prolonged sounds to reduce their influence on the 'norm5'.
norm51 :: [Int] -> Int
norm51 xs
| null xs = 0
| compare (minimum xs) 1 /= GT = let ys = filter (\t -> compare t 1 == GT) xs in
case length ys of
0 -> sum xs
1 -> (3 * sum xs) `quot` (minimum ys + maximum ys)
_ -> (3 * sum xs) `quot` (minimum ys + minimum (ys \\ [minimum ys]))
| length xs == 1 = 1
| otherwise = (3 * sum xs) `quot` (minimum xs + minimum (xs \\ [minimum xs]))
{-# INLINE norm51 #-}
-- | The fifth modified (with three minimums) norm for the list of non-negative 'Int'. Tries to take into account doubled and prolonged sounds
-- to reduce their influence on the 'norm5'.
norm513 :: [Int] -> Int
norm513 xs
| null xs = 0
| compare (minimum xs) 1 /= GT =
let ys = filter (\t -> compare t 1 == GT) xs in
case length ys of
0 -> sum xs
1 -> (3 * sum xs) `quot` (minimum ys + maximum ys)
2 -> let zs = ys \\ [minimum ys] in (3 * sum xs) `quot` (minimum ys + 2 * minimum zs)
_ -> let zs = ys \\ [minimum ys] in (3 * sum xs) `quot` (minimum ys + minimum zs + minimum (zs \\ [minimum zs]))
| otherwise =
let zs = xs \\ [minimum xs] in
case length zs of
0 -> sum xs
1 -> (3 * sum xs) `quot` (minimum zs + maximum zs)
2 -> let ts = zs \\ [minimum zs] in (3 * sum xs) `quot` (minimum zs + 2 * minimum ts)
_ -> let ts = zs \\ [minimum zs] in (3 * sum xs) `quot` (minimum zs + minimum ts + minimum (ts \\ [minimum ts]))
{-# INLINE norm513 #-}
-- | The sixth norm for the list of non-negative 'Int'.
norm6 :: [Int] -> Int
norm6 xs = (norm5 xs * sum xs) `quot` norm3 xs
{-# INLINE norm6 #-}
-- | The sixth modified norm for the list of non-negative 'Int'.
norm6r :: [Int] -> Int
norm6r xs = (norm513 xs * norm3 xs) `quot` sum xs
{-# INLINE norm6r #-}
-- | The fifth-fourth norm for the list of non-negative 'Int'. Tries to generate more suitable for poetry text.
norm54 :: [Int] -> Int
norm54 xs = (norm513 xs * norm6r xs) `quot` norm4 xs
{-# INLINE norm54 #-}
-- | The eigth norm for the list of the non-negative 'Int'. Similarly to 'norm4' is used to quickly evaluate the possibly more diverse texts,
-- which are not simple to quickly pronounce. Is not informative (and therefore, is not intended to be used) for the lists of no more than 1 element.
norm8 :: [Int] -> Int
norm8 xs
| null xs = 0
| length xs == 1 = 1
| otherwise = (5040 * maximum xs) `quot` minimum xs
{-# INLINE norm8 #-}
-- | Splits a given list of non-negative integers into lists of elements not equal to zero and then applies to them the norms from the 'V.Vector' starting
-- from the last element in the vector right-to-left.
splitNorm :: [Int] -> V.Vector ([Int] -> Int) -> [Int]
splitNorm xs vN
| null (filter (/=0) xs) || V.length vN /= length (filter (== 0) xs) + 1 = []
| otherwise =
let (ys,zs) = break (== 0) xs
zzs = drop 1 zs
in (V.unsafeIndex vN (V.length vN - 1)) ys:splitNorm zzs (V.unsafeSlice 0 (V.length vN - 1) vN)
-- | Applies all the given norms in the 'V.Vector' to the first argument and collects the result as a list.
combineNorms :: [Int] -> V.Vector ([Int] -> Int) -> [Int]
combineNorms xs vN
| null xs = []
| otherwise = V.toList . V.map (\f -> f xs) $ vN
-- | The flipped variant of the 'combineNorms' (can be more convenient for applications).
flSplitNorms :: V.Vector ([Int] -> Int) -> [Int] -> [Int]
flSplitNorms = flip combineNorms
{-# INLINE flSplitNorms #-}
-- | Using 'combineNorms' and given a group of norms (represented as a 'V.Vector') returns the sum of their applications. These norms are equally important
-- and their order can be volatile.
normSplit :: V.Vector ([Int] -> Int) -> ([Int] -> Int)
normSplit v = sum . flSplitNorms v
{-# INLINE normSplit #-}
-- | Using 'combineNorms' and given a group of norms (represented as a 'V.Vector') returns the sum of their applications. The importance of these norms can be
-- easily controlled by the first function argument. The corresponding greater numbers in the first argument list signify the greater importance of the
-- norm in the 'V.Vector' of norms all being applied (so these numbers are multiplicative weights in the sum). If some of the numbers are equal to zero then
-- the corresponding norm is not taken into account. If some of the numbers are negative then the corresponding norms are weightly subtracted from the sum.
normSplitWeighted :: [Int] -> V.Vector ([Int] -> Int) -> ([Int] -> Int)
normSplitWeighted = normSplitWeightedG (*)
{-# INLINE normSplitWeighted #-}
-- | Similar to 'normSplitWeighted', but uses more complex modification instead of multiplication.
-- Using 'splitNorm' and given a group of norms (represented as a 'V.Vector') returns the sum of their applications. The importance of these norms can be
-- controlled by the first function argument. The corresponding greater numbers in the first argument list signify the greater importance of the
-- norm in the 'V.Vector' of norms all being applied. If some of the numbers are negative then the corresponding norms reduces the sum in some way.
normSplitShifted :: [Int] -> V.Vector ([Int] -> Int) -> ([Int] -> Int)
normSplitShifted = normSplitWeightedG (\x y -> x * (x + y))
{-# INLINE normSplitShifted #-}
-- | Generalization for the 'normSplitWeighted' and 'normSplitShifted' with the possibility to define and use the volatile function that influences the
-- weights for the norms in the 'V.Vector'. This function used in the 'zipWith' is given as the first argument.
normSplitWeightedG :: (Int -> Int -> Int) -> [Int] -> V.Vector ([Int] -> Int) -> ([Int] -> Int)
normSplitWeightedG h xs v
| null xs = \ys -> 0
| otherwise = let g ts = zipWith h (flSplitNorms v ts) xs in sum . g