In[]:=
DecomposeExpression[expr_]:=With[{pos=Position[Unevaluated@expr,_]},Thread[pos->Extract[Unevaluated@expr,pos,HoldForm]]​​]
In[]:=
DecomposeExpression[Unevaluated@f[1+2]]
Out[]=
{{0}f,{1,0}Plus,{1,1}1,{1,2}2,{1}1+2,{}f[1+2]}
In[]:=
releaseInnerHold[expr_,h_:HoldForm]:=With[{pos=FirstPosition[expr,_h]},​​If[MissingQ[pos]||pos==={0},​​expr,​​ReplacePart[expr,With[{e=Unevaluated@@Extract[expr,pos]},pos:>e]]​​]​​]​​releaseInnerHolds[expr_,h_:HoldForm]:=FixedPoint[releaseInnerHold[#,h]&,expr]
In[]:=
nextChild[pos:{_Integer...}]:=Append[pos,0]​​nextSibling[pos:{_Integer..}]:=ReplacePart[pos,-1->Last[pos]+1]​​​​RecombineExpressions[pos_Association,expr_,init_]:=If[KeyExistsQ[pos,init],​​DeleteDuplicates@Catenate[(subExpr|->Catenate[RecombineExpressions[pos,releaseInnerHold@ReplacePart[expr,Prepend[init,1]->subExpr],#]&/@{nextChild[init],If[Length[init]>0,nextSibling[init],Nothing]}])/@pos[init]​​],​​{expr}​​]​​RecombineExpressions[pos_Association]:=RecombineExpressions[pos,HoldForm[Null],{}]​​RecombineExpressions[tokens:{({_Integer...}->_)...}]:=RecombineExpressions@Merge[tokens,Identity]
In[]:=
DecomposeExpression[Unevaluated[f[1+2]]]
Out[]=
{{0}f,{1,0}Plus,{1,1}1,{1,2}2,{1}1+2,{}f[1+2]}
In[]:=
DecomposeExpression[Unevaluated[f[1+2]]]​​RecombineExpressions@%
Out[]=
{{0}f,{1,0}Plus,{1,1}1,{1,2}2,{1}1+2,{}f[1+2]}
Out[]=
{f[1+2]}
In[]:=
RecombineExpressions[{0}{f,g},{1,0}{Plus,Times},{1,1}{1,a},{1,2}{2},{1}{1+2,b},{}{f[1+2],x}]
Out[]=
{f[1+2],f[a+2],f[12],f[a2],f[b],g[1+2],g[a+2],g[12],g[a2],g[b],x}
In[]:=
RecombineExpressions@{{0}Plus,{1}1,{2,0}Plus,{2,1}2,{2,2}3,{2}2+3,{}1+(2+3)}
Out[]=
{1+(2+3)}
In[]:=
TokenEventGraph[{​​(pos_->h_[p:HoldPattern@Plus[_Integer..]]):><|"eval"->pos->h[Evaluate@p]|>,​​(*(pos_->h_[f[arg_]]):><|"eval"->pos->h[f[arg-1]+f[arg-2]]|>,*)(pos_->expr:Except[HoldPattern@Plus[_Integer..]]):><|""->pos->expr|>},​​HoldForm[1+(2+3)],2,​​"TokenDecompositionFunction"->(With[{e=Unevaluated@@#},DecomposeExpression[e]]&),​​"TokenRecombinationFunction"->RecombineExpressions@*Map[Replace[{"Token",token_,___}:>token]]@*Apply[Union],​​"TokenRenderingFunction"->Replace[r_Rule:>Last@r],​​"TokenDeduplication"->False,​​"StateDeduplication"->False,​​"EventDeduplication"->True,​​"StateVertices"->True,​​"StateLabeling"->True,​​"EventLabeling"->"Colors",​​EdgeLabelsDirectedEdge[{"Event",__},__]->"EdgeTag",​​AspectRatio1]
Out[]=