{-# LANGUAGE NoImplicitPrelude #-}
module Phladiprelio.General.Simple where
import GHC.Base
import GHC.Enum (fromEnum)
import GHC.Real (fromIntegral,(/))
import Text.Show (show)
import Phladiprelio.General.PrepareText
import Phladiprelio.General.Syllables
import Phladiprelio.General.Base
import System.Environment (getArgs)
import GHC.Num ((+),(-),(*))
import Text.Read (readMaybe)
import System.IO (putStrLn, FilePath)
import Rhythmicity.MarkerSeqs hiding (id)
import Rhythmicity.BasicF
import Data.List hiding (foldr)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Tuple (fst,snd)
import CLI.Arguments
import CLI.Arguments.Get
import CLI.Arguments.Parsing
import GHC.Int (Int8)
import Data.Ord (comparing)
generalF
:: GWritingSystemPRPLX
-> [(Char,Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> Int
-> HashCorrections
-> (Int8,[Int8])
-> Bool
-> [String]
-> IO [()]
generalF :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> Int
-> HashCorrections
-> (Int8, [Int8])
-> Bool
-> [String]
-> IO [()]
generalF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h Int
numTest HashCorrections
hc (Int8
grps,[Int8]
mxms) Bool
descending [String]
rss = do
let syllN :: Int
syllN = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (GWritingSystemPRPLX
-> CharPhoneticClassification -> String -> String -> String -> Int
countSyll GWritingSystemPRPLX
wrs CharPhoneticClassification
arr String
us String
vs) forall a b. (a -> b) -> a -> b
$ [String]
rss
universalSet :: [String]
universalSet = forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
permutations forall a b. (a -> b) -> a -> b
$ [String]
rss
f :: Int8 -> [Int8] -> String -> Integer
f Int8
grps [Int8]
mxms = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Ord a =>
HashCorrections -> Int8 -> [Int8] -> [a] -> [Integer]
countHashesG HashCorrections
hc Int8
grps [Int8]
mxms forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[PRS]]] -> [[Double]]
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> [[[PRS]]]
createSyllablesPL GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs
if Int
numTest forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0,Int
2] then do
String -> IO ()
putStrLn String
"Feet Val Stat Proxim"
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Int8
q,[Int8]
qs) -> let m :: Int
m = Int -> (Int8, [Int8]) -> Int
stat1 Int
syllN (Int8
q,[Int8]
qs) in let max1 :: String
max1 = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int8 -> [Int8] -> String -> Integer
f Int8
q [Int8]
qs)) [String]
universalSet in let mx :: Integer
mx = Int8 -> [Int8] -> String -> Integer
f Int8
q [Int8]
qs String
max1 in String -> IO ()
putStrLn (forall a. Show a => a -> String
show (forall a. Enum a => a -> Int
fromEnum Int8
q) forall a. Monoid a => a -> a -> a
`mappend` String
" | " forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show Integer
mx forall a. Monoid a => a -> a -> a
`mappend` String
" " forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show Int
m forall a. Monoid a => a -> a -> a
`mappend` String
" -> " forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show (Double
100 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
mx forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) forall a. Monoid a => a -> a -> a
`mappend` String
"%")) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. [a] -> [b] -> [(a, b)]
zip [Int8
2..Int8
7] forall a b. (a -> b) -> a -> b
$ ([Int8
1]forall a. a -> [a] -> [a]
:(if Int
numTest forall a. Eq a => a -> a -> Bool
== Int
0 then [[Int8
2,Int8
1],[Int8
3,Int8
2],[Int8
4,Int8
3,Int8
2],[Int8
5,Int8
4,Int8
3],[Int8
6,Int8
5,Int8
4,Int8
3,Int8
2]] else [[Int8
2],[Int8
3],[Int8
4,Int8
3],[Int8
5,Int8
4],[Int8
6,Int8
5,Int8
4]]))
else forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Integer
x,String
y) -> String -> IO ()
putStrLn (forall a. Show a => a -> String
show Integer
x forall a. Monoid a => a -> a -> a
`mappend` (Char
' 'forall a. a -> [a] -> [a]
:String
y))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (let h1 :: (a, b) -> (a, b)
h1 (a
u,b
w) = if Bool
descending then ((-a
1)forall a. Num a => a -> a -> a
*a
u,b
w) else (a
u,b
w) in forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall {a} {b}. Num a => (a, b) -> (a, b)
h1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
xss -> (Int8 -> [Int8] -> String -> Integer
f Int8
grps [Int8]
mxms String
xss, String
xss)) forall a b. (a -> b) -> a -> b
$ [String]
universalSet
countSyll
:: GWritingSystemPRPLX
-> CharPhoneticClassification
-> String
-> String
-> String
-> Int
countSyll :: GWritingSystemPRPLX
-> CharPhoneticClassification -> String -> String -> String -> Int
countSyll GWritingSystemPRPLX
wrs CharPhoneticClassification
arr String
us String
vs String
xs = forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\PRS
x Integer
y -> if PRS -> Bool
createsSyllable PRS
x then Integer
y forall a. Num a => a -> a -> a
+ Integer
1 else Integer
y) Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CharPhoneticClassification -> String -> [PRS]
str2PRSs CharPhoneticClassification
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs forall a b. (a -> b) -> a -> b
$ String
xs
where g :: Char -> Maybe Char
g :: Char -> Maybe Char
g Char
x
| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
us = forall a. Maybe a
Nothing
| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
vs = forall a. a -> Maybe a
Just Char
x
| Bool
otherwise = forall a. a -> Maybe a
Just Char
' '
words1 :: String -> [String]
words1 String
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts then [] else String
w forall a. a -> [a] -> [a]
: String -> [String]
words1 String
s''
where ts :: String
ts = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') String
xs
(String
w, String
s'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
' ') String
ts
{-# NOINLINE words1 #-}
stat1 :: Int -> (Int8,[Int8]) -> Int
stat1 :: Int -> (Int8, [Int8]) -> Int
stat1 Int
n (Int8
k, [Int8]
ks) = forall a b. (a, b) -> a
fst (Int
n Int -> Int -> (Int, Int)
`quotRemInt` forall a. Enum a => a -> Int
fromEnum Int8
k) forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int8]
ks
processingF
:: GWritingSystemPRPLX
-> [(Char,Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> Int
-> HashCorrections
-> (Int8,[Int8])
-> [[String]]
-> [[String]]
-> Bool
-> String
-> IO ()
processingF :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> Int
-> HashCorrections
-> (Int8, [Int8])
-> [[String]]
-> [[String]]
-> Bool
-> String
-> IO ()
processingF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h Int
numTest HashCorrections
hc (Int8
grps,[Int8]
mxms) [[String]]
ysss [[String]]
zsss Bool
descending String
xs = do
[String]
args <- IO [String]
getArgs
let str1 :: [String]
str1 = forall a. Int -> [a] -> [a]
take Int
7 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]] -> String -> String -> [String]
prepareText [[String]]
ysss [[String]]
zsss String
xs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ [String]
args
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([[[PRS]]] -> [[Double]])
-> Int
-> HashCorrections
-> (Int8, [Int8])
-> Bool
-> [String]
-> IO [()]
generalF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [[[PRS]]] -> [[Double]]
h Int
numTest HashCorrections
hc (Int8
grps,[Int8]
mxms) Bool
descending [String]
str1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()