Есть ли в Haskell нечто похожее на подостры?

Ответ 1

Позвольте мне использовать более короткий пример, чем опубликованный:

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 не возвращаются во внешний случай.

Обратите внимание, что это не проблема, когда вы знаете, что внешний случай имеет неперекрывающиеся условия. В коде, отправленном OP, это, похоже, так, поэтому подходы 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 ]

Это немного более многословно, но не намного. Написание кода в этом стиле проще, чем могло бы выглядеть: простой условный символ multiway записывается как

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]

Трюк здесь в том, что когда a guard терпит неудачу, он генерирует значение Nothing. Функция библиотеки msum просто выбирает первое значение не Nothing в списке. Таким образом, даже если каждый элемент во внутреннем списке Nothing, внешний msum рассмотрит следующий элемент во внешнем списке - обратный поиск, если захотите.

Ответ 2

Я бы рекомендовал группировать каждое вложенное условие в функцию:

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")
                       ...

Ответ 3

На самом деле это не ответ на вопрос заголовка, а адрес вашего конкретного приложения. Подобные подходы будут работать для многих других проблем, где вы можете захотеть таких подзащитных.

Сначала я бы посоветовал вам начинать с менее "строкового ввода":

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   )
...

Затем вы можете "заполнить" те качества интервала undefined, сравнив размер 12edo с тем, который вы указали, используя ¹

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
       ...