diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,3 +15,7 @@ ## 0.2.0.0 -- 2020-11-07 * Second version. Added new metrices based on the new syllable durations generated with r-glpk-phonetic-languages-ukrainian-durations package. + +## 0.3.0.0 -- 2020-11-09 + +* Third version. Added a possibility to use versions with the coefficients (using new data type Coeffs2). diff --git a/Languages/UniquenessPeriods/Vector/PropertiesFuncRepG.hs b/Languages/UniquenessPeriods/Vector/PropertiesFuncRepG.hs --- a/Languages/UniquenessPeriods/Vector/PropertiesFuncRepG.hs +++ b/Languages/UniquenessPeriods/Vector/PropertiesFuncRepG.hs @@ -50,6 +50,8 @@ import GHC.Float (int2Float) import Melodics.ByteString.Ukrainian import Languages.Phonetic.Ukrainian.Syllable +import Data.Maybe (isNothing,fromMaybe) +import Text.Read (readMaybe) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__==708 @@ -75,97 +77,143 @@ procDiverse2Fneg = D2 (uniquenessPeriodsVector3 " 01-" . convertToProperUkrainianV2X) ((:[]) . int2Float . negate . fromEnum . diverse2) {-# INLINE procDiverse2Fneg #-} -procRhythmicity23F :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procRhythmicity23F = procRhythm23F rhythmicityV0 +-------------------------------------------------------------------------------------------- + +procRhythmicity23F :: String -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythmicity23F choice coeffs = procRhythm23F choice rhythmicityV coeffs {-# INLINE procRhythmicity23F #-} -- | Can be used to find out the minimum element. -procRhythmicity23Fneg :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procRhythmicity23Fneg = procRhythm23Fneg rhythmicityV0 +procRhythmicity23Fneg :: String -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythmicity23Fneg choice coeffs = procRhythm23Fneg choice rhythmicityV coeffs {-# INLINE procRhythmicity23Fneg #-} -procBothF :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBothF = procB2F syllableDurations +procBothF :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBothF coeffs = procB2F syllableDurations coeffs {-# INLINE procBothF #-} -- | Can be used to find out the minimum element. -procBothFneg :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBothFneg = procB2Fneg syllableDurations +procBothFneg :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBothFneg coeffs = procB2Fneg syllableDurations coeffs {-# INLINE procBothFneg #-} -procBothInvF :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBothInvF = procB2InvF syllableDurations +procBothInvF :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBothInvF coeffs = procB2InvF syllableDurations coeffs {-# INLINE procBothInvF #-} -- | Can be used to find out the minimum element. -procBothInvFneg :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBothInvFneg = procB2InvFneg syllableDurations +procBothInvFneg :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBothInvFneg coeffs = procB2InvFneg syllableDurations coeffs {-# INLINE procBothInvFneg #-} ------------------------------------------------------------------------------- -procRhythmicity232F :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procRhythmicity232F = procRhythm23F rhythmicityV02 +procRhythmicity232F :: String -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythmicity232F choice coeffs = procRhythm23F choice rhythmicityV coeffs {-# INLINE procRhythmicity232F #-} -- | Can be used to find out the minimum element. -procRhythmicity232Fneg :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procRhythmicity232Fneg = procRhythm23Fneg rhythmicityV02 +procRhythmicity232Fneg :: String -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythmicity232Fneg choice coeffs = procRhythm23Fneg choice rhythmicityV coeffs {-# INLINE procRhythmicity232Fneg #-} -procBoth2F :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBoth2F = procB2F syllableDurations2 +procBoth2F :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBoth2F coeffs = procB2F syllableDurations2 coeffs {-# INLINE procBoth2F #-} -- | Can be used to find out the minimum element. -procBoth2Fneg :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBoth2Fneg = procB2Fneg syllableDurations2 +procBoth2Fneg :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBoth2Fneg coeffs = procB2Fneg syllableDurations2 coeffs {-# INLINE procBoth2Fneg #-} -procBoth2InvF :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBoth2InvF = procB2InvF syllableDurations2 +procBoth2InvF :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBoth2InvF coeffs = procB2InvF syllableDurations2 coeffs {-# INLINE procBoth2InvF #-} -- | Can be used to find out the minimum element. -procBoth2InvFneg :: FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procBoth2InvFneg = procB2InvFneg syllableDurations2 +procBoth2InvFneg :: Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procBoth2InvFneg coeffs = procB2InvFneg syllableDurations2 coeffs {-# INLINE procBoth2InvFneg #-} ------------------------------------------------------------- -procRhythm23F :: (VB.Vector Char -> Float) -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procRhythm23F g = U1 ((:[]) . g) +eval23Coeffs :: Coeffs2 -> [Float] -> Float +eval23Coeffs (CF2 x y) = evalRhythmicity23K (fromMaybe 1.0 x) (fromMaybe 1.0 y) +eval23Coeffs CF0 = evalRhythmicity23 + +procRhythm23F :: String -> (String -> Coeffs2 -> VB.Vector Char -> Float) -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythm23F choice g coeffs = U1 ((:[]) . g choice coeffs) {-# INLINE procRhythm23F #-} -procRhythm23Fneg :: (VB.Vector Char -> Float) -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procRhythm23Fneg g = U1 ((:[]) . negate . g) +procRhythm23Fneg :: String -> (String -> Coeffs2 -> VB.Vector Char -> Float) -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythm23Fneg choice g coeffs = U1 ((:[]) . negate . g choice coeffs) {-# INLINE procRhythm23Fneg #-} -procB2F :: ([[[UZPP2]]] -> [[Float]]) -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procB2F g = U1 (\v -> let ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v in (:[]) ((int2Float . fromEnum . diverse2 . uniquenessPeriodsVector3 " 01-" . VB.fromList $ ys)*(evalRhythmicity23 . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys))) +procB2F :: ([[[UZPP2]]] -> [[Float]]) -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2F g coeffs = U1 (\v -> let ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v in (:[]) ((int2Float . fromEnum . diverse2 . uniquenessPeriodsVector3 " 01-" . VB.fromList $ ys)*(eval23Coeffs coeffs . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys))) {-# INLINE procB2F #-} -- | Can be used to find out the minimum element. -procB2Fneg :: ([[[UZPP2]]] -> [[Float]]) -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procB2Fneg g = U1 (\v -> let ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v in (:[]) ((int2Float . negate . fromEnum . diverse2 . uniquenessPeriodsVector3 " 01-" . - VB.fromList$ ys)*(evalRhythmicity23 . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys))) +procB2Fneg :: ([[[UZPP2]]] -> [[Float]]) -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2Fneg g coeffs = U1 (\v -> let ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v in (:[]) ((int2Float . negate . fromEnum . diverse2 . uniquenessPeriodsVector3 " 01-" . + VB.fromList$ ys)*(eval23Coeffs coeffs . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys))) {-# INLINE procB2Fneg #-} -procB2InvF :: ([[[UZPP2]]] -> [[Float]]) -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procB2InvF g = U1 (\v -> +procB2InvF :: ([[[UZPP2]]] -> [[Float]]) -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2InvF g coeffs = U1 (\v -> let !ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v !zs = uniquenessPeriodsVector3 " 01-" . VB.fromList $ ys in if VB.null zs then (:[]) ((evalRhythmicity23 . mconcat . g . map (divVwls . + reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) * (eval23Coeffs coeffs . mconcat . g . map (divVwls . reSyllableCntnts . + groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys)) else (:[]) ((eval23Coeffs coeffs . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . + vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) / (int2Float . fromEnum . diverse2 $ zs))) +{-# INLINE procB2InvF #-} + +-- | Can be used to find out the minimum element. +procB2InvFneg :: ([[[UZPP2]]] -> [[Float]]) -> Coeffs2 -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2InvFneg g coeffs = U1 (\v -> + let !ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v + !zs = uniquenessPeriodsVector3 " 01-" .VB.fromList $ ys in if VB.null zs then (:[]) (negate (eval23Coeffs coeffs . mconcat . g . map (divVwls . + reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) * (eval23Coeffs coeffs . mconcat . g . map (divVwls . reSyllableCntnts . + groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys)) else (:[]) ((eval23Coeffs coeffs . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . + vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) / (int2Float . negate . fromEnum . diverse2 $ zs))) +{-# INLINE procB2InvFneg #-} + +--------------------------------------------------------------- +{- +procRhythm23FK :: (Float -> Float -> VB.Vector Char -> Float) -> Float -> Float -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythm23FK g k2 k3 = U1 ((:[]) . g k2 k3) +{-# INLINE procRhythm23FK #-} + +procRhythm23FKneg :: (Float -> Float -> VB.Vector Char -> Float) -> Float -> Float -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procRhythm23FKneg g k2 k3 = U1 ((:[]) . negate . g k2 k3) +{-# INLINE procRhythm23FKneg #-} + +procB2FK :: (Float -> Float -> [[[UZPP2]]] -> Float -> Float -> [[Float]]) -> Float -> Float -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2FK g k2 k3 = U1 (\v -> let ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v in (:[]) ((int2Float . fromEnum . diverse2 . uniquenessPeriodsVector3 " 01-" . VB.fromList $ ys)*(evalRhythmicity23K k2 k3 . mconcat . g k2 k3 . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys))) +{-# INLINE procB2FK #-} + +-- | Can be used to find out the minimum element. +procB2FKneg :: (Float -> Float -> [[[UZPP2]]] -> Float -> Float -> [[Float]]) -> Float -> Float -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2FKneg g k2 k3 = U1 (\v -> let ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v in (:[]) ((int2Float . negate . fromEnum . diverse2 . uniquenessPeriodsVector3 " 01-" . + VB.fromList$ ys)*(evalRhythmicity23K k2 k3 . mconcat . g k2 k3 . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys))) +{-# INLINE procB2FKneg #-} + +procB2InvFK :: (Float -> Float -> [[[UZPP2]]] -> Float -> Float -> [[Float]]) -> Float -> Float -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2InvFK g k2 k3 = U1 (\v -> + let !ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v + !zs = uniquenessPeriodsVector3 " 01-" . VB.fromList $ ys in if VB.null zs then (:[]) ((evalRhythmicity23 . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) * (evalRhythmicity23 . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys)) else (:[]) ((evalRhythmicity23 . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) / (int2Float . fromEnum . diverse2 $ zs))) -{-# INLINE procB2InvF #-} +{-# INLINE procB2InvFK #-} -- | Can be used to find out the minimum element. -procB2InvFneg :: ([[[UZPP2]]] -> [[Float]]) -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] -procB2InvFneg g = U1 (\v -> +procB2InvFKneg :: ([[[UZPP2]]] -> Float -> Float -> [[Float]]) -> Float -> Float -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float] +procB2InvFKneg g k2 k3 = U1 (\v -> let !ys = convertToProperUkrainianV2S . VB.map (\x -> if x == '-' then ' ' else x) $ v - !zs = uniquenessPeriodsVector3 " 01-" .VB.fromList $ ys in if VB.null zs then (:[]) (negate (evalRhythmicity23 . mconcat . g . map (divVwls . + !zs = uniquenessPeriodsVector3 " 01-" .VB.fromList $ ys in if VB.null zs then (:[]) (negate (evalRhythmicity23K . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) * (evalRhythmicity23 . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys)) else (:[]) ((evalRhythmicity23 . mconcat . g . map (divVwls . reSyllableCntnts . groupSnds . vec2UZPP2s) . vecWords . V.filter (/='0') . V.fromList $ ys) / (int2Float . negate . fromEnum . diverse2 $ zs))) -{-# INLINE procB2InvFneg #-} +{-# INLINE procB2InvFKneg #-} +-} diff --git a/Languages/UniquenessPeriods/Vector/PropertiesSyllablesG.hs b/Languages/UniquenessPeriods/Vector/PropertiesSyllablesG.hs --- a/Languages/UniquenessPeriods/Vector/PropertiesSyllablesG.hs +++ b/Languages/UniquenessPeriods/Vector/PropertiesSyllablesG.hs @@ -9,12 +9,20 @@ -- and DobutokO.Poetry.Norms.Extended modules -- from the @dobutokO-poetry@ package. Uses syllables information. -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, BangPatterns #-} module Languages.UniquenessPeriods.Vector.PropertiesSyllablesG ( + -- * Newtype to work with + CoeffTwo(..) + , Coeffs2 + , isEmpty + , isPair + , fstCF + , sndCF + , readCF -- * Rhythmicity metrices (semi-empirical) -- ** Simple ones - rhythmicity0 + , rhythmicity0 , rhythmicityV0 -- ** With weight coefficients , rhythmicityVK @@ -26,6 +34,9 @@ -- ** With weight coefficients , rhythmicityVK2 , rhythmicityK2 + -- * General + , rhythmicity + , rhythmicityV ) where #ifdef __GLASGOW_HASKELL__ @@ -37,6 +48,8 @@ import qualified Data.Vector as VB import Languages.Rhythmicity import Languages.Phonetic.Ukrainian.Syllable +import Data.Maybe (isNothing,fromMaybe) +import Text.Read (readMaybe) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__==708 @@ -45,6 +58,34 @@ #endif #endif +data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (Eq) + +isEmpty :: CoeffTwo a -> Bool +isEmpty CF0 = True +isEmpty _ = False + +isPair :: CoeffTwo a -> Bool +isPair CF0 = False +isPair _ = True + +fstCF :: CoeffTwo a -> Maybe a +fstCF (CF2 x _) = x +fstCF _ = Nothing + +sndCF :: CoeffTwo a -> Maybe a +sndCF (CF2 _ y) = y +sndCF _ = Nothing + +readCF :: String -> Coeffs2 +readCF xs + | any (== '_') xs = let (!ys,!zs) = (\(ks,ts) -> (readMaybe ks::Maybe Float,readMaybe (drop 1 ts)::Maybe Float)) . break (== '_') $ xs in + if (isNothing ys && isNothing zs) then CF0 else CF2 ys zs + | otherwise = CF0 + +type Coeffs2 = CoeffTwo Float + +-------------------------------------------------------------------------------------------- + eval23 = evalRhythmicity23 . mconcat {-# INLINE eval23 #-} @@ -92,3 +133,21 @@ rhythmicityVK2 k2 k3 v | VB.null v = 0.0 | otherwise = eval23K k2 k3 . syllableDurations2 . createSyllablesUkrVP $ v + +------------------------------------------------------------------ + +rhythmicity :: String -> Coeffs2 -> String -> Float +rhythmicity choice CF0 + | choice == "0y" = rhythmicity0 + | otherwise = rhythmicity02 +rhythmicity choice (CF2 x y) + | choice == "0y" = rhythmicityK (fromMaybe 1.0 x) (fromMaybe 1.0 y) + | otherwise = rhythmicityK2 (fromMaybe 1.0 x) (fromMaybe 1.0 y) + +rhythmicityV :: String -> Coeffs2 -> VB.Vector Char -> Float +rhythmicityV choice CF0 + | choice == "0y" = rhythmicityV0 + | otherwise = rhythmicityV02 +rhythmicityV choice (CF2 x y) + | choice == "0y" = rhythmicityVK (fromMaybe 1.0 x) (fromMaybe 1.0 y) + | otherwise = rhythmicityVK2 (fromMaybe 1.0 x) (fromMaybe 1.0 y) diff --git a/phonetic-languages-properties.cabal b/phonetic-languages-properties.cabal --- a/phonetic-languages-properties.cabal +++ b/phonetic-languages-properties.cabal @@ -2,7 +2,7 @@ -- For further documentation, see http://haskell.org/cabal/users-guide/ name: phonetic-languages-properties -version: 0.2.0.0 +version: 0.3.0.0 synopsis: A generalization of the uniqueness-periods-vector-properties package. -- description: homepage: https://hackage.haskell.org/package/phonetic-languages-properties @@ -20,6 +20,6 @@ exposed-modules: Languages.UniquenessPeriods.Vector.PropertiesG, Languages.UniquenessPeriods.Vector.PropertiesFuncRepG, Languages.UniquenessPeriods.Vector.PropertiesSyllablesG -- other-modules: other-extensions: BangPatterns, CPP - build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, phonetic-languages-vector >=0.1 && <1, phonetic-languages-rhythmicity >=0.1.2 && <1, phonetic-languages-common >=0.1.1 && <1, ukrainian-phonetics-basic >=0.2 && <1 + build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, phonetic-languages-vector >=0.1 && <1, phonetic-languages-rhythmicity >=0.1.2 && <1, phonetic-languages-common >=0.1.1 && <1, ukrainian-phonetics-basic >=0.2.0.1 && <1 -- hs-source-dirs: default-language: Haskell2010