[Haskell-cafe] Re: Painting logs to get a coloured tree
Heinrich Apfelmus
apfelmus at quantentunnel.de
Tue Feb 10 05:59:22 EST 2009
Joachim Breitner wrote:
>
> Assume you have a tree (and you can think of a real tree here), defined
> by something like this:
>
> data Tree a = Bud | Branch a Double Tree Tree
> -- | ` Lenght of this branch
> -- ` General storage field for additional information
>
> Now, I have a nice algorithm that calulates something for each branch,
> but it only works on lists of branches, so I have to cut them apart
> first, remembering their position in space, and then work on these,
> well, logs.
>
> data Point = Point Double Double
> data Log = Log Point Point
> type Info = ...
> noInfo :: Info
>
> cutTreeApart :: Tree a -> [(Log, a)]
> someAlgorithm :: [(Log,a)] -> [(a, Info)]
>
> Conveniently, the algorithm allows me to tag the logs with something, to
> be able to keep track at least somewhat of the logs.
>
> [...]
>
> Some ideas where numbering the Nodes and then using this number as the
> tag on the log, but this is not much different from using STRefs, it
> seems.
Yes, tagging the logs with their position in the tree isn't really
different from using STRefs. There are many options for representing
positions (depth/breath first numbers; paths like [L,R,L,...] etc.) but
in the end, it boils down to the same thing.
Here's an example with with numbers
annotate tree =
thread tree (\(x:xs) -> (x,xs)) . map snd
. sort (comparing fst)
. someAlgorithm . cutTreeApart
. thread tree (\n -> (n, succ n)) $ (0 :: Int)
where
thread tree f x = evalState (mapM (const $ State f) tree) x
However, I would be surprised if someAlgorithm could not be formulated
directly on the tree or at least satisfies a few invariants like for example
map fst . someAlgorithm = map snd
Also, how does cutTreeApart arrange the list? The idea is that most of
the tree structure survives in the list and can be reconstructed.
Regards,
apfelmus
--
http://apfelmus.nfshost.com
More information about the Haskell-Cafe
mailing list