-- |
-- Module      :  Phladiprelio.RulesIntervalsPlus
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Additional statistic rules to choose the number of the intervals.

{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}

module Phladiprelio.RulesIntervalsPlus where

import GHC.Base
import GHC.List (length, filter)
import Phladiprelio.RulesIntervals
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Data.List (words)

getIntervalsNS :: Bool -> String -> [String] -> Int
getIntervalsNS :: Bool -> String -> [String] -> Int
getIntervalsNS Bool
lstW String
xs [String]
yss
  | String
xs forall a. Eq a => a -> a -> Bool
== String
"s" = Int -> Int
sturgesH Int
z
  | String
xs forall a. Eq a => a -> a -> Bool
== String
"l" = Int -> Int
levynskyiMod Int
z
  | Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe Int
9 (forall a. Read a => String -> Maybe a
readMaybe String
xs::(Maybe Int))
     where k :: Int
k = if Bool
lstW then Int
2 else Int
1
           z :: Int
z = forall a. [a] -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) forall a b. (a -> b) -> a -> b
$ [String]
yss
{-# INLINE getIntervalsNS #-}

getIntervalsN :: String -> [a] -> Int
getIntervalsN :: forall a. String -> [a] -> Int
getIntervalsN String
xs [a]
yss
  | String
xs forall a. Eq a => a -> a -> Bool
== String
"s" = Int -> Int
sturgesH (forall a. [a] -> Int
length [a]
yss)
  | String
xs forall a. Eq a => a -> a -> Bool
== String
"l" = Int -> Int
levynskyiMod (forall a. [a] -> Int
length [a]
yss)
  | Bool
otherwise = forall a. a -> Maybe a -> a
fromMaybe Int
9 (forall a. Read a => String -> Maybe a
readMaybe String
xs::(Maybe Int))
{-# INLINE getIntervalsN #-}