module Evaluation (
   Result,
   fromClicksFineIntervals,
   fromGlobalRumbleSolo,
   fromGlobalRumbleDuo,
   ) where

import qualified LabelTrack
import qualified LabelChain
import qualified SignalProcessingMethods as SPMethods
import qualified SignalProcessing as SP
import qualified Signal
import qualified Rate
import qualified Named
import qualified Class
import qualified Parameters as Params
import LabelChain (BreakRel(BreakRel), )
import Parameters (Time(Time), getTime, )
import Measurement
          (ClassFeatures, ChunkFeatures, SpectralParameters, measureSignal, )

import qualified Control.Functor.HT as FuncHT
import Control.Monad (join, )
import Control.Applicative ((<$>), )
import Control.Functor.HT (void)

import qualified Data.NonEmpty as NonEmpty
import qualified Data.List.HT as ListHT
import Data.Tuple.HT (mapSnd, )

import Text.Printf (printf, )

import Algebra.ToRational (realToField)

import NumericPrelude.Numeric
import NumericPrelude.Base
import Prelude ()



type SoundMeasure t = Class.Sound Int (BreakRel t) Int Int


doubleFromTime :: Time -> Double
doubleFromTime = realToField . Params.getTime

_classFromClicksFloat ::
   Params.T ->
   LabelChain.T Double String ->
   LabelChain.T Double (SoundMeasure Double)
_classFromClicksFloat params =
   let skip :: (a -> a) -> (a -> a)
       skip _ = id
   in  fmap
          (Class.mapTicking SP.foldLength .
           Class.mapRasping SP.foldLength .
           Class.mapGrowling SP.foldLength) .
       LabelChain.classRelativeFromAbsolute .
       LabelChain.fuseTickingBouts join .
       LabelChain.tickingsFromRaspings
          (ListHT.lengthAtLeast (Params.raspingMinNumClicks params) .
           NonEmpty.flatten) .
       skip
          (LabelChain.breakLongClicks
             (realToField (Params.raspingMaxRelativeClickDistance params) *)) .
       LabelChain.mergeRaspingGrowling
          join (void . concatMap NonEmpty.flatten) .
       LabelChain.classFromFineIntervals .
       LabelChain.correctShortChirping
          (doubleFromTime $ Params.chirpingHackDur params) .
       skip
          (LabelChain.mergeRaspingShortPause
             (doubleFromTime $ Params.hardHighDist params))

classFromClicksInt ::
   Params.T -> Rate.Sample ->
   LabelChain.T Int String ->
   LabelChain.T Int (SoundMeasure Int)
classFromClicksInt params rate =
   let skip :: (a -> a) -> (a -> a)
       skip _ = id
   in  fmap
          (Class.mapTicking SP.foldLength .
           Class.mapRasping SP.foldLength .
           Class.mapGrowling SP.foldLength) .
       LabelChain.classRelativeFromAbsolute .
       LabelChain.fuseTickingBouts join .
       LabelChain.tickingsFromRaspings
          (ListHT.lengthAtLeast (Params.raspingMinNumClicks params) .
           NonEmpty.flatten) .
       skip
          (LabelChain.breakLongClicks
             (\median ->
                ceiling $
                Params.raspingMaxRelativeClickDistance params
                   * fromIntegral median)) .
       LabelChain.mergeRaspingGrowling
          join (void . concatMap NonEmpty.flatten) .
       LabelChain.classFromFineIntervals .
       LabelChain.correctShortChirping
          (Params.time rate $ Params.chirpingHackDur params) .
       skip
          (LabelChain.mergeRaspingShortPause
             (Params.time rate $ Params.hardHighDist params))


classLabelsFromChunkFeatures ::
   ChunkFeatures ->
   Class.Sound rasping chirping ticking growling -> SoundMeasure Int
classLabelsFromChunkFeatures
      ((numClicks, _sumHalfLifes, _numEmphasized), chirpMain) cls =

   case cls of
      Class.Rasping _ -> Class.Rasping numClicks
      Class.Chirping _ -> Class.Chirping $ BreakRel chirpMain
      Class.Ticking _ -> Class.Ticking numClicks
      Class.Growling _ -> Class.Growling numClicks
      Class.Other str -> Class.Other str


checkWarn :: Bool -> a -> [a]
checkWarn cond msg = if cond then [] else [msg]

checkChirping :: Params.T -> (Double, Double) -> [String]
checkChirping params bnd =
   let dur = Time $ realToFrac $ uncurry subtract bnd
       minDur = Params.chirpingMinDur params
       maxDur = Params.chirpingMaxDur params
   in  (checkWarn (dur >= minDur) $
        printf "duration must be at least %f" $ getTime minDur)
       ++
       (checkWarn (dur <= maxDur) $
        printf "duration must be at most %f" $ getTime maxDur)

checkTicking :: Int -> [String]
checkTicking numClicks =
   checkWarn (numClicks > 0) "zero ticks"

suspiciousIntervalsFromClicks ::
   Params.T -> Rate.Sample ->
   LabelTrack.T Double (ChunkFeatures, SoundMeasure Int) ->
   LabelTrack.T Double String
suspiciousIntervalsFromClicks params highRate =
   let measRate = Params.measureSampleRate params
   in  LabelTrack.concat .
       LabelTrack.mapWithTime
          (\bnd (((numClicks, _sumHalfLifes, _numEmphasized), chirpMain), cls) ->
             case cls of
                Class.Rasping n ->
                   let minNumClicks = Params.raspingMinNumClicks params
                   in  (checkWarn (n == numClicks) $
                        printf "deviating alternative click count: %d" n)
                       ++
                       (checkWarn (numClicks >= minNumClicks) $
                        printf "expected at least %d clicks" minNumClicks)
                Class.Chirping (BreakRel brk) ->
                   let maxDev = Params.chirpingMainDurMaxDeviation params
                       brkTime = Params.toTime highRate brk
                       mainTime = Params.toTime measRate chirpMain
                   in  checkChirping params bnd
                       ++
                       (checkWarn
                          ((Time $ realToFrac $ abs $ brkTime-mainTime)
                             <= maxDev) $
                        printf "deviating main duration: %f vs. %f"
                          brkTime mainTime)
                Class.Growling n ->
                   (checkWarn (n == numClicks) $
                     printf "deviating alternative click count: %d" n)
                Class.Ticking n -> checkTicking n
                _ -> [])


type Result =
       (LabelChain.T Double (SoundMeasure Int),
        LabelTrack.T Double String,
        (Signal.LabelChain Rate.Measure
            (SpectralParameters Float, ClassFeatures),
         ([Float], Signal.T Rate.Measure [Named.Signal])))

fromClicks ::
   SPMethods.T -> Params.T -> Signal.SoxLabelled (SoundMeasure Int) -> Result
fromClicks sigProc params labelled =
   let (sig, classified) = FuncHT.unzip labelled
       (chunkFeats, measuresEnvelopes) = measureSignal sigProc params labelled
       classifiedMeas =
         LabelChain.zipWithList (,) chunkFeats $
         Signal.labelRealTimes classified
   in  (fmap (uncurry classLabelsFromChunkFeatures) classifiedMeas,
        suspiciousIntervalsFromClicks params (Signal.sampleRate sig) $
          LabelTrack.fromLabelChain classifiedMeas,
        measuresEnvelopes)

fromClicksFineIntervals ::
   SPMethods.T -> Params.T -> Signal.SoxLabelled String -> Result
fromClicksFineIntervals sigProc params sig =
   fromClicks sigProc params $
   fmap (mapSnd (classFromClicksInt params (Signal.sampleRate sig))) sig


suspiciousIntervalsFromGlobal ::
   Params.T ->
   LabelTrack.T Double (Class.Sound rasping chirping Int growling) ->
   LabelTrack.T Double String
suspiciousIntervalsFromGlobal params =
   LabelTrack.concat .
   LabelTrack.mapWithTime
      (\bnd cls ->
         case cls of
            Class.Chirping _ -> checkChirping params bnd
            Class.Ticking numClicks -> checkTicking numClicks
            _ -> [])


countClicksGlobal ::
   SPMethods.T -> Params.T ->
   Signal.SoxLabelled (Class.Sound rasping chirping ticking growling) ->
   LabelChain.T Double (Class.Sound Int (BreakRel Int) Int Int)
countClicksGlobal sigProc params sigClassified =
   {- ToDo:
   comparison could be made more lazy
   using lazy chunky numbers from non-negative package
   -}
   LabelChain.mergeRaspingGrowling NonEmpty.sum sum $
   LabelChain.zipWithList classLabelsFromChunkFeatures
      (fst $ measureSignal sigProc params sigClassified) $
   Signal.labelRealTimes $ fmap snd sigClassified

{- |
Works on sequences like rasping-rumble-rasping.
-}
classFromGlobalRumbleSolo ::
   SPMethods.T -> Params.T -> Signal.SoxLabelled String ->
   (LabelTrack.T Double String,
    LabelChain.T Double (SoundMeasure Int))
classFromGlobalRumbleSolo sigProc params sigClassified =
   let (rumbling, classifiedMeas) =
         LabelChain.unzipRumbling $
         {-
         The NonEmpty.head selects the information of the first chirping chunk.
         That carries a BreakRel value that becomes rather arbitrary
         after merging chirping with rumble.
         -}
         LabelChain.assimilateRumblingSolo
            NonEmpty.sum NonEmpty.head NonEmpty.sum
            (doubleFromTime $ Params.maxInterimRumblingDur params) $
         countClicksGlobal sigProc params $
         fmap (mapSnd (fmap Class.fromLabel)) sigClassified
   in  (rumbling,
        LabelChain.fuseTickingBouts NonEmpty.sum $
        LabelChain.tickingsFromRaspings
         (Params.raspingMinNumClicks params <=) $
        classifiedMeas)

{- |
Works on sequences like rasping-raspingRumble-rasping.
-}
classFromGlobalRumbleDuo ::
   SPMethods.T -> Params.T -> Signal.SoxLabelled String ->
   (LabelTrack.T Double String,
    LabelChain.T Double (SoundMeasure Int))
classFromGlobalRumbleDuo sigProc params sigClassified =
   let sigRumbleClassified =
         mapSnd
            (LabelChain.unzipRumbling .
             LabelChain.assimilateRumblingDuo .
             fmap (Class.checkPurity . Class.fromLabel))
         <$>
         sigClassified
   in  (LabelTrack.mergeNamesakes $
         LabelTrack.realTimes $ fst . snd <$> sigRumbleClassified,
        LabelChain.fuseTickingBouts NonEmpty.sum $
        LabelChain.tickingsFromRaspings (Params.raspingMinNumClicks params <=) $
        countClicksGlobal sigProc params $
        mapSnd snd <$> sigRumbleClassified)

{- ToDo:
Is it possible and sensible to split measureSignal,
such that we need to call it only once?
-}
fromGlobal ::
   SPMethods.T -> Params.T -> Signal.Sox ->
   (LabelTrack.T Double String, LabelChain.T Double (SoundMeasure Int)) ->
   Result
fromGlobal sigProc params sig (rumbling, classifiedMeas) =
   (classifiedMeas,
    LabelTrack.merge
     (suspiciousIntervalsFromGlobal params
        (LabelTrack.fromLabelChain classifiedMeas))
     rumbling,
    snd $ measureSignal sigProc params $
    Signal.addDiscretizedLabels sig classifiedMeas)

fromGlobalRumbleSolo ::
   SPMethods.T -> Params.T -> Signal.SoxLabelled String -> Result
fromGlobalRumbleSolo sigProc params labelled =
   fromGlobal sigProc params (fmap fst labelled) $
   classFromGlobalRumbleSolo sigProc params labelled

fromGlobalRumbleDuo ::
   SPMethods.T -> Params.T -> Signal.SoxLabelled String -> Result
fromGlobalRumbleDuo sigProc params labelled =
   fromGlobal sigProc params (fmap fst labelled) $
   classFromGlobalRumbleDuo sigProc params labelled