aftovolio-0.1.0.0: Aftovolio/Partir.hs

{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Aftovolio.Partir
-- Copyright   :  (c) Oleksandr Zhabenko 2022-2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- 

{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses, NoImplicitPrelude #-}

module Aftovolio.Partir where

import GHC.Base
import GHC.Num
import GHC.Real
import GHC.Float
import qualified Data.Foldable as F
import Data.InsertLeft (InsertLeft(..)) 
import Aftovolio.DataG
import Aftovolio.Basis
import Data.Char (isDigit)
import Data.List (uncons, filter, null)
import Data.Maybe (fromJust, fromMaybe)
import Text.Read (readMaybe)

class F.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
{-# INLINE partitioningR #-}
{-# SPECIALIZE  partitioningR 
  :: String
  -> [Result [] Char Double Double]
  -> ([Result [] Char Double Double], [Result [] Char Double Double])#-}

partitioningR2
  :: (InsertLeft t2 (Result2 a b Double), Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double, Monoid (t2 Double)) => String
  -> t2 (Result2 a b Double)
  -> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 !xs dataR
 | F.null dataR = (mempty,mempty)
 | otherwise = partiR2 (decodeCDouble xs) dataR
{-# INLINE partitioningR2 #-}
{-# SPECIALIZE partitioningR2 :: (Eq a) => String
  -> [Result2 a Double Double]
  -> ([Result2 a Double Double], [Result2 a Double Double]) #-}