[Haskell-cafe] Re: ANNOUNCE: vacuum-cairo: a cairo frontend
tovacuum for live Haskell data visualization
Peter Verswyvelen
bugfact at gmail.com
Wed Apr 1 18:45:12 EDT 2009
Wed, Apr 1, 2009 at 11:20 PM, Claus Reinke <claus.reinke at talk21.com> wrote:
> A platform-independent, open-source, 2d/3d graph layout engine
>>
> for incrementally updated graphs (where the graph after the update
> has to be similar enough to the one before that one can follow the
> animation and make sense of the data displayed) might be a good
> project for frp+opengl hackers - force equations between nodes,
> influenced by edges, and keeping the structure stable while adding
> nodes (parsed from an input stream).
Something like this?
http://en.wikipedia.org/wiki/Force-based_algorithms
Yes, I'm all for it :-) The only problem is finding time to do it :-(
Although QuickSilver might be able to pull this off easily?
Claus
>
> This cabalized project doesn't appear to be on hackage!
>>
>> gleb.alexeev:
>>
>>> Don Stewart wrote:
>>>
>>>> I am pleased to announce the release of vacuum-cairo, a Haskell library
>>>> for interactive rendering and display of values on the GHC heap using
>>>> Matt Morrow's vacuum library.
>>>>
>>>
>>> Awesome stuff, kudos to you and Matt Morrow!
>>>
>>> I thought it'd be fun to visualize data structures in three dimensions.
>>> Attached is quick and dirty hack based on your code and Ubigraph server
>>> (http://ubietylab.net/ubigraph/).
>>>
>>> The demo video (apologies for poor quality):
>>> http://www.youtube.com/watch?v=3mMH1cHWB6c
>>>
>>> If someone finds it fun enough, I'll cabalize it and upload to Hackage.
>>>
>>
>> module Ubigraph where
>>>
>>> import Network.XmlRpc.Client
>>>
>>> type Url = String
>>> type VertexId = Int
>>> type EdgeId = Int
>>>
>>> defaultServer = "http://127.0.0.1:20738/RPC2"
>>>
>>> void :: IO Int -> IO ()
>>> void m = m >> return ()
>>>
>>> clear :: Url -> IO ()
>>> clear url = void (remote url "ubigraph.clear")
>>>
>>> newVertex :: Url -> IO VertexId
>>> newVertex url = remote url "ubigraph.new_vertex"
>>>
>>> newEdge :: Url -> VertexId -> VertexId -> IO EdgeId
>>> newEdge url = remote url "ubigraph.new_edge"
>>>
>>> removeVertex :: Url -> VertexId -> IO ()
>>> removeVertex url vid = void (remote url "ubigraph.remove_vertex" vid)
>>>
>>> removeEgde :: Url -> EdgeId -> IO ()
>>> removeEgde url eid= void (remote url "ubigraph.remove_edge" eid)
>>>
>>>
>>> zeroOnSuccess :: IO Int -> IO Bool
>>> zeroOnSuccess = fmap (==0)
>>>
>>> newVertexWithId :: Url -> VertexId -> IO Bool
>>> newVertexWithId url vid = zeroOnSuccess (remote url
>>> "ubigraph.new_vertex_w_id" vid)
>>>
>>> newEdgeWithId :: Url -> EdgeId -> VertexId -> VertexId -> IO Bool
>>> newEdgeWithId url eid x y = zeroOnSuccess (remote url
>>> "ubigraph.new_edge_w_id" eid x y)
>>>
>>> setVertexAttribute :: Url -> VertexId -> String -> String -> IO Bool
>>> setVertexAttribute url vid attr val = zeroOnSuccess (remote url
>>> "ubigraph.set_vertex_attribute" vid attr val)
>>>
>>> setEdgeAttribute :: Url -> VertexId -> String -> String -> IO Bool
>>> setEdgeAttribute url eid attr val = zeroOnSuccess (remote url
>>> "ubigraph.set_edge_attribute" eid attr val)
>>>
>>
>> module VacuumUbigraph where
>>>
>>> import GHC.Vacuum
>>> import Data.Char
>>> import Text.Printf
>>> import Data.List
>>>
>>> import qualified Data.IntMap as IntMap
>>> import qualified Data.IntSet as IntSet
>>>
>>> import qualified Ubigraph as U
>>>
>>> nodeStyle n =
>>> case nodeName n of
>>> ":" -> ("(:)", "cube", "#0000ff")
>>>
>>> -- atomic stuff is special
>>> k | k `elem` ["S#" ,"I#" ,"W#"
>>> ,"I8#" ,"I16#" ,"I32#" ,"I64#"
>>> ,"W8#" ,"W16#" ,"W32#" ,"W64#"] -> (showLit n,
>>> "sphere", "#00ff00")
>>> -- chars
>>> "C#" -> (show . chr . fromIntegral . head . nodeLits $ n, "sphere",
>>> "#00ff00")
>>> "D#" -> ("Double", "sphere", "#009900")
>>> "F#" -> ("Float", "sphere", "#009900")
>>>
>>> -- bytestrings
>>> "PS" -> (printf "ByteString[%d,%d]" (nodeLits n !! 1) (nodeLits n
>>> !! 2), "cube", "#ff0000")
>>> "Chunk" -> (printf "Chunk[%d,%d]" (nodeLits n !! 1) (nodeLits n !!
>>> 2), "cube", "#ff0000")
>>>
>>> -- otherwise just the constructor and local fields
>>> c | z > 0 ->
>>> (c ++ show (take (fromIntegral z) $ nodeLits n),
>>> "cube", "#990000")
>>> | otherwise -> (c, "cube", "#990000")
>>> where z = itabLits (nodeInfo n)
>>> where
>>> showLit n = show (head $ nodeLits n)
>>>
>>> view a = do
>>> U.clear srv
>>> mapM_ renderNode nodes
>>> mapM_ renderEdge edges
>>> where
>>> g = vacuum a
>>> alist = toAdjList g
>>> nodes = nub $ map fst alist ++ concatMap snd alist
>>> edges = concatMap (\(n, ns) -> map ((,) n) ns) alist
>>>
>>> style nid = maybe ("...", "cube", "#ff0000") nodeStyle
>>> (IntMap.lookup nid g)
>>>
>>> renderNode nid = do
>>> U.newVertexWithId srv nid
>>> let (label, shape, color) = style nid
>>> U.setVertexAttribute srv nid "label" label
>>> U.setVertexAttribute srv nid "shape" shape
>>> U.setVertexAttribute srv nid "color" color
>>>
>>> renderEdge (a, b) = do
>>> e <- U.newEdge srv a b
>>> U.setEdgeAttribute srv e "stroke" "dotted"
>>> U.setEdgeAttribute srv e "arrow" "true"
>>>
>>> srv = U.defaultServer
>>>
>>>
>> _______________________________________________
>>> Haskell-Cafe mailing list
>>> Haskell-Cafe at haskell.org
>>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>>
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20090402/66bc8ed6/attachment.htm
More information about the Haskell-Cafe
mailing list