-- |
-- Module      :  DobutokO.Poetry
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to order the 7 or less Ukrainian words (or their concatenations) 
-- to obtain somewhat suitable for poetry or music text.

{-# LANGUAGE BangPatterns #-}

module DobutokO.Poetry (
  -- * Main functions
  uniq10Poetical4
  , uniq10Poetical5
  , uniq10PoeticalG
  , uniqNPoeticalG
  , uniqNPoetical
  , uniqNPoeticalV
  , uniqNPoeticalVG
  -- * Additional functions
  , uniquenessVariantsG
  , uniquenessVariants3
  , uniquenessVariants4
  , uniqMaxPoeticalG
  , uniqInMaxPoetical
  -- * Different norms
  , norm1
  , norm2
  , norm3
  , norm4
  , norm5
  , norm6
  -- * Help functions
  , fourFrom5
  , lastFrom5  
) where

import Control.Monad
import Data.Char (isPunctuation)
import qualified Data.Vector as V
import Data.List ((\\))
import MMSyn7s 

-- | A variant of 'uniquesessVariantsG' with the norm being 'norm3'.
uniquenessVariants3 :: String -> V.Vector ([Int],Int,Int,Int,String)
uniquenessVariants3 = uniquenessVariantsG norm3

-- | A variant of 'uniquesessVariantsG' with the norm being 'norm4'.
uniquenessVariants4 :: String -> V.Vector ([Int],Int,Int,Int,String)
uniquenessVariants4 = uniquenessVariantsG norm4

-- | Given a 'String' consisting of no more than 7 Ukrainian words [some of them can be created by concatenation with preserving the Ukrainian 
-- pronunciation of the parts, e. g. \"так як\" (actually two correnc Ukrainian words) can be written \"такйак\" (one phonetical Ukrainian word 
-- obtained with preserving phonetical structure), if you would not like to treat them separately] it returns a 'V.Vector' of possible combinations 
-- without repeating of the words in differnet order and for every one of them appends also information about 'uniquenessPeriods' to it and finds out 
-- three different metrics -- named \"norms\". Afterwards, depending on these norms it can be specified some phonetical properties of the words that 
-- allow to use them poetically or to create a varied melody with them. Some variants of this generalized function are 'uniquesessVariants3' and 
-- 'uniquesessVariants4' with the predefined norms.
uniquenessVariantsG :: ([Int] -> Int) -> String -> V.Vector ([Int],Int,Int,Int,String)
uniquenessVariantsG g xs 
  | null xs = V.empty
  | otherwise = 
     case V.length . V.fromList . take 7 . words $ xs of 
      7 -> 
       V.fromList . map ((\vs -> let !rs = uniquenessPeriods vs in (rs, norm1 rs, norm2 rs, g rs, vs)) . unwords . V.toList . 
        V.backpermute (V.fromList . take 7 . words $ xs)) $ 
         ([V.fromList [x1,x2,x3,x4,x5,x6,x7] | !x1 <- [0..6], !x2 <- [0..6] \\ [x1], !x3 <- [0..6] \\ [x1,x2], !x4 <- [0..6] \\ [x1,x2,x3], 
           !x5 <- [0..6] \\ [x1,x2,x3,x4], !x6 <- [0..6] \\ [x1,x2,x3,x4,x5], !x7 <- [0..6] \\ [x1,x2,x3,x4,x5,x6]]::[V.Vector Int])
      6 -> 
       V.fromList . map ((\vs -> let rs = uniquenessPeriods vs in (rs, norm1 rs, norm2 rs, g rs, vs)) . unwords . V.toList . 
        V.backpermute (V.fromList . take 7 . words $ xs)) $
         ([V.fromList [x1,x2,x3,x4,x5,x6] | !x1 <- [0..5], !x2 <- [0..5] \\ [x1], !x3 <- [0..5] \\ [x1,x2], !x4 <- [0..5] \\ [x1,x2,x3], 
           !x5 <- [0..5] \\ [x1,x2,x3,x4], !x6 <- [0..5] \\ [x1,x2,x3,x4,x5]]::[V.Vector Int])
      5 -> 
       V.fromList . map ((\vs -> let rs = uniquenessPeriods vs in (rs, norm1 rs, norm2 rs, g rs, vs)) . unwords . V.toList . 
        V.backpermute (V.fromList . take 7 . words $ xs)) $
         ([V.fromList [x1,x2,x3,x4,x5] | !x1 <- [0..4], !x2 <- [0..4] \\ [x1], !x3 <- [0..4] \\ [x1,x2], !x4 <- [0..4] \\ [x1,x2,x3], 
            !x5 <- [0..4] \\ [x1,x2,x3,x4]]::[V.Vector Int])
      4 -> 
       V.fromList . map ((\vs -> let rs = uniquenessPeriods vs in (rs, norm1 rs, norm2 rs, g rs, vs)) . unwords . V.toList . 
        V.backpermute (V.fromList . take 7 . words $ xs)) $
         ([V.fromList [x1,x2,x3,x4] | !x1 <- [0..3], !x2 <- [0..3] \\ [x1], !x3 <- [0..3] \\ [x1,x2], !x4 <- [0..3] \\ [x1,x2,x3]]::[V.Vector Int])
      3 -> 
       V.fromList . map ((\vs -> let rs = uniquenessPeriods vs in (rs, norm1 rs, norm2 rs, g rs, vs)) . unwords . V.toList . 
        V.backpermute (V.fromList . take 7 . words $ xs)) $ ([V.fromList [x1,x2,x3] | !x1 <- [0..2], !x2 <- [0..2] \\ [x1], 
          !x3 <- [0..2] \\ [x1,x2]]::[V.Vector Int])
      2 -> 
       V.fromList . map ((\vs -> let rs = uniquenessPeriods vs in (rs, norm1 rs, norm2 rs, g rs, vs)) . unwords . V.toList . 
        V.backpermute (V.fromList . take 7 . words $ xs)) $ ([V.fromList [x1,x2] | !x1 <- [0,1], !x2 <- [0,1] \\ [x1]]::[V.Vector Int])
      _ -> V.empty
         
-- | A first norm for the list of positive 'Int'. For not empty lists equals to the maximum element.
norm1 :: [Int] -> Int 
norm1 xs 
  | null xs = 0
  | otherwise = maximum xs

-- | A second norm for the list of positive 'Int'. For not empty lists equals to the sum of the elements.
norm2 :: [Int] -> Int
norm2 xs = sum xs 

-- | A third norm for the list of positive 'Int'. For not empty lists equals to the sum of the doubled maximum element and a rest elements of the list.
norm3 :: [Int] -> Int
norm3 xs 
 | null xs = 0
 | otherwise = maximum xs + sum xs

-- | A fourth norm for the list of positive 'Int'. Equals to the sum of the 'norm3' and 'norm2'.
norm4 :: [Int] -> Int
norm4 xs 
 | null xs = 0
 | otherwise = maximum xs + sum xs + maximum (xs \\ [maximum xs])

-- | A fifth norm for the list of positive '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
 | otherwise = sum xs `quot` (minimum xs + minimum (xs \\ [minimum xs]))

-- | A sixth norm for the list of positive 'Int'.
norm6 :: [Int] -> Int
norm6 xs = floor (fromIntegral (norm5 xs * sum xs) / fromIntegral (norm3 xs))

-- | Given a norm and a Ukrainian 'String' consisting of no more than 7 words (see also the information for 'uniquenessVariantG') returns the maximum by the
-- specified norm element of the 'uniquenessVariantsG' applied to the same arguments.
uniqMaxPoeticalG :: ([Int] -> Int) ->  String -> ([Int],Int,Int,Int,String)
uniqMaxPoeticalG g = V.maximumBy (\(_,_,_,x30,_) (_,_,_,x31,_) -> compare x30 x31) . uniquenessVariantsG g

fourFrom5 :: (a,b,b,b,c) -> (a,b,b,b)
fourFrom5 (x,y0,y1,y2,_) = (x,y0,y1,y2)

lastFrom5 :: (a,b,b,b,c) -> c
lastFrom5 (_,_,_,_,z) = z

-- | Similar to 'uniqMaxPoeticalG' but instead of resulting in a maximum element, outputs it by parts and returns the rest of the 'V.Vector' without this 
-- maximum element.
uniqInMaxPoetical :: V.Vector ([Int],Int,Int,Int,String) -> IO (V.Vector ([Int],Int,Int,Int,String))
uniqInMaxPoetical v = do
  let !uniq = V.maximumBy (\(_,_,_,x30,_) (_,_,_,x31,_) -> compare x30 x31) v
  putStrLn (filter (not . isPunctuation) . lastFrom5 $ uniq) >> print (fourFrom5 uniq) >> putStrLn "" 
  return . V.filter (/= uniq) $ v

-- | A variant of the 'uniqNPoeticalG' function with the @n@ equal to 10.
uniq10PoeticalG :: ([Int] -> Int) -> String -> IO ()
uniq10PoeticalG = uniqNPoeticalG 10

-- | A variant of 'uniq10PoeticalG' with the 'norm4' applied. The list is (according to some model, not universal, but a reasonable one in the most cases) the 
-- most suitable for intonation changing and, therefore, for the accompaniment of the highly changable or variative melody.
uniq10Poetical4 :: String -> IO ()
uniq10Poetical4 = uniq10PoeticalG norm4

-- | A variant of 'uniq10PoeticalG' with the 'norm5' applied. The list is (according to some model, not universal, but a reasonable one in the most cases) the 
-- most suitable for rhythmic speech and two-syllabilistic-based poetry. Therefore, it can be used to create a poetic composition or to emphasize some 
-- thoughts.
uniq10Poetical5 :: String -> IO ()
uniq10Poetical5 = uniq10PoeticalG norm5

-- | Recursive @n :: Int@ times application of the 'uniqInMaxPoetical' function. Prints @n@ (or less if there are less of them) maximum elements starting from 
-- the first and further to the rest. The norm given defines the way, in which the elements are considered the \"maximum\" ones.
uniqNPoetical :: Int -> V.Vector ([Int],Int,Int,Int,String) -> IO ()
uniqNPoetical n v 
 | n == 0 = return ()
 | compare (V.length v) n == LT = print v
 | otherwise = (uniqInMaxPoetical v >>= uniqNPoetical (n - 1))

-- | The result of the recursive @n :: Int@ times application of the 'uniqInMaxPoetical' function. The norm given defines the way, in which the elements 
-- are considered the \"maximum\" ones.
uniqNPoeticalV :: Int -> V.Vector ([Int],Int,Int,Int,String) -> IO (V.Vector ([Int],Int,Int,Int,String))
uniqNPoeticalV n v 
 | n == 0 || compare (V.length v) n == LT = return v
 | otherwise = (uniqInMaxPoetical v >>= uniqNPoeticalV (n - 1)) 

-- | Recursive @n :: Int@ times application of the 'uniqInMaxPoetical' function after the 'uniquenessVariantsG' application to the 'String'. 
-- Prints @n@ (or less if there are less of them) maximum elements starting from the first and further to the rest. The norm given defines the way, 
-- in which the elements are considered the \"maximum\" ones.
uniqNPoeticalG :: Int -> ([Int] -> Int) -> String -> IO ()
uniqNPoeticalG n g xs 
 | n == 0 = return ()
 | otherwise = do 
   let v = uniquenessVariantsG g xs
   if compare (V.length v) n == LT then print v else (uniqInMaxPoetical v >>= uniqNPoetical (n - 1))

-- | The result of the recursive @n :: Int@ times application of the 'uniqInMaxPoetical' function after the 'uniquenessVariantsG' application to the 'String'. 
-- The norm given defines the way, in which the elements are considered the \"maximum\" ones.
uniqNPoeticalVG :: Int -> ([Int] -> Int) -> String -> IO (V.Vector ([Int],Int,Int,Int,String))
uniqNPoeticalVG n g xs 
 | n == 0 = return V.empty
 | otherwise = do 
   let v = uniquenessVariantsG g xs
   if compare (V.length v) n == LT then return v else uniqNPoeticalV n v