Adding Alignment to a Manipulate Ouput in Mathematica - coding-style

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}
]

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"
]
]

Make Axis and ticks invisible in mathematica plot, but keep labels

I want to make a mathematica plot with no visible y-axis, but retaining the tick labels.
I've tried AxesStyle -> {Thickness[.001], Thickness[0]} with no effect, and setting the opacity to 0 also makes the tick labels fully transparent (and thus invisible).
Any help would be very much appreciated...
p = Plot[Sin[x], {x, 0, 6 Pi},
AxesStyle -> {Black, Opacity[0]},
TicksStyle -> Directive[Opacity[1], Black]]
ticks = AbsoluteOptions[p, Ticks];
ticks[[1, 2, 2]] = DeleteCases[ticks[[1, 2, 2]], {_, "", __}];
ticks[[1, 2, 2, All, 3]] = ConstantArray[{0, 0},
Length[ticks[[1, 2, 2, All, 3]]]];
ticks[[1, 2, 2, All, 2]] = Map[ToString,
ticks[[1, 2, 2, All, 2]]] /. a_String :>
If[StringTake[a, -1] == ".", a <> "0", a];
Plot[Sin[x], {x, 0, 6 Pi},
AxesStyle -> {Black, Directive[Opacity[0], Red]},
TicksStyle -> Directive[Opacity[1], Black],
Ticks -> {Automatic, ticks[[1, 2, 2]]}]
To get the exact original ticks you can use
Cases[Charting`FindTicks[{0, 1}, {0, 1}] ## PlotRange[p][[2]], {_, _}]
{{-1.,-1.0},{-0.5,-0.5},{0.,0},{0.5,0.5},{1.,1.0}}
as implemented here:
p = Plot[Sin[x], {x, 0, 6 Pi},
AxesStyle -> {Automatic, Opacity[0]},
TicksStyle -> Opacity[1]];
ticks = AbsoluteOptions[p, Ticks];
onestyledtick = ticks[[1, 2, 2, 1]];
labels = Cases[Charting`FindTicks[{0, 1}, {0, 1}] ##
PlotRange[p][[2]], {_, _}];
yticks = Map[Join[#, {{0, 0}},
Take[onestyledtick, -1]] &, labels];
Plot[Sin[x], {x, 0, 6 Pi},
AxesStyle -> {Automatic, Opacity[0]},
TicksStyle -> Opacity[1],
Ticks -> {Automatic, yticks}]

Multiple grids in Panel

I have MainTable and SecondTable what I want to do:
MainTable and SecondTable are mostly same (example):
{{1, 1, 0}, {2, 1, 0}, {3, 1, 0}}
All this is in function:
function[] := Module[{}, Panel[Manipulate[
All is working smoothly but I can't get those grids to their position. It's always print only one. I was searching and spent many hours without any result. I appreciates any help.
Example:
function[] := Module[{}, Panel[Manipulate[
MainTable = {{x, 1, 0}, {2, 1, 0}, {3, 1, 0}};
SecondTable = {{y, 1, 0}, {2, 1, 5}, {5, 5, 5}};
Grid[{MainTable, SecondTable}, Frame -> All],
{{x, 1, "Input 1"}, ControlType -> InputField},
{{y, 1, "Input 2"}, ControlType -> InputField}],
FrameMargins -> Automatic]]
Solution:
function[] :=
Module[{},
Panel[Manipulate[
MainTable = {{x, 1, 0}, {2, 1, 0}, {3, 1, 0}};
SecondTable = {{y, 1, 0}, {2, 1, 5}, {5, 5, 5}};
Grid[{{Grid[MainTable, Frame -> All]}, {Grid[SecondTable, Frame -> All]}}],
{{x, 1, "Input 1"}, ControlType -> InputField},
{{y, 1, "Input 2"}, ControlType -> InputField}, Alignment -> Center]]]

PlotMarkers disappear when plotting exactly two polylines in Mathematica?

Not sure if this is a MMA bug or me doing something wrong.
Consider the following function:
plotTrace[points_] :=
ListPlot[points,
Joined -> True,
PlotMarkers -> Table[i, {i, Length#points}]]
now consider passing it values generated by RandomReal. Namely, consider
RandomReal[1, {nTraces, nPointsPerTrace, 2(*constant = nDimensions*)}].
If nTraces is 1, then PlotMarkers are displayed for all values of nPointsPerTrace that I tried:
Manipulate[
plotTrace[RandomReal[1, {1, nPointsPerTrace, 2}]],
{nPointsPerTrace, 1, 20, 1}]
If nTraces is 3 or greater, then plot markers are displayed for all values of nPointsPerTrace that I tried
Manipulate[plotTrace[RandomReal[1, {nTraces, nPointsPerTrace, 2}]],
{nTraces, 3, 20, 1}, {nPointsPerTrace, 1, 20, 1}]
But if nTraces is exactly 2, I don't see plot markers, no matter the value of nPointsPerTrace:
Manipulate[plotTrace[RandomReal[1, {2, nPointsPerTrace, 2}]],
{nPointsPerTrace, 1, 20, 1}]
Hints, clues, advice would be greatly appreciated!
It's treating PlotMarkers -> {1,2} as a marker and size, instead of as two markers:
In[137]:= ListPlot[{{1, 2, 3}, {4, 5, 6}}, PlotMarkers -> {1, 2}] // InputForm
Out[137]//InputForm=
Graphics[GraphicsComplex[{{1., 1.}, {2., 2.}, {3., 3.}, {1., 4.}, {2., 5.}, {3., 6.},
{1., 1.}, {2., 2.}, {3., 3.}, {1., 4.}, {2., 5.}, {3., 6.}},
{{{Hue[0.67, 0.6, 0.6], Inset[Style[1, FontSize -> 2], 7],
Inset[Style[1, FontSize -> 2], 8], Inset[Style[1, FontSize -> 2], 9]},
{Hue[0.9060679774997897, 0.6, 0.6], Inset[Style[1, FontSize -> 2], 10],
Inset[Style[1, FontSize -> 2], 11], Inset[Style[1, FontSize -> 2], 12]}, {}}}],
{AspectRatio -> GoldenRatio^(-1), Axes -> True, AxesOrigin -> {0, 0},
PlotRange -> {{0, 3.}, {0, 6.}}, PlotRangeClipping -> True,
PlotRangePadding -> {Scaled[0.02], Scaled[0.02]}}]
Things get even stranger when you try different things for PlotMarkers. The following does not display the plot markers, as in your examples above.
pts = RandomReal[1, {2, 10, 2}];
(* No markers *)
ListPlot[pts,
Joined -> True,
PlotMarkers -> {1, 2}
]
However, when you change the 2 to b, it does:
pts = RandomReal[1, {2, 10, 2}];
(* Has markers *)
ListPlot[pts,
Joined -> True,
PlotMarkers -> {1, b}
]
If you try to change the 1 to something, it doesn't work:
pts = RandomReal[1, {2, 10, 2}];
(* No markers *)
ListPlot[pts,
Joined -> True,
PlotMarkers -> {a, 2}
]
It does indeed sound like a bug, but I'm not sure if this is version dependent or some behavior that's not obvious.

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

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.

Resources