Cellular Automata rule function in mathematica / notebook source, Patterns, Alternatives - wolfram-mathematica

I found this from a Cellular Automata Mathematica file, what is pattern and alternatives?
In this block of code, what does Pattern mean:
CellularAutomaton[{ { 0, Blank[], 3} -> 0,
{ Blank[], 2, 3} -> 3,
{ 1, 1, 3 } -> 4,
{ Blank[], 1, 4} -> 4,
{ Alternatives[1, 2] << 1 or 2 >>, 3, Blank[]} -> 5,
{ Pattern[$CellContext`p, Alternatives[0, 1]], 4, Blank[]} -> 7 - $CellContext`p,
{ 7, 2, 6} -> 3,
{ 7, Blank[], Blank[]} -> 7,
{ Blank[], 7, Pattern[$CellContext`p, Alternatives[1, 2]]} -> $CellContext`p,
{ Blank[], Pattern[$CellContext`p, Alternatives[5, 6]], Blank[]} -> 7 - $CellContext`p,
{ Alternatives[5, 6], Pattern[$CellContext`p, Alternatives[1, 2]], Blank[]} -> 7 - $CellContext`p,
{ Alternatives[5, 6], 0, 0} -> 1,
{ Blank[], Pattern[$CellContext`p, Alternatives[1, 2]], Blank[]} -> $CellContext`p,
{ Blank[], Blank[], Blank[]} -> 0}, {

You are defining a Cellular Automaton explicitly.
Each row defines an evolution rule.
You may find the relevant information here.
A few hints for reading your code:
Blank[] is the blank pattern "_" that matches any expression
Pattern[] is Mathematica construct for pattern matching
Alternatives[a,b,c] is the full form for a | b| c ... any of "a, b or c"
Pattern[p, Alternatives[a, b]] names as p the matched expr (a or b)
Edit
So, as an example, the following Automatons are made equivalent:
CellularAutomaton[{
{1, 0} -> 1,
{1, 1} -> 0,
{0, 1} -> 1,
{0, 0} -> 1},
{0, 1, 0}, 10]
CellularAutomaton[{
{1, Pattern[t, Alternatives[1, 0]]} -> Abs[1 - t],
{0, 1} -> 1,
{0, 0} -> 1
}, {0, 1, 0}, 10]
Note: The example is just for you to ease the understanding of the code you posted. There are better ways to define this Automaton.

Related

Can I get AST for wolfram language expressions?

In Mathematica, we use FullForm or TreeForm or Developer'WriteExpressionJSONString to get the syntax details for given expressions. How can I get a complete AST (Abstract Syntax Tree) for any expression? For example, is there any function toAST such that
toAST["a +b c\nSin[%];"]
which will give the result like this:
{
{
Plus,
0,
6,
{a, 0, 1},
{Multiply, 3, 6, {b, 3, 4}, {c, 5, 6}}
},
{
CompoundExpression,
7,
14,
{Sin, 7, 13, {Out, 11, 12}},
{Null, 14, 14}
}
}
Probably your best option ATM is codeparser. It'll be bundled with the next version of Mathematica, but you can use PacletInstall["CodeParser"] to install it for now.
The function you want to use (i.e. for ASTs) is CodeParse. (You can get CSTs with CodeConcreteParse.) The documentation seems to be a bit scarce.
Needs["CodeParser`"];
ast = CodeParse[parseStr]
(* Output *)
ContainerNode[String, {CallNode[
LeafNode[Symbol,
"Plus", <||>], {LeafNode[Symbol,
"a", <|Source -> {{1, 1}, {1, 2}}|>],
CallNode[
LeafNode[Symbol,
"Times", <||>], {LeafNode[Symbol,
"b", <|Source -> {{1, 4}, {1, 5}}|>],
LeafNode[Symbol,
"c", <|Source -> {{1, 6}, {1, 7}}|>]}, <|Source -> {{1, 4}, {1,
7}}|>]}, <|Source -> {{1, 1}, {1, 7}}|>],
CallNode[LeafNode[Symbol,
"CompoundExpression", <||>], {CallNode[
LeafNode[Symbol,
"Sin", <|Source -> {{2, 1}, {2, 4}}|>], {CallNode[
LeafNode[Symbol,
"Out", <||>], {}, <|Source -> {{2, 5}, {2,
6}}|>]}, <|Source -> {{2, 1}, {2, 7}}|>],
LeafNode[Symbol,
"Null", <|Source -> {{2, 8}, {2, 8}}|>]}, <|Source -> {{2,
1}, {2, 8}}|>]}, <||>]
You can use Developer`WriteExpressionJSONString that you mentioned or ExportString[ast, "ExpressionJSON"] to get output pretty close to what you wanted, albeit more verbose (so I've squashed it down here):
ExportString[ast[[2;;]], "ExpressionJSON", Compact -> 3]
(* Output *)
[
"ContainerNode",
[
"List",
[
"CallNode",
["LeafNode","Symbol","'Plus'",["Association"]],
["List",["LeafNode","Symbol","'a'",["Association",["Rule","Source",["List",["List",1,1],["List",1,2]]]]],["CallNode",["LeafNode","Symbol","'Times'",["Association"]],["List",["LeafNode","Symbol","'b'",["Association",["Rule","Source",["List",["List",1,4],["List",1,5]]]]],["LeafNode","Symbol","'c'",["Association",["Rule","Source",["List",["List",1,6],["List",1,7]]]]]],["Association",["Rule","Source",["List",["List",1,4],["List",1,7]]]]]],
["Association",["Rule","Source",["List",["List",1,1],["List",1,7]]]]
],
[
"CallNode",
["LeafNode","Symbol","'CompoundExpression'",["Association"]],
["List",["CallNode",["LeafNode","Symbol","'Sin'",["Association",["Rule","Source",["List",["List",2,1],["List",2,4]]]]],["List",["CallNode",["LeafNode","Symbol","'Out'",["Association"]],["List"],["Association",["Rule","Source",["List",["List",2,5],["List",2,6]]]]]],["Association",["Rule","Source",["List",["List",2,1],["List",2,7]]]]],["LeafNode","Symbol","'Null'",["Association",["Rule","Source",["List",["List",2,8],["List",2,8]]]]]],
["Association",["Rule","Source",["List",["List",2,1],["List",2,8]]]]
]
],
[
"Association"
]
]

How to avoid asymptotes when I ListPlot a table of data using Mathematica?

I am plotting a table of data using ListPlot in Mathematica. I notice that there are a few asymptotes on the graph which I do not want it to be plotted (i.e. the straight lines between the curves). What should I do to remove the straight lines?
A method from Mark McClure's post here: How to annotate multiple datasets in ListPlots
t = Table[Tan[i], {i, -Pi, Pi, .01}];
plot = ListLinePlot[t];
DeleteCases[plot, Line[_?(Length[#] < 4 &)], Infinity]
Perhaps:
t = Table[Tan[i], {i, -Pi, Pi, .01}];
ListPlot[#, Joined -> True] & /# {t, t /. x_ /; Abs#x > 10 -> None}
Edit
More robust:
t = Table[Tan[i], {i, -Pi, Pi, .01}];
ao = AbsoluteOptions[ListPlot[t, Joined -> True],PlotRange]/. {_ -> {_,x_}} ->x;
ListPlot[t /. x_ /; (x < ao[[1]] || x > ao[[2]]) -> None, Joined -> True]
t = Table[Tan[i], {i, -Pi, Pi, .01}];
plot = ListLinePlot[t];
Using Position
Position[plot, Line[___], Infinity]
{{1, 1, 3, 2}, {1, 1, 3, 3}, {1, 1, 3, 4}, {1, 1, 3, 5}, {1, 1, 3, 6}}
Using Part:
plot[[1, 1, 3, 5 ;; 6]] = Sequence[]; Show[plot]

Adding Alignment to a Manipulate Ouput in Mathematica

Considering the following :
Manipulate[
If[Intersection[Row1, Row2] == {},
Style[Plus ## {Plus ## Row1, Plus ## Row2}, Bold, 20],
"Error"],
{{Row1, {1}}, {1, 2, 3, 4, 5}, ControlType -> TogglerBar},
{{Row2, {2}}, {1, 2, 3, 4, 5}, ControlType -> TogglerBar}
]
- I would like the "3" to be centered, is it possible ?
Manipulate has its own Alignment option. You can see if that works for you:
Manipulate[
If[Intersection[Row1,Row2]=={},Style[Plus##{Plus##Row1,Plus##Row2},Bold,20],"Error"],
{{Row1,{1}},{1,2,3,4,5},ControlType->TogglerBar},
{{Row2,{2}},{1,2,3,4,5},ControlType->TogglerBar},
Alignment->Center
]
Use a Panel, with the Alignment option:
Manipulate[
Panel[
If[Intersection[Row1, Row2] == {},
Style[Plus ## {Plus ## Row1, Plus ## Row2}, Bold, 20], "Error"
],
ImageSize -> 150, Alignment -> Center, Appearance -> "Frameless"
],
{{Row1, {1}}, {1, 2, 3, 4, 5}, ControlType -> TogglerBar},
{{Row2, {2}}, {1, 2, 3, 4, 5}, ControlType -> TogglerBar}
]

Putting a smooth curve inside of a tube

What is a good way to draw a smooth curve with specified starting and ending point and restricted to be inside of a piecewise linear tube like below?
(source: yaroslavvb.com)
coords = {1 -> {0, 2}, 2 -> {1/3, 1}, 3 -> {0, 0},
4 -> {(1/3 + 2)/2, 1}, 5 -> {2, 1}, 6 -> {2 + 1/3, 0},
7 -> {2 + 1/3, 2}};
gp = GraphPlot[graph, VertexCoordinateRules -> coords];
pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
scale = 50;
is = -scale*(Subtract ### pr);
lineThickness = 2/3;
graph = {1 -> 2, 3 -> 2, 2 -> 4, 4 -> 5, 5 -> 6, 5 -> 7};
path = {3, 2, 4, 5, 7};
lp = Graphics[{Blue, Opacity[.5],
AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
Show[lp, gp, PlotRange -> pr, ImageSize -> is]
Perhaps something like this:
coords = {2 -> {1/3, 1}, 1 -> {0, 0}, 3 -> {(1/3 + 2)/2, 1},
4 -> {2, 1}, 5 -> {2 + 1/3, 2}};
pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
scale = 50;
is = -scale*(Subtract ### pr);
lineThickness = 2/3;
graph = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5};
gp = GraphPlot[graph, VertexCoordinateRules -> coords];
path = {1, 2, 3, 4, 5};
f = BezierFunction[
SortBy[coords /. Rule[x_, List[a_, b_]] -> List[a, b], First]];
pp = ParametricPlot[f[t], {t, 0, 1}];
lp = Graphics[{Blue, Opacity[.5],
AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
Show[pp, lp, gp, PlotRange -> pr, ImageSize -> is]
You may gain a better control over the path by adding/removing control points for the Bezier. As I remember "A Bspline is contained in the convex hull of its control points", so you can add control points inside your thick lines (up and down the middlepoints in actual point set, for example) to bound the Bezier more and more.
Edit
The following is a first try to bound the curve. Bad programming, just to get the feeling of what can be done:
coords = {2 -> {1/3, 1}, 1 -> {0, 0}, 3 -> {(1/3 + 2)/2, 1},
4 -> {2, 1}, 5 -> {2 + 1/3, 2}};
pr = {{-1, 3 + 1/3}, {-1 - 1/6, 3 + 1/6}};
scale = 50;
is = -scale*(Subtract ### pr);
lineThickness = 2/3;
graph = {1 -> 2, 2 -> 3, 3 -> 4, 4 -> 5};
gp = GraphPlot[graph, VertexCoordinateRules -> coords];
path = {1, 2, 3, 4, 5};
kk = SortBy[coords /. Rule[x_, List[y_, z_]] -> List[y, z],
First]; f = BezierFunction[kk];
pp = ParametricPlot[f[t], {t, 0, 1}, Axes -> False];
mp = Table[{a = (kk[[i + 1, 1]] - kk[[i, 1]])/2 + kk[[i, 1]],
Interpolation[{kk[[i]], kk[[i + 1]]}, InterpolationOrder -> 1][
a] + lineThickness/2}, {i, 1, Length[kk] - 1}];
mp2 = mp /. {x_, y_} -> {x, y - lineThickness};
kk1 = SortBy[Union[kk, mp, mp2], First]
g = BezierFunction[kk1];
pp2 = ParametricPlot[g[t], {t, 0, 1}, Axes -> False];
lp = Graphics[{Blue, Opacity[.5],
AbsoluteThickness[lineThickness*scale], Line[path /. coords]}];
Show[pp, pp2, lp, gp, PlotRange -> pr, ImageSize -> is]
Edit 2
Or perhaps better yet:
g1 = Graphics[BSplineCurve[kk1]];
Show[lp, g1, PlotRange -> pr, ImageSize -> is]
This one scales quite well when you enlarge the image (the previous ones don't)

Mathematica: Getting rid of the "x ->" in FindInstance results

Suppose I have the following results:
a=FindInstance[2*b^2 + b^3 == b^4 + t && t < 10 && t > -1, {b, t},
Integers, 20]
{{b -> -1, t -> 0}, {b -> 0, t -> 0}, {b -> 1, t -> 2}, {b -> 2,
t -> 0}}
How can I get rid of the "b->" and just get the array of b answers? I can get halfway there with:
a[[All,1]]
{b -> -1, b -> 0, b -> 1, b -> 2}
but how can I get to just:
{-1, 0, 1, 2}
Thanks
I might be missing something from dreeves' answer, but the way I always believed you do this was simply by writing:
b /. a
There is an example of this in the "Basic Examples" section of the documentation for the Solve function, which uses the same output style.
Though Will's answer is the canonical way to do it, I'll provide a few alternatives just for fun.
In[37]:= ans={{b -> -1, t -> 0},{b -> 0, t -> 0},{b -> 1, t -> 2},{b -> 2, t -> 0}};
In[38]:= Cases[ans, (b -> a_) :> a, Infinity]
Out[38]= {-1, 0, 1, 2}
In[39]:= ans[[All, 1]][[All, 2]]
Out[39]= {-1, 0, 1, 2}
In[40]:= ans /. {b -> a_, _} :> a
Out[40]= {-1, 0, 1, 2}
In[41]:= (ans /. Rule -> List)[[All, 1, 2]]
Out[41]= {-1, 0, 1, 2}

Resources