Make Return[] do its proper (C++) task - wolfram-mathematica

I saw that there are many threads about the Return[] function on this site. There is even a very good description of its behavior. But what happens if I'm really new to Mathematica?
Without further ado, I want to use this function:
getBinIndex[eta_, pt_, etalimits_, ptlimits_] :=
List[
For[i = 1, i < Length[etalimits], i++,
If[eta < etalimits[[i + 1]], Return[i]]],
For[i = 1, i < Length[ptlimits], i++,
If[pt < ptlimits[[i + 1]], Return[i]]]
];
As you can see, I am really new. I suppose there are 1 million ways of doing this in Mathematica but I have a C background and I feel the need to tell the computer everything. The function works. It returns a list with 2 variables which, after lots of testing, are OK. But it puts the results as the argument of two Return's: {Return[4],Return[5]} which I can't use as indexes for a...Table, for example. What do you need to do to get these Return[x] into x?
To give you an idea of how much a newb I am, I tried N[Return[i]].
Cheers,
Adrian

Catch[For[ .... If[ Throw[i] ] ]
Of course in mathematica you hardly ever need loops..
something like
Position[etalimits,ei_/;ei<eta&][[1,1]]
will do.
edit .. try this:
For[i = 1, i < Length[etalimits], i++,
If[eta < etalimits[[i + 1]], Return[i,CompoundExpression]]];,
Note the extra semicolon which makes the For[] loop a CompoundExpression. Personally I find this weird and wouldn't use it..

Related

Mathematica list will not populate

NOTE: I am not a Mathematica programmer, but for a class I need to write expressions in it. I understand it is a functional language unlike C or Java.
I am trying to 'compare' (I use that for lack of a better term) the indexes or two irrational numbers. I then try to store whether or not they are equal, 1 and 0 respectively, in a list. Though, the comparison list is not populated (OUTPUT = "{}")
What is wrong with my logic in the for loop (aside from being non-functionally programed and inefficient)
piDigits = RealDigits[N[Pi, 15000000]]
rootDigits = RealDigits[N[Sqrt[2],15000000]]
comparisonList = List[]
For[i = 1, i < Length[Part[piDigits, 0]], i++,
If[Part[piDigits, i] == Part[rootDigits, i] ,
Append[comparisonList, 1], Append[comparisonList, 0]]]
comparisonList

Performance of Wolfram Mathematica InverseFunction

given the constants
mu = 20.82;
ex = 1.25;
kg1 = 1202.76;
kp = 76.58;
kvb = 126.92;
I need to invert the function
f[Vpx_,Vgx_] := Vpx Log[1 + Exp[kp (1/mu + Vgx/(Vpx s[Vpx]))]];
where
s[x_] := 1 + kvb/(2 x^2);
so that I get a function of two variables, the second one being Vgx.
I tried with
t = InverseFunction[Function[{Vpx, Vgx}, f[Vpx, Vgx]], 1, 2];
tested with t[451,-4]
It takes so much time that every time I try it I stop the evaluation.
On the other side, working with only one variable, everything works:
Vgx = -4;
t = InverseFunction[Function[{Vpx}, f[Vpx,Vgx]]];
t[451]
It's my fault? the method is inappropriate? or it's a limitation of Wolfram Mathematica?
Thanks
Teodoro Marinucci
P.S. For everyone interested it's a problem related to the Norman Koren model of triodes.
As I said in my comment, my guess is that InverseFunction first tries to solve symbolically for the inverse, e.g. Solve[Function[{Vpx, Vgx}, f[Vpx, Vgx]][X, #2] == #1, X], which takes a very long time (I didn't let it finish). However, I came across a system option that seems to turn this off and produce a function:
With[{opts = SystemOptions["ExtendedInverseFunction"]},
Internal`WithLocalSettings[
SetSystemOptions["ExtendedInverseFunction" -> False],
t = InverseFunction[Function[{Vpx, Vgx}, f[Vpx, Vgx]], 1, 2],
SetSystemOptions[opts]
]];
t[451, -4]
(* 199.762 *)
A couple of notes:
According to the documentation, InverseFunction with exact input should produce an exact answer. Here some of the parameters are approximate (floating-point) real numbers, so the answer above is a numerical approximation.
The actual definition of t depends on f. If f changes, then a side effect will be that t changes. If that is not something you explicitly want, then it is probably better to define t this way:
t = InverseFunction[Function[{Vpx, Vgx}, Evaluate#f[Vpx, Vgx]], 1, 2]
As my late Theoretical Physics professor said, "a simple and beautiful solution is likely to be true".
Here is the piece of code that works:
mu = 20.82; ex = 1.25; kg1 = 1202.76; kp = 76.58; kvb = 126.92;
Ip[Vpx_, Vgx_] = Power[Vpx/kp Log[1 + Exp[kp (1/mu + Vgx/Sqrt[kvb + Vpx^2])]], ex] 2/kg1;
Vp[y_, z_] := x /. FindRoot[Ip[x, z] == y, {x, 80}]
The "real" amplification factor of a tube is the partial derivative of Ip[Vpx, Vgx] by respect to Vgx, with give Vpx. I would be happier if could use the Derivative, but I'm having errors.
I'll try to understand why, but for the moment the definition
[CapitalDelta]x = 10^-6;
[Micro][Ipx_, Vgx_] := Abs[Vp[Ipx, Vgx + [CapitalDelta]x] - Vp[Ipx, Vgx]]/[CapitalDelta]x
works well for me.
Thanks, it was really the starting point of the FindRoot the problem.

Mathematica, define multiple functions using for loop

I am using usual for-loop for computation in Mathematica:
For[i=1,i<n+1,i++, ...calculation... ]
For each i I need to define a function F_i[x_,y_]:=.... Here "i" is suuposed to be a label of the function. This is however not the corrcet Mathematica expression.
The question is, how to define multiple functions distinguished by the label i? I mean, what is the correct syntax?
Thanks a lot.
I'm not exactly sure what you are trying to do, but I have some confidence that the for loop is not the way to go in Mathematica. Mathematica already has pattern matching that likely eliminates the need for the loop.
What about something like this
f[i_][x_,y_]:= i(x+y)
or something like this
f[s_String][x_,y_]:=StringLength[s](x+y)
or even
f[s_,x_,y_]:=StringLength[s](x+y)
Here are some steps which may help. There are two versions below, the second one includes the value of i on the RHS of the function definition.
n = 2;
For[i = 1, i < n + 1, i++,
f[i][x_, y_] := (x + y)*i]
?f
Global`f
f[1][x_,y_] := (x+y) i
f[2][x_,y_] := (x+y) i
Clear[i]
f[2][2, 3]
5 i
Quit[]
n = 2;
For[i = 1, i < n + 1, i++,
With[{j = i},
f[i][x_, y_] := (x + y)*j]]
?f
Global`f
f[1][x$,y$] := (x$+y$) 1
f[2][x$,y$] := (x$+y$) 2
Clear[i]
f[2][2, 3]
10

Speeding up Nested Loop; Can it be vectorized?

I am trying to match some data on what could be a fairly large data set and even on the medium sized data set it is taking too long.
The task I am performing is to take a mechanical problem, then go back 6 months and look for procedural problems (failures on the part of individual employees). I match first on machine and location, so I want to match the same place with the same machine. Then I require that the procedural error comes before the mechanical one, since its in the future. Finally, I limit it to 180 days to keep things comparable.
In the data construction phase, I limit the mechanical issues to exclude the first 6 months, so I have the same 180 day block for each.
I have read a fair bit on optimizing loops. I know that you want to create a storage variable outside of the loop and then just add to it, but I don't actually have any idea how many matches it will return, so initially I had been using rbind inside of the loop. I know the upper bound on the storage variables is the number of mechanical issues * number of procedural issues, but this is gigantic and I can't allocate a vector that large. The code I have places here has my max sized storage variable approach, but I think I will have to go back to something like this:
if (counter == 1) {
pro = procedural[i, ]
other = mechanical[j, ]
}
if (counter != 1) {
pro = rbind(pro, procedural[i, ])
other = rbind(other, mechanical[j, ])
}
I have also read a fair bit about vectorization, but I have never actually managed to get it to work. I have tried a few different things on the vectorization front, but I think I must be doing something wrong.
I also tried removing the second loop and just using the which command, but that doesn't seem to work with a full column of data (from the procedural data) being compared to a single value (from the mechanical data).
Here is the code I have currently. It works for small sets of data fine, but for anything remotely large it takes forever.
maxval = mechrow * prorow
pro = matrix(nrow = maxval, ncol = ncol(procedural))
other = matrix(nrow = maxval, ncol = ncol(procedural))
numprocissues = matrix(nrow = mechrow, ncol = 1)
counter = 1
for (j in 1:mechrow) {
for (i in 1:prorow) {
if (procedural[i, 16] == mechanical[j, 16] &
procedural[i, 17] < mechanical[j, 17] &
procedural[i, 2] == mechanical[j, 2] &
abs(procedural[i, 17] - mechanical[j, 17]) < 180) {
pro[counter, ] = procedural[i, ]
other[counter, ] = mechanical[j, ]
counter = counter + 1
}
}
numprocissues[j, 1] = counter
}
The places I imagine improvement can be made is in my storage variable, potential vectorization, changing the conditions in the if statement or maybe a fancy which statement to remove a loop.
Any advice would be greatly appreciated!
Thank you.
Untested...
xy <- expand.grid(mech=1:mechrow, pro=1:prorow)
ok <- (procedural[xy$pro, 16] == mechanical[xy$mech, 16] &
procedural[xy$pro, 17] < mechanical[xy$mech, 17] &
procedural[xy$pro, 2] == mechanical[xy$mech, 2] &
abs(procedural[xy$pro, 17] - mechanical[xy$mech, 17]) < 180)
pro <- procedural[xy$pro[ok],]
other <- mechanical[xy$mech[ok],]
numprocissues <- tapply(ok, xy$mech, sum)

Identify important minima and maxima in time-series w/ Mathematica

I need a way to identify local minima and maxima in time series data with Mathematica. This seems like it should be an easy thing to do, but it gets tricky. I posted this on the MathForum, but thought I might get some additional eyes on it here.
You can find a paper that discusses the problem at: http://www.cs.cmu.edu/~eugene/research/full/compress-series.pdf
I've tried this so far…
Get and format some data:
data = FinancialData["SPY", {"May 1, 2006", "Jan. 21, 2011"}][[All, 2]];
data = data/First#data;
data = Transpose[{Range[Length#data], data}];
Define 2 functions:
First method:
findMinimaMaxima[data_, window_] := With[{k = window},
data[[k + Flatten#Position[Partition[data[[All, 2]], 2 k + 1, 1], x_List /; x[[k + 1]] < Min[Delete[x, k + 1]] || x[[k + 1]] > Max[Delete[x, k + 1]]]]]]
Now another approach, although not as flexible:
findMinimaMaxima2[data_] := data[[Accumulate#(Length[#] & /# Split[Prepend[Sign[Rest#data[[All, 2]] - Most#data[[All, 2]]], 0]])]]
Look at what each the functions does. First findMinimaMaxima2[]:
minmax = findMinimaMaxima2[data];
{Length#data, Length#minmax}
ListLinePlot#minmax
This selects all minima and maxima and results (in this instance) in about a 49% data compression, but it doesn't have the flexibility of expanding the window.
This other method does. A window of 2, yields fewer and arguably more important extrema:
minmax2 = findMinimaMaxima[data, 2];
{Length#data, Length#minmax2}
ListLinePlot#minmax2
But look at what happens when we expand the window to 60:
minmax2 = findMinimaMaxima[data, 60];
ListLinePlot[{data, minmax2}]
Some of the minima and maxima no longer alternate.
Applying findMinimaMaxima2[] to the output of findMinimaMaxima[] gives a workaround...
minmax3 = findMinimaMaxima2[minmax2];
ListLinePlot[{data, minmax2, minmax3}]
, but this seems like a clumsy way to address the problem.
So, the idea of using a fixed window to look left and right doesn't quite do everything one would like. I began thinking about an alternative that could use a range value R (e.g. a percent move up or down) that the function would need to meet or exceed to set the next minima or maxima. Here's my first try:
findMinimaMaxima3[data_, R_] := Module[{d, n, positions},
d = data[[All, 2]];
n = Transpose[{data[[All, 1]], Rest#FoldList[If[(#2 <= #1 + #1*R && #2 >= #1) || (#2 >= #1 - #1* R && #2 <= #1), #1, #2] &, d[[1]], d]}];
n = Sign[Rest#n[[All, 2]] - Most#n[[All, 2]]];
positions = Flatten#Rest[Most[Position[n, Except[0]]]];
data[[positions]]
]
minmax4 = findMinimaMaxima3[data, 0.1];
ListLinePlot[{data, minmax4}]
This too benefits from post processing with findMinimaMaxima2[]
ListLinePlot[{data, findMinimaMaxima2[minmax4]}]
But if you look closely, you see that it misses the extremes if they go beyond the R value in several positions - including the chart's absolute minimum and maximum as well as along the big moves up and down. Changing the R value shows how it misses the top and bottoms even more:
minmax4 = findMinimaMaxima3[data, 0.15];
ListLinePlot[{data, minmax4}]
So, I need to reconsider. Anyone can look at a plot of the data and easily identify the important minima and maxima. It seems harder to get an algorithm to do it. A window and/or an R value seem important to the solution, but neither on their own seems enough (at least not in the approaches above).
Can anyone extend any of the approaches shown or suggest an alternative to identifying the important minima and maxima?
Happy to forward a notebook with all of this code and discussion in it. Let me know if anyone needs it.
Thank you,
Jagra
I suggest to use an iterative approach. The following functions are taken from this post, and while they can be written more concisely without Compile, they'll do the job:
localMinPositionsC =
Compile[{{pts, _Real, 1}},
Module[{result = Table[0, {Length[pts]}], i = 1, ctr = 0},
For[i = 2, i < Length[pts], i++,
If[pts[[i - 1]] > pts[[i]] && pts[[i + 1]] > pts[[i]],
result[[++ctr]] = i]];
Take[result, ctr]]];
localMaxPositionsC =
Compile[{{pts, _Real, 1}},
Module[{result = Table[0, {Length[pts]}], i = 1, ctr = 0},
For[i = 2, i < Length[pts], i++,
If[pts[[i - 1]] < pts[[i]] && pts[[i + 1]] < pts[[i]],
result[[++ctr]] = i]];
Take[result, ctr]]];
Here is your data plot:
dplot = ListLinePlot[data]
Here we plot the mins, which are obtained after 3 iterations:
mins = ListPlot[Nest[#[[localMinPositionsC[#[[All, 2]]]]] &, data, 3],
PlotStyle -> Directive[PointSize[0.015], Red]]
The same for maxima:
maxs = ListPlot[Nest[#[[localMaxPositionsC[#[[All, 2]]]]] &, data, 3],
PlotStyle -> Directive[PointSize[0.015], Green]]
And the resulting plot:
Show[{dplot, mins, maxs}]
You may vary the number of iterations, to get more coarse-grained or finer minima/maxima.
Edit:
actually, I just noticed that a couple of points were still missed by this method, both for the
minima and maxima. So, I suggest it as a starting point, not as a complete solution. Perhaps, you
could analyze minima/maxima, coming from different iterations, and sometimes include those from a "previous", more fine-grained one. Also, the only "physical reason" that this kind of works, is that the nature of the financial data appears to be fractal-like, with several distinctly different scales. Each iteration in the above Nest-s targets a particular scale. This would not work so well for an arbitrary signal.

Resources