{-# LANGUAGE BangPatterns #-}
module DobutokO.Poetry (
Uniqueness
, uniq10Poetical4
, uniq10Poetical5
, uniq10PoeticalG
, uniqNPoeticalG
, uniqNPoeticalGN
, uniqNPoetical
, uniqNPoeticalN
, uniqNPoeticalV
, uniqNPoeticalVN
, uniqNPoeticalVG
, uniqNPoeticalVGN
, uniquenessVariantsG
, uniquenessVariantsGN
, uniquenessVariants3
, uniquenessVariants4
, uniqMaxPoeticalG
, uniqMaxPoeticalGN
, uniqMaxPoeticalGNV
, uniqInMaxPoetical
, uniqInMaxPoeticalN
, uniqNPoetical2GN
, uniqNPoetical2VGN
, uniqNPoeticalUGN_
, uniqNPoeticalUGN
, uniqNPoeticalUGN51_
, uniqNPoeticalUGN51
, uniquenessVariants2GN
, uniqMaxPoetical2GN
, uniqInMaxPoeticalNLine
, uniqNPoeticalNLine
, uniqNPoetical2GNLine
) where
import Data.Char (isPunctuation)
import qualified Data.Vector as V
import Data.List ((\\))
import MMSyn7s
import DobutokO.Poetry.Norms
import DobutokO.Poetry.Auxiliary
import DobutokO.Poetry.UniquenessPeriodsG
type Uniqueness = ([Int],V.Vector Int,String)
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
uniquenessVariantsGN :: V.Vector ([Int] -> Int) -> String -> V.Vector Uniqueness
uniquenessVariantsGN vN = uniquenessVariants2GN vN (uniquenessPeriods)
uniqMaxPoeticalG :: ([Int] -> Int) -> String -> ([Int],Int,Int,Int,String)
uniqMaxPoeticalG g = V.maximumBy (\(_,_,_,x30,_) (_,_,_,x31,_) -> compare x30 x31) . uniquenessVariantsG g
uniqMaxPoeticalGN :: Int -> V.Vector ([Int] -> Int) -> String -> Uniqueness
uniqMaxPoeticalGN k vN = uniqMaxPoetical2GN k vN (uniquenessPeriods)
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
uniqInMaxPoeticalN :: Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> IO (V.Vector Uniqueness)
uniqInMaxPoeticalN k vN v = do
let !uniq = uniqMaxPoeticalGNV k vN v
putStrLn (filter (not . isPunctuation) . lastFrom3 $ uniq) >> print (twoFrom3 uniq) >> putStrLn ""
return . V.filter (/= uniq) $ v
uniqInMaxPoeticalNLine :: Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> IO (V.Vector Uniqueness)
uniqInMaxPoeticalNLine k vN v = do
let !uniq = uniqMaxPoeticalGNV k vN v
putStr (filter (not . isPunctuation) . lastFrom3 $ uniq) >> putStr " "
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 = V.mapM_ (\x -> putStrLn (filter (not . isPunctuation) . lastFrom5 $ x) >> print (fourFrom5 x) >> putStrLn "" ) v
| otherwise = (uniqInMaxPoetical v >>= uniqNPoetical (n - 1))
uniqNPoeticalN :: Int -> Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> IO ()
uniqNPoeticalN n k vN v
| n == 0 = return ()
| compare (V.length v) n == LT = V.mapM_ (\x -> putStrLn (filter (not . isPunctuation) . lastFrom3 $ x) >> print (twoFrom3 x) >> putStrLn "" ) v
| otherwise = (uniqInMaxPoeticalN k vN v >>= uniqNPoeticalN (n - 1) k vN)
uniqNPoeticalNLine :: Int -> Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> IO ()
uniqNPoeticalNLine n k vN v
| n == 0 = putStrLn ""
| compare (V.length v) n == LT = V.mapM_ (\x -> putStr (filter (not . isPunctuation) . lastFrom3 $ x) >> putStr " " ) v >> putStrLn ""
| otherwise = (uniqInMaxPoeticalNLine k vN v >>= uniqNPoeticalNLine (n - 1) k vN)
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))
uniqNPoeticalVN :: Int -> Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> IO (V.Vector Uniqueness)
uniqNPoeticalVN n k vN v
| n == 0 || compare (V.length v) n == LT = return v
| otherwise = (uniqInMaxPoeticalN k vN v >>= uniqNPoeticalVN (n - 1) k vN)
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 V.mapM_ (\x -> putStrLn (filter (not . isPunctuation) . lastFrom5 $ x) >> print (fourFrom5 x) >> putStrLn "" ) v
else (uniqInMaxPoetical v >>= uniqNPoetical (n - 1))
uniqNPoeticalGN :: Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()
uniqNPoeticalGN n k vN = uniqNPoetical2GN n k vN (uniquenessPeriods)
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
uniqNPoeticalVGN :: Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO (V.Vector Uniqueness)
uniqNPoeticalVGN n k vN = uniqNPoetical2VGN n k vN (uniquenessPeriods)
uniquenessVariants2GN :: V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> V.Vector Uniqueness
uniquenessVariants2GN vN g xs
| null xs = V.empty
| otherwise =
case V.length . V.fromList . take 7 . words $ xs of
7 ->
V.fromList . map ((\vs -> let !rs = g vs in (rs, V.map (\f -> f rs) vN, 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 = g vs in (rs, V.map (\f -> f rs) vN, 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 = g vs in (rs, V.map (\f -> f rs) vN, 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 = g vs in (rs, V.map (\f -> f rs) vN, 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 = g vs in (rs, V.map (\f -> f rs) vN, 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 = g vs in (rs, V.map (\f -> f rs) vN, 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
uniqMaxPoetical2GN :: Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> Uniqueness
uniqMaxPoetical2GN k vN g xs
| compare k (V.length vN) == GT = error "DobutokO.Poetry.uniqMaxPoetical2GN: undefined for that amount of norms. "
| compare k 0 == GT =
let vM = uniquenessVariants2GN vN g xs
maxK = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 (k - 1)) (V.unsafeIndex vN1 (k - 1))) vM
vK = V.filter (\(_,vN2,_) -> V.unsafeIndex vN2 (k - 1) == ((\(_,vNk,_) -> V.unsafeIndex vNk (k - 1)) maxK)) vM in
uniqMaxPoeticalGNV (k - 1) (V.unsafeSlice 0 (V.length vN - 1) vN) vK
| otherwise = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 0) (V.unsafeIndex vN1 0)) . uniquenessVariantsGN vN $ xs
uniqMaxPoeticalGNV :: Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> Uniqueness
uniqMaxPoeticalGNV k vN vM
| compare k (V.length vN) == GT = error "DobutokO.Poetry.uniqMaxPoeticalGNV: undefined for that amount of norms. "
| compare k 0 == GT =
let maxK = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 (k - 1)) (V.unsafeIndex vN1 (k - 1))) vM
vK = V.filter (\(_,vN2,_) -> V.unsafeIndex vN2 (k - 1) == ((\(_,vNk,_) -> V.unsafeIndex vNk (k - 1)) maxK)) vM in
uniqMaxPoeticalGNV (k - 1) (V.unsafeSlice 0 (V.length vN - 1) vN) vK
| otherwise = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 0) (V.unsafeIndex vN1 0)) vM
uniqNPoetical2GN :: Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO ()
uniqNPoetical2GN n k vN g xs
| n == 0 = return ()
| otherwise = do
let v = uniquenessVariants2GN vN g xs
if compare (V.length v) n == LT
then V.mapM_ (\x -> putStrLn ((filter (not . isPunctuation) . lastFrom3 $ x)) >> print (twoFrom3 x) >> putStrLn "" ) v
else (uniqInMaxPoeticalN k vN v >>= uniqNPoeticalN (n - 1) k vN)
uniqNPoetical2GNLine :: Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO ()
uniqNPoetical2GNLine n k vN g xs
| n == 0 = putStrLn ""
| otherwise = do
let v = uniquenessVariants2GN vN g xs
if compare (V.length v) n == LT
then V.mapM_ (\x -> putStr ((filter (not . isPunctuation) . lastFrom3 $ x)) >> putStr " " ) v >> putStrLn ""
else (uniqInMaxPoeticalNLine k vN v >>= uniqNPoeticalNLine (n - 1) k vN)
uniqNPoetical2VGN :: Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO (V.Vector Uniqueness)
uniqNPoetical2VGN n k vN g xs
| n == 0 = return V.empty
| otherwise = do
let v = uniquenessVariants2GN vN g xs
if compare (V.length v) n == LT then return v else uniqNPoeticalVN n k vN v
uniqNPoeticalUGN_ :: Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()
uniqNPoeticalUGN_ x n k vN = uniqNPoetical2GN n k vN (uniquenessPeriods2 x)
uniqNPoeticalUGN :: Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO (V.Vector Uniqueness)
uniqNPoeticalUGN x n k vN = uniqNPoetical2VGN n k vN (uniquenessPeriods2 x)
uniqNPoeticalUGN51_ :: Int -> Int -> String -> IO ()
uniqNPoeticalUGN51_ x n = uniqNPoeticalUGN_ x n 1 (V.singleton norm51)
uniqNPoeticalUGN51 :: Int -> Int -> String -> IO (V.Vector Uniqueness)
uniqNPoeticalUGN51 x n = uniqNPoeticalUGN x n 1 (V.singleton norm51)