You are using a browser not supported by the Wolfram Cloud
Supported browsers include recent versions of Chrome, Edge, Firefox and Safari.
I understand and wish to continue anyway »
WOLFRAM NOTEBOOK
In[]:=
PacletInstall["https://wolfr.am/Multicomputation.paclet",ForceVersionInstall->True]
Out[]=
PacletObject
In[]:=
Quiet@Get["Wolfram`Multicomputation`"]
In[]:=
res=MultiwaySystem[x_Integer+y_Integer:>x+y/;True,Unevaluated[(1+(2+2))+(3+4)]]
Out[]=
MultiwaySystem
There is a chain of three transformations from expression rule to hypergraph pattern rule. First LHS and RHS are turned into a linked hypergraphs:
In[]:=
ToLinkedHypergraph[x_Integer+y_Integer:>x+y/;True]
Out[]=
{{1,Plus,2,3},{2,x_Integer},{3,y_Integer}}/;True{{1,x+y}}
Then proper patterns and potentially new variables with Module are introduced:
In[]:=
LinkedHypergraphRuleToPatternRule@ToLinkedHypergraph[x_Integer+y_Integer:>x+y/;True]
Out[]=
{{x.1_,Plus,x.2_,x.3_},{x.2_,x___Integer},{x.3_,y___Integer}}/;TrueModule[{},{{x.1,x+y}}]
And lastly, not so important step, RHS is turned into something that MultiReplace can use directly, preserving input and output length with introduction of Splice and Nothing trick:
In[]:=
PatternRuleToMultiReplaceRule@LinkedHypergraphRuleToPatternRule@ToLinkedHypergraph[x_Integer+y_Integer:>x+y/;True]
Out[]=
{{x.1_,Plus,x.2_,x.3_},{x.2_,x___Integer},{x.3_,y___Integer}}/;True{Module[{},Splice[{{x.1,x+y}}]],Nothing,Nothing}
In[]:=
ResourceFunction["MultiReplace"][ToLinkedHypergraph[Unevaluated[(1+(2+2))+(3+4)]],{{x.1_,Plus,x.2_,x.3_},{x.2_,x___Integer},{x.3_,y___Integer}}/;True{Module[{},Splice[{{x.1,x+y}}]],Nothing,Nothing}]
Out[]=
{{{4},{5},{6}}}{{{1,Plus,2,7},{2,Plus,3,4},{3,1},{4,4},{7,Plus,8,9},{8,3},{9,4}}},{{{7},{8},{9}}}{{{1,Plus,2,7},{2,Plus,3,4},{3,1},{4,Plus,5,6},{5,2},{6,2},{7,7}}}
In[]:=
FromLinkedHypergraph[First@#,"HoldExpression"]&/@%
Out[]=
{{{4},{5},{6}}}(1+4)+(3+4),{{{7},{8},{9}}}(1+(2+2))+7
In[]:=
ResourceFunction["MultiReplace"][ToLinkedHypergraph[Unevaluated[1+(2+3)]],{{x.1_,Plus,x.2_,x.3_},{x.2_,x___Integer},{x.3_,y___Integer}}/;True{Module[{},Splice[{{x.1,x+y}}]],Nothing,Nothing}]
Out[]=
{{{3},{4},{5}}}{{{1,Plus,2,3},{2,1},{3,5}}}
In[]:=
PatternRuleToMultiReplaceRule@LinkedHypergraphRuleToPatternRule@ToLinkedHypergraph[(PatternSequence[Plus,x___])+y_:>x+y]
Out[]=
{{x.1_,Plus,x.2_,x.3_},{x.2_,y___},{x.3_,PatternSequence[Plus,x___]}}{Module[{},Splice[{{x.1,Plus,x.2,x.3},{x.2,x},{x.3,y}}]],Nothing,Nothing}
In[]:=
ToLinkedHypergraph[Unevaluated[1+(2+3)]]
Out[]=
{{1,Plus,2,3},{2,1},{3,Plus,4,5},{4,2},{5,3}}
In[]:=
LinkedHypergraph[{{1,Plus,2,7},{2,Plus,3,4},{3,1},{4,Plus,5,6},{5,2},{6,2},{7,Plus,8,9},{8,3},{9,4}},"NodeStyle"->{FontSize->14,FontColor->Black},"NodeFrameStyle"->{Background->LightBlue,FrameMargins->{4{1,1},{1,1}},FrameStyle->RGBColor[0.34,0.39,0.55,.5],RoundingRadius->{5,10}}]
Out[]=
In[]:=
NestGraph[Catenate@Values@ResourceFunction["MultiReplace"][#,{{{x.1_,Plus,x.2_},{x.2_,x_Integer}}{{x.1,x},Nothing},{{x.1_,Plus,x.2_,x.3_,x.4___},{x.2_,x_Integer},{x.3_,y_Integer}}{{x.1,Plus,x.2,x.4},{x.2,x+y},Nothing},{{x.1_,Plus,x.2_,x.3_},{x.2_,PatternSequence[Plus,x___]},{x.3_,y___}}{{x.1,Plus,x,x.3},{x.3,y},Nothing},{{x.1_,Plus,x.2_,x.3_},{x.2_,x___},{x.3_,PatternSequence[Plus,y___]}}{{x.1,Plus,x.2,y},{x.2,x},Nothing}}]&,{ToLinkedHypergraph[Unevaluated[1+(2+3)]]},4,VertexShapeFunction->Function[Inset[Framed@StandardForm@LinkedHypergraph[#2,"NodeStyle"->{8,Black},VertexLabels->None,PlotLabel->FromLinkedHypergraph[#2,"HoldExpression"],ImageSize->{128,128}],#1,{0,0}]],PerformanceGoal->"Quality"]
Out[]=
In[]:=
res["StatesGraph",4,"CanonicalStateFunction"->None,VertexShapeFunction->(Inset[Framed[StandardForm@LinkedHypergraph[#2,PlotLabel->FromLinkedHypergraph[#2,"HoldExpression"],"NodeStyle"->{8,Black},VertexLabels->None,ImageSize->2{128,64}]],#1,#3]&)]
Out[]=