Sim.hs

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

import HarmTrace.HAnTree.HAn
import HarmTrace.HAnTree.Tree
import HarmTrace.Base.MusicRep
import HarmTrace.Models.ChordTokens (ChordToken)

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

class Sim a where
  sim :: a -> a -> Int
  
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

instance Sim HAn where
  sim (HAn    _ a) (HAn    _ b) = if a == b then 1 else 0
  sim (HAnFunc  a) (HAnFunc  b) = sim a b
  sim (HAnPrep  a) (HAnPrep  b) = sim a b
  sim (HAnTrans a) (HAnTrans b) = sim a b
  sim (HAnChord a) (HAnChord b) = sim a b
  sim  _            _           = 0
  
instance Sim Int where
  {-# INLINE sim #-}
  sim i j = if i == j then 1 else 0

instance Sim HFunc where
  {-# INLINE sim #-}
  sim (Ton _ _m c _) (Ton _ _m2 c2 _) = if c == c2 then 1 else 0 -- 1 + sim m m2
  sim (Dom _ _m c _) (Dom _ _m2 c2 _) = if c == c2 then 1 else 0 -- 1 + sim m m2
  sim (Sub _ _m c _) (Sub _ _m2 c2 _) = if c == c2 then 1 else 0 -- 1 + sim m m2
  sim P             P              = 1      
  sim PD            PD             = 1      
  sim PT            PT             = 1 
  sim _             _              = 0
  
instance Sim Mode where
  {-# INLINE sim #-}
  sim MajMode MajMode = 1  
  sim MinMode MinMode = 1  
  sim _       _       = 0

instance Sim Trans where                                             
  {-# INLINE sim #-}
  sim (Trit     _v sd) (Trit     _v2 sd2) = if sd == sd2 then 1 else 0
  sim (DimTrit  _v sd) (DimTrit  _v2 sd2) = if sd == sd2 then 1 else 0
  sim (DimTrans _v sd) (DimTrans _v2 sd2) = if sd == sd2 then 1 else 0
  sim _ _ =0

instance Sim Prep where                                             
  {-# INLINE sim #-}  
  sim (DiatDom  _v sd) (DiatDom  _v2 sd2) = if sd == sd2 then 3 else 2
  sim (SecDom   _v sd) (SecDom   _v2 sd2) = if sd == sd2 then 3 else 2
  sim (SecMin   _v sd) (SecMin   _v2 sd2) = if sd == sd2 then 3 else 2
  
  sim (SecMin   _v sd) (DiatDom  _v2 sd2) = if sd == sd2 then 2 else 1
  sim (DiatDom  _v sd) (SecMin   _v2 sd2) = if sd == sd2 then 2 else 1
  
  sim (SecMin   _v sd) (SecDom   _v2 sd2) = if sd == sd2 then 2 else 1
  sim (SecDom   _v sd) (SecMin   _v2 sd2) = if sd == sd2 then 2 else 1
  
  sim (DiatDom  _v sd) (SecDom   _v2 sd2) = if sd == sd2 then 2 else 1
  sim (SecDom   _v sd) (DiatDom  _v2 sd2) = if sd == sd2 then 2 else 1
  -- sim  NoTrans           NoTrans = 
  sim _                 _        = 0      
  
instance Sim ChordToken where
  sim c1 c2 = if c1 == c2 then 2 else 0
  
-------------------------------------------------------------------------------- 
-- Some utility functions
--------------------------------------------------------------------------------  
  
-- calculates the self similarity value (used for normalisation) i.e. the
-- maximum similarity score
maxSim :: Sim a => [a] -> Int
maxSim =  foldr (\a b -> sim a a + b) 0  
   
div1 :: Int -> Int -> Int 
div1 n c = if n == 1 then 1 else n `div` c