Collapsible Tree

So I took a slightly different tack from lowriniak, making a tree object, rather than just using a tree hierarchy, but the result is much the same. What's worth noting, though, is that this gives you a somewhat more dynamic tree.

Here's the tree making boiler plate:

$tree = <|Root -> <|"Title" -> ".", "Children" -> {}, 
     "Open" -> True|>|>;
$id = 1;
childNodes[parent : _Integer | Root] := $tree[parent]["Children"];
nodeOpen[node : _Integer | Root] := TrueQ@$tree[node]["Open"];
nodeTitle[node_] := $tree[node]["Title"];
toggleNode[node_] := $tree[node]["Open"] = ! $tree[node]["Open"];
addNode[parent : _Integer | Root : Root, node_] := (
   AssociateTo[$tree, $id -> <|"Title" -> node, "Children" -> {}, 
      "Open" -> True|>];
   AppendTo[$tree[parent]["Children"], $id];
   $id++
   );
removeNode[node_Integer] :=

  KeyDropFrom[$tree, Prepend[childNodes[node], node]];
retitleNode[node_Integer, name_] := $tree[node]["Title"] = name;

Then we'll want a way to collect our visible nodes and assign them the right coordinates:

$viewNodes :=
  Block[{
    processing = {},
    nodeStack = {Root},
    visibleNodes = {{Root}},
    layerNodes = {},
    nodeDepth = 1
    },
   While[Length@nodeStack > 0,
    processing = nodeStack;
    nodeStack = {};
    layerNodes = {};
    Do[
     If[nodeOpen@node,
      AppendTo[layerNodes, childNodes@node];
      nodeStack = Join[nodeStack, childNodes@node]
      ],
     {node, processing}];
    AppendTo[visibleNodes, Flatten@layerNodes]
    ];
   visibleNodes
   ];
$allNodes := Block[{nodeOpen = (True &)}, $viewNodes];
$graphNodes :=

  With[{totalTree = $allNodes, nodes = Flatten@$viewNodes},
   Flatten@
    With[{d = Length@totalTree},
     Table[
      With[{l = Length@totalTree[[i]]},
       Table[
        If[MemberQ[nodes, totalTree[[i, j]]],
         {(i - 1), (j - Floor[l/2])/2.2} -> totalTree[[i, j]],
         Nothing],
        {j, l}]
       ],
      {i, d}
      ]
     ]
   ];

Then we'll make a graph and formatting wrapper:

$viewTree :=
 With[{nodes = $graphNodes},
  If[Length@nodes > 1,
   Graph[
    Flatten@
     Table[
      If[nodeOpen@node, Thread[node -> childNodes@node], {}],
      {node, Last /@ nodes}],
    VertexShape -> Table[
      With[{node = node},
       node ->
        EventHandler[
         Graphics[{
           EdgeForm[Hue[.6, .5, .25]],
           GrayLevel[.95],
           Disk[{0, 0}, 50],
           Black,
           Inset@nodeTitle@node
           }
          ], "MouseClicked" :> (toggleNode@node)]
       ], {node, Last /@ nodes}],
    VertexSize -> .15,
    VertexCoordinates -> Reverse /@ nodes
    ],
   With[{node = Last@First@nodes},
    EventHandler[
     Graphics[{
       EdgeForm[Hue[.6, .5, .25]],
       GrayLevel[.95], ,
       Disk[{0, 0}, 50],
       Black,
       Inset@nodeTitle@node
       }
      ],
     "MouseClicked" :> (toggleNode@node)]
    ]
   ]
  ]

Format[HoldPattern[$TreeObject]] :=
 Interpretation[
  Dynamic[$viewTree, TrackedSymbols :> {$viewTree, $tree}],
  $TreeObject]

And this gives you a dynamically editable tree with toggle-able nodes:

Do[
  With[{i = addNode[n]},
   Do[
    With[{j = addNode[i, m]},
     Do[addNode[j, k], {k, RandomInteger[3]}]
     ],
    {m, RandomInteger[5]}
    ]
   ],
  {n, RandomInteger[10]}
  ];
$TreeObject

Then toggle some nodes:

It isn't as elegant as your source example, but it works as one would hope.

I've made a start, but getting the vertices to stay static relative to each other is a challenge...

Set up the values:

hierarchy = {
   1 -> 11, 1 -> 12, 1 -> 13,

   11 -> 111, 11 -> 112, 11 -> 113,
   12 -> 121, 12 -> 122, 12 -> 123,
   13 -> 131, 13 -> 132, 13 -> 133,

   121 -> 1211, 121 -> 1212, 121 -> 1213
};

Make an association to track 'openness':

select = Association[# -> True & /@ Union[Flatten[List @@@ hierarchy]]];

A function to toggle the 'openness' of an object:

toggle[obj_] := select[obj] = ! select[obj];

Make a nested version so you can do it on trees:

togglenested[obj_] := (
  If[obj != 1, toggle[obj]];
  togglenested /@ Cases[
    hierarchy, 
    rule : Rule[left_, right_] /; left == obj :> right
  ];
  Null
)

Creating the vertex primitive with event handler for clicks:

action[obj_, loc_] :=  Inset[EventHandler[obj, {"MouseClicked" :> togglenested[obj]}], loc]

And make a graph that can be interacted with:

Dynamic[
  GraphPlot[
    Cases[hierarchy, rule : Rule[left_, right_] /; select[left]], 
    VertexRenderingFunction -> (action[#2, #] &), 
    Method -> "LayeredDigraphDrawing"
  ]
]

It's not pretty but that's not too hard to add. The current drawbacks: collapsing the first value means the GraphPlot fails so I turned that off. Also the vertices do rearrange themselves - maybe giving specific coordinates to the values in the select association and then drawing it from there could work?