Extracting the graph of Keys in nested Associations

Question

Related to this q: Extract all Values from nested Association

How to extract the direct graph of all Keys in nested Associations?

Mapping Keys doesn't seem to get at the deeper branches:

as = <|"a" -> <|"c" -> <|"e" -> 2|>, "d" -> 4|>, <|"b" -> 5|>|> 

Then

as // Map[Keys, #, Infinity] & /* Quiet

<|"a" -> {"c", "d"}, "b" -> Keys[5]|>

To limit application of keys to only Associations, can define the handler:

keys[as_Association] := Keys[as]; keys[expr_] := expr

But even so:

as // Map[keys, #, Infinity] & 

<|"a" -> {"c", "d"}, "b" -> 5|>

Why isn't "e" included?

While the Replace based answer in the Q linked above works for Values, it does not work for Keys:

as //. a_Association :> Keys[a] // Flatten

{"a", "b"}

Answer 1

Associations are very different from mere lists of rules. For instance, they are atomic, so Replace cannot dive into them.

The replacement

as //. a_Association :> Keys[a] // Flatten

with does work because one uses //. (a.k.a. ReplaceRepeated): After the first replacement, the outer association was removed and so the next round of replacement can attack the next level. Try ReplaceAll instead and you will see that it stops after the first level:

as /. a_Association :> Keys[a]

The following however works:

ToGraph[a_Association] := Graph[Flatten[{
     Map[x \[Function] DirectedEdge["root", x], Keys[a]],
     toGraph[a]
     }],
   VertexLabels -> "Name",
   GraphLayout -> "LayeredEmbedding"];

toGraph[a_Association] := {
   MapThread[
    {key, value} \[Function] If[AssociationQ[value],
      {Map[x \[Function] DirectedEdge[key, x], Keys[value]], toGraph[value]},
      {DirectedEdge[key, value]}
      ],
    {Keys[a], Values[a]}
    ]
   };

as2 = <|"a" -> <|"c" -> <|"e" -> 2, "f" -> 3|>, "d" -> 4|>, <|"b" -> 5|>|>
ToGraph[as2]

This is a slightly modified version of the code.

SetAttributes[AssociationToGraph, HoldAll];
AssociationToGraph[a_] := Module[{toGraph, data},
   toGraph[b_] := {
     KeyValueMap[{key, value} \[Function] If[AssociationQ[value],
        {
         Map[x \[Function] DirectedEdge[key, x], Keys[value]],
         toGraph[value]},
        {}
        ],
      b]
     };
   data = Flatten[{Map[
    x \[Function] DirectedEdge[ToString[Unevaluated[a]], x], Keys[a]], 
    toGraph[a]
    }];
   Graph[data, VertexLabels -> "Name", GraphLayout -> "LayeredEmbedding"]
   ] /; AssociationQ[a]

as2 = <|"a" -> <|"c" -> <|"e" -> 2, "f" -> 3|>, "d" -> 4|>, <|"b" -> 5|>|>
AssociationToGraph[as2]