-- |
-- Module      :  Languages.UniquenessPeriods.Vector.ConstraintsG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Provides several the most important variants of constraints for the
-- 'VB.Vector' of 'VB.Vector' 'Int' that are permutations. All the 'VB.Vector'
-- here must consists of unique 'Int' starting from 0 to n and the 'Int'
-- arguments must be in the range [0..n] though these inner constraints are
-- not checked. It is up to user to check them.
--

{-# LANGUAGE BangPatterns #-}

module Languages.UniquenessPeriods.Vector.ConstraintsG (
  -- * Basic predicate
  unsafeOrderIJ
  -- * Functions to work with permutations with basic constraints
  , filterOrderIJ
  , unsafeTriples
  , unsafeQuadruples
  -- ** With multiple elements specified
  , unsafeSeveralA
  , unsafeSeveralB
) where

import qualified Data.Vector as VB
import Data.Maybe (fromJust)

-- | Being given the data satisfying the constraints in the module header checks whether in the 'VB.Vector' the first argument stands before the second one.
unsafeOrderIJ :: Int -> Int -> VB.Vector Int -> Bool
unsafeOrderIJ :: Int -> Int -> Vector Int -> Bool
unsafeOrderIJ Int
i Int
j Vector Int
v = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust ((Int -> Bool) -> Vector Int -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
VB.findIndex (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) Vector Int
v) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust ((Int -> Bool) -> Vector Int -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
VB.findIndex (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j) Vector Int
v)

-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeOrderIJ' as a predicate.
filterOrderIJ :: Int -> Int -> VB.Vector (VB.Vector Int) -> VB.Vector (VB.Vector Int)
filterOrderIJ :: Int -> Int -> Vector (Vector Int) -> Vector (Vector Int)
filterOrderIJ Int
i Int
j = (Vector Int -> Bool) -> Vector (Vector Int) -> Vector (Vector Int)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (Int -> Int -> Vector Int -> Bool
unsafeOrderIJ Int
i Int
j)

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the 'VB.Vector' of
-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication if the
-- arguments are the indeces of the duplicated words or their concatenated combinations in the corresponding line.
-- The first three arguments
-- are the indices of the the triple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).
unsafeTriples :: Int -> Int -> Int -> VB.Vector (VB.Vector Int) -> VB.Vector (VB.Vector Int)
unsafeTriples :: Int -> Int -> Int -> Vector (Vector Int) -> Vector (Vector Int)
unsafeTriples Int
i Int
j Int
k = (Vector Int -> Bool) -> Vector (Vector Int) -> Vector (Vector Int)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\Vector Int
v -> Int -> Int -> Vector Int -> Bool
unsafeOrderIJ Int
i Int
j Vector Int
v Bool -> Bool -> Bool
&& Int -> Int -> Vector Int -> Bool
unsafeOrderIJ Int
j Int
k Vector Int
v)

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the 'VB.Vector' of
-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication if the
-- arguments are the indeces of the duplicated words or their concatenated combinations in the corresponding line.
-- The first four arguments
-- are the indices of the the quadruple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).
unsafeQuadruples :: Int -> Int -> Int -> Int -> VB.Vector (VB.Vector Int) -> VB.Vector (VB.Vector Int)
unsafeQuadruples :: Int
-> Int -> Int -> Int -> Vector (Vector Int) -> Vector (Vector Int)
unsafeQuadruples Int
i Int
j Int
k Int
l = (Vector Int -> Bool) -> Vector (Vector Int) -> Vector (Vector Int)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\Vector Int
v -> Int -> Int -> Vector Int -> Bool
unsafeOrderIJ Int
i Int
j Vector Int
v Bool -> Bool -> Bool
&& Int -> Int -> Vector Int -> Bool
unsafeOrderIJ Int
j Int
k Vector Int
v Bool -> Bool -> Bool
&& Int -> Int -> Vector Int -> Bool
unsafeOrderIJ Int
k Int
l Vector Int
v)

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the 'VB.Vector' of
-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication.
-- The first argument
-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument
-- is 'VB.Vector' of indices that are in the range [0..n]. Filters (and reduces further complex computtions) the permutations so that only the
-- variants with the indices in the second argument all stand AFTER the element with the index equal to the first argument.
unsafeSeveralA :: Int -> VB.Vector Int -> VB.Vector (VB.Vector Int) -> VB.Vector (VB.Vector Int)
unsafeSeveralA :: Int -> Vector Int -> Vector (Vector Int) -> Vector (Vector Int)
unsafeSeveralA !Int
i0 Vector Int
v1 Vector (Vector Int)
v2 =
 let j :: a -> Vector a -> Int
j !a
i !Vector a
v = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust ((a -> Bool) -> Vector a -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
VB.findIndex (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i) Vector a
v) in
  (Vector Int -> Bool) -> Vector (Vector Int) -> Vector (Vector Int)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\Vector Int
v -> Int
-> (Int -> Vector Int -> Int) -> Vector Int -> Vector Int -> Bool
forall a t.
Eq a =>
t -> (t -> Vector a -> Int) -> Vector a -> Vector a -> Bool
g Int
i0 Int -> Vector Int -> Int
forall a. Eq a => a -> Vector a -> Int
j Vector Int
v Vector Int
v1) Vector (Vector Int)
v2
   where g :: t -> (t -> Vector a -> Int) -> Vector a -> Vector a -> Bool
g !t
i t -> Vector a -> Int
j !Vector a
v Vector a
v3 = (Int -> Bool) -> Vector Int -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
VB.all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> t -> Vector a -> Int
j t
i Vector a
v) (Vector Int -> Bool)
-> (Vector a -> Vector Int) -> Vector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Vector a -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
VB.findIndices (a -> Vector a -> Bool
forall a. Eq a => a -> Vector a -> Bool
`VB.elem` Vector a
v3) (Vector a -> Bool) -> Vector a -> Bool
forall a b. (a -> b) -> a -> b
$ Vector a
v

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the 'VB.Vector' of
-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication.
-- The first argument
-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument
-- is 'VB.Vector' of indices that are in the range [0..n]. Filters (and reduces further complex computtions) the permutations so that only the
-- variants with the indices in the second argument all stand BEFORE the element with the index equal to the first argument.
unsafeSeveralB :: Int -> VB.Vector Int -> VB.Vector (VB.Vector Int) -> VB.Vector (VB.Vector Int)
unsafeSeveralB :: Int -> Vector Int -> Vector (Vector Int) -> Vector (Vector Int)
unsafeSeveralB !Int
i0 Vector Int
v1 Vector (Vector Int)
v2 =
 let j :: a -> Vector a -> Int
j !a
i !Vector a
v = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust ((a -> Bool) -> Vector a -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
VB.findIndex (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
i) Vector a
v) in
  (Vector Int -> Bool) -> Vector (Vector Int) -> Vector (Vector Int)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\Vector Int
v -> Int
-> (Int -> Vector Int -> Int) -> Vector Int -> Vector Int -> Bool
forall a t.
Eq a =>
t -> (t -> Vector a -> Int) -> Vector a -> Vector a -> Bool
g Int
i0 Int -> Vector Int -> Int
forall a. Eq a => a -> Vector a -> Int
j Vector Int
v Vector Int
v1) Vector (Vector Int)
v2
   where g :: t -> (t -> Vector a -> Int) -> Vector a -> Vector a -> Bool
g !t
i t -> Vector a -> Int
j !Vector a
v Vector a
v3 = (Int -> Bool) -> Vector Int -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
VB.all (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< t -> Vector a -> Int
j t
i Vector a
v) (Vector Int -> Bool)
-> (Vector a -> Vector Int) -> Vector a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Vector a -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
VB.findIndices (a -> Vector a -> Bool
forall a. Eq a => a -> Vector a -> Bool
`VB.elem` Vector a
v3) (Vector a -> Bool) -> Vector a -> Bool
forall a b. (a -> b) -> a -> b
$ Vector a
v