Generating Manipulate 'sliders' on the fly - wolfram-mathematica

Mathematica's Manipulate function takes as its final arguments separate lists of the parameters you want sliders for along with their value ranges. But why not a list of lists?
This way I could I easily generate all the sliders for this big list of transformation rules that I have, e.g.:
parms = {a -> 2, b -> 4, c -> 5};
Table[{{parms[[i]][[1]], parms[[i]][[2]]}, 0, 10}, {i, 1,Length[parms]}]
{{{a, 2}, 0, 10}, {{b, 4}, 0, 10}, {{c, 5}, 0, 10}}
What I would like to have, however, is:
{{a, 2}, 0, 10}, {{b, 4}, 0, 10}, {{c, 5}, 0, 10}
This I'm copy pasting now between cells, which is rather messy. I'm sure there's a better way to do this. Please help, thanks!

Please see this and this on similar questions.
What you need is Sequence## to get the list of lists to be treated as your desired output when used as input.
Perhaps something like:
ClearAll[a, b, c];
parms = {a -> 2, b -> 4, c -> 5};
With[{values = Table[parms[[i]][[1]], {i, 1, Length[parms]}],
controls = Sequence ##
Table[{{parms[[i]][[1]], parms[[i]][[2]],
Style[ToString[parms[[i]][[1]]], Red, Bold]}, 0, 10}, {i, 1,
Length[parms]}]},
Manipulate[values, controls]]
which gives

Related

Extending ListPointPlot3D with a 3rd variable?

I am trying to extend a function like this: (a 4x4 square)
ListPointPlot3D[Table[{x, y, 0}, {x, 0, 4, 1}, {y, 0, 4, 1}]]
into something like this: (a 4x4x4 cube)
ListPointPlot3D[Table[{x, y, z}, {x, 0, 4, 1}, {y, 0, 4, 1}, {z, 0, 4, 1}]]
by adding a 3rd dimension.
However, the dimensions of the latter seem to be incorrect. It seems to form a 2x2 matrix of 3d points rather than a list.
Any ideas how to fix this?
If you look a bit more closely you'll see that the expression
Table[{x, y, z}, {x, 0, 4, 1}, {y, 0, 4, 1}, {z, 0, 4, 1}]
returns a structure with 5x5x5 triplets. That is exactly what the expression is supposed to return. You can see this if you apply the Dimensions[] function to the returned structure.
There are several ways to turn the table into a list of 125 triplets, one is to use Flatten like this
Flatten[Table[{x, y, z}, {x, 0, 4, 1}, {y, 0, 4, 1}, {z, 0, 4, 1}], 2]
Or you could simply generate your list of triplets directly; for your example one alternative would be
Tuples[Range[0, 4], 3]

Fast extraction of elements from nested lists

This is a basic question on list manipulation in Mathematica.
I have a large list where each element has the following schematic form: {List1, List2,Number}. For e.g.,
a = {{{1,2,3},{1,3,2},5},{{1,4,5},{1,0,2},10},{{4,5,3},{8,3,4},15}}}.
I want to make a new lists which only has some parts from each sublist. Eg., pick out the third element from each sublist to give {5,10,15} from the above. Or drop the third element to return {{{1,2,3},{1,3,2}},{{1,4,5},{1,0,2}},{{4,5,3},{8,3,4}}}.
I can do this by using the table command to construct new lists, e.g.,
Table[a[[i]][[3]],{i,1,Length[a]}
but I was wondering if there was a must faster way which would work on large lists.
In Mathematica version 5 and higher, you can use the keyword All in multiple ways to specify a list traversal.
For instance, instead of your Table, you can write
a[[All,3]]
Here Mathematica converts All into all acceptable indices for the first dimension then takes the 3rd one of the next dimension.
It is usually more efficient to do this than to make a loop with the Mathematica programming language. It is really fine for homogenous lists where the things you want to pick or scan through always exist.
Another efficient notation and shortcut is the ;; syntax:
a[[ All, 1 ;; 2]]
will scan the first level of a and take everything from the 1st to the 2st element of each sublist, exactly like your second case.
In fact All and ;; can be combined to any number of levels. ;; can even be used in a way similar to any iterator in Mathematica:
a[[ start;;end;;step ]]
will do the same things as
Table[ a[[i]], {i,start,end,step}]
and you can omit one of start, end or step, it is filled with its default of 1, Length[(of the implicit list)], and 1.
Another thing you might want to lookup in Mathematica's Help are ReplacePart and MapAt that allow programmatic replacement of structured expressions. The key thing to use this efficiently is that in ReplacePart you can use patterns to specify the coordinates of the things to be replaced, and you can define functions to apply to them.
Example with your data
ReplacePart[a, {_, 3} -> 0]
will replace every 3rd part of every sublist with 0.
ReplacePart[a, {i : _, 3} :> 2*a[[i, 3]]]
will double every 3rd part of every sublist.
As the authors suggest, the approaches based on Part need well-formed data, but Cases is built for robust separation of Lists:
Using your a,
a = {{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}};
Cases[a,{_List,_List,n_}:>n,Infinity]
{5, 10, 15}
The other pieces of a record can be extracted by similar forms.
Part-based approaches will gag on ill-formed data like:
badA = {{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}, {baddata}, {{1, 2, 3}, 4}};
badA[[All,3]]
{{{1, 2, 3}, {1, 3, 2}, 5}, {{1, 4, 5}, {1, 0, 2},
10}, {{4, 5, 3}, {8, 3, 4}, 15}, {baddata}, {{1, 2, 3},
4}}[[All, 3]]
,but Cases will skip over garbage, operating only on conforming data
Cases[badA, {_List, _List, s_} :> s, Infinity]
{5, 10, 15}
hth,
Fred Klingener
You can use Part (shorthand [[...]]) for this :
a[[All, 3]]
a[[All, {1, 2}]]

Plot of bars with height data in Mathematica

I have a matrix {{2, 1, 2, 2, 1}, {1, 3, 0, 1, 2}, {3, 3, 0, 3, 1}, {1, 1, 2, 1, 1}}, and I want to generate a 3d plot such as there are a total of 4*5=20 bars.
There is a bar of height 2 based at the little square (1, 1) (i.e. the square formed on the x-y plane by the points {{0,0},{0,1},{1,1},{1,0}}),
another bar of height 1 based at the little square (1,2) (i.e. the square formed on the x-y plane by the points {{0,1},{0,2},{1,2},{1,0}}),
...
another bar of height 3 based at the little square (2,2) (i.e. the square formed on the x-y plane by the points {{1,1},{2,1},{2,2},{1,2}})
...
and another bar of height 1 based at the little square (4,5) (i.e. the square formed on the x-y plane by the points {{3,4},{4,4},{4,5},{3,5}})
I cannot find an easy way to do this. Thanks a lot for your help!
What you want is BarChart3D.
Note, this function exists in two incarnations:
There is a BarChart3D in the BarCharts package. This function does what you want out of the box, but is deprecated in Mathematica 7+.
Then there's a BarChart3D in the main namespace (Mathematica 7+ only), which can do what you want as well, but needs to be passed the option ChartStyle -> "Grid" to display the result you want.
Here is some example code for both of these:
Mathematica 6 and prior
<<BarCharts`;
data = {{2, 1, 2, 2, 1}, {1, 3, 0, 1, 2}, {3, 3, 0, 3, 1}, {1, 1, 2, 1, 1}};
BarChart3D[data]
Mathematica 7 and later
data = {{2, 1, 2, 2, 1}, {1, 3, 0, 1, 2}, {3, 3, 0, 3, 1}, {1, 1, 2, 1, 1}};
BarChart3D[data, ChartLayout -> "Grid"]
data = {{2,1,2,2,1}, {1,3,0,1,2}, {3,3,0,3,1}, {1,1,2,1,1}};
BarChart3D[data, ChartLayout -> "Grid", BarSpacing -> 0]
Edit
Updating after wiki-specifying the question :
BarChart3D[data, ChartLayout -> "Grid", BarSpacing -> {0, 0},
LabelingFunction -> (Row[{#1, Reverse[#2 - 1], Reverse[#2]}] &),
AxesLabel -> {"x", "y", "z"}]
Here the both x and y-spacings vanish. Setting the cursor on a given bar you get z{x_min,y_min}{x_max,y_max}, on the top-red i.e. : 2{4,1}{5,2}

two questions on string manipulation in Mathematica

Given a character or a string s, generate a result string with n (an integer) repeats of s
Given a list of characters or strings, and a list of the frequencies of their appearance (in correspondence), generate a result string with each string in the list repeated with the desired times as specified in the second list and StringJoin them together. For example, given {"a", "b", "c"} and {1,0,3}, I want to have "accc".
I of course want to have the most efficient way of doing these. Otherwise, my own way is too ugly and slow.
Thank you for your help!
rep[s_String, n_] := StringJoin[ConstantArray[s, n]]
then
rep["f", 3]
(*fff*)
next
chars = {"a", "b", "c"};
freqs = {1, 0, 3};
StringJoin[MapThread[rep, {chars, freqs}]]
gives "accc"
For 1, Table will do what you need.
s = "samplestring";
StringJoin[Table[s, {3}]]
"samplestringsamplestringsamplestring"
But acl's answer using ContantArray is faster, if you care about the last 1/100th second.
Do[StringJoin[Table[s, {30}]];, {10000}] // Timing
{0.05805, Null}
Do[StringJoin[ConstantArray[s, 30]];, {10000}] // Timing
{0.033306, Null}
Do[StringJoin[Table[s, {300}]];, {10000}] // Timing
{0.39411, Null}
Do[StringJoin[ConstantArray[s, 300]];, {10000}] // Timing
{0.163103, Null}
For 2, MapThread will handle cases where the second list is known to be non-negative integers.
StringJoin #
MapThread[Table[#1, {#2}] &, {{"a", "b", "c"} , {1, 0, 3}}]
"accc"
If the second list contains negative integers, these are treated as zeros.
Non-integer elements in the second list are treated as if they are the integer part. I am not sure if this is what you want.
StringJoin #
MapThread[Table[#1, {#2}] &, {{"a", "b", "c"} , {1, 0, 3.7}}]
"accc"
Knowing your application I propose using Inner:
sets = {{0, 0, 0, 4}, {0, 0, 1, 3}, {0, 1, 0, 3}, {0, 1, 1, 2}, {0, 2, 0, 2},
{0, 2, 1, 1}, {1, 0, 0, 3}, {1, 0, 1, 2}, {1, 1, 0, 2}, {1, 1, 1, 1},
{1, 2, 0, 1}, {1, 2, 1, 0}, {2, 0, 0, 2}, {2, 0, 1, 1}, {2, 1, 0, 1},
{2, 1, 1, 0}, {2, 2, 0, 0}};
chars = {"a", "b", "c", "d"};
Inner[ConstantArray[#2, #] &, sets, chars, StringJoin]
{"dddd", "cddd", "bddd", "bcdd", "bbdd", "bbcd", "addd", "acdd",
"abdd", "abcd", "abbd", "abbc", "aadd", "aacd", "aabd", "aabc", "aabb"}

Mathematica: Removing graphics primitives

Given that g is a graphics object with primitives such as Lines and Polygons, how do you remove some of them? To add more primitives to an existing graphics object we can use Show, for instance: Show[g, g2] where g2 is another graphics object with other primitives. But how do you remove unwanted primitive objects? Take a look at the following
ListPlot3D[{{0, 0, 1}, {1, 0, 0}, {0, 1, 0}, {1, 1, 0}}, Mesh -> {1, 1}]
Now, for the input form:
InputForm[
ListPlot3D[{{0, 0, 1}, {1, 0, 0}, {0, 1, 0}, {1, 1, 0}}, Mesh -> {1, 1}]
]
To create a wire frame from this object all we have to do is remove the polygons. As an extra we can also remove the vertex normals since they don't contribute to the wireframe.
Notice that to make a wireframe we can simply set PlotStyle -> None as an option in ListPlot3D. This gets rid of the Polygons but doesn't remove the VertexNormals.
To clarify the question. Given that
g = ListPlot3D[{{0, 0, 1}, {1, 0, 0}, {0, 1, 0}, {1, 1, 0}}, Mesh -> {1, 1}]
How do you remove some of the of the graphics primitives from g and how do you remove some of the options, i.e. VertexNormals? Note: option VertexNormals is an option of GraphicsComplex.
If this is not possible then maybe the next question would be, how do you obtain the data used to generate g to generate a new graphics object with some of the data obtained from g.
One way is to use transformation rules. Given your
im = ListPlot3D[{{0, 0, 1}, {1, 0, 0}, {0, 1, 0}, {1, 1, 0}}, Mesh -> {1, 1}]
You can do
newim = im /. {_Polygon :> Sequence[], (VertexNormals -> _) :> Sequence[]}
or, more compactly using Alternatives:
newim = im /. _Polygon | (VertexNormals -> _) :> Sequence[]
You could also use DeleteCases to get a similar effect:
newim = DeleteCases[im, (_Polygon | (VertexNormals -> _)), Infinity]

Resources