{-# LANGUAGE BangPatterns #-}
module DobutokO.Poetry (
uniq10Poetical4
, uniq10Poetical5
, uniq10PoeticalG
, uniqNPoeticalG
, uniqNPoetical
, uniqNPoeticalV
, uniqNPoeticalVG
, uniquenessVariantsG
, uniquenessVariants3
, uniquenessVariants4
, uniqMaxPoeticalG
, uniqInMaxPoetical
, norm1
, norm2
, norm3
, norm4
, norm5
, norm6
, fourFrom5
, lastFrom5
) where
import Control.Monad
import Data.Char (isPunctuation)
import qualified Data.Vector as V
import Data.List ((\\))
import MMSyn7s
uniquenessVariants3 :: String -> V.Vector ([Int],Int,Int,Int,String)
uniquenessVariants3 = uniquenessVariantsG norm3
uniquenessVariants4 :: String -> V.Vector ([Int],Int,Int,Int,String)
uniquenessVariants4 = uniquenessVariantsG norm4
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
norm1 :: [Int] -> Int
norm1 xs
| null xs = 0
| otherwise = maximum xs
norm2 :: [Int] -> Int
norm2 xs = sum xs
norm3 :: [Int] -> Int
norm3 xs
| null xs = 0
| otherwise = maximum xs + sum xs
norm4 :: [Int] -> Int
norm4 xs
| null xs = 0
| otherwise = maximum xs + sum xs + maximum (xs \\ [maximum xs])
norm5 :: [Int] -> Int
norm5 xs
| null xs = 0
| otherwise = sum xs `quot` (minimum xs + minimum (xs \\ [minimum xs]))
norm6 :: [Int] -> Int
norm6 xs = floor (fromIntegral (norm5 xs * sum xs) / fromIntegral (norm3 xs))
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
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
uniq10PoeticalG :: ([Int] -> Int) -> String -> IO ()
uniq10PoeticalG = uniqNPoeticalG 10
uniq10Poetical4 :: String -> IO ()
uniq10Poetical4 = uniq10PoeticalG norm4
uniq10Poetical5 :: String -> IO ()
uniq10Poetical5 = uniq10PoeticalG norm5
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))
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))
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))
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