Related
Any Ideas on how I can accomplish this? I am very new to mathematica...
My initial thoughts were to import the data from excel in .CSV and determine the max y value in all of the sets of data, and shift the rest of the initial y values to that value. Also I need to keep the time values unchanged, and it needs to work for N# of lists.
I have no Idea how to do this, or if there is a simpler solution. Thanks!
Example:
List#1-> {{8,0},{6,1},{4,2}}, List#2-> {{7,0},{6,1},{2,2}}
List#1-> {{8,0},{6,1},{4,2}}, List#2-> {{8,0},{7,1},{3,2}}
All y values in list #2 were shifted up by one.
He has asked this question at least one other place. He seems to want to add an offset to each pair in a list so that the first of the first of all the lists become the same, the first of each pair in the rest of each list have the same offset added and the second of each pair is unchanged and he wants this to work on a relatively arbitrary number of lists.
Try to adapt this and see if it works for you
list1 = {{8, 0}, {6, 1}, {4, 2}};
list2 = {{7, 0}, {6, 1}, {2, 2}};
list3 = {{5, 0}, {7, 1}, {5, 2}};
list4 = {{9, 0}, {4, 1}, {1, 2}};
f[v_] := Map[# + {list1[[1, 1]] - v[[1, 1]], 0} &, v];
{list2, list3, list4} = Map[f, {list2, list3, list4}]
which should assign {{8,0},{7,1},{3,2}} to list2, {{8,0},{10,1},{8,2}} to list3 and {{8,0},{3,1},{0,2}} to list4.
I have a list of 200 data points. I want to select one value, and change the data using the manipulate function to create a bad data point, and observe the effects on the graph.
My recent attempts included creating a variable i, and assigning like:
myarray[[80,2]] = i;
and then use manipulate as such:
Manipulate[Curve[myarray], {i, 0, 5}]
This is not giving the desired output, however. It doesn't really make sense to me to put it like that, but I don't see the alternative way. Any help on this particular problem would be greatly appreciated!
Making up some data and a Curve function :-
myarray = Transpose[{Range[10], Range[10]/2}];
Curve[myarray_] := ListLinePlot[myarray]
Manipulate[myarray[[8, 2]] = i; Curve[myarray], {i, 0, 5}]
To complement Chris Degnen's answer, which shows a good approach, here is an explanation for why your original code failed.
Manipulate, like Module, acts as a scoping construct. For this reason the i used by Manipulate (the manipulation variable) is not the same i as set with myarray[[80, 2]] = i; -- it exists in a different Context:
Manipulate[Context[i], {i, 0, 5}]
(* FE` *)
Here is a minimal example of the problem:
ClearAll[x, i]
x = i;
Manipulate[{x, i}, {i, 0, 5}]
(* {i, 2.24} *)
One way around this is to use Block, but you need to use a different name for the manipulate variable:
ClearAll[x, i]
x = {1, 2, i};
Manipulate[Block[{i = ii}, x], {ii, 0, 5}]
(* {1, 2, 1.41} *)
I am still not good working with lists in Mathematica the functional way. Here is a small problem that I'd like to ask what is a good functional way to solve.
I have say the following list made up of points. Hence each element is coordinates (x,y) of one point.
a = {{1, 2}, {3, 4}, {5, 6}}
I'd like to traverse this list, and every time I find a point whose y-coordinate is say > 3.5, I want to generate a complex conjugate point of it. At the end, I want to return a list of the points generated. So, in the above example, there are 2 points which will meet this condition. Hence the final list will have 5 points in it, the 3 original ones, and 2 complex conjugtes ones.
I tried this:
If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, #] & /# a
but I get this
{{1, 2}, {{3, 4}, {3, -4}}, {{5, 6}, {5, -6}}}
You see the extra {} in the middle, around the points where I had to add a complex conjugate point. I'd like the result to be like this:
{{1, 2}, {3, 4}, {3, -4}, {5, 6}, {5, -6}}
I tried inserting Flatten, but did not work, So, I find myself sometimes going back to my old procedural way, and using things like Table and Do loop like this:
a = {{1, 2}, {3, 4}, {5, 6}}
result = {};
Do[
If[a[[i, 2]] > 3.5,
{
AppendTo[result, a[[i]]]; AppendTo[result, {a[[i, 1]], -a[[i, 2]]}]
},
AppendTo[result, a[[i]]]
],
{i, 1, Length[a]}
]
Which gives me what I want, but not functional solution, and I do not like it.
What would be the best functional way to solve such a list operation?
update 1
Using the same data above, let assume I want to make a calculation per each point as I traverse the list, and use this calculation in building the list. Let assume I want to find the Norm of the point (position vector), and use that to build a list, whose each element will now be {norm, point}. And follow the same logic as above. Hence, the only difference is that I am making an extra calculation at each step.
This is what I did using the solution provided:
a = {{1, 2}, {3, 4}, {5, 6}}
If[#[[2]] > 3.5,
Unevaluated#Sequence[ {Norm[#], #}, {Norm[#], {#[[1]], -#[[2]]}}],
{Norm[#], #}
] & /# a
Which gives what I want:
{ {Sqrt[5],{1,2}}, {5,{3,4}}, {5,{3,-4}}, {Sqrt[61],{5,6}}, {Sqrt[61],{5,-6}} }
The only issue I have with this, is that I am duplicating the call to Norm[#] for the same point in 3 places. Is there a way to do this without this duplication of computation?
This is how I currently do the above, again, using my old procedural way:
a = {{1, 2}, {3, 4}, {5, 6}}
result = {};
Do[
o = Norm[a[[i]]];
If[a[[i, 2]] > 3.5,
{
AppendTo[result, {o, a[[i]]}]; AppendTo[result, {o, {a[[i, 1]], -a[[i, 2]]}}]
},
AppendTo[result, {o, a[[i]]}]
],
{i, 1, Length[a]}
]
And I get the same result as the functional way, but in the above, since I used a temporary variable, I am doing the calculation one time per point.
Is this a place for things like sow and reap? I really never understood well these 2 functions. If not, how would you do this in functional way?
thanks
One way is to use Sequence.
Just a minor modification to your solution:
If[#1[[2]] > 3.5, Unevaluated#Sequence[#1, {#1[[1]], -#1[[2]]}], #1] & /# a
However, a plain ReplaceAll might be simpler:
a /. {x_, y_} /; y > 3.5 :> Sequence[{x, y}, {x, -y}]
This type of usage is the precise reason Rule and RuleDelayed have attribute SequenceHold.
Answer to update 1
I'd do it in two steps:
b = a /. {x_, y_} /; y > 3.5 :> Sequence[{x, y}, {x, -y}]
{Norm[#], #}& /# b
In a real calculation there's a chance you'd want to use the norm separately, so a Norm /# b might do
While Mathematica can simulate functional programming paradigms quite well, you might consider using Mathematica's native paradigm -- pattern matching:
a = {{1,2},{3,4},{5,6}}
b = a /. p:{x_, y_ /; y > 3.5} :> Sequence[p, {x, -y}]
You can then further transform the result to include the Norms:
c = Cases[b, p_ :> {Norm#p, p}]
There is no doubt that using Sequence to generate a very large list is not as efficient as, say, pre-allocating an array of the correct size and then updating it using element assignments. However, I usually prefer clarity of expression over such micro-optimization unless said optimization is measured to be crucial to my application.
Flatten takens a second argument that specifies the depth to which to flatten. Thus, you could also do the following.
a = {{1, 2}, {3, 4}, {5, 6}};
Flatten[If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, {#}] & /# a, 1]
The most serious problem with your Do loop is the use of AppendTo. This will be very slow if result grows long. The standard way to deal with lists that grow as the result of a procedure like this is to use Reap and Sow. In this example, you can do something like so.
new = Reap[
Do[If[el[[2]] > 3.5, Sow[{el[[1]], -el[[2]]}]],
{el, a}]][[2, 1]];
Join[a, new]
To answer your edit, use With (or Module) if you're going to use something expensive more than once.
Here's my version of the problem in your edit:
a = {{1, 2}, {3, 4}, {5, 6}};
Table[With[{n = Norm[x]},
Unevaluated#Sequence[{n, x},
If[x[[2]] > 3.5, {n, {1, -1} x}, Unevaluated#Sequence[]]]],
{x, a}]
The structure of the above could be modified for use in a Map or ReplaceAll version, but I think that Table is clearer in this case. The unevaluated sequences are a little annoying. You could instead use some undefined function f then replace f with Sequence at the end.
Mark's Sow/Reap code does not return the elements in the order requested. This does:
a = {{1, 2}, {3, 4}, {5, 6}};
Reap[
If[Sow[#][[2]] > 3.5, Sow[# {1, -1}]] & /# a;
][[2, 1]]
You may use join with Apply(##):
Join ## ((If[#[[2]] > 3.5, {#, {#[[1]], -#[[2]]}}, {#}]) & /# a)
Suppose we want to generate a list of primes p for which p + 2 is also prime.
A quick solution is to generate a complete list of the first n primes and use the Select function to return the elements which meet the condition.
Select[Table[Prime[k], {k, n}], PrimeQ[# + 2] &]
However, this is inefficient as it loads a large list into the memory before returning the filtered list. A For loop with Sow/Reap (or l = {}; AppendTo[l, k]) solves the memory issue, but it is far from elegant and is cumbersome to implement a number of times in a Mathematica script.
Reap[
For[k = 1, k <= n, k++,
p = Prime[k];
If[PrimeQ[p + 2], Sow[p]]
]
][[-1, 1]]
An ideal solution would be a built-in function which allows an option similar to this.
Table[Prime[k], {k, n}, AddIf -> PrimeQ[# + 2] &]
I will interpret this more as a question about automation and software engineering rather than about the specific problem at hand, and given a large number of solutions posted already. Reap and Sow are good means (possibly, the best in the symbolic setting) to collect intermediate results. Let us just make it general, to avoid code duplication.
What we need is to write a higher-order function. I will not do anything radically new, but will simply package your solution to make it more generally applicable:
Clear[tableGen];
tableGen[f_, iter : {i_Symbol, __}, addif : Except[_List] : (True &)] :=
Module[{sowTag},
If[# === {}, #, First##] &#
Last#Reap[Do[If[addif[#], Sow[#,sowTag]] &[f[i]], iter],sowTag]];
The advantages of using Do over For are that the loop variable is localized dynamically (so, no global modifications for it outside the scope of Do), and also the iterator syntax of Do is closer to that of Table (Do is also slightly faster).
Now, here is the usage
In[56]:= tableGen[Prime, {i, 10}, PrimeQ[# + 2] &]
Out[56]= {3, 5, 11, 17, 29}
In[57]:= tableGen[Prime, {i, 3, 10}, PrimeQ[# + 1] &]
Out[57]= {}
In[58]:= tableGen[Prime, {i, 10}]
Out[58]= {2, 3, 5, 7, 11, 13, 17, 19, 23, 29}
EDIT
This version is closer to the syntax you mentioned (it takes an expression rather than a function):
ClearAll[tableGenAlt];
SetAttributes[tableGenAlt, HoldAll];
tableGenAlt[expr_, iter_List, addif : Except[_List] : (True &)] :=
Module[{sowTag},
If[# === {}, #, First##] &#
Last#Reap[Do[If[addif[#], Sow[#,sowTag]] &[expr], iter],sowTag]];
It has an added advantage that you may even have iterator symbols defined globally, since they are passed unevaluated and dynamically localized. Examples of use:
In[65]:= tableGenAlt[Prime[i], {i, 10}, PrimeQ[# + 2] &]
Out[65]= {3, 5, 11, 17, 29}
In[68]:= tableGenAlt[Prime[i], {i, 10}]
Out[68]= {2, 3, 5, 7, 11, 13, 17, 19, 23, 29}
Note that since the syntax is different now, we had to use the Hold-attribute to prevent the passed expression expr from premature evaluation.
EDIT 2
Per #Simon's request, here is the generalization for many dimensions:
ClearAll[tableGenAltMD];
SetAttributes[tableGenAltMD, HoldAll];
tableGenAltMD[expr_, iter__List, addif : Except[_List] : (True &)] :=
Module[{indices, indexedRes, sowTag},
SetDelayed ## Prepend[Thread[Map[Take[#, 1] &, List ## Hold ### Hold[iter]],
Hold], indices];
indexedRes =
If[# === {}, #, First##] &#
Last#Reap[Do[If[addif[#], Sow[{#, indices},sowTag]] &[expr], iter],sowTag];
Map[
First,
SplitBy[indexedRes ,
Table[With[{i = i}, Function[Slot[1][[2, i]]]], {i,Length[Hold[iter]] - 1}]],
{-3}]];
It is considerably less trivial, since I had to Sow the indices together with the added values, and then split the resulting flat list according to the indices. Here is an example of use:
{i, j, k} = {1, 2, 3};
tableGenAltMD[i + j + k, {i, 1, 5}, {j, 1, 3}, {k, 1, 2}, # < 7 &]
{{{3, 4}, {4, 5}, {5, 6}}, {{4, 5}, {5, 6}, {6}}, {{5, 6}, {6}}, {{6}}}
I assigned the values to i,j,k iterator variables to illustrate that this function does localize the iterator variables and is insensitive to possible global values for them. To check the result, we may use Table and then delete the elements not satisfying the condition:
In[126]:=
DeleteCases[Table[i + j + k, {i, 1, 5}, {j, 1, 3}, {k, 1, 2}],
x_Integer /; x >= 7, Infinity] //. {} :> Sequence[]
Out[126]= {{{3, 4}, {4, 5}, {5, 6}}, {{4, 5}, {5, 6}, {6}}, {{5, 6}, {6}}, {{6}}}
Note that I did not do extensive checks so the current version may contain bugs and needs some more testing.
EDIT 3 - BUG FIX
Note the important bug-fix: in all functions, I now use Sow with a custom unique tag, and Reap as well. Without this change, the functions would not work properly when expression they evaluate also uses Sow. This is a general situation with Reap-Sow, and resembles that for exceptions (Throw-Catch).
EDIT 4 - SyntaxInformation
Since this is such a potentially useful function, it is nice to make it behave more like a built-in function. First we add syntax highlighting and basic argument checking through
SyntaxInformation[tableGenAltMD] = {"ArgumentsPattern" -> {_, {_, _, _., _.}.., _.},
"LocalVariables" -> {"Table", {2, -2}}};
Then, adding a usage message allows the menu item "Make Template" (Shift+Ctrl+k) to work:
tableGenAltMD::usage = "tableGenAltMD[expr,{i,imax},addif] will generate \
a list of values expr when i runs from 1 to imax, \
only including elements if addif[expr] returns true.
The default of addiff is True&."
A more complete and formatted usage message can be found in this gist.
I think the Reap/Sow approach is likely to be most efficient in terms of memory usage. Some alternatives might be:
DeleteCases[(With[{p=Prime[#]},If[PrimeQ[p+2],p,{}] ] ) & /# Range[K]),_List]
Or (this one might need some sort of DeleteCases to eliminate Null results):
FoldList[[(With[{p=Prime[#2]},If[PrimeQ[p+2],p] ] )& ,1.,Range[2,K] ]
Both hold a big list of integers 1 to K in memory, but the Primes are scoped inside the With[] construct.
Yes, this is another answer. Another alternative that includes the flavour of the Reap/Sow approach and the FoldList approach would be to use Scan.
result = {1};
Scan[With[{p=Prime[#]},If[PrimeQ[p+2],result={result,p}]]&,Range[2,K] ];
Flatten[result]
Again, this involves a long list of integers, but the intermediate Prime results are not stored because they are in the local scope of With. Because p is a constant in the scope of the With function, you can use With rather than Module, and gain a bit of speed.
You can perhaps try something like this:
Clear[f, primesList]
f = With[{p = Prime[#]},Piecewise[{{p, PrimeQ[p + 2]}}, {}] ] &;
primesList[k_] := Union#Flatten#(f /# Range[k]);
If you want both the prime p and the prime p+2, then the solution is
Clear[f, primesList]
f = With[{p = Prime[#]},Piecewise[{{p, PrimeQ[p + 2]}}, {}] ] &;
primesList[k_] :=
Module[{primes = f /# Range[k]},
Union#Flatten#{primes, primes + 2}];
Well, someone has to allocate memory somewhere for the full table size, since it is not known before hand what the final size will be.
In the good old days before functional programming :), this sort of thing was solved by allocating the maximum array size, and then using a separate index to insert to it so no holes are made. Like this
x=Table[0,{100}]; (*allocate maximum possible*)
j=0;
Table[ If[PrimeQ[k+2], x[[++j]]=k],{k,100}];
x[[1;;j]] (*the result is here *)
{1,3,5,9,11,15,17,21,27,29,35,39,41,45,51,57,59,65,69,71,77,81,87,95,99}
Here's another couple of alternatives using NextPrime:
pairs1[pmax_] := Select[Range[pmax], PrimeQ[#] && NextPrime[#] == 2 + # &]
pairs2[pnum_] := Module[{p}, NestList[(p = NextPrime[#];
While[p + 2 != (p = NextPrime[p])];
p - 2) &, 3, pnum]]
and a modification of your Reap/Sow solution that lets you specify the maximum prime:
pairs3[pmax_] := Module[{k,p},
Reap[For[k = 1, (p = Prime[k]) <= pmax, k++,
If[PrimeQ[p + 2], Sow[p]]]][[-1, 1]]]
The above are in order of increasing speed.
In[4]:= pairs2[10000]//Last//Timing
Out[4]= {3.48,1261079}
In[5]:= pairs1[1261079]//Last//Timing
Out[5]= {6.84,1261079}
In[6]:= pairs3[1261079]//Last//Timing
Out[7]= {0.58,1261079}
The Table[ ] command usually returns a list with the same cardinality of its iterator.
Table[i, {i,4}]
(*
->{1,2,3,4}
*)
It is easy to show that is possible to return a list with a greater cardinality than the iterator
Table[Sequence ## ConstantArray[1, i], {i, 2}]
(*
->{1,1,1}
*)
But ... Are there ways to return a list with LESS cardinality than the iterator?
This should work:
Table[Sequence ## {}, {i, 10}]
Assuming that I now understand your intent, I do not see the advantage to "on the fly" elimination within Table itself. One could accomplish it with something like:
Table[If[EvenQ#i, i, ##&[]], {i, 25}]
but it is faster to use Join:
Join ## Table[If[EvenQ#i, {i}, {}], {i, 25}]
or DeleteCases:
DeleteCases[Table[If[EvenQ#i, i], {i, 25}], , 1]
and in this simple case, Select is more than twice as fast:
Table[i, {i, 25}] ~Select~ EvenQ
If it is a matter of memory usage, the first method using Sequence does come out ahead, but the Join method is not far behind.
A simple example:
Table[Sequence ## ConstantArray[1, i - 1], {i, 2}]
Out[1] = {1}
This need not always return a list with smaller cardinality. For e.g., {i,3} returns equal and {i,4} returns more.
Or an even sillier example would be
Table[Sequence ## {}, {i, 2}]
but I don't know if it counts.
You could also use Piecewise inside Table
Table[Sequence ## Piecewise[{
{ConstantArray[1, i], i < 3},
{ConstantArray[2, i], 3 <= i < 5},
{{}, i >= 5}}],
{i, 20}]
Out[2] = {1, 1, 1, 2, 2, 2, 2, 2, 2, 2}