-- |
-- Module      :  Phonetic.Languages.Simplified.DataG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Simplified version of the @phonetic-languages-common@ and @phonetic-languages-general@ packages.


{-# LANGUAGE BangPatterns, FlexibleContexts #-}

module Phonetic.Languages.Simplified.DataG where

import qualified Data.Foldable as F
import Data.Monoid
import Data.SubG
import Data.MinMax.Preconditions

data Result t a b c = R {line :: !(t a), metrices :: !b,  transMetrices :: !c} deriving Eq

instance (Ord (t a), Ord b, Ord c) => Ord (Result t a b c) where
  compare x y
    = case compare (transMetrices x) (transMetrices y) of
       EQ -> case compare (metrices x) (metrices y) of
              EQ -> compare (line x) (line y)
              z -> z
       z0 -> z0

data FuncRep2 a b c = D (a -> b) (b -> c)

getAC :: FuncRep2 a b c -> (a -> c)
getAC (D f g) = g . f

getAB :: FuncRep2 a b c -> (a -> b)
getAB (D f _) = f

getBC :: FuncRep2 a b c -> (b -> c)
getBC (D _ g) = g

maximumEl
  :: (Foldable t2, Ord c) => FuncRep2 (t a) b c
  -> t2 (t a)
  -> Result t a b c
maximumEl frep2 data0 =
  let l = F.maximumBy (\x y -> compare (getAC frep2 x) (getAC frep2 y)) data0
      m = getAB frep2 l
      tm = getBC frep2 m in R {line = l, metrices = m, transMetrices = tm}

minMaximumEls
  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord (t a), Ord c) => FuncRep2 (t a) b c
  -> t2 (t a)
  -> (Result t a b c,Result t a b c)
minMaximumEls frep2 data0 =
  let (ln,lx) = minMax11ByC (\x y -> compare (getAC frep2 x) (getAC frep2 y)) data0
      mn = getAB frep2 ln
      mx = getAB frep2 lx
      tmn = getBC frep2 mn
      tmx = getBC frep2 mx in (R {line = ln, metrices = mn, transMetrices = tmn}, R {line = lx, metrices = mx, transMetrices = tmx})

maximumElR
  :: (Foldable t2, Ord c) => t2 (Result t a b c)
  -> Result t a b c
maximumElR = F.maximumBy (\x y -> compare (transMetrices x) (transMetrices y))

minMaximumElRs
  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), Ord (t a), Ord b, Ord c) => t2 (Result t a b c)
  -> (Result t a b c,Result t a b c)
minMaximumElRs = minMax11ByC (\x y -> compare (transMetrices x) (transMetrices y))

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

innerPartitioning
  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c) => FuncRep2 (t a) b c
  -> t2 (t a)
  -> (t2 (t a), t2 (t a))
innerPartitioning frep2 data0 =
  let l = getAC frep2 . F.maximumBy (\x y -> compare (getAC frep2 x) (getAC frep2 y)) $ data0 in partitionG ((== l) . getAC frep2) data0

maximumGroupsClassification
  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, Integral d) => d
  -> FuncRep2 (t a) b c
  -> (t2 (t a), t2 (t a))
  -> (t2 (t a), t2 (t a))
maximumGroupsClassification nGroups frep2 (dataT,dataF)
 | nGroups <= 0 = (dataT,dataF)
 | otherwise = maximumGroupsClassification (nGroups - 1) frep2 (dataT `mappend` partT,partF)
     where (partT,partF) = innerPartitioning frep2 dataF

maximumGroupsClassification1
  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, Integral d) => d
  -> FuncRep2 (t a) b c
  -> t2 (t a)
  -> (t2 (t a), t2 (t a))
maximumGroupsClassification1 nGroups frep2 data0
 | nGroups <= 0 = innerPartitioning frep2 data0
 | otherwise = maximumGroupsClassification (nGroups - 1) frep2 . innerPartitioning frep2 $ data0

maximumGroupsClassificationR
  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), Ord c, Integral d) => d
  -> FuncRep2 (t a) b c
  -> t2 (Result t a b c)
  -> (t2 (Result t a b c), t2 (Result t a b c))
maximumGroupsClassificationR nGroups frep2 data0
 | nGroups <= 1 = (partT,partF)
 | otherwise = (partT `mappend` (fst . maximumGroupsClassificationR (nGroups - 1) frep2 $ partF),snd . maximumGroupsClassificationR (nGroups - 1) frep2 $ partF)
     where maxE0 = transMetrices . F.maximumBy (\x y -> compare (transMetrices x) (transMetrices y)) $ data0
           (partT,partF) = partitionG ((== maxE0) . transMetrices) data0

toResultR
  :: FuncRep2 (t a) b c
  -> t a
  -> Result t a b c
toResultR frep2 ys = R { line = ys, metrices = m, transMetrices = tm}
  where m = getAB frep2 ys
        tm = getBC frep2 m