<p dir="ltr"><br>
The paper "Functional programming with structured graphs" might be of interest to you. It describes a way to build graphs with references back and forth.</p>
<p dir="ltr">Can't provide link because my phone hides it...</p>
<div class="gmail_extra"><br><div class="gmail_quote">Den 24 okt. 2016 14:57 skrev "David Rogers" <<a href="mailto:predictivestatmech@gmail.com">predictivestatmech@gmail.com</a>>:<br type="attribution"><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Haskell-Cafe:<br>
<br>
I have been working on the following idea, and would appreciate<br>
any comments on the novelty or usefulness in your own applications.<br>
A scan of the usual Haskell documents turns up lots of clever data<br>
structures, but nothing particularly enlightening for graphs.<br>
Here is my attempt:<br>
<br>
<br>
<br>
Graphs are difficult to represent in functional languages<br>
because they express arbitrary undirected connectivity between nodes,<br>
whereas functional code naturally expresses directed trees.<br>
<br>
Most functional algorithms for graphs use an edge-list<br>
with global labels. Although effective, this method<br>
loses compositionality and does not exploit the type system<br>
for enforcing graph invariants such as consistency of the edge list.<br>
<br>
This note presents a functional method for constructing<br>
a local representation for undirected graphs functionally as<br>
compositions of other graphs. The resulting data structure<br>
does not use unique node labels, but rather allows edge traversal<br>
from any node to its neighbor through a lookup function.<br>
Graph traversal then emerges as a discussion among static<br>
nodes. I have found this method useful for assembling sets<br>
of molecules in chemical simulations. It's also an interesting<br>
model for framing philosophical questions about the measurement<br>
problem in quantum physics.<br>
<br>
As a disclaimer, although it is useful for constructing graphs,<br>
it is not obvious how common operations like graph<br>
copying or node deletion could be performed. This note<br>
does not discuss how to implement any graph algorithms.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
import qualified Prelude<br>
import Prelude hiding ((.))<br>
import Data.Semigroup(Semigroup,(<>))<br>
import Data.Tuple(swap)<br>
</blockquote>
<br>
First, I change the meaning of "." to be element access.<br>
I think this is a cleaner way to work with record data,<br>
and suggest that there should be a special way to use this<br>
syntax without making accessor names into global variables.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
infixl 9 .<br>
a . b = b a -- switch to member access<br>
</blockquote>
<br>
Every subgraph has open ends, which we just number<br>
sequentially from zero. The lookup function<br>
provides the subgraph's window to the outside world.<br>
Its inputs reference outgoing connections.<br>
A subgraph, built as a composite of two<br>
subgraphs, will have the job of providing the correct<br>
lookup environment to both children.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
type Conn = Int<br>
newtype Lookup l = Lookup ( Conn -> (l, Lookup l) )<br>
</blockquote>
<br>
The tricky part is making the connections between<br>
the internal and external worlds. For the internal nodes to be complete,<br>
they must have access to complete external nodes. The problem<br>
is reversed for the external nodes.<br>
<br>
A naive idea is to represent a graph using<br>
a reader monad parameterized over label<br>
and result types (l,r).<br>
-- newtype Grph l r = Reader (Int -> (l, Lookup)) r<br>
Unfortunately, this breaks down<br>
because the outside world also needs to be able to<br>
`look inside' the subgraph. The above approach runs into trouble<br>
when constructing the lookup function<br>
specific to each child. That lookup function needs the outside world,<br>
and the outside world can't be completed without the<br>
ability to look inside!<br>
<br>
We capitulate to this symmetry between the graph and its environment<br>
by using a representation of a subgraph that provides<br>
both a top-down mechanism for using the graph<br>
as well as a bottom-up representation of the subgraph<br>
to the outside world.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
data Grph l r = Grph { runGrph :: Lookup l -> r,<br>
self :: Conn -> Lookup l -> (l, Lookup l),<br>
nopen :: Int<br>
}<br>
</blockquote>
<br>
The default action of `running' a graph is to run a local action<br>
on each node. That local function has access to the complete<br>
graph topology via the lookup function.<br>
Since we expect this to be a fold, the result type will<br>
probably be a monoid, or at least a semigroup.<br>
Any sub-graph can be run by specifying what to<br>
do with incomplete connections. At the top-level, there<br>
should not be `open' connections.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
--run g = (g.runGrph) $ Lookup (\ _ -> error "Tried to go out of<br>
</blockquote>
top-level.")<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
run g = (g.runGrph) $ u<br>
where u = Lookup $ \ _ -> ("end", u)<br>
</blockquote>
<br>
Individual nodes are themselves subgraphs.<br>
Nodes must specify how many external connections<br>
can be made, as well as an arbitrary label and an action.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
node :: Int -> l -> ((l, Lookup l) -> r) -> Grph l r<br>
node n l run = Grph (\e -> run (l, e)) (\_ e -> (l, e)) n<br>
</blockquote>
<br>
Arbitrary graphs are constructed by joining two subgraphs.<br>
The key here is the construction of separate lookup<br>
environments for the each subgraph. The left subgraph<br>
can be connected to the first few openings in the environment<br>
or to the right subgraph. The right subgraph can connect<br>
to the last few openings of the environment, or to the<br>
left subgraph. Each time an edge is traversed,<br>
a series of "env" calls are made -- sweeping upward<br>
until an internal connection happens. Then a downward<br>
sweep of "self" calls are made. This takes at best<br>
O(log|nodes|) operations.<br>
<br>
Connections are specified by (Conn,Conn) pairs,<br>
so we need the ability to lookup from the permutation<br>
or else to return the re-numbering after subtracting<br>
connections used by the permutation.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
type Permut = [(Conn, Conn)]<br>
find_fst :: Conn -> Permut -> Either Conn Conn<br>
find_fst = find1 0 where<br>
find1 n a ((a',b):tl) | a == a' = Left b -- internal<br>
find1 n a ((a',_):tl) | a' < a = find1 (n+1) a tl<br>
find1 n a (_:tl) = find1 n a tl<br>
find1 n a [] = Right (a-n) -- external<br>
find_snd b p = find_fst b (map swap p)<br>
</blockquote>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
-- append 2 subgraphs<br>
append :: (Semigroup r) => Permut -> Grph l r -> Grph l r -> Grph l r<br>
append p x y = Grph { runGrph = \(Lookup env) -><br>
(x.runGrph) (e1 env)<br>
<> (y.runGrph) (e2 env),<br>
self = down,<br>
nopen = (x.nopen) + (y.nopen) - 2*(length p)<br>
}<br>
where<br>
down n (Lookup env) | n < ystart = (x.self) n (e1 env)<br>
down n (Lookup env) = (y.self) (n-ystart) (e2 env)<br>
e1 env = Lookup $ \n -> case find_fst n p of<br>
Right m -> env m<br>
Left m -> (y.self) m (e2 env)<br>
e2 env = Lookup $ \n -> case find_snd n p of<br>
Right m -> env (m+ystart)<br>
Left m -> (x.self) m (e1 env)<br>
ystart = (x.nopen) - length p -- start of b's env. refs<br>
</blockquote>
<br>
This is a helper function for defining linear graphs.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
instance Semigroup r => Semigroup (Grph l r) where<br>
(<>) = append [(1,0)]<br>
</blockquote>
<br>
A simple action is just to show the node labels and<br>
the labels of each immediate neighbor.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
show_node (l, Lookup env) = " " ++ show l<br>
show_env (l, Lookup env) = show l<br>
++ foldl (++) (":") (map (\u -> show_node(env u)) [0, 1])<br>
++ "\n"<br>
</blockquote>
<br>
The following example graphs are a list of 4 single nodes,<br>
two incomplete 2-member chains, and a complete 4-member cycle.<br>
The key feature here is that that the graphs are all composable.<br>
<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
c6 = [ node 2 ("C"++show n) show_env | n <- [1..4] ]<br>
str = c6!!0 <> c6!!1<br>
str' = c6!!2 <> c6!!3<br>
cyc = append [(1,0), (0,1)] str str' -- Tying the knot.<br>
main = putStrLn $ run cyc<br>
</blockquote>
<br>
The connection to the measurement problem in quantum physics<br>
comes out because the final output of running any graph<br>
is deterministic, but can depend nontrivially on the graph's environment.<br>
Like links in the graph, physical systems communicate through<br>
their mutual interactions, and from those determine a new state<br>
a short time later. In a closed universe, the outcome is deterministic,<br>
while for any an open system (subgraph), the outcome is probabilistic.<br>
The analogy suggests that understanding how probabilities<br>
emerge in the measurement problem requires a<br>
two-way communication channel between the system and its environment.<br>
<br>
~ David M. Rogers<br>
<br>
______________________________<wbr>_________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bi<wbr>n/mailman/listinfo/haskell-caf<wbr>e</a><br>
Only members subscribed via the mailman list are allowed to post.</blockquote></div></div>