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",EdgeLabelsDirectedEdge[{"Event",__},__]->"EdgeTag",AspectRatio1]
Out[]=