{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Pladiprelio.Constraints
-- Copyright   :  (c) OleksandrZhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Provides several the most important variants of constraints for the
-- permutations. All the 'Array'
-- 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.
-- Uses arrays instead of vectors.

{-# LANGUAGE BangPatterns, FlexibleContexts, NoImplicitPrelude #-}

module Phladiprelio.Constraints (
  -- * Basic predicate
  unsafeOrderIJ
  -- * Functions to work with permutations with basic constraints ('Array'-based)
  , filterOrderIJ
  , unsafeTriples
  , unsafeQuadruples
  -- ** With multiple elements specified
  , unsafeSeveralA
  , unsafeSeveralB
  -- ** With fixed points
  , fixedPointsG
  , fixedPointsS
  -- * Distances between elements
  , unsafeSignDistanceIJ
  , unsafeUnsignDistanceIJ
  , filterSignDistanceIJ
  , filterUnsignDistanceIJ
  , filterSignDistanceIJK3
  , filterUnsignDistanceIJK3
) where

import GHC.Base hiding (foldr)
import GHC.Num ((-),(+))
import Data.Maybe (fromJust)
import Data.SubG (InsertLeft(..),filterG)
import GHC.Arr
import Data.Foldable (all, foldr)

-- | Being given the data satisfying the constraints in the module header checks whether in the 'Array' the first argument stands before the second one.
unsafeOrderIJ :: Int -> Int -> Array Int Int -> Bool
unsafeOrderIJ i j = (\(_,_,r) -> if r == 0 then True else False) . foldr helpG (j,i,0)

helpG z (t,u,n)
  | z == t = (t,u,1)
  | z == u =
     case n of
      0 -> (t,u,2)
      _ -> (t,u,n - 1)
  | otherwise = (t,u,n)
{-# INLINE helpG #-}

unsafeSignDistanceIJ 
  :: Int 
  -> Int 
  -> Int -- ^ Can be of both signs, but not equal to 0. The positive value gives 'True' for the first argument being find earlier in the 'Array' than the second and the distance between their positions are equal to 'abs' @d@ (this argument). The negative value gives 'True' for the second argument  being earlier in the 'Array' than the first one and the distance between their positions are equal to 'abs' @d@ (this argument).
  -> Array Int Int 
  -> Bool
unsafeSignDistanceIJ i j d = (\(_,_,r) -> if r > 100 then (100 - r) == d else r == d) . foldr helpG2 (j, i, -1)

helpG2 z (t, u, n)
  | n < 0 = if (z /= t && z /= u) then (t, u, n) else (t, u, if z == t then 1 else 101)
  | z /= u && z /= t && t >= 0 = (t, u, n + 1)
  | otherwise = (-1, u, n)

unsafeUnsignDistanceIJ 
  :: Int 
  -> Int 
  -> Int -- ^ Only for positive values can give 'True', if the distance between the positions of the elements equal to the first two arguments are equal to this argument. Otherwise, 'False'.
  -> Array Int Int 
  -> Bool
unsafeUnsignDistanceIJ i j d = (\(_,_,r) -> r == d) . foldr helpG3 (j, i, -1)

helpG3 z (t, u, n)
  | n < 0 = if (z /= t && z /= u) then (t, u, n) else (t, u, 1)
  | z /= u && z /= t && t >= 0 = (t, u, n + 1)
  | otherwise = (-1, u, n)


-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeOrderIJ' as a predicate.
filterOrderIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterOrderIJ i j = filterG (unsafeOrderIJ i j)

-- | 
filterSignDistanceIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterSignDistanceIJ i j d = filterG (unsafeSignDistanceIJ i j d)

-- | 
filterUnsignDistanceIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterUnsignDistanceIJ i j d = filterG (unsafeUnsignDistanceIJ i j d)

-- | 
filterSignDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterSignDistanceIJK3 i j k d1 d2 = filterG (\arr -> unsafeSignDistanceIJ i j d1 arr && unsafeSignDistanceIJ j k d2 arr)

-- | 
filterUnsignDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterUnsignDistanceIJK3 i j k d1 d2 = filterG (\arr -> unsafeUnsignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr)

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements 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 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
unsafeTriples i j k = filterG (\v -> unsafeOrderIJ i j v && unsafeOrderIJ j k v)

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements 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 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
unsafeQuadruples i j k l = filterG (\v -> unsafeOrderIJ i j v && unsafeOrderIJ j k v && unsafeOrderIJ k l v)

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements 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 'Array' 'Int' of indices that are in the range [0..n]. Filters (and reduces further complex computations) 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 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)
unsafeSeveralA !i0 arr x = filterG (g i0 arr) x
   where g !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ i0 k arr2) arr1

-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements 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 'Array' of indices that are in the range [0..n]. Filters (and reduces further complex computations) 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 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)
unsafeSeveralB !i0 arr x = filterG (g i0 arr) x
   where g !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ k i0 arr2) arr1

--------------------------------------------------------------------------------

-- | Reduces the number of permutations using filtering leaving just those ones permutations where elements on the
-- first elements in the tuples in the first argument 'Array' places are moved to the places indexed with the second
-- elements in the tuples respectively.
fixedPointsG :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int (Int,Int) -> t (Array Int Int) -> t (Array Int Int)
fixedPointsG arr xs = filterG (f arr) xs
   where f arr1 arr2 = all (\(k,j) -> unsafeAt arr2 k == j) arr1

-- | A simplified variant of the 'fixedPointsG' function where the specified elements stay on their place and that is
-- why are 'fixed points' in the permutation specified.
fixedPointsS :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int Int -> t (Array Int Int) -> t (Array Int Int)
fixedPointsS arr xs = filterG (f arr) xs
   where f arr1 arr2 = all (\k -> unsafeAt arr2 k == k) arr1