{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Module    :  CaseBi.Arr
-- Copyright   :  (c) OleksandrZhabenko 2019
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A library that can be used as a @case ... of@ constuction analogue for the multiple @Ord a => a -> b@
-- transformations and data representation. Uses 'Array' internally. If you use the module in GHCi, then, please,
-- run the interpreter with the flag -fobject-code.
--

module CaseBi.Arr (
{- |  * Functions that can be used instead of @case ... of@ construction
@
case var of
 a1 -> b1
 a2 -> b2
 a3 -> b3
 ...
 an -> bn
 _  -> def
@
for efficiency or other data representation
-}
  -- * Basic functions
  getBFst''
  , getBFst'
  -- * With a transformation to the array
  , listArrSortedByFst
  , getBFstLSorted'
  , getBFstL'
) where

import qualified Data.List as L (sortBy)
import GHC.Arr
import Data.Ord (comparing)

{- | The function that can be used instead of the 'case ... of' function
@
case var of
 a1 -> b1
 a2 -> b2
 a3 -> b3
 ...
 an -> bn
 _  -> defaultValue
@
If we follow a lot of teaching materials that explain the workflow of the construction
we think that the complexity of it is about /O(n)/ for the transformation of @a@ to @b@ here.
David Feuer (david.feuer (at) gmail.com) said that 'case ... of' is already optimized in GHC.
Some benchmarks show that its behaviour  tends to be about of /O(log n)/ complexity, the same as
the proposed function 'getBFst''. Nevertheless, the last one shows better performance in some situations,
is rather general and can be used for another data representation. Therefore, it can be preferred in
some situations. 'getBFst'' uses binary search algorithm and an 'Array' of @(a, b)@ as somewhat like a complicated filter or like a special sieve. The array must be sorted in ascending order here for the algorithm to be used correctly. For this you can use the function 'listArrSortedBy' or the similar ones.
The function 'getBFst''' is used internally in the 'getBFst'' that is recommended to be used in most cases. Nevertheless,
it is provided here if you have precomputed the first two arguments or at least some parts of them so that
you can reduce the needed amount of computations in the 'getBFst''.
-}
getBFst''
  :: Ord a => (# Int, (a, b) #) -- ^ The first unboxed tuple of the index and the element of the array.
  -> (# Int, (a, b) #) -- ^ The second unboxed tuple of the index and the element of the array.
  -> Array i (a, b) -- ^ The array of the pairs of the compared value and the result that is used in case the last argument is equal to the compared value.
  -> b -- ^ The default value that is used if no first element in the array tuples equals to the compared value.
  -> a -- ^ The compared value, well, the @main@ function argument, to which it is applied.
  -> b -- ^ The resulting branch value.
getBFst'' :: (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
getBFst'' (# Int
i, (a, b)
k #) (# Int
j, (a, b)
m #) Array i (a, b)
arr b
def a
x
 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
k Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
m = (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
forall a b i.
Ord a =>
(# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
gBF3 (# Int
i, (a, b)
k #) (# Int
j, (a, b)
m #) Array i (a, b)
arr b
def a
x
 | Bool
otherwise = b
def
{-# INLINE getBFst'' #-}

-- | The meaning of the arguments is the same as for 'getBFst'''. Is used internally in it.
gBF3 :: Ord a => (# Int, (a, b) #) -> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
gBF3 :: (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
gBF3 (# Int
i, (a, b)
k #) (# Int
j, (a, b)
m #) Array i (a, b)
arr b
def a
x
 | Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = let !n :: Int
n = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2 in let !p :: (a, b)
p = Array i (a, b) -> Int -> (a, b)
forall i e. Array i e -> Int -> e
unsafeAt Array i (a, b)
arr Int
n in
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x ((a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
p) of
     Ordering
GT -> (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
forall a b i.
Ord a =>
(# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
gBF3 (# Int
n, (a, b)
p #) (# Int
j, (a, b)
m #) Array i (a, b)
arr b
def a
x
     Ordering
EQ -> (a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
p
     Ordering
_  -> (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
forall a b i.
Ord a =>
(# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
gBF3 (# Int
i, (a, b)
k #) (# Int
n, (a, b)
p #) Array i (a, b)
arr b
def a
x
 | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
m = (a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
m
 | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
k = (a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
k
 | Bool
otherwise = b
def
{-# INLINABLE gBF3 #-}

-- | A generally written without extending variant of the 'getBFst'''.
getBFst' :: Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' :: (b, Array Int (a, b)) -> a -> b
getBFst' (b
def, Array Int (a, b)
arr) = (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array Int (a, b) -> b -> a -> b
forall a b i.
Ord a =>
(# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
getBFst'' (# Int
i, (a, b)
k #) (# Int
j, (a, b)
m #) Array Int (a, b)
arr b
def
  where (!Int
i,!Int
j) = Array Int (a, b) -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int (a, b)
arr
        !k :: (a, b)
k = Array Int (a, b) -> Int -> (a, b)
forall i e. Array i e -> Int -> e
unsafeAt Array Int (a, b)
arr Int
i
        !m :: (a, b)
m = Array Int (a, b) -> Int -> (a, b)
forall i e. Array i e -> Int -> e
unsafeAt Array Int (a, b)
arr Int
j
{-# INLINE getBFst' #-}

{- | If the list argument is sorted in the ascending order by the first element in every tuple, then to reduce
computations instead of
@
\def xs x -> getBFst' (def, listArray (0,length xs - 1) xs) x
@
you can use this function.
-}
getBFstLSorted'
  :: Ord a => b
  -> [(a, b)]
  -> a
  -> b
getBFstLSorted' :: b -> [(a, b)] -> a -> b
getBFstLSorted' b
def [(a, b)]
xs = (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array Int (a, b) -> b -> a -> b
forall a b i.
Ord a =>
(# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
getBFst'' (# Int
0, (a, b)
k #) (# Int
l, (a, b)
m #) Array Int (a, b)
arr b
def
  where !l :: Int
l = [(a, b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        !arr :: Array Int (a, b)
arr = (Int, Int) -> [(a, b)] -> Array Int (a, b)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) [(a, b)]
xs
        !k :: (a, b)
k = Array Int (a, b) -> Int -> (a, b)
forall i e. Array i e -> Int -> e
unsafeAt Array Int (a, b)
arr Int
0
        !m :: (a, b)
m = Array Int (a, b) -> Int -> (a, b)
forall i e. Array i e -> Int -> e
unsafeAt Array Int (a, b)
arr Int
l
{-# INLINE getBFstLSorted' #-}

{- | If it is unknown whether the list argument is sorted in the ascending order by the first element in every
tuple (or, definitely, it is not, speaking generally), then instead of
@
\def xs x -> getBFst' (def, listArray (0,length xs - 1) . sortBy (comparing fst) $ xs) x
@
you can use this function.
-}
getBFstL'
  :: Ord a => b
  -> [(a, b)]
  -> a
  -> b
getBFstL' :: b -> [(a, b)] -> a -> b
getBFstL' b
def [(a, b)]
xs = (# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array Int (a, b) -> b -> a -> b
forall a b i.
Ord a =>
(# Int, (a, b) #)
-> (# Int, (a, b) #) -> Array i (a, b) -> b -> a -> b
getBFst'' (# Int
0, (a, b)
k #) (# Int
l, (a, b)
m #) Array Int (a, b)
arr b
def
  where !l :: Int
l = [(a, b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        !arr :: Array Int (a, b)
arr = (Int, Int) -> [(a, b)] -> Array Int (a, b)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) ([(a, b)] -> Array Int (a, b))
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> Array Int (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> a
forall a b. (a, b) -> a
fst) ([(a, b)] -> Array Int (a, b)) -> [(a, b)] -> Array Int (a, b)
forall a b. (a -> b) -> a -> b
$ [(a, b)]
xs
        !k :: (a, b)
k = Array Int (a, b) -> Int -> (a, b)
forall i e. Array i e -> Int -> e
unsafeAt Array Int (a, b)
arr Int
0
        !m :: (a, b)
m = Array Int (a, b) -> Int -> (a, b)
forall i e. Array i e -> Int -> e
unsafeAt Array Int (a, b)
arr Int
l
{-# INLINE getBFstL' #-}

{- | Sorts the list of pairs by the first element in the tuples, then transforms them into an immutable array. Can be
used only if the list contains no more than 2^31 - 1 elements though this is not checked, it is up to user
to check this constraint before or provide its correctness by design.
-}
listArrSortedByFst :: Ord a => [(a,b)] -> Array Int (a,b)
listArrSortedByFst :: [(a, b)] -> Array Int (a, b)
listArrSortedByFst [(a, b)]
xs = (Int, Int) -> [(a, b)] -> Array Int (a, b)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(a, b)]
ys
  where !ys :: [(a, b)]
ys = ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
xs
        !l :: Int
l = [(a, b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, b)]
ys
{-# INLINE listArrSortedByFst #-}