Related
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)
I want to repeat a function n times on a table, For n=2 I have the following code, How can I be sure that the function had run twice since my fc is differend every time?
smat = Table[{9, 8, 10}, {3}]
f[x_?Table] := ReplacePart[
x, {{2, 1} -> x[[2]][[1]] - #, {2, 2} -> x[[2]][[2]] + #}] &# fc[x[[2]][[1]]];
fc[k_?NumericQ] := Count[RandomReal[{0, 1}, k], x_ /; x < .1]
Nest[f, smat, 2]
This is probably what you want:
smat = Table[{9, 8, 10}, {3}]
ClearAll[f, fc];
f[x_List] :=
ReplacePart[
x, {{2, 1} -> x[[2]][[1]] - #, {2, 2} -> x[[2]][[2]] + #}] &#
fc[x[[2]][[1]]];
fc[k_?NumericQ] := Count[RandomReal[{0, 1}, k], x_ /; x < .1]
Nest[f, smat, 2]
ClearAll clears any previous definitions for those symbols (just in case). f[x_?Table] won't work; you want f[x_List], which means that the argument has a List head (Table is not a Head, and ? isn't what you want here).
I am not sure I have really answered your question though...
EDIT: To be clear, f[x_?something] means "apply something to x and, if it returns True, evaluate the right hand side of the := that follows. Look up PatternTest in Mathematica's documentation for more.
Acl covered the problems with the code pretty well, so I won't. To answer your question, though, I'd first separate your functions f and fc in separate cells, with fc being declared prior to f, and preface each cell with Clear[<function name>]. Now, to test if f is being applied twice, temporarily replace fc with
fc[_]:= a
or use another "dummy" value other than a, but it should be symbolic to increase readability. As a point of note, {1,2,3} + a == {1 + a, 2 + a, 3 + a}, so if f is applied twice, each term in x[[2]][[1]] and x[[2]][[2]] will have 2 a added to it.
Now, if you are unsure if fc is working correctly by itself, I'd apply it to a number separate cases without f, first.
I have two arrays, say A={1, 2, 3} and B={2, 4, 8} (array item count and numbers may vary). How do I find a bijection between the arrays.
In this case, it would be f:A->B; f(x)=2^(x)
I don't think this problem has a general solution. You may try FindSequenceFunction, but it will not always find the solution. For the case at hand, you'd need a bit longer lists:
In[250]:= FindSequenceFunction[Transpose[{{1, 2, 3}, {2, 4, 8}}], n]
Out[250]= FindSequenceFunction[{{1, 2}, {2, 4}, {3, 8}}, n]
but
In[251]:= FindSequenceFunction[Transpose[{{1, 2, 3, 4}, {2, 4, 8, 16}}], n]
Out[251]= 2^n
You can also play with FindFit, if you have some guesses about the bijection:
In[252]:= FindFit[Transpose[{{1, 2, 3}, {2, 4, 8}}], p*q^x, {p, q}, x]
Out[252]= {p -> 1., q -> 2.}
As others have remarked, this problem is ill-defined.
Other possible functions that give the same results are (among probably infinite others): (8 x)/3 - x^2 + x^3/3, x + (37 x^2)/18 - (4 x^3)/3 + (5 x^4)/18, and (259 x^3)/54 - (31 x^4)/9 + (35 x^5)/54.
I found these solutions using:
n = 5; (* try various other values *)
A = {1, 2, 3} ; B = {2, 4, 8}
eqs = Table[
Sum[a[i] x[[1]]^i, {i, n}] == x[[2]], {x, {A, B}\[Transpose]}]
sol = Solve[eqs, Table[a[i], {i, n}], Reals]
Sum[a[i] x^i, {i, n}] /. sol
Sometimes not all of the a[i]'s are fully determined and you may come up with values of your own.
[tip: better not use variables starting with a capital letter in Mathematica so as not to get into conflict with reserved words]
Since you tag Mathematica, I'll use Mathematica functions as a reference.
If you are interested in an arbitrary fit of your data with a smooth function, you can use Interpolation. E.g.
a = {1, 2, 3}; b = {2, 4, 8};
f = Interpolation[Transpose[{a, b}]];
(* Graph the interpolation function *)
Show[Plot[f[x], {x, 1, 3}], Graphics[Point /# Transpose[{a, b}]],
PlotRange -> {{0, 4}, {0, 9}}, Frame -> Automatic, Axes -> None]
Interpolation uses piecewise polynomials. You can do the same in your favorite programming language if you happen know or are willing to learn a bit about numerical methods, especially B-Splines.
If instead you know something about your data, e.g. that it is of the form c d^x, then you can do a minimization to find the unknowns (c and d in this case). If your data is in fact generated from the form c d^x, then the fit will be fairly, otherwise it's the error is minimized in the least-squares sense. So for your data:
FindFit[Transpose[{a, b}], c d^x, {c, d}, {x}]
reports:
{c -> 1., d -> 2.}
Indicating that your function is 2^x, just as you knew all along.
Suppose I have a list of param->value rules where the params are symbols that might have values assigned to them. For example:
{a, b, c} = {1, 2, 3};
x = Hold[{a->1, b->2, c->3}];
I need the list wrapped in Hold otherwise it would evaluate to {1->1, 2->2, 3->3}. (I'm open to any alternatives to Hold there if it makes the rest of this easier.)
Now suppose I want to convert x into this:
{"a"->1, "b"->2, "c"->3}
The following function will do that:
f[h_] := Block[{a,b,c}, ToString[#[[1]]]->#[[2]]& /# ReleaseHold#h]
My question: Can you write a version of f where the list of symbols {a,b,c} doesn't have to be provided explicitly?
Here is a way using Unevaluated:
In[1]:= {a, b, c} = {1, 2, 3};
In[2]:= x = Hold[{a -> 1, b -> 2, c -> 3}];
In[3]:= ReleaseHold[
x /. (symb_ -> e_) :> ToString[Unevaluated[symb]] -> e]
Out[3]= {"a" -> 1, "b" -> 2, "c" -> 3}
{a, b, c} = {1, 2, 3};
x = Hold[{a -> 1, b -> 2, c -> 3}];
f[x_] := Cases[x, HoldPattern[z_ -> y_] :>
StringTake[ToString[(Hold#z)], {6, -2}] -> y, 2];
f[x] // InputForm
Out:
{"a" -> 1, "b" -> 2, "c" -> 3}
Perhaps not very elegant, but seems to work.
This is a bit of an old question, but I think there's an answer that combines the virtues of both Andrew Moylan's answer and belisarius' answer. You really want to have lists of rules with HoldPattern on the left-hand side, instead of lists of rules that have Hold wrapped around the whole thing, so that you can actually use the rules without having to go through any sort of ReleaseHold process.
In[1]:= {a, b, c} = {1, 2, 3};
Unevaluated can also be helpful in constructing the sort of list you want:
In[2]:= x = Thread[HoldPattern /# Unevaluated[{a, b, c}] -> Range[3]]
Out[2]= {HoldPattern[a] -> 1, HoldPattern[b] -> 2, HoldPattern[c] -> 3}
Now you can do what you want with rule replacement. It's a bit involved, but it's something I find myself doing over and over and over again. You may notice that this list of rules has almost exactly the form of a list of OwnValues or DownValues, so being able to manipulate it is very helpful. The trick is using HoldPattern and Verbatim in concert:
In[3]:= f[rules_] :=
Replace[rules,
HoldPattern[Verbatim[HoldPattern][s_Symbol] -> rhs_] :>
With[{string = ToString[Unevaluated[s]]},
string -> rhs], {1}]
The level spec on Replace is just there to make sure nothing unexpected happens if rhs is itself a rule or list of rules.
In[4]:= f[x] // InputForm
Out[4]= {"a" -> 1, "b" -> 2, "c" -> 3}
I have imported some data into Mathematica. The data will look similar to
{{0,2},{2,3},{4,3},{5,4},{8,4}}
I want to throw out all elements for which the x-values are smaller than a given value or create a new list that contains the data for which the x-values are larger than this value. I assume that Select should do the job but I don't know how.
Thanks in advance for the help.
How about
data = {{0,2},{2,3},{4,3},{5,4},{8,4}};
filtered = Select[data, First[#]>3&];
where you replace 3 with your given value?
Another versatile approach is to use Cases and attach a condition (/;)
For example:
data = {{0, 2}, {2, 3}, {4, 3}, {5, 4}, {8, 4}};
Cases[data, {x_, y_} /; x > 3]
or attach a condition as follows (for example):
Cases[data, {x_ /; x > 3, _}]
(The approach will also work with DeleteCases)