Function Repository Resource:

DirectedAcyclicEvaluate

Source Notebook

Evaluate functions locally over any directed acyclic graph

Contributed by: Bradley Klee

ResourceFunction["DirectedAcyclicEvaluate"][graph,rules]

assigns values to the vertices of a directed acyclic graph by recursively summing over preceding values, starting from initial values listed in rules.

ResourceFunction["DirectedAcyclicEvaluate"][graph,rules,vfun]

allows for a wide range of calculations via specified function vfun, which evaluates locally on each vertex (see Details).

ResourceFunction["DirectedAcyclicEvaluate"][expr]

allows specification of expr as an Association with the keys "Graph", "VertexWeights", "VertexFunction", and optionally "EdgeWeights".

Details

Graph vertices can be thought of as named memory locations for both inputs and outputs.
Evaluation distinguishes inputs as the set of root vertices not pointed to by any directed edge (sources).
All other vertices reached by following directed edges are considered outputs.
A vertex vi and its edge are both said to precede another vertex vj, if the graph indeed contains edge .
Values (or weights) wi are assigned to vertices vi using rules of the form viwi.
Input rules should list viwi for all input vertices vi.
If input values are missing from rules, vertex names vi are assumed as values.
If rules includes a rule for an output vertex vi, the associated value is ignored and overwritten upon evaluation.
Function vfun accepts three arguments parallel over index i:
#1a list of values wi on all vertices vi preceeding vj
#2a list of edge weights wij for each preceeding edge
#3a list of all preceeding edges
If vfun is specified as a symbol sym (such as Times or Plus), then vfun=sym@@#1&.
Optional specification of may simplify some calculations.
Values in #2 are obtained most efficiently using an Association, so it is possible to get a Missing["KeyAbsent",_] error if the list of EdgeWeights is incomplete.
ResourceFunction["DirectedAcyclicEvaluate"] also acts as Evaluate on an Unevaluated expr, which is formatted as an Association.
Association expr has a primary key "Graph", which should point to a directed acyclic graph.
Optional Keys of the Association and their default values are:
"VertexWeights"{}a list of function values
"VertexFunction"Plusdetermines how to fold over incoming values
"EdgeWeights"{}weights or phases per graph edge
The Association expr is then effectively its own type of expression, which should have a definite evaluation.
Any expr that conforms to the schema outlined above should ultimately be easy to compile for optimized evaluation.
Ultimately, ResourceFunction["DirectedAcyclicEvaluate"] returns a complete Association listing all function values under key "VertexWeights".
The output Association is certified in the sense that it is locally checkable on every graph vertex.

Examples

Basic Examples (3) 

Enumerate the first few terms of the Fibonacci sequence:

In[1]:=
fibonacci = ResourceFunction[
    "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
    Graph[Flatten[
      {DirectedEdge[#1, #3], DirectedEdge[#2, #3]
         } & @@@ Partition[Range[0, #], 3, 1]],
     GraphLayout -> "SpringEmbedding"]
    ] &[10]
Out[1]=

Compare with pre-compiled function Fibonacci:

In[2]:=
With[{uneval = Unevaluated[Fibonacci[#]] & /@ Range[0, 10]},
 Evaluate /@ uneval]
Out[2]=

Depict the Fibonacci calculation on its directed graph:

In[3]:=
Graph[fibonacci["Graph"], VertexLabels -> (#1 -> Placed[
       Style[#2, 12], Center] & @@@ fibonacci["VertexWeights"]),
 VertexStyle -> Directive[White, EdgeForm[LightGray]],
 VertexSize -> 1/3, EdgeStyle -> Gray]
Out[3]=

Scope (5) 

Count walks on a directed grid:

In[4]:=
With[{binomials = ResourceFunction[
    "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
    Graph[GridGraph[{#, #},
        DirectedEdges -> True]] &[5]]},
 Graph[binomials["Graph"], VertexLabels -> (#1 -> Placed[
        Style[#2, 12], Center] & @@@ binomials["VertexWeights"]),
  VertexStyle -> Directive[White, EdgeForm[LightGray]],
  VertexSize -> 1/3, EdgeStyle -> Gray]]
Out[4]=

Convert to partial probabilities by adding edge weights:

In[5]:=
Function[{graph0},
  With[{binomials = ResourceFunction[
      "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
      graph0, {_List :> 1}, Function[Total[#1*#2]],
      "EdgeWeights" -> (# -> 1/VertexOutDegree[
             graph0, #[[1]]] & /@ EdgeList[graph0])]},
   Graph[binomials["Graph"], VertexLabels -> (#1 -> Placed[
          Style[#2, 10], Center] & @@@ binomials["VertexWeights"]),
    VertexStyle -> Directive[White, EdgeForm[LightGray]],
    VertexSize -> 1/2, EdgeStyle -> Gray]]][
 Graph[GridGraph[{5, 5}, DirectedEdges -> True]]]
Out[5]=

Count the leaves on a random tree:

In[6]:=
With[{treeGraph0 = (SeedRandom["TreeTest"];
    Graph[Reverse /@ EdgeList[TreeGraph[RandomTree[50]]]])},
 Graph[#["Graph"], VertexLabels -> (#1 -> Placed[
          Style[#2, 12], Center] & @@@ #["VertexWeights"]),
    VertexStyle -> Directive[White, EdgeForm[LightGray]],
    VertexSize -> 1/1.5, EdgeStyle -> Gray, ImageSize -> 500,
    GraphLayout -> "LayeredDigraphEmbedding"] &@
  ResourceFunction[
   "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"]@Association["Graph" -> treeGraph0,
    "VertexWeights" -> (# -> 1 & /@ Select[VertexList[treeGraph0],
        SameQ[VertexInComponent[treeGraph0, #, {1}], {}] &])]]
Out[6]=

Evaluate a Factorial number using binary splitting:

In[7]:=
With[{factorialEval = ResourceFunction[
      "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
      Association["Graph" -> #,
       "VertexWeights" -> {8 -> 2, 2 -> 8, 3 -> 5, 5 -> 3},
       "VertexFunction" -> Times]]},
   Labeled[Graph[factorialEval["Graph"], VertexLabels -> (#1 -> Placed[
           Style[#2, 12], Center] & @@@ factorialEval["VertexWeights"]),
     VertexStyle -> Directive[White, EdgeForm[None]],
     VertexSize -> 1/2, EdgeStyle -> Gray, ImageSize -> 500],
    Rule[HoldForm[8!], (2^4 - 1) /. factorialEval["VertexWeights"]]]
   ] &[VertexReplace[Graph[Reverse /@ EdgeList[
     KaryTree[2^4 - 1, 2, DirectedEdges -> True]]],
  {x_ :> 2^4 - x}]]
Out[7]=

Use symbolic functions to create an encoding of 24 branching and merging traversals of a hypercube:

In[8]:=
With[{hypercubeEval = ResourceFunction[
    "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][Association[
     "Graph" -> GridGraph[{2, 2, 2, 2}, DirectedEdges -> True],
     "VertexFunction" -> Function[{values, edgeWeights, edges},
       Fold[Vee, LongRightArrow @@@ Transpose[{values, edges[[All, 2]]}]]]
     ]]}, Grid[{{Graph[hypercubeEval["Graph"]]},
   {16 /. hypercubeEval["VertexWeights"]}},
  ItemSize -> 40]]
Out[8]=

Split path symbols based on parity of the outgoing and incoming vertices:

In[9]:=
With[{hypercubeEval = ResourceFunction[
    "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][Association[
     "Graph" -> GridGraph[{2, 2, 2, 2}, DirectedEdges -> True],
     "VertexFunction" -> Function[{values, edgeWeights, edges},
       Fold[If[OddQ[edges[[1, 2]]], Vee, Wedge], If[OddQ[#2],
           UpperRightArrow[#1, #3], LowerRightArrow[#1, #3]
           ] & @@@ Transpose[{values, edges[[All, 1]], edges[[All, 2]]}]]]
     ]]}, Grid[{{Graph[hypercubeEval["Graph"]]},
   {16 /. hypercubeEval["VertexWeights"]}},
  ItemSize -> 40]]
Out[9]=

Properties and Relations (2) 

Valid output Association instances should cause the following check function to list zeros:

In[10]:=
CertifyDAGEvaluate[function_Association] := With[{ioMaps = DeleteCases[{
        VertexInComponent[function["Graph"], #, {1}],
        #} & /@ VertexList[function["Graph"]], {{}, _}]},
  Function[{ins, out}, Subtract[out /. function["VertexWeights"],
     Apply[function["VertexFunction"], Transpose[
       {# /. function["VertexWeights"], DirectedEdge[#, out] /. If[function["EdgeWeights"] == None, {},
            function["EdgeWeights"]],
          DirectedEdge[#, out]} & /@ ins]]]] @@@ ioMaps]

Double check a p-recurrence important to the theory of algebraic sphere curves (cf. OEIS A318495):

In[11]:=
With[{A318495 = ResourceFunction[
      "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][Graph[Flatten[
        {DirectedEdge[#1, #3], DirectedEdge[#2, #3]
           } & @@@ Partition[Range[0, #], 3, 1]],
       GraphLayout -> "SpringEmbedding"],
      {0 -> 1, 1 -> 10}, (Apply[Plus, #1*(#3 /. {
             DirectedEdge[x_, y_] :> If[y - x == 1,
               (59 y^2 - 59 y + 20)/2/y^2,
               -6 (6 y - 7) (6 y - 5)/y^2]})] &)] &[10]},
 Append[A318495, "ValuesCertificate" -> CertifyDAGEvaluate[A318495]]]
Out[11]=

Possible Issues (3) 

Invalid inputs result in a failure message:

In[12]:=
ResourceFunction[
 "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
 Association["Graph" -> Graph[UndirectedEdge[1, 2]]]]
Out[12]=
In[13]:=
ResourceFunction[
 "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
 Association["Graph" -> Graph[{1 -> 2, 2 -> 1}]]]
Out[13]=

DirectedAcyclicEvaluate ignores double edges:

In[14]:=
ResourceFunction[
 "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
 Association["Graph" -> Graph[{1 -> 2, 1 -> 2}]]]
Out[14]=

If necessary, a corrected input could assign a factor of 2 via EdgeWeights:

In[15]:=
ResourceFunction[
 "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][Association[
  "Graph" -> Graph[{DirectedEdge[1, 2]}],
  "EdgeWeights" -> {DirectedEdge[1, 2] -> 2},
  "VertexFunction" -> (Apply[Plus, #1*#2] &)]]
Out[15]=

Neat Examples (4) 

Calculate a Fourier transform with only n Log2 n complexity (n=32):

In[16]:=
(* Evaluate this cell to get the example input *) CloudGet["https://www.wolframcloud.com/obj/bd53a0ae-1fe0-48b9-b691-3ff6282ebaab"]
Out[16]=

Calculate the first few Fubini numbers (OEIS A000670):

In[17]:=
Function[{dim}, With[{
    fubiniEval = ResourceFunction[
      "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][Association[
       "Graph" -> Graph[Flatten[If[
             And[SubsetQ[#1, #2], ! SameQ[#1, #2]]
             , DirectedEdge[#2, #1], {} ] & @@@ Tuples[
            Subsets[Range[dim]], {2}]]],
       "VertexWeights" -> {{} -> 1}]]},
   Graph[fubiniEval["Graph"], VertexLabels -> (
      #1 -> Style[#2, 16] & @@@ Map[First,
        GatherBy[fubiniEval["VertexWeights"],
         {#[[2]], Length[#[[1]]]} &]]),
    EdgeStyle -> LightGray, AspectRatio -> 2/3]]][5]
Out[17]=

Count corner-to-corner walks on three-dimensional grids:

In[18]:=
Grid[MapThread[Function[{label, fun},
   Prepend[
    Times @@ fun[#] /. ResourceFunction[
         "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
         GridGraph[fun[#], DirectedEdges -> True]
         ]["VertexWeights"] & /@ Range[1, 5], label]
   ], {TraditionalForm /@ {s == 3, s == 4, s == 6},
   {Function[{#, #, #}],
    Function[{#, #, 2 # - 1}],
    Function[{#, 2 # - 1, 3 # - 2}]}}],
 Frame -> All, Spacings -> {2, 1}, FrameStyle -> LightGray]
Out[18]=

Compare with series expansion of Ramanujan's elliptic integrals:

In[19]:=
Grid[MapThread[Function[{label, fun},
   Prepend[CoefficientList[Normal@Series[fun, {z, 0, 4}], z],
    label]], {TraditionalForm /@ {s == 3, s == 4, s == 6},
   MapThread[Hypergeometric2F1[1/#1, 1 - 1/#1, 1, #2 z] &,
    {{3, 4, 6}, {3^3, 4^3, 2 6^3}}]}],
 Frame -> All, Spacings -> {2, 1}, FrameStyle -> LightGray]
Out[19]=

Count corner-to-corner walks on the cells of MengerMesh when n=2:

In[20]:=
With[{SierpinskiGraph = Graph[
    ReplaceAll[EdgeList[NearestNeighborGraph[Position[
        Function[{n}, Nest[ArrayFlatten[
             {{#, #, #}, {#, 0, #}, {#, #, #}}
             ] &, 1, n]][2], 1]]],
     UndirectedEdge[x_, y_] :> If[Total[y - x] > 0,
       DirectedEdge[x, y], DirectedEdge[y, x]]]]},
 ResourceFunction[
  "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][SierpinskiGraph, {{1, 1} -> 1}]]
Out[20]=

Repeat this calculation for sequential inputs, then output maximum path counts:

In[21]:=
Function[{dim}, With[{SierpinskiGraph = Graph[
      ReplaceAll[EdgeList[NearestNeighborGraph[Position[
          Function[{n}, Nest[ArrayFlatten[
               {{#, #, #}, {#, 0, #}, {#, #, #}}
               ] &, 1, n]][dim], 1]]],
       UndirectedEdge[x_, y_] :> If[Total[y - x] > 0,
         DirectedEdge[x, y], DirectedEdge[y, x]]]]},
   {3^dim, 3^dim} /. ResourceFunction[
      "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
      SierpinskiGraph, {{1, 1} -> 1}]["VertexWeights"]]] /@ Range[4]
Out[21]=

Try a similar calculation for the Menger sponge (a.k.a. MengerMesh with d=3):

In[22]:=
Function[{dim}, With[{MengerGraph = Graph[
      ReplaceAll[EdgeList[NearestNeighborGraph[Position[
          Function[{n}, With[{face = Nest[ArrayFlatten[
                  {{#, #, #}, {#, 0, #}, {#, #, #}}] &, 1, n]}, Outer[Times[face[[#1, #2]], face[[#2, #3]] , face[[#3, #1]] ] &,
              Range[Length[face]],
              Range[Length[face]],
              Range[Length[face]], 1]]][dim], 1]]],
       UndirectedEdge[x_, y_] :> If[Total[y - x] > 0,
         DirectedEdge[x, y], DirectedEdge[y, x]]]]},
   {3^dim, 3^dim, 3^dim} /. ResourceFunction[
      "DirectedAcyclicEvaluate", ResourceSystemBase -> "https://www.wolframcloud.com/obj/resourcesystem/api/1.0"][
      MengerGraph, {{1, 1, 1} -> 1}]["VertexWeights"]]] /@ Range[3]
Out[22]=

Publisher

Brad Klee

Version History

  • 2.0.0 – 08 November 2022
  • 1.1.0 – 03 May 2022
  • 1.0.0 – 11 April 2022

Related Resources

Author Notes

License Information