{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module : Phonetic.Languages.Simplified.DataG.Partir
-- Copyright : (c) OleksandrZhabenko 2022
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
--
{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses #-}
module Phonetic.Languages.Simplified.DataG.Partir where
import qualified Data.Foldable as F
import Data.Monoid
import Data.SubG
import Data.MinMax.Preconditions
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Basis
import Data.Char (isDigit)
import Data.List (uncons)
import Data.Maybe (fromJust, fromMaybe)
import Text.Read (readMaybe)
class Foldable t => ConstraintsG t a where
decodeCDouble :: t a -> Double -> Bool
instance ConstraintsG [] Char where
decodeCDouble xs !y
| null xxs = True
| t < '2' = (if t == '0' then (>) else (<)) y (fromIntegral . fromMaybe 1 $ (readMaybe ts :: Maybe Integer))
| otherwise = getScale c cs t y
where xxs = filter isDigit xs
(t,ts) = fromJust . uncons $ xxs
(c,cs) = fromMaybe ('0',"1") . uncons $ ts
getScale c0 ws t0 y0
| c0 == '1' = (ords t0) (logBase 10 y0) base
| c0 == '2' = (ords t0) (637.0 * atan y0) base -- atan Infinity * 637.0 \approx 1000.0
| c0 == '3' = (ords t0) (sin (k * y0)) (0.01 * base1)
| c0 == '4' = (ords t0) (cos (k * y0)) (0.01 * base1)
| c0 == '5' = (ords t0) (sin (k * y0)) (0.001 * base2)
| c0 == '6' = (ords t0) (cos (k * y0)) (0.001 * base2)
| c0 == '7' = (ords t0) (sin (k * y0)) (-0.01 * base1)
| c0 == '8' = (ords t0) (cos (k * y0)) (-0.01 * base1)
| otherwise = (ords t0) (y0 ** k) base1
where base = fromIntegral . fromMaybe 1 $ (readMaybe ws :: Maybe Integer)
ords t0
| t0 == '2' = (>)
| otherwise = (<)
(w,wws) = fromMaybe ('2',"") . uncons $ ws
base1 = fromIntegral . fromMaybe 50 $ (readMaybe wws :: Maybe Integer)
base2 = fromIntegral . fromMaybe 500 $ (readMaybe wws :: Maybe Integer)
k = fromIntegral . fromMaybe 2 $ (readMaybe [w] :: Maybe Integer)
partitioningR
:: (InsertLeft t2 (Result [] Char b Double), Monoid (t2 (Result [] Char b Double)), InsertLeft t2 Double, Monoid (t2 Double)) => String
-> t2 (Result [] Char b Double)
-> (t2 (Result [] Char b Double), t2 (Result [] Char b Double))
partitioningR !xs dataR
| F.null dataR = (mempty,mempty)
| otherwise = partiR (decodeCDouble xs) dataR
{-# INLINABLE partitioningR #-}