-- |
-- Module      :  CaseBi.Unboxed
-- Copyright   :  (c) OleksandrZhabenko 2019-2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--

module CaseBi.Unboxed (
-- * Function 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
  getBFst', getBFst, getBFstV, 
-- * Additional functions that are used to sort a list of pairs (which can be obtained e. g. by 'Prelude.zip')
  sortFst, sortFstV,
-- ** Function that can be used for changing the @Vector (a, b)@ during its creation 
  filterP
) where

import qualified Data.Vector.Unboxed as V (Vector,unsafeIndex,unsafeSlice,length,fromList,map)
import qualified Data.List as L (groupBy,nubBy)
import Data.Vector.Unboxed.Base

-- | A variant of the 'CaseBi.getBFst'' function that operates on the unboxed 'V.Vector'.
-- 
getBFst' 
  :: (Ord a, Unbox a, Unbox b) 
  => (b, V.Vector (a, b)) -- ^ @b@ is a default value that can be substituted if there is no correspendence in the set of @(a, b)@ tuples (the 'otherwise' or irrefutable pattern analogue). Vector of the @(a, b)@ tuples that must be sorted in ascending order for the first argument. If there are several pairs @(a, b)@ with the same @a@, the function gives a resulting @b@ as if there is only the first one
  -> a -- ^ an element for which the corresponding resulting b must be found
  -> b -- ^ the result
getBFst' :: (b, Vector (a, b)) -> a -> b
getBFst' (b
def, Vector (a, b)
vec) a
l | if a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l ((a, b) -> a
forall a b. (a, b) -> a
fst (Vector (a, b) -> Int -> (a, b)
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector (a, b)
vec Int
0)) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then Bool
True else a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l ((a, b) -> a
forall a b. (a, b) -> a
fst (Vector (a, b) -> Int -> (a, b)
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector (a, b)
vec (Vector (a, b) -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector (a, b)
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = b
def
                      | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector (a, b) -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector (a, b)
vec) Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT = if a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
l ((a, b) -> a
forall a b. (a, b) -> a
fst (Vector (a, b) -> Int -> (a, b)
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector (a, b)
vec ((Vector (a, b) -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector (a, b)
vec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT
  then (b, Vector (a, b)) -> a -> b
forall a b.
(Ord a, Unbox a, Unbox b) =>
(b, Vector (a, b)) -> a -> b
getBFst' (b
def, (Int -> Int -> Vector (a, b) -> Vector (a, b)
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
0 (Vector (a, b) -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector (a, b)
vec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) Vector (a, b)
vec)) a
l 
  else (b, Vector (a, b)) -> a -> b
forall a b.
(Ord a, Unbox a, Unbox b) =>
(b, Vector (a, b)) -> a -> b
getBFst' (b
def, (Int -> Int -> Vector (a, b) -> Vector (a, b)
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
V.unsafeSlice (Vector (a, b) -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector (a, b)
vec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) (Vector (a, b) -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector (a, b)
vec Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Vector (a, b) -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector (a, b)
vec Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)) Vector (a, b)
vec)) a
l 
                      | Bool
otherwise = (a, b) -> b
forall a b. (a, b) -> b
snd (Vector (a, b) -> Int -> (a, b)
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector (a, b)
vec Int
0)
{-# INLINABLE getBFst' #-}
                   
-- | A variant of the 'CaseBi.getBFstV' that operates on the unboxed 'V.Vector'.
-- 
getBFstV :: (Ord a, Unbox a, Unbox b) => V.Vector (a, b) -- ^ Vector of the @(a, b)@ tuples that are sorted in ascending order for the first argument
  -> b -- ^ a default value that can be substituted if there is no correspendence in the set of @(a, b)@ tuples (the 'otherwise' or irrefutable pattern analogue)
  -> V.Vector a -- ^ a Vector needed to be transformed accordingly to the correct @(a, b)@ tuple pairs
  -> V.Vector b -- ^ the resulting Vector
getBFstV :: Vector (a, b) -> b -> Vector a -> Vector b
getBFstV Vector (a, b)
c b
y = (a -> b) -> Vector a -> Vector b
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
V.map ((b, Vector (a, b)) -> a -> b
forall a b.
(Ord a, Unbox a, Unbox b) =>
(b, Vector (a, b)) -> a -> b
getBFst' (b
y, Vector (a, b)
c))
{-# INLINE getBFstV #-}

-- | A variant of the 'CaseBi.getBFst' that operates on the unboxed 'V.Vector'.
-- 
getBFst :: (Ord a, Unbox a, Unbox b) => V.Vector (a, b) -- ^ Vector of the @(a, b)@ tuples that must be sorted in ascending order for the first argument
  -> b -- ^ a default value that can be substituted if there is no correspendence in the set of @(a, b)@ tuples (the 'otherwise' or irrefutable pattern analogue)
  -> [a] -- ^ a list of values needed to be transformed accordingly to the correct @(a, b)@ tuple pairs
  -> [b] -- ^ the resulting list
getBFst :: Vector (a, b) -> b -> [a] -> [b]
getBFst Vector (a, b)
c b
y = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((b, Vector (a, b)) -> a -> b
forall a b.
(Ord a, Unbox a, Unbox b) =>
(b, Vector (a, b)) -> a -> b
getBFst' (b
y, Vector (a, b)
c))
{-# INLINE getBFst #-}

-- | A variant of the 'CaseBi.sortFst' that operates on the unboxed 'V.Vector'. It is inspired by the work: https://wiki.haskell.org/Introduction
sortFst :: (Ord a, Unbox a, Unbox b) => [(a, b)] -> [(a, b)]
sortFst :: [(a, b)] -> [(a, b)]
sortFst [(a, b)]
xs = if [(a, b)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, b)]
xs then [] else [(a, b)] -> [(a, b)]
forall a b. (Ord a, Unbox a, Unbox b) => [(a, b)] -> [(a, b)]
sortFst (((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
x, b
_) -> 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)] -> (a, b)
forall a. [a] -> a
head [(a, b)]
xs)) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT) [(a, b)]
xs) [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
x, b
_) -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== ((a, b) -> a
forall a b. (a, b) -> a
fst ([(a, b)] -> (a, b)
forall a. [a] -> a
head [(a, b)]
xs))) [(a, b)]
xs [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. [a] -> [a] -> [a]
++ 
  [(a, b)] -> [(a, b)]
forall a b. (Ord a, Unbox a, Unbox b) => [(a, b)] -> [(a, b)]
sortFst (((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
x, b
_) -> 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)] -> (a, b)
forall a. [a] -> a
head [(a, b)]
xs)) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT) [(a, b)]
xs)
{-# INLINABLE sortFst #-}           

-- | A variant of the 'CaseBi.sortFstV' that operates on the unboxed 'V.Vector'.
--
sortFstV 
  :: (Ord a, Unbox a, Unbox b) => [(a, b)] -- ^ The list of conditions that is then converted to the corresponding Vector
   -> V.Vector (a, b) -- ^ the resulting sorted Vector that can be used further in getBFst' and its successors.
sortFstV :: [(a, b)] -> Vector (a, b)
sortFstV = [(a, b)] -> Vector (a, b)
forall a. Unbox a => [a] -> Vector a
V.fromList ([(a, b)] -> Vector (a, b))
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> Vector (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy (\(a
x, b
_) (a
y, b
_) -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y) ([(a, b)] -> [(a, b)])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> [(a, b)]
forall a b. (Ord a, Unbox a, Unbox b) => [(a, b)] -> [(a, b)]
sortFst
{-# INLINE sortFstV #-}

-- | A variant of the 'CaseBi.filterP' that operates on the unboxed 'V.Vector'.
filterP 
  :: (Ord a, Unbox a, Unbox b) => ((a, b) -> Bool) -- ^ The predicate @p@ used to select the only one value of @b@ in the pairs @(a, b)@ with the same @a@. 
  -- ^ If there are several pairs @(a, b)@ for the same @a@ that satisfies a predicate then the first one is used. For large @[(a, b)]@ 
  -- ^ it can be rather complex.
  -> [(a, b)] -- ^ The list of @(a, b)@ sorted in the ascending order by the first element a (e. g. by the 'sortFst' function)
  -> V.Vector (a, b) -- ^ The resulting filtered @Vector (a, b)@ that can be used for getFstB' and its successor functions.
--
filterP :: ((a, b) -> Bool) -> [(a, b)] -> Vector (a, b)
filterP (a, b) -> Bool
p [(a, b)]
xs = [(a, b)] -> Vector (a, b)
forall a. Unbox a => [a] -> Vector a
V.fromList ([(a, b)] -> Vector (a, b))
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> Vector (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(a, b)] -> [(a, b)]) -> [[(a, b)]] -> [(a, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[(a, b)]
x -> Int -> [(a, b)] -> [(a, b)]
forall a. Int -> [a] -> [a]
take Int
1 ([(a, b)] -> [(a, b)])
-> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> ((a, b) -> Bool) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> Bool
p) ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ [(a, b)]
x) ([[(a, b)]] -> [(a, b)])
-> ([(a, b)] -> [[(a, b)]]) -> [(a, b)] -> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\(a
x1,b
_) (a
x2,b
_) -> a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2) ([(a, b)] -> Vector (a, b)) -> [(a, b)] -> Vector (a, b)
forall a b. (a -> b) -> a -> b
$ [(a, b)]
xs
{-# INLINE filterP #-}