code manipulation via interactive tree for Mathema

This question caused me to ponder an interactive method for editing code. I wonder if it is possible to implement something like this given the dynamic capabilities of Mathematica.

Consider an expression:

Text[Row[{PaddedForm[currentTime, {6, 3}, NumberSigns -> {"", ""}, NumberPadding -> {"0", "0"}]}]]

And its TreeForm:

I would like to be able to edit that tree directly, and then have the result translated back into Mathematica code. One should at least be able to:

rename nodes, replacing symbols
delete nodes, reverting their leaves to the node above
reorder nodes and leaves (the order of arguments)

I believe that there are languages or environments which specialize in this kind of manipulation, and I do not find that attractive, but I am interested in having this kind of interactive tree editing for special purposes.

I will provide a partial solution, but the one that could get you started. I will use the mutable tree data structure from this post, since it seems like mutability is natural for this problem. Repeating it for convenience here:

Module[{parent, children, value},
  children[_] := {};
  value[_] := Null;
  node /: new[node[]] := node[Unique[]];
  node /: node[tag_].getChildren[] := children[tag];
  node /: node[tag_].addChild[child_node, index_] := 
     children[tag] = Insert[children[tag], child, index];
  node /: node[tag_].removeChild[child_node, index_] := 
     children[tag] = Delete[children[tag], index];
  node /: node[tag_].getChild[index_] := children[tag][[index]];
  node /: node[tag_].getValue[] := value[tag];
  node /: node[tag_].setValue[val_] := value[tag] = val;
];

Here is the code to create a mutable tree from any Mathematica expression, and read the expression back from the tree:

Clear[makeExpressionTreeAux];
makeExpressionTreeAux[expr_?AtomQ] :=
  With[{nd = new[node[]], val = Hold[Evaluate[Unique[]]]},
    nd.setValue[val];
    Evaluate[val[[1]]] = expr;
    nd];
makeExpressionTreeAux[expr_] :=
  With[{nd = new[node[]], val = Hold[Evaluate[Unique[]]]},
   nd.setValue[val];
   Evaluate[val[[1]]] = Head[expr];
   Do[nd.addChild[makeExpressionTreeAux[expr[[i]]], i], {i, Length[expr]}];
   nd];

Clear[expressionFromTree];
expressionFromTree[nd_node] /; nd.getChildren[] == {} := (nd.getValue[])[[-1, 1]];
expressionFromTree[nd_node] := 
  Apply[(nd.getValue[])[[-1, 1]], Map[expressionFromTree, nd.getChildren[]]];

Clear[traverse];
traverse[root_node, f_] :=
  Module[{},
   f[root];
   Scan[traverse[#, f] &, root.getChildren[]]];

Clear[indexNodes];
indexNodes[root_node] :=
  Module[{i = 0},
     traverse[root, #.setValue[{i++, #.getValue[]}] &]];

Clear[makeExpressionTree];
makeExpressionTree[expr_] :=
  With[{root  = makeExpressionTreeAux[expr]},
   indexNodes[root];
   root];

You can test on simple expressions like a+b. A few comments on how this works: to create a mutable expression tree (built of node-s) from an expression, we call the makeExpressionTree function, which first creates the tree (call to makeExpressionTreeAux), and then indexes the nodes (call to indexNodes). The makeExpressionTree function is recursive, it recursively traverses the expression tree while copying its structure to the structure of the resulting mutable tree. One subtle point here is why we need things like val = Hold[Evaluate[Unique[]]], nd.setValue[val];, Evaluate[val[[1]]] = expr; rather than just nd.setValue[expr]. This is done with InputField[Dynamic[some-var]] in mind - for this, we need a variable to store the value (perhaps, one could write a more custom Dynamic to avoid this problem if one likes). So, after the tree is created, each node contains a value that is Hold[someSymbol], while someSymbol contains the value of an atom, or of a head, for non-atomic sub-part. The indexing procedure changes the value of each node from Hold[sym] to {index,Hold[symbol]}. Note that it uses the traverse function which implements the generic depth-first mutable tree traversal (similar to Map[f,expr, Infinity], but for mutable trees). Therefore, indexes are incremented in depth-first order. Finally, the expressionFromTree function traverses the tree and builds the expression that the tree stores.

Here is the code to render the mutable tree:

Clear[getGraphRules];
getGraphRules[root_node] :=
 Flatten[
  Map[Thread,
   Rule @@@ 
     Reap[traverse[root, 
       Sow[{First[#.getValue[]], 
         Map[First[#.getValue[]] &, #.getChildren[]]}] &]][[2, 1]]]]

Clear[getNodeIndexRules];
getNodeIndexRules[root_node] :=
 Dispatch@ Reap[traverse[root, Sow[First[#.getValue[]] -> #] &]][[2, 1]];

Clear[makeSymbolRule];
makeSymbolRule[nd_node] :=
   With[{val = nd.getValue[]},
      RuleDelayed @@ Prepend[Last[val], First[val]]];

Clear[renderTree];
renderTree[root_node] :=
 With[{grules = getGraphRules[root],
    ndrules = getNodeIndexRules[root]},
     TreePlot[grules, VertexRenderingFunction ->
      (Inset[
        InputField[Dynamic[#2], FieldSize -> 10] /. 
          makeSymbolRule[#2 /. ndrules], #] &)]];

This part works as follows: the getGraphRules function traverses the tree and collects parent-child pares of node indices (in the form of rules), the resulting set of rules is what the GraphPlot expects as a first argument. The getNodeIndexRules function traverses the tree and builds the hash table where keys are node indices and values are the nodes themselves. The makeSymbolRule function takes the node and returns the delayed rule of the form index:>node-var-symbol. It is important that the rule is delayed, so that the symbols do not evaluate. This is used to insert the symbol from the node tree into InputField[Dynamic[]].

Here is how you can use it: first create a tree:

root  = makeExpressionTree[(b + c)*d];

Then render it:

renderTree[root]

You must be able to modify data in each input field, although it takes a few clicks to make the cursor appear there. For example, I edited c to be c1 and b to be b1. Then, you get the modified expression:

In[102]:= expressionFromTree[root]

Out[102]= (b1 + c1) d

This solution handles only modifications, but not removal of nodes etc. It can however be a starting point, and be extended to cover that as well.

EDIT

Here is a much shorter function, based on the same ideas but not using the mutable tree data structure.

Clear[renderTreeAlt];
renderTreeAlt[expr_] :=
  Module[{newExpr, indRules, grules, assignments, i = 0, set},
    getExpression[] := newExpr;
    newExpr = expr /. x_Symbol :> set[i++, Unique[], x];
    grules = 
      Flatten[ Thread /@ Rule @@@ 
        Cases[newExpr, set[i_, __][args___] :> 
          {i, Map[If[MatchQ[#, _set], First[#], First[#[[0]]]] &, {args}]}, 
          {0, Infinity}]];
   indRules = Dispatch@ 
        Cases[newExpr, set[ind_, sym_, _] :> (ind :> sym), {0, Infinity}, Heads -> True];
   assignments = 
       Cases[newExpr, set[_, sym_, val_] :> set[sym , val], {0, Infinity},Heads -> True];
   newExpr = newExpr /. set[_, sym_, val_] :> sym;
   assignments /. set -> Set;
   TreePlot[grules, VertexRenderingFunction -> (Inset[
           InputField[Dynamic[#2], FieldSize -> 10] /. indRules, #] &)]
]

Here is how you use it:

renderTreeAlt[(a + b) c + d]

You can call getExpression[] at any time to see the current value of expression or assign it to any variable, or you can use

Dynamic[getExpression[]]

This method yields much shorter code since the Mathematica native tree structure is reused as a skeleton for the tree, where all informative pieces (heads and atoms) were replaces by symbols. This is still a mutable tree as long as we have access to original symbols and not just their values, but we don't need to think about building blocks for the tree - we use expression structure for that. This is not to diminish the previous longer solution, conceptually I think it is more clear, and it is probably still better for more complicated tasks.