Este es el primer programita en Haskell que hice por gusto propio, principalmente para afianzar un poco conceptos y además para probar tipos de datos y sobre todo de pensar desde Haskell. Lo fantástico es que estas cosas las hacia a mano, cuando tenía 17 años y estaba aprendiendo armonía (Por mi cuenta, obviamente).

Primero definí un tipo de datos Nota y una función sucesor cíclica (dado que estoy interesado en relaciones puramente armónicas).

data Nota = A | Bb | B | C | Db | D | Eb | E | F | Gb | G | Ab deriving (Eq)

suc :: Nota -> Nota
suc A = Bb; suc Bb = B; suc B = C; suc C = Db; suc Db = D; suc D = Eb; suc Eb = E; suc E = F; suc F = Gb; suc Gb = G; suc G = Ab; suc Ab = A;

Después hice que el tipo de datos Nota fuera instancia de la clase show, dando una definición especifica de la función show para mi tipo de datos para tratar los problemas del doble nombre de determinadas notas ( equivalencias enarmonicas ).

instance Show Nota where
	show A = show "A"
	show Bb = show "A#/Bb"
	show B = show "B"
	show C = show "C"
	show Db = show "C#/Db"
	show D = show "D"
	show Eb = show "D#/Eb"
	show E = show "E"
	show F = show "F"
	show Gb = show "F#/Gb"
	show G = show "G"
	show Ab = show "G#/Ab"

A partir de esto puedo definir la función intervalo, que toma un número natural (de 0 a 11, aunque se puede considerar al tipo Nota y a la función intervalo como compartiendo propiedades con la aritmética mod(12), por lo que n puede tomar valores mayores a 11 y los resultados van a ser los mismos a intervalo _ (n mod (12))). En un principio había pensado que se podía pensar como un isomorfismo, pero no estoy convencido, aunque si tomamos aplicación parcial de intervalo x como una función en si misma, ahí si podría serlo.

intervalo :: Nota -> Integer -> Nota
intervalo a 0 = a
intervalo a 1 = suc(a)
intervalo a n = suc( intervalo a (n-1))

No intente definir los intervalos a partir de sus nombres usuales sino simplemente desde su distancia (ascendente) a partir de la nota base. O sea, se sobreentiende que si le doy un valor de uno representa a una segunda menor, de 4 a una tercera mayor, etc. (Por otro lado es como siempre me acerque al concepto de intervalo).

Paso siguiente construir funciones para definir las cuatro triadas básicas.

type Triada = (Nota, Nota, Nota) 

maj :: Nota -> Triada
maj a = (a, intervalo a 4, intervalo a 7)

men :: Nota -> Triada
men a = (a, intervalo a 3, intervalo a 7)

aug :: Nota -> Triada
aug a = (a, intervalo a 4, intervalo a 8 )

dim :: Nota -> Triada
dim a = (a, intervalo a 3, intervalo a 6)

Y luego definir las escalas y modos básicos.

escala :: Nota -> [Integer] -> [Nota]
escala a [] = []
escala a (x:xs) = intervalo a x : escala a xs

escala_cromatica :: Nota -> [Nota]
escala_cromatica a = escala a [0..11]

escala_mayor :: Nota -> [Nota]
escala_mayor a = escala a [0,2,4,5,7,9,11]

escala_menor :: Nota -> [Nota]
escala_menor a = escala a [0,2,3,5,7,8,10]

escala_menor_armonica :: Nota -> [Nota]
escala_menor_armonica a = escala a [0,2,3,5,7,8,11]

escala_menor_melodica :: Nota -> [Nota]
escala_menor_melodica a = escala a [0,2,3,5,7,9,11]

modo_dorico :: Nota -> [Nota]
modo_dorico a = escala a [0,2,3,5,7,9,10]

modo_frigio :: Nota -> [Nota]
modo_frigio a = escala a [0,1,3,5,7,8,10]

modo_lidio :: Nota -> [Nota]
modo_lidio a = escala a [0,2,4,6,7,9,11]

modo_mixolidio :: Nota -> [Nota]
modo_mixolidio a = escala a [0,2,4,5,7,9,10]

modo_locrio :: Nota -> [Nota]
modo_locrio a = escala a [0,1,3,5,6,8,10]

escala_disminuida :: Nota -> [Nota]
escala_disminuida a = escala a [0,2,3,5,6,8,9,11]

escala_aumentada :: Nota -> [Nota]
escala_aumentada a = escala a [0,2,4,6,8,10]

Dado que voy a intentar hacer reconocimiento de acordes, se vuelve necesario definir la función distancia (que es distancia ascendente).

distancia :: Nota -> Nota -> Integer
distancia a b 	| (intervalo a 0) == b 	= 0
		| otherwise 		= 1 + (distancia (suc a) b)

Probar de Reconocer Acordes.

es_triada_mayor :: Triada -> Bool
es_triada_mayor (a,b,c) | (distancia a b) == 4 && (distancia a c) == 7 = True
			| otherwise = False

es_triada_menor :: Triada -> Bool
es_triada_menor (a,b,c) | (distancia a b) == 3 && (distancia a c) == 7 = True
			| otherwise = False

es_triada_disminuida :: Triada -> Bool
es_triada_disminuida (a,b,c) 	| (distancia a b) == 3 && (distancia a c) == 6 = True
				| otherwise = False

es_triada_aumentada :: Triada -> Bool
es_triada_aumentada (a,b,c) 	| (distancia a b) == 4 && (distancia a c) == 8 = True
				| otherwise = False

Ejemplo de uso:

*Main> es_triada_mayor (A,Db,E)
True
*Main> es_triada_mayor (A,C,E)
False

Aclaración: Como el tipo de datos es cíclico a partir de la función suc y estamos trabajando con triadas básicas, no importan las diferentes inversiones de los acordes.

Ver si una triada existe en una escala:

esta_triada_en_escala :: [Nota] -> Triada -> Bool
esta_triada_en_escala xs (a,b,c)	| elem a xs && elem b xs && elem c xs = True
					| otherwise = False
{- 
*Main> esta_triada_en_escala (men A) (modo_dorico A)
True
-}

Ahora ya puedo armonizar escalas por un método de Brute Force, no muy elegante, pero por lo pronto efectivo. Primero creo todas las posibles triadas (4*12 = 48) y después filtro las que corresponden a la escala, además de crear una función que muestre los resultados de una forma visualmente más agradable.

show_triada :: Triada -> String
show_triada (a,b,c) 	| es_triada_mayor (a,b,c) = strip_slashes(show a) ++ " maj"
			| es_triada_menor (a,b,c) = strip_slashes(show a) ++ " min"
			| es_triada_aumentada (a,b,c) = strip_slashes(show a) ++ " aug"
			| es_triada_disminuida (a,b,c) = strip_slashes(show a) ++ " dim"
			| otherwise = strip_slashes(show (a,b,c)) ++ " No es Triada"
			where 
				strip_slashes :: [Char] -> [Char]
				strip_slashes [] = []
				strip_slashes (x:xs) 	| x == ‘\”‘ = strip_slashes xs
							| otherwise = x : strip_slashes xs		

todas_las_triadas :: Nota -> [Triada]
todas_las_triadas a = concat( map hacer_triadas_de (escala_cromatica a))
			where
			hacer_triadas_de :: Nota -> [Triada]
			hacer_triadas_de a = [(dim a),(men a),(maj a),(aug a)]
armonizar_escala :: [Nota] -> [String]
armonizar_escala (x:xs) = map show_triada (filter (esta_triada_en_escala (x:xs)) (todas_las_triadas x))

{-
*Main> armonizar_escala (modo_dorico A)
["A min","B min","C maj","D maj","E min","F#/Gb dim","G maj"]
*Main> armonizar_escala (escala_menor_armonica E)
["E min","F#/Gb dim","G aug","A dim","A min","B maj","B aug","C dim","C min","C maj","D#/Eb dim","D#/Eb aug"]
*Main> armonizar_escala (escala_aumentada E)
["E aug","F#/Gb aug","G#/Ab aug","A#/Bb aug","C aug","D aug"]
*Main> armonizar_escala (escala_disminuida E)
["E dim","F#/Gb dim","F#/Gb min","F#/Gb maj","G dim","A dim","A min","A maj","A#/Bb dim","C dim","C min","C maj","C#/Db dim","D#/Eb dim","D#/Eb min","D#/Eb maj"]
-}

Detalle: otro ejemplo de currying en esta_triada_en_escala (x:xs).

Obviamente esto un principio y hay un montón de ideas que se me ocurrieron mientras hacia esto. Así que, sera continuado.