{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK show-extensions #-}

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

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

class (F.Foldable t) => ConstraintsG t a where
    decodeCDouble :: t a -> Double -> Bool

instance ConstraintsG [] Char where
    decodeCDouble :: [Char] -> Double -> Bool
decodeCDouble [Char]
xs !Double
y
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
xxs = Bool
True
        | Char
t Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'2' =
            (if Char
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' then Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(>) else Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
(<))
                Double
y
                (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double)
-> (Maybe Integer -> Integer) -> Maybe Integer -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
1 (Maybe Integer -> Double) -> Maybe Integer -> Double
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ts :: Maybe Integer))
        | Bool
otherwise = Char -> [Char] -> Char -> Double -> Bool
forall {a}.
(Ord a, Floating a) =>
Char -> [Char] -> Char -> a -> Bool
getScale Char
c [Char]
cs Char
t Double
y
      where
        xxs :: [Char]
xxs = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit [Char]
xs
        (Char
t, [Char]
ts) = Maybe (Char, [Char]) -> (Char, [Char])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Char, [Char]) -> (Char, [Char]))
-> ([Char] -> Maybe (Char, [Char])) -> [Char] -> (Char, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe (Char, [Char])
forall a. [a] -> Maybe (a, [a])
uncons ([Char] -> (Char, [Char])) -> [Char] -> (Char, [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
xxs
        (Char
c, [Char]
cs) = (Char, [Char]) -> Maybe (Char, [Char]) -> (Char, [Char])
forall a. a -> Maybe a -> a
fromMaybe (Char
'0', [Char]
"1") (Maybe (Char, [Char]) -> (Char, [Char]))
-> ([Char] -> Maybe (Char, [Char])) -> [Char] -> (Char, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe (Char, [Char])
forall a. [a] -> Maybe (a, [a])
uncons ([Char] -> (Char, [Char])) -> [Char] -> (Char, [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
ts
        getScale :: Char -> [Char] -> Char -> a -> Bool
getScale Char
c0 [Char]
ws Char
t0 a
y0
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
10 a
y0) a
base
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'2' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a
637.0 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
atan a
y0) a
base -- atan Infinity * 637.0 \approx 1000.0
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'3' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a -> a
forall a. Floating a => a -> a
sin (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
y0)) (a
0.01 a -> a -> a
forall a. Num a => a -> a -> a
* a
base1)
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'4' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a -> a
forall a. Floating a => a -> a
cos (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
y0)) (a
0.01 a -> a -> a
forall a. Num a => a -> a -> a
* a
base1)
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'5' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a -> a
forall a. Floating a => a -> a
sin (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
y0)) (a
0.001 a -> a -> a
forall a. Num a => a -> a -> a
* a
base2)
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'6' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a -> a
forall a. Floating a => a -> a
cos (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
y0)) (a
0.001 a -> a -> a
forall a. Num a => a -> a -> a
* a
base2)
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'7' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a -> a
forall a. Floating a => a -> a
sin (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
y0)) (-a
0.01 a -> a -> a
forall a. Num a => a -> a -> a
* a
base1)
            | Char
c0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'8' = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a -> a
forall a. Floating a => a -> a
cos (a
k a -> a -> a
forall a. Num a => a -> a -> a
* a
y0)) (-a
0.01 a -> a -> a
forall a. Num a => a -> a -> a
* a
base1)
            | Bool
otherwise = (Char -> a -> a -> Bool
forall {a}. Ord a => Char -> a -> a -> Bool
ords Char
t0) (a
y0 a -> a -> a
forall a. Floating a => a -> a -> a
** a
k) a
base1
          where
            base :: a
base = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> (Maybe Integer -> Integer) -> Maybe Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
1 (Maybe Integer -> a) -> Maybe Integer -> a
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
ws :: Maybe Integer)
            ords :: Char -> a -> a -> Bool
ords Char
t0
                | Char
t0 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'2' = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(>)
                | Bool
otherwise = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)
            (Char
w, [Char]
wws) = (Char, [Char]) -> Maybe (Char, [Char]) -> (Char, [Char])
forall a. a -> Maybe a -> a
fromMaybe (Char
'2', [Char]
"") (Maybe (Char, [Char]) -> (Char, [Char]))
-> ([Char] -> Maybe (Char, [Char])) -> [Char] -> (Char, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe (Char, [Char])
forall a. [a] -> Maybe (a, [a])
uncons ([Char] -> (Char, [Char])) -> [Char] -> (Char, [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
ws
            base1 :: a
base1 = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> (Maybe Integer -> Integer) -> Maybe Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
50 (Maybe Integer -> a) -> Maybe Integer -> a
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
wws :: Maybe Integer)
            base2 :: a
base2 = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> (Maybe Integer -> Integer) -> Maybe Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
500 (Maybe Integer -> a) -> Maybe Integer -> a
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
wws :: Maybe Integer)
            k :: a
k = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> (Maybe Integer -> Integer) -> Maybe Integer -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
2 (Maybe Integer -> a) -> Maybe Integer -> a
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char
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 :: forall (t2 :: * -> *) b.
(InsertLeft t2 (Result [] Char b Double),
 Monoid (t2 (Result [] Char b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
[Char]
-> t2 (Result [] Char b Double)
-> (t2 (Result [] Char b Double), t2 (Result [] Char b Double))
partitioningR ![Char]
xs t2 (Result [] Char b Double)
dataR
    | t2 (Result [] Char b Double) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result [] Char b Double)
dataR = (t2 (Result [] Char b Double)
forall a. Monoid a => a
mempty, t2 (Result [] Char b Double)
forall a. Monoid a => a
mempty)
    | Bool
otherwise = (Double -> Bool)
-> t2 (Result [] Char b Double)
-> (t2 (Result [] Char b Double), t2 (Result [] Char b Double))
forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 InsertLeft t2 c) =>
(c -> Bool)
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
partiR ([Char] -> Double -> Bool
forall (t :: * -> *) a. ConstraintsG t a => t a -> Double -> Bool
decodeCDouble [Char]
xs) t2 (Result [] Char b Double)
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 :: forall (t2 :: * -> *) a b.
(InsertLeft t2 (Result2 a b Double),
 Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double,
 Monoid (t2 Double)) =>
[Char]
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
partitioningR2 ![Char]
xs t2 (Result2 a b Double)
dataR
    | t2 (Result2 a b Double) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result2 a b Double)
dataR = (t2 (Result2 a b Double)
forall a. Monoid a => a
mempty, t2 (Result2 a b Double)
forall a. Monoid a => a
mempty)
    | Bool
otherwise = (Double -> Bool)
-> t2 (Result2 a b Double)
-> (t2 (Result2 a b Double), t2 (Result2 a b Double))
forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c) =>
(c -> Bool)
-> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
partiR2 ([Char] -> Double -> Bool
forall (t :: * -> *) a. ConstraintsG t a => t a -> Double -> Bool
decodeCDouble [Char]
xs) t2 (Result2 a b Double)
dataR
{-# INLINE partitioningR2 #-}
{-# SPECIALIZE partitioningR2 ::
    (Eq a) =>
    String ->
    [Result2 a Double Double] ->
    ([Result2 a Double Double], [Result2 a Double Double])
    #-}