Gibt es in Haskell sowas wie Unterwächter?

Question

Ich schreibe ein Programm über die Klassifizierung von musikalischen Intervallen. Die konzeptionelle Struktur ist ziemlich kompliziert und ich würde sie so klar wie möglich darstellen. Die ersten paar Codezeilen sind ein kleiner Auszug, der richtig funktioniert. Der zweite ist der Pseudo-Code, der meinen Bedürfnissen der Prägnanz entspricht.

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 

Gibt es eine Programmstruktur, die den Code vereinfachen könnte wie der folgende Pseudo-Code macht?

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 

Vielen Dank im Voraus für Ihre Vorschläge.

Answer 1

Lassen Sie mich als den entsandten eine kürzere Beispiel verwenden:

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 

Der Code läuft in GHCi wie folgt:

> map original [1..12] 
[4,4,4,3,3,2,2,1,1,2,2,4] 

Unser Ziel ist es, „Gruppe“ zusammen die beiden Zweige erfordern mit n < 12, Factoring diese Bedingung aus. (Dies ist kein großer Gewinn im original Spielzeug Beispiel, aber es könnte in komplexeren Fällen.)

Wir naiv zu spalten den Code in zwei verschachtelten Fällen denken konnten:

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 

oder äquivalent , die MultiWayIf Erweiterung mit:

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 

Dies führt jedoch zu Überraschungen:

> map wrong1 [1..12] 
*** Exception: Non-exhaustive patterns in case 

> map wrong2 [1..12] 
*** Exception: Non-exhaustive guards in multi-way if 

Das Problem ist, dass, wenn n ist 1, der n < 12 Zweig wird genommen, der innere Fall wird ausgewertet, und dann keine Verzweigung berücksichtigt 1. Der original Code versucht einfach den nächsten Zweig, der es handhabt. wrong1,wrong2 sind jedoch nicht zurück zum äußeren Fall.

Bitte beachten Sie, dass dies kein Problem ist, wenn Sie wissen, dass das äußere Gehäuse nicht überlappende Bedingungen hat. In dem Code des OP scheint dies der Fall zu sein, so dass die wrong1,wrong2 Ansätze dort funktionieren würden (wie von Jefffrey gezeigt).

Aber was ist mit dem allgemeinen Fall, wo es Überschneidungen geben könnte? Glücklicherweise ist Haskell faul, daher ist es einfach, eigene Kontrollstrukturen zu erstellen.Dazu können wir die Maybe Monade ausnutzen wie folgt:

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 ] 

Es ist ein bisschen ausführlicher, aber nicht viel. Das Schreiben von Code in diesem Stil ist einfacher, als es aussehen könnte: ein einfache Mehrweg-bedingten geschrieben als

foo n = fromJust $ msum 
    [ guard boolean1 >> return value1 
    , guard boolean2 >> return value2 
    , ... 
    ] 

und, wenn Sie einen „verschachtelten“ Fall mögen, ersetzen Sie einfach eine der return value mit einem msum [ ... ].

Dadurch wird sichergestellt, dass wir das gewünschte Backtracking erhalten. Tatsächlich:

> map correct [1..12] 
[4,4,4,3,3,2,2,1,1,2,2,4] 

Der hier Trick besteht darin, dass, wenn ein guard ausfällt, erzeugt sie einen Nothing Wert. Die Bibliotheksfunktion msum wählt einfach den ersten Nicht-Nothing-Wert in der Liste aus. Also, selbst wenn jedes Element in der inneren Liste Nothing ist, wird das äußere msum das nächste Element in der äußeren Liste betrachten - Backtracking, wie gewünscht.

Answer 2

Ich würde jeden verschachtelten Zustand in einer Funktion Gruppe empfehlen:

interval :: _ -> _ -> (String, String) 
interval pt1 pt2 
    | gd == 0 = doSomethingA pt1 pt2 
    | gd == 1 = doSomethingB pt1 pt2 
    | gd == 2 = doSomethingC pt1 pt2 
    ... 

und dann zum Beispiel:

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 

---

Alternativ können Sie die MultiWayIf Spracherweiterung verwenden:

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

Answer 3

Dies ist nicht wirklich eine Antwort auf die Titelfrage, sondern adressiert Ihre spezielle Anwendung. Ähnliche Ansätze werden für viele andere Probleme funktionieren, bei denen Sie sich solche Unterwächter wünschen könnten.

Zuerst würde ich empfehlen Sie beginnen weniger “ getippt stringly ”:

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 

Und unabhängig davon, dass Ihre besondere Aufgabe wesentlich eleganter durch “ Computing getan werden kann ” die Werte, anstatt zu vergleichen mit einer Reihe von hartcodierten Fällen. Im Grunde, was Sie brauchen, ist dies:

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

Sie können dann füllen “ in ” diese undefinierte Intervall Qualitäten durch einen Vergleich der 12edo-Größe mit der von Ihnen gegeben haben, mit

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 

damit können Sie Ihre Funktion so implementieren:

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

---

_{Sie nicht wirklich brauchen eine Klasse hier, ich könnte auch zwei verschiedene Funktionen für reine und andere Intervalle definiert haben.}