Monoidale Falten an Fixpunkten

Question

Können wir für eine beliebige Datenstruktur mit einem Fixpunkt eine Monoidalgebra konstruieren, ohne alle Fälle manuell zu spezifizieren?

Angenommen, wir erhalten den Datentyp Expr wie folgt. Mit der Bibliothek können wir einen Basisfunktor ExprF ableiten, der automatisch auch Functor, und Traversable Instanzen hat. Jetzt

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} 
{-# LANGUAGE TypeFamilies #-} 
{-# LANGUAGE TemplateHaskell #-} 

import Data.Semigroup (Sum(..)) 
import Data.Functor.Foldable 
import Data.Functor.Foldable.TH 

import Prelude hiding (fail) 

data Expr = Var String 
      | Const Int 
      | Add [Expr] 
      | Mult [Expr] 
      deriving Show 

$(makeBaseFunctor ''Expr) 

expr :: Fix ExprF 
expr = ana project $ Add [Const 1, Const 2, Mult [Const 3, Const 4], Var "hello"] 

, lassen Sie uns sagen, dass wir die Anzahl der Blätter in expr zählen möchten. Wir können leicht eine Algebra für eine so kleine Datenstruktur schreiben:

alg (ConstF _) = 1 
alg (VarF _) = 1 
alg (AddF xs) = sum xs 
alg (MulF xs) = sum xs 

Nun wir cata alg expr nennen können, die 5, das richtige Ergebnis zurückgibt.

Nehmen wir an, Expr wird wirklich groß und komplex und wir wollen nicht Fälle für alle Datenkonstruktoren manuell schreiben. Wie kann cata die Ergebnisse aus allen Fällen kombinieren? Ich vermute, dass dies möglich ist mit Monoid s, möglicherweise in Verbindung mit dem Const Funktor (nicht ganz sicher über diesen letzten Teil).

fail = getSum $ foldMap (const (Sum 1) . unfix) $ unfix expr 

fail kehrt 4, während wir 5 Blätter tatsächlich haben. Ich gehe davon aus, dass das Problem im Fixpunkt liegt, da wir nur eine Schicht von Fix schälen können und somit die Mult [..] nur als ein Blatt gezählt wird.

Ist es möglich, generisch den gesamten Fixpunkt zu falten und die Ergebnisse in einer Monoid -ähnlichen Struktur ohne manuell alle Instanzen zu sammeln? Was ich will ist eine Art von foldMap aber in einer allgemeineren Art und Weise.

Ich habe das Gefühl, ich vermisse etwas wirklich offensichtlich.

Answer 1

Hier ist die Essenz einer Lösung. Ich habe eingeschaltet

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, PatternSynonyms #-} 

Lassen Sie uns nur Fixpunkte und Katamorphismen zusammenfassen.

newtype Fix f = In {out :: f (Fix f)} 

cata :: Functor f => (f t -> t) -> Fix f -> t 
cata alg = alg . fmap (cata alg) . out 

Die Algebra, nimmt alg :: f t -> t, einen Knoten, wo die Kinder bereits durch einen t Wert ersetzt, dann die t für die Eltern zurückkehrt. Der Operator cata entpackt den übergeordneten Knoten, verarbeitet alle untergeordneten Elemente rekursiv und wendet dann alg an, um den Job zu beenden.

Wenn wir also Blätter in einer solchen Struktur zählen wollen, können wir wie folgt beginnen:

leaves :: (Foldable f, Functor f) => Fix f -> Integer 
leaves = cata sumOrOne where 
    -- sumOrOne :: f Integer -> Integer 

Die Algebra, sumOrOne die Anzahl der Blätter in jedem Kind des Elternknotens sehen. Wir können cata verwenden, weil f ein Functor ist. Und weil fFoldable ist, können wir die Gesamtzahl der Blätter in den Kindern berechnen.

sumOrOne fl = case sum fl of 
    ... 

Es gibt dann zwei Möglichkeiten: Wenn die Eltern keine Kinder hat, sein Blatt Summe 0 sein wird, die wir erkennen können, aber das bedeutet, dass die Eltern selbst ist ein Blatt, so 1 zurückgegeben werden sollte. Andernfalls ist die Blattsumme ungleich Null, in diesem Fall ist das Elternteil kein Blatt, also ist seine Blattsumme tatsächlich die gesamte Blattsumme seiner Kinder. Das gibt uns

leaves :: (Foldable f, Functor f) => Fix f -> Integer 
leaves = cata sumOrOne where 
    sumOrOne fl{- number of leaves in each child-} = case sum fl of 
    0 -> 1 -- no leaves in my children means I am a leaf 
    l -> l -- otherwise, pass on the total 

Ein kurzes Beispiel, basierend auf Hutton Rasiermesser (die Ausdruckssprache mit ganzen Zahlen und zusätzlich, die oft ist die einfachste Sache, die den Punkt zeigt). Die Ausdrücke werden von Huttons Funktor generiert.

data HF h = Val Int | h :+: h deriving (Functor, Foldable, Traversable) 

Ich führe einige Synonymen von Mustern ein, um das Aussehen eines speziellen Typs wiederherzustellen.

pattern V x = In (Val x) 
pattern s :+ t = In (s :+: t) 

Ich koche einen schnellen Beispielausdruck, mit einigen Blättern, die drei Ebenen tief sind.

example :: Fix HF 
example = (V 1 :+ V 2) :+ ((V 3 :+ V 4) :+ V 5) 

Sicher genug

Ok, modules loaded: Leaves. 
*Leaves> leaves example 
5 

Ein alternativer Ansatz ist funktoriellen und faltbar in Unterbauten von Interesse zu sein, in diesem Fall, Sachen auf Blättern. (Wir bekommen genau die freien Monaden.)

data Tree f x = Leaf x | Node (f (Tree f x)) deriving (Functor, Foldable) 

Sobald Sie das Blatt/Knoten Trennung Teil Ihrer Grundkonstruktion vorgenommen haben, können Sie die Blätter direkt mit foldMap besuchen. Werfen in ein wenig Control.Newtype, wir bekommen

ala' Sum foldMap (const 1) :: Foldable f => f x -> Integer 

, die unterhalb der Schwelle Fairbairn ist (das heißt, kurz genug, um nicht einen Namen zu müssen und alle klareren für keines haben).

Das Problem ist natürlich, dass Datenstrukturen oft in "interessanten Unterstrukturen" auf mehrere interessante, aber widersprüchliche Weise funktionieren. Haskell ist nicht immer der beste Weg, uns "gefundene Funktorität" zugänglich zu machen: Wir müssen irgendwie die Funktionalität vorhersagen, die wir brauchen, wenn wir einen Datentyp zum Zeitpunkt der Deklaration parametrisieren. Aber es ist noch Zeit, all das zu ändern ...