Scene graphs as terms of algebraic data type

gistfile1.hs

-- Formalism of scene graphs as algebraic data types

{-# LANGUAGE ExistentialQuantification #-}

import Control.Monad

-- Algebraic datatypes for scene graphs

type Id = String
type Matrix = String

-- Represent a scene graph node with geometric element of type a

data Scene a = forall b. Node a [Transform (Scene b)]
data Transform a = Transform Matrix a

-- Actual types like Door and Wall to instantiate that type variable
data Door = WoodDoor | MetalDoor
data Wall = BrickWall | GlassWall | MetalWall

-- E.g.,
test1 :: Scene Door
test1 = Node WoodDoor [Transform "Left" (Node BrickWall [])]

test2 :: Scene Wall
test2 = Node GlassWall [Transform "Right" (Node WoodDoor [])] 

-- So, we properly allow for different elements of the same type, and disregard
-- the type of children nodes when comparing.

-- Nonterminals can be functions taking unit argument and returning a nondet
-- computation (MonadPlus) of scenes of the same type. There are many other
-- possible variations

data NonTerminal a m = NonTerminal Id (() -> m (Scene a))

-- Type and implementation of merge operation---only nonterminals of the same
-- type (i.e., producing scenes of the same type) allowed to merge

merge :: (MonadPlus m) => NonTerminal a m -> NonTerminal a m -> NonTerminal a m
merge (NonTerminal id1 f1) (NonTerminal id2 f2) = NonTerminal (id1 ++ id2) (\() -> (f1 ()) `mplus` (f2 ()))

-- A grammar, parameterized by the nondeterminism monad

data Grammar m = forall a. Grammar [NonTerminal a m]

-- We would implement the rest like this 

-- finds every generalization of a grammar
all_generalizations :: (MonadPlus n) => Grammar m -> n (Grammar m) -- Have some kind of monad for beam search/depth/breadth whatever
all_generalizations grammar = let
    lggs = all_lggs grammar in
    lggs `mplus` (do
        g <- lggs
        all_generalizations g) 

all_lggs :: (MonadPlus n) => Grammar m -> n (Grammar m)
all_lggs grammar = undefined