parts = Append[
    Flatten[DeleteCases[WordData[#, "PartTerms", "Rules"], _ -> {}] & /@
       WordData[], 1], _ -> {{}}];
 query = "";
 view = Graphics[{}, ImageSize -> 1000];
 expandableNodes = {};
 
 expand[v_, n_] :=
 Rest@Nest[
    DeleteDuplicates@
      DeleteCases[
       Flatten@{#,
         Thread[# [DirectedEdge] (# /. parts),
            List, {2}] & /@ #[[All,
            2]]}, _ [DirectedEdge] {}] &, {"" [DirectedEdge] v},
    n] // (expandableNodes =
     expandableNodes~Join~
      Intersection[parts[[;; -2, 1]],
       Complement[#[[All, 2]], #[[All, 1]]]]; #) &

input = InputField[Dynamic@query, String, ContinuousAction -> True];

buttonRow =
  Dynamic@Row[
    Button[#[[1]] <> If[Length@# == 3, " (" <> #[[3]] <> ")", ""],
       expandableNodes = {};
       view = Graph[expand[#, 1],
         VertexShapeFunction -> (Inset[
             Row[{Tooltip[
                 Rasterize[Text[Style[First@#2, Black, 12]],
                  Background -> None],
                 First@WordData[#2, "Definitions", "List"]]}~Join~
               If[MemberQ[expandableNodes, #2], {" ",
                 Graphics[{EdgeForm@Black,
                  
                   Button[
                    Mouseover[{White, Disk[]}, {Lighter[Blue, .7],
                    Disk[]}],
                    expandableNodes =
                    DeleteCases[expandableNodes, #2];
                    view = EdgeAdd[view, expand[#2, 1]]]},
                  ImageSize -> 10]}, {}],
              Alignment -> {Center, Center}], #] &),
         GraphLayout -> "RadialEmbedding"]] & /@
     Select[Most@parts, StringMatchQ[#[[1, 1]], query <> "*"] &,
       5][[All, 1]]];

Panel@Column[{input, buttonRow, Panel@Dynamic@view}]