{-# OPTIONS_GHC -Wall #-}
module HarmTrace.Matching.Sim where

import HarmTrace.Tokenizer.Tokens
import HarmTrace.HAnTree.HAn
import HarmTrace.HAnTree.Tree

-------------------------------------------------------------------------------- 
-- A class for representing numerical similarity between datatypes
-------------------------------------------------------------------------------- 

-- parameters

funkWeight, secdomWeight, transWeight, chordVSan :: Float
funkWeight   = 0.5
secdomWeight = 1.0
transWeight  = 1.0
chordVSan    = 0.2

class Sim a where
  sim :: a -> a -> Float
  
instance Sim a => Sim (Tree a) where
  sim (Node l _ _) (Node l' _ _) = sim l l'

  
instance Sim a => Sim [a] where
  sim [ha]    [hb]    = sim ha hb 
  sim (ha:ta) (hb:tb) = sim ha hb + sim ta tb
  sim _       _       = 0.0
  
instance Sim HAn where 
  sim (HAnChord chord) (HAnChord chord2) = sim chord chord2
  sim (HAnFunc  hfunk) (HAnFunc  hfunk2) = sim hfunk hfunk2
  sim (HAnTrans trans) (HAnTrans trans2) = sim trans trans2
  sim a b 
    | a == b = funkWeight * chordVSan * durWeight (getDur a) (getDur b)
    | otherwise = 0.0
   
instance Sim HFunc where
  sim a b 
    | a == b = funkWeight * chordVSan * durWeight (getDur a) (getDur b)
    | otherwise = 0.0      

instance Sim Trans where
  sim (SecDom   d sd)    (SecDom d2 sd2)  
    | sd == sd2 = secdomWeight * chordVSan * (durWeight d d2) 
    | otherwise = 0.0
  sim (SecMin   d sd)    (SecMin d2 sd2)      
    | sd == sd2 = secdomWeight * chordVSan * (durWeight d d2) 
    | otherwise = 0.0
  sim (Trit     d sd)    (Trit   d2 sd2)      
    | sd == sd2 = secdomWeight * chordVSan * (durWeight d d2) 
    | otherwise = 0.0
  sim (DimTrit  d _)     (DimTrit  d2 _)   = 
    transWeight * chordVSan * durWeight d d2
  sim (DimTrans d _)     (DimTrans d2 _)   = 
    transWeight * chordVSan * durWeight d d2
  sim (DiatDom  d sd) (DiatDom d2 sd2)
    | sd == sd2 = secdomWeight * chordVSan * (durWeight d d2) 
    | otherwise = 0.0
  sim _ _                                  = 0.0
    
instance Sim ChordToken where
  sim (ChordToken sd  clss  _cs  _stat  _n  d ) 
      (ChordToken sd2 clss2 _cs2 _stat2 _n2 d2) 
   -- | sameDeg && sameClss && sameStat = 1.0 * weight
   -- | sameDeg && sameClss && sameCs   = 0.9 * weight
    | sameDeg && sameClss = 1.0 * weight
    | otherwise = 0.0 where
      sameDeg  = sd   == sd2
      sameClss = clss == clss2
   --   sameCs   = cs   == cs2
    --  sameStat = stat == stat2
      weight   = durWeight d d2

durWeight :: Int -> Int -> Float      
durWeight durA durB = fromIntegral (min durA durB) 

-- calculates the self similarity value (used for normalisation)      
selfSim :: (Sim a) => Tree a -> Float
selfSim (Node l [] _) = sim l l
selfSim (Node l cs _) = sim l l + (sum $ map selfSim cs)

selfSiml :: (Sim a) => [Tree a] -> Float
selfSiml trees = sum $ map selfSim trees