I have been searching google for a while, but was not able to find an answer:
Say I have Tree ADT that is polymorphic, a base payload sum type and two extention sum types:
--Base.hs
data Tree a = Node a [Tree a] | Empty
data BasePayload = BaseA String | BaseB Int
--Extention1.hs
data Extention1 = Ext1A String String | Ext1B Int
--Extention2.hs
data Extention2 = B | A
I cannot modify the base type, and I do not know if and how many extention types are used at compile time. Is it possible to create functions that work like this:
--Base.hs
type GeneralTree = Tree SomeBoxType
transform :: Tree (SomeBoxType (any | BasePayload)) -> Tree (SomeBoxType any)
--Extention1.hs
transform :: Tree (SomeBoxType (any | Extention1)) -> Tree (SomeBoxType any)
--Extention2.hs
transform :: Tree (SomeBoxType (any | Extention2)) -> Tree (SomeBoxType any)
Is something like this possible? When I searched I found GADT, which is not what I need and DataKinds and TypeFamilies, which I did not understand 100%, but dont think will help here. Is that Row Polymorphism?
Thanks for your help.
I suspect you just want a Functor instance. Thus:
instance Functor Tree where
fmap f (Node x children) = Node (f x) (fmap (fmap f) children)
fmap f Empty = Empty
Now fmap can be given any of these types:
fmap :: (Either any BasePayload -> any) -> Tree (Either any BasePayload) -> Tree any
fmap :: (Either any Extention1 -> any) -> Tree (Either any Extention1 ) -> Tree any
fmap :: (Either any Extention2 -> any) -> Tree (Either any Extention2 ) -> Tree any
As an aside, I find the Empty constructor very suspicious. What's the difference between Node 0 [] and Node 0 [Empty] for example? Is Node 0 [Empty, Empty] a sensible value to have at all? Consider using Data.Tree, which comes with your compiler, doesn't have this issue, and already has a Functor instance.
Related
I've been thinking in how to implement the equivalent of unfold for the following type:
data Tree a = Node (Tree a) (Tree a) | Leaf a | Nil
It was not immediately obvious since the standard unfold for lists returns a value and the next seed. For this datatype, it doesn't make sense, since there is no "value" until you reach a leaf node. This way, it only really makes sense to return new seeds or stop with a value. I'm using this definition:
data Drive s a = Stop | Unit a | Branch s s deriving Show
unfold :: (t -> Drive t a) -> t -> Tree a
unfold fn x = case fn x of
Branch a b -> Node (unfold fn a) (unfold fn b)
Unit a -> Leaf a
Stop -> Nil
main = print $ unfold go 5 where
go 0 = Stop
go 1 = Unit 1
go n = Branch (n - 1) (n - 2)
While this seems to work, I'm not sure this is how it is supposed to be. So, that is the question: what is the correct way to do it?
If you think of a datatype as the fixpoint of a functor then you can see that your definition is the sensible generalisation of the list case.
module Unfold where
Here we start by definition the fixpoint of a functor f: it's a layer of f followed by some more fixpoint:
newtype Fix f = InFix { outFix :: f (Fix f) }
To make things slightly clearer, here are the definitions of the functors corresponding to lists and trees. They have basically the same shape as the datatypes except that we have replace the recursive calls by an extra parameter. In other words, they describe what one layer of list / tree looks like and are generic over the possible substructures r.
data ListF a r = LNil | LCons a r
data TreeF a r = TNil | TLeaf a | TBranch r r
Lists and trees are then respectively the fixpoints of ListF and TreeF:
type List a = Fix (ListF a)
type Tree a = Fix (TreeF a)
Anyways, hopping you now have a better intuition about this fixpoint business, we can see that there is a generic way of defining an unfold function for these.
Given an original seed as well as a function taking a seed and building one layer of f where the recursive structure are new seeds, we can build a whole structure:
unfoldFix :: Functor f => (s -> f s) -> s -> Fix f
unfoldFix node = go
where go = InFix . fmap go . node
This definition specialises to the usual unfold on list or your definition for trees. In other words: your definition was indeed the right one.
Given a list of steps:
>>> let path = ["item1", "item2", "item3", "item4", "item5"]
And a labeled Tree:
>>> import Data.Tree
>>> let tree = Node "item1" [Node "itemA" [], Node "item2" [Node "item3" []]]
I'd like a function that goes through the steps in path matching the labels in tree until it can't go any further because there are no more labels matching the steps. Concretely, here it falls when stepping into "item4" (for my use case I still need to specify the last matched step):
>>> trav path tree
["item3", "item4", "item5"]
If I allow [String] -> Tree String -> [String] as the type of trav I could write a recursive function that steps in both structures at the same time until there are no labels to match the step. But I was wondering if a more general type could be used, specifically for Tree. For example: Foldable t => [String] -> t String -> [String]. If this is possible, how trav could be implemented?
I suspect there could be a way to do it using lens.
First, please let's use type Label = String. String is not exactly descriptive and might not be ideal in the end...
Now. To use Traversable, you need to pick a suitable Applicative that can contain the information you need for deciding what to do in its "structure". You only need to pass back information after a match has failed. That sounds like some Either!
A guess would thus be Either [Label] (t Label) as the pre-result. That would mean, we use the instantiation
traverse :: Traversable t
=> (Label -> Either [Label] Label) -> t Label -> Either [Label] (t Label)
So what can we pass as the argument function?
travPt0 :: [Label] -> Label -> Either [Label] Label
travPt0 ls#(l0 : _) label
| l0 /= label = Left ls
| otherwise = Right label ?
The problem is, traverse will then fail immediately and completely if any node has a non-matching label. Traversable doesn't actually have a notion of "selectively" diving down into a data structure, it just passes through everything, always. Actually, we only want to match on the topmost node at first, only that one is mandatory to match at first.
One way to circumvent immediate deep-traversal is to first split up the tree into a tree of sub-trees. Ok, so... we need to extract the topmost label. We need to split the tree in subtrees. Reminds you of anything?
trav' :: (Traversable t, Comonad t) => [Label] -> t Label -> [Label]
trav' (l0 : ls) tree
| top <- extract tree
= if top /= l0 then l0 : ls
else let subtrees = duplicate tree
in ... ?
Now amongst those subtrees, we're basically interested only in the one that matches. This can be determined from the result of trav': if the second element is passed right back again, we have a failure. Unlike normal nomenclature with Either, this means we wish to go on, but not use that branch! So we need to return Either [Label] ().
else case ls of
[] -> [l0]
l1:ls' -> let subtrees = duplicate tree
in case traverse (trav' ls >>> \case
(l1':_)
| l1'==l1 -> Right ()
ls'' -> Left ls''
) subtrees of
Left ls'' -> ls''
Right _ -> l0 : ls -- no matches further down.
I have not tested this code!
We'll take as reference the following recursive model
import Data.List (minimumBy)
import Data.Ord (comparing)
import Data.Tree
-- | Follows a path into a 'Tree' returning steps in the path which
-- are not contained in the 'Tree'
treeTail :: Eq a => [a] -> Tree a -> [a]
treeTail [] _ = []
treeTail (a:as) (Node a' trees)
| a == a' = minimumBy (comparing length)
$ (a:as) : map (treeTail as) trees
| otherwise = as
which suggests that the mechanism here is less that we're traversing through the tree accumulating (which is what a Traversable instance might do) but more that we're stepping through the tree according to some state and searching for the deepest path.
We can characterize this "step" by a Prism if we like.
import Control.Lens
step :: Eq a => a -> Prism' (Tree a) (Forest a)
step a =
prism' (Node a)
(\n -> if rootLabel n == a
then Just (subForest n)
else Nothing)
This would allow us to write the algorithm as
treeTail :: Eq a => [a] -> Tree a -> [a]
treeTail [] _ = []
treeTail pth#(a:as) t =
maybe (a:as)
(minimumBy (comparing length) . (pth:) . map (treeTail as))
(t ^? step a)
but I'm not sure that's significantly more clear.
I have a tree like this:
data Tree a
= Empty
| Leaf a
| Node a (Tree a) (Tree a) String
deriving (Show)
and I need a function which finds the top of the tree. I have written this:
root :: Tree a -> a
root (Leaf a) = a
root (Node a _ _ _) = a
which perfectly works, but when I have an Empty tree, I have an error message.
If I add
root Empty = Empty
I have an error again because it does not return a value of type a. What can I do ?
You have no sensible value of a in case of the Empty constructor. The type Maybe encodes exactly what you need in this case: a sensible value or no value. Therefore the following would be an idiomatic way of implementing your function:
root :: Tree a -> Maybe a
root (Leaf a) = Just a
root (Node a _ _ _) = Just a
root _ = Nothing
You can easily compose this function with other functions of your library using functors, applicative functors and monads. E.g.:
functionOnPlainA :: a -> a
functionOnPlainA = error "implement me"
-- So simply we can lift our plain function to work on values of type `Maybe`.
-- This is a Functor example.
functionOnMaybeA :: Maybe a -> Maybe a
functionOnMaybeA = fmap functionOnPlainA
-- Because the above is so simple, it's conventional to inline it,
-- as in the following:
applyFunctionOnPlainAToResultOfRoot :: Tree a -> Maybe a
applyFunctionOnPlainAToResultOfRoot tree = fmap functionOnPlainA $ root tree
-- And here is an example of how Monads can serve us:
applyRootToMaybeTree :: Maybe (Tree a) -> Maybe a
applyRootToMaybeTree maybeTree = maybeTree >>= root
Good day!
I have a tree of elements:
data Tree a = Node [Tree a]
| Leaf a
I need to get to the leaf of that tree. The path from the root to the leaf is determined by a sequence of switch functions. Each layer in that tree corresponds to a specific switch function that takes something as a parameter and returns an index to the subtree.
class Switchable a where
getIndex :: a -> Int
data SwitchData = forall c. Switchable c => SwitchData c
The final goal is to provide a function that expects all necessary SwitchData and returns
the leaf in a tree.
But I see no way
to enforce the one-to-one mapping at type-level. My current implementation of switch
functions accepts a list of SwitchData instances:
switch :: SwitchData -> Tree a -> Tree a
switch (SwitchData c) (Node vec) = vec `V.unsafeIndex` getIndex c
switch _ _ = error "switch: performing switch on a Leaf of context tree"
switchOnData :: [SwitchData] -> Tree a -> a
switchOnData (x:xs) tree = switchOnData xs $ switch x tree
switchOnData [] (Leaf c) = c
switchOnData [] (Node _) = error "switchOnData: partial data"
The order and the exact types of Switchable instances
are not considered neither at compile time nor at runtime, the correctness is left for a programmer, which bothers me a lot. That gist reflects the current state of affair.
Could you suggest some ways of establishing that one-to-one mapping between layers in a context tree and particular instances of Switchable?
Your current solution is equivalent to simply switchOnIndices :: [Int] -> Tree a -> a (simply apply getIndex before storing in list!). Make this explicitly "partial" by wrapping the return in Maybe and this may actually be the ideal signature, simple and fine.
But apparently, your real use case is more complex; you want to have basically different dictionaries at each level. Then you actually need to link the multiple levels of types to those of tree depths. You're in for some crazy almost-dependent-typed hackery!
{-# LANGUAGE GADTs, TypeOperators, LambdaCase #-}
infixr 5 :&
data Nil = Nil
data s :& ss where
(:&) :: s -> ss -> s :& ss
data Tree switch a where
Node ::
(s -> Tree ss a) -- Such a function is equiv. to `Switchable c => (c, [Tree a])`.
-> Tree (s :& ss) a
Leaf :: a -> Tree Nil a
switch :: s -> Tree (s :& ss) a -> Tree ss a
switch s (Node f) = f s
switchOnData :: s -> Tree s a -> a
switchOnData sw (Node f) = switchOnData ss $ f s
where (s :& ss) = sw
switchOnData _ (Leaf a) = a
data Sign = P | M
signTree :: Tree (Sign :& Sign :& Nil) Char
signTree = Node $ \case P -> Node $ \case P -> Leaf 'a'
M -> Leaf 'b'
M -> Node $ \case P -> Leaf 'c'
M -> Leaf 'd'
testSwitch :: IO()
testSwitch = print $ switchOnData (P :& M :& Nil) signTree
main = testSwitch
Of course, this greatly limits the flexibility of the tree structure: each level has a fixed predetermined number of nodes. In fact, that makes the entire structure of e.g. signTree equivalent to simply (Sign, Sign) -> Char, so unless you really need a tree for some specific reason (e.g. extra information attached to the nodes), why not just use that!
Or, again, the way simpler [Int] -> Tree a -> a signature. But using existentials makes no sense to me at all here.
Let's assume that we're traversing a Tree at a particular Node and have our particular kind of desired polymorphic Switchable value available as well. In other words, we want to take a step
step :: Switchable -> Tree a -> Maybe (Tree a)
Here the output Tree is one of the children of the input Tree and we wrap it in a Maybe just in case something goes wrong. So let's try to write step
step s Leaf{} = Nothing
step s (Node children) = switch s (?extract children)
Here, the challenge arises out of defining ?extract as we need it to polymorphically produce the right kind of value for switch s to operate on. We can't meaningfully use polymorphism to get this to work:
-- won't work!
class Extractable b where
extract :: [Tree a] -> b
since now switch . extract is ambiguous. In fact, if Switchable operates by existentially quantifying a value that it needs passed in then there is no way (outside of Typeable) to build an extract that works properly. Instead, we need each Switchable to have its own individual extract with the proper type, a type that only exists inside of the context of the data type.
{-# LANGUAGE ExistentialQuantification #-}
data Switchable = forall pass . Switchable
{ extract :: [Tree a] -> pass
, switch :: pass -> Int
}
step s (Node children) = children `safeLookup` switch s (extract s children)
But due to the containment of this existential type, we know that there's absolutely no way to use a Switchable except to immediately compute the existentially hidden pass value and then consume it with switch. There's not even any reason to store pass since the only way we can get any information out of it is to use switch.
Altogether this leads to the intuition that Switchable ought to be this instead.
data Switchable = Switchable { switch :: [Tree a] -> Int }
step s (Node children) = children `safeLookup` switch s children
Or even
data Switchable = Switchable { switch :: [Tree a] -> Tree a }
step s (Node children) = Just (switch s children)
Let's say that I have an adt representing some kind of tree structure:
data Tree = ANode (Maybe Tree) (Maybe Tree) AValType
| BNode (Maybe Tree) (Maybe Tree) BValType
| CNode (Maybe Tree) (Maybe Tree) CValType
As far as I know there's no way of pattern matching against type constructors (or the matching functions itself wouldn't have a type?) but I'd still like to use the compile-time type system to eliminate the possibility of returning or parsing the wrong 'type' of Tree node. For example, it might be that CNode's can only be parents to ANodes. I might have
parseANode :: Parser (Maybe Tree)
as a Parsec parsing function that get's used as part of my CNode parser:
parseCNode :: Parser (Maybe Tree)
parseCNode = try (
string "<CNode>" >>
parseANode >>= \maybeanodel ->
parseANode >>= \maybeanoder ->
parseCValType >>= \cval ->
string "</CNode>"
return (Just (CNode maybeanodel maybeanoder cval))
) <|> return Nothing
According to the type system, parseANode could end up returning a Maybe CNode, a Maybe BNode, or a Maybe ANode, but I really want to make sure that it only returns a Maybe ANode. Note that this isn't a schema-value of data or runtime-check that I want to do - I'm actually just trying to check the validity of the parser that I've written for a particular tree schema. IOW, I'm not trying to check parsed data for schema-correctness, what I'm really trying to do is check my parser for schema correctness - I'd just like to make sure that I don't botch-up parseANode someday to return something other than an ANode value.
I was hoping that maybe if I matched against the value constructor in the bind variable, that the type-inferencing would figure out what I meant:
parseCNode :: Parser (Maybe Tree)
parseCNode = try (
string "<CNode>" >>
parseANode >>= \(Maybe (ANode left right avall)) ->
parseANode >>= \(Maybe (ANode left right avalr)) ->
parseCValType >>= \cval ->
string "</CNode>"
return (Just (CNode (Maybe (ANode left right avall)) (Maybe (ANode left right avalr)) cval))
) <|> return Nothing
But this has a lot of problems, not the least of which that parseANode is no longer free to return Nothing. And it doesn't work anyways - it looks like that bind variable is treated as a pattern match and the runtime complains about non-exhaustive pattern matching when parseANode either returns Nothing or Maybe BNode or something.
I could do something along these lines:
data ANode = ANode (Maybe BNode) (Maybe BNode) AValType
data BNode = BNode (Maybe CNode) (Maybe CNode) BValType
data CNode = CNode (Maybe ANode) (Maybe ANode) CValType
but that kind of sucks because it assumes that the constraint is applied to all nodes - I might not be interested in doing that - indeed it might just be CNodes that can only be parenting ANodes. So I guess I could do this:
data AnyNode = AnyANode ANode | AnyBNode BNode | AnyCNode CNode
data ANode = ANode (Maybe AnyNode) (Maybe AnyNode) AValType
data BNode = BNode (Maybe AnyNode) (Maybe AnyNode) BValType
data CNode = CNode (Maybe ANode) (Maybe ANode) CValType
but then this makes it much harder to pattern-match against *Node's - in fact it's impossible because they're just completely distinct types. I could make a typeclass wherever I wanted to pattern-match I guess
class Node t where
matchingFunc :: t -> Bool
instance Node ANode where
matchingFunc (ANode left right val) = testA val
instance Node BNode where
matchingFunc (BNode left right val) = val == refBVal
instance Node CNode where
matchingFunc (CNode left right val) = doSomethingWithACValAndReturnABool val
At any rate, this just seems kind of messy. Can anyone think of a more succinct way of doing this?
I don't understand your objection to your final solution. You can still pattern match against AnyNodes, like this:
f (AnyANode (ANode x y z)) = ...
It's a little more verbose, but I think it has the engineering properties you want.
I'd still like to use the compile-time type system to eliminate the possibility of returning or parsing the wrong 'type' of Tree node
This sounds like a use case for GADTs.
{-# LANGUAGE GADTs, EmptyDataDecls #-}
data ATag
data BTag
data CTag
data Tree t where
ANode :: Maybe (Tree t) -> Maybe (Tree t) -> AValType -> Tree ATag
BNode :: Maybe (Tree t) -> Maybe (Tree t) -> BValType -> Tree BTag
CNode :: Maybe (Tree t) -> Maybe (Tree t) -> CValType -> Tree CTag
Now you can use Tree t when you don't care about the node type, or Tree ATag when you do.
An extension of keegan's answer: encoding the correctness properties of red/black trees is sort of a canonical example. This thread has code showing both the GADT and nested data type solution: http://www.reddit.com/r/programming/comments/w1oz/how_are_gadts_useful_in_practical_programming/cw3i9