Есть ли в Хаскеле что-то похожее на субгвардейцев?
Я пишу программу по классификации музыкальных интервалов. Концептуальная структура довольно сложна, и я хотел бы представить ее как можно более четко. Первые несколько строк кода представляют собой небольшой фрагмент, который работает правильно. Вторым является псевдокод, который бы соответствовал моим потребностям краткости.
interval pt1 pt2
| gd == 0 && sd < (-2) = ("unison",show (abs sd) ++ "d")
| gd == 0 && sd == (-2) = ("unison","dd")
| gd == 0 && sd == (-1) = ("unison","d")
| gd == 0 && sd == 0 = ("unison","P")
| gd == 0 && sd == 1 = ("unison","A")
| gd == 0 && sd == 2 = ("unison","AA")
| gd == 0 && sd > 2 = ("unison",show sd ++ "A")
| gd == 1 && sd < (-1) = ("second",show (abs sd) ++ "d")
| gd == 1 && sd == (-1) = ("second","dd")
| gd == 1 && sd == 0 = ("second","d")
| gd == 1 && sd == 1 = ("second","m")
| gd == 1 && sd == 2 = ("second","M")
| gd == 1 && sd == 3 = ("second","A")
| gd == 1 && sd == 4 = ("second","AA")
| gd == 1 && sd > 4 = ("second",show (abs sd) ++ "A")
where
(bn1,acc1,oct1) = parsePitch pt1
(bn2,acc2,oct2) = parsePitch pt2
direction = signum sd
sd = displacementInSemitonesOfPitches pt1 pt2
gd = abs $ displacementBetweenTwoBaseNotes direction bn1 bn2
Существует ли структура программирования, которая могла бы упростить код, как это делает следующий псевдокод?
interval pt1 pt2
| gd == 0 | sd < (-2) = ("unison",show (abs sd) ++ "d")
| sd == (-2) = ("unison","dd")
| sd == (-1) = ("unison","d")
| sd == 0 = ("unison","P")
| sd == 1 = ("unison","A")
| sd == 2 = ("unison","AA")
| sd > 2 = ("unison",show sd ++ "A")
| gd == 1 | sd < (-1) = ("second",show (abs sd) ++ "d")
| sd == (-1) = ("second","dd")
| sd == 0 = ("second","d")
| sd == 1 = ("second","m")
| sd == 2 = ("second","M")
| sd == 3 = ("second","A")
| sd == 4 = ("second","AA")
| sd > 4 = ("second",show (abs sd) ++ "A")
| gd == 2 | sd ... = ...
| sd ... = ...
...
| mod gd 7 == 1 | mod sd 12 == ...
| mod sd 12 == ...
...
| otherwise = ...
where
(bn1,acc1,oct1) = parsePitch pt1
(bn2,acc2,oct2) = parsePitch pt2
direction = signum sd
sd = displacementInSemitonesOfPitches pt1 pt2
gd = abs $ displacementBetweenTwoBaseNotes direction bn1 bn2
Заранее благодарю за ваши предложения.
3 ответа
Позвольте мне использовать более короткий пример, чем опубликованный:
original :: Int -> Int
original n
| n < 10 && n > 7 = 1 -- matches 8,9
| n < 12 && n > 5 = 2 -- matches 6,7,10,11
| n < 12 && n > 3 = 3 -- matches 4,5
| n < 13 && n > 0 = 4 -- matches 1,2,3,12
Код работает в GHCi следующим образом:
> map original [1..12]
[4,4,4,3,3,2,2,1,1,2,2,4]
Наша цель состоит в том, чтобы "сгруппировать" вместе две ветви, требующие n < 12 с учетом этого условия. (Это не огромный выигрыш в original игрушечный пример, но это может быть в более сложных случаях.)
Мы могли наивно думать о разбиении кода на два вложенных случая:
wrong1 :: Int -> Int
wrong1 n = case () of
_ | n < 10 && n > 7 -> 1
| n < 12 -> case () of
_ | n > 5 -> 2
| n > 3 -> 3
| n < 13 && n > 0 -> 4
Или, что эквивалентно, используя MultiWayIf расширение:
wrong2 :: Int -> Int
wrong2 n = if
| n < 10 && n > 7 -> 1
| n < 12 -> if | n > 5 -> 2
| n > 3 -> 3
| n < 13 && n > 0 -> 4
Это, однако, приводит к неожиданностям:
> map wrong1 [1..12]
*** Exception: Non-exhaustive patterns in case
> map wrong2 [1..12]
*** Exception: Non-exhaustive guards in multi-way if
Проблема в том, что когда n является 1, n < 12 берется ветвь, вычисляется внутренний случай, и тогда ни одна ветвь там не рассматривается 1, original код просто пытается перейти к следующей ветви, которая его обрабатывает. Тем не мение, wrong1,wrong2 не возвращаются к внешнему случаю.
Обратите внимание, что это не проблема, если вы знаете, что внешний корпус имеет неперекрывающиеся условия. В коде, опубликованном ФП, похоже, это так, поэтому wrong1,wrong2 подходы будут работать там (как показано Джеффри).
Однако как насчет общего случая, когда могут быть совпадения? К счастью, Haskell ленив, поэтому легко создавать собственные управляющие структуры. Для этого мы можем использовать Maybe монада следующим образом:
correct :: Int -> Int
correct n = fromJust $ msum
[ guard (n < 10 && n > 7) >> return 1
, guard (n < 12) >> msum
[ guard (n > 5) >> return 2
, guard (n > 3) >> return 3 ]
, guard (n < 13 && n > 0) >> return 4 ]
Это немного более многословно, но не намного. Написание кода в этом стиле проще, чем может показаться: простое многогранное условие записывается как
foo n = fromJust $ msum
[ guard boolean1 >> return value1
, guard boolean2 >> return value2
, ...
]
и, если вы хотите "вложенный" случай, просто замените любой из return value с msum [ ... ],
Это гарантирует, что мы получим желаемый возврат. В самом деле:
> map correct [1..12]
[4,4,4,3,3,2,2,1,1,2,2,4]
Хитрость в том, что когда guard не удается, он генерирует Nothing значение. Функция библиотеки msum просто выбирает первый Nothing значение в списке. Таким образом, даже если каждый элемент во внутреннем списке Nothing, внешний msum рассмотрим следующий элемент во внешнем списке - возврат, как и хотелось.
Я бы рекомендовал сгруппировать каждое вложенное условие в функцию:
interval :: _ -> _ -> (String, String)
interval pt1 pt2
| gd == 0 = doSomethingA pt1 pt2
| gd == 1 = doSomethingB pt1 pt2
| gd == 2 = doSomethingC pt1 pt2
...
а затем, например:
doSomethingA :: _ -> _ -> (String, String)
doSomethingA pt1 pt2
| sd < (-2) = ("unison",show (abs sd) ++ "d")
| sd == (-2) = ("unison","dd")
| sd == (-1) = ("unison","d")
| sd == 0 = ("unison","P")
| sd == 1 = ("unison","A")
| sd == 2 = ("unison","AA")
| sd > 2 = ("unison",show sd ++ "A")
where sd = displacementInSemitonesOfPitches pt1 pt2
В качестве альтернативы вы можете использовать MultiWayIf расширение языка:
interval pt1 pt2 =
if | gd == 0 -> if | sd < (-2) -> ("unison",show (abs sd) ++ "d")
| sd == (-2) -> ("unison","dd")
| sd == (-1) -> ("unison","d")
...
| gd == 1 -> if | sd < (-1) -> ("second",show (abs sd) ++ "d")
| sd == (-1) -> ("second","dd")
| sd == 0 -> ("second","d")
...
На самом деле это не ответ на заглавный вопрос, а адрес вашей конкретной заявки. Подобные подходы будут работать для многих других проблем, когда вы можете пожелать таких подзащитных.
Во-первых, я бы порекомендовал вам начать с "строкового типа":
interval' :: PitchSpec -> PitchSpec -> Interval
data Interval = Unison PureQuality
| Second IntvQuality
| Third IntvQuality
| Fourth PureQuality
| ...
data IntvQuality = Major | Minor | OtherQual IntvDistortion
type PureQuality = Maybe IntvDistortion
data IntvDistortion = Augm Int | Dimin Int -- should actually be Nat rather than Int
И независимо от этого, ваша конкретная задача может быть выполнена более элегантно, "вычисляя" значения, а не сравнивая с кучей жестко закодированных случаев. В основном, что вам нужно, это:
type RDegDiatonic = Int
type RDeg12edo = Rational -- we need quarter-tones for neutral thirds etc., which aren't in 12-edo tuning
courseInterval :: RDegDiatonic -> (Interval, RDeg12edo)
courseInterval 0 = ( Unison undefined, 0 )
courseInterval 1 = ( Second undefined, 1.5 )
courseInterval 2 = ( Third undefined, 3.5 )
courseInterval 3 = ( Fourth undefined, 5 )
...
Затем вы можете "заполнить" эти неопределенные интервальные качества, сравнивая размер 12о с тем, который вы дали, используя 1
class IntervalQuality q where
qualityFrom12edoDiff :: RDeg12edo -> q
instance IntervalQuality PureQuality where
qualityFrom12edoDiff n = case round n of
0 -> Nothing
n' | n'>0 -> Augm n
| otherwise -> Dimin n'
instance IntervalQuality IntvQuality where
qualityFrom12edoDiff n | n > 1 = OtherQual . Augm $ floor n
| n < -1 = OtherQual . Dimin $ ceil n
| n > 0 = Major
| otherwise = Minor
При этом вы можете реализовать свою функцию таким образом:
interval pt1 pt2 = case gd of
0 -> Unison . qualityFrom12edoDiff $ sd - 0
1 -> Second . qualityFrom12edoDiff $ sd - 1.5
2 -> Third . qualityFrom12edoDiff $ sd - 3.5
3 -> Fourth . qualityFrom12edoDiff $ sd - 5
...
1 Вам действительно не нужен класс типов здесь, я мог бы также определить две функции с различными именами для чистых и других интервалов.