Trouble using position in wolfram-mathematica - wolfram-mathematica

Hi im coding a homework in mathematica about finding the probability of a program failing, make a plot and a table with the results however Im having trouble getting the last value of the table
Clear[bin1]
bin1[n_, p_, k_] :=
Module[{prob = (1 - p)^n, i},
Do[prob = (((n - i + 1)/i) (p/(1 - p))) prob, {i, k}]; prob]
distribution =
Table[bin1[50, #, k], {k, 0, 50}] & /# Range[0, .9, .1];
thats the probability calculator
prob = Max[Take[distribution, {#}]] & /# Range[1, 10] thats to take the first value of the table (its the porcentage of failiure)
position = # & /# Range[0, .9, .1](thats just for the third value)
max = Last[
Last[Position[distribution, Take[prob {#}] & /# Range[1, 10]]]]
thats the third value and where i have trouble its supossed to be tha maximum value but the prob{#} part doesnt work i have no idea why
The final table should be: TableForm[{position, prob, max}]

See the documentation for Module:
Module[{x,y,…},expr]
specifies that occurrences of the symbols x, y, … in expr should be treated as local.
When you say bin1[n_, p_, k_] := Module[{prob = …}], then prob is only defined inside the Module, and has no value outside.
You can see how this works by playing with it:
In[1]:= Module[{foo}, foo]
Out[1]= foo$185
Module renames variables inside its scope to have unique names not accessible outside.
You’ll probably need another function to compute prob, or set up bin1[] to compute both distribution and probability.

Related

Making a matrix in a for loop

I am currently working with mathematica and I got stuck on some technicalities.
Rvec[R_] := UnitVector[Length[R], RandomInteger[{1, Length[R]}]]
Fvec[R_] := R - Rvec[R] + Rvec[R]
vec[R_] := Module[{S = Fvec[R]}, If[Count[S, -1] > 0, R, S]]
Loop[R_, n_] := For[i = 1; L = R, i < n + 1, i++, L = vec[L]; Print[L]]
The idea is that I now have a loop going that will randomly subtract one number from one entry in a set and add it to another in the next iteration, but with the catch that no entry can drop below zero. The output I then get is a set of outcomes put beneath each other.
Having done that I would like to know how I could put the entire output in the form of one matrix:
https://i.gyazo.com/a4ef70ba5670fd53003e0ac5ec1e434e.png
Instead of having the output like that, I would like to have it in matrix form, as in having this set of outputs placed in a larger set containing those sets as elements. This would greatly help me, as I would be able to manipulate and work with the entire output.
If you need to make matrix by consequently adding vector by vector, you can do like this:
vector = {1, 2, 3, 4, 5};
matrix = {}; (* Initialize matrix *)
Do[matrix = Append[matrix, vector], 5]; (* Construct matrix by adding line by line*)
MatrixForm[matrix] (* Print matrix *)
Please tell me If I didn't understanf youy problem properly.

How to obtain values from a NMaximize in a For loop

I am using NMaximize to obtain values from an NDSolve function:
Flatten[NDSolve[{x''[t] == (F Cos[\[CapitalOmega] t] -
c x'[t] - (k + \[Delta]kb) x[t] + \[Delta]kb y[t])/m,
y''[t] == (-c y'[t] - (k + \[Delta]kb) y[t] + \[Delta]kb x[t])/m,
x'[0] == 0, y'[0] == 0, x[0] == 0, y[0] == 0}, {x[t], y[t]}, {t, 0, 10}]];
NMaximize[{Evaluate[y[t] /. s], 8 < t < 9}, t]
This is the case of a set of coupled, second order, ordinary differential equations (they were derived by a constant rotational speed gyroscope).
I need to obtain the maximum of the response function after the transient solution has faded and no longer influences the result.
I am trying to use a For loop to obtain the different maximums achieved for a range of "CapitalOmega", say 80 to 130 in steps of 1/2.
Currently I am getting the result in a form:
{a, {t -> b}}
How could This be placed on a list for all the values of "a" obtained from the For loop? This so they can be plotted using
ListLinePlot[]
If for each value of CapitalOmega you are getting some {a,{t->b}} from your NDSolve and you just want the list of 'a' values then
Table[First[NDSolve[...],{CapitalOmega,80,130,1/2}]
should do it. The First will extract the 'a' each time and using Table instead of For will put them in a list for you. If my example isn't exactly what your actual code is then you should still be able to use this idea to accomplish what you want.
Note: When I try to paste just your NDSolve[...] into Mathematica I get
NDSolve::ndnum: Encountered non-numerical value for a derivative at t==0.`.
which may be a real problem or may just be because of how you cut and pasted your posting.

Mathematica fast 2D binning algorithm

I am having some trouble developing a suitably fast binning algorithm in Mathematica. I have a large (~100k elements) data set of the form
T={{x1,y1,z1},{x2,y2,z2},....}
and I want to bin it into a 2D array of around 100x100 bins, with the bin value being given by the sum of the Z values that fall into each bin.
Currently I am iterating through each element of the table, using Select to pick out which bin it is supposed to be in based on lists of bin boundaries, and adding the z value to a list of values occupying that bin. At the end I map Total onto the list of bins, summing their contents (I do this because I sometimes want to do other things, like maximize).
I have tried using Gather and other such functions to do this but the above method was ridiculously faster, though perhaps I am using Gather poorly. Anyway It still takes a few minutes to do the sorting by my method and I feel like Mathematica can do better. Does anyone have a nice efficient algorithm handy?
Here is a method based on Szabolcs's post that is about about an order of magnitude faster.
data = RandomReal[5, {500000, 3}];
(*500k values*)
zvalues = data[[All, 3]];
epsilon = 1*^-10;(*prevent 101 index*)
(*rescale and round (x,y) coordinates to index pairs in the 1..100 range*)
indexes = 1 + Floor[(1 - epsilon) 100 Rescale[data[[All, {1, 2}]]]];
res2 = Module[{gb = GatherBy[Transpose[{indexes, zvalues}], First]},
SparseArray[
gb[[All, 1, 1]] ->
Total[gb[[All, All, 2]], {2}]]]; // AbsoluteTiming
Gives about {2.012217, Null}
AbsoluteTiming[
System`SetSystemOptions[
"SparseArrayOptions" -> {"TreatRepeatedEntries" -> 1}];
res3 = SparseArray[indexes -> zvalues];
System`SetSystemOptions[
"SparseArrayOptions" -> {"TreatRepeatedEntries" -> 0}];
]
Gives about {0.195228, Null}
res3 == res2
True
"TreatRepeatedEntries" -> 1 adds duplicate positions up.
I intend to do a rewrite of the code below because of Szabolcs' readability concerns. Until then, know that if your bins are regular, and you can use Round, Floor, or Ceiling (with a second argument) in place of Nearest, the code below will be much faster. On my system, it tests faster than the GatherBy solution also posted.
Assuming I understand your requirements, I propose:
data = RandomReal[100, {75, 3}];
bins = {0, 20, 40, 60, 80, 100};
Reap[
Sow[{#3, #2}, bins ~Nearest~ #] & ### data,
bins,
Reap[Sow[#, bins ~Nearest~ #2] & ### #2, bins, Tr##2 &][[2]] &
][[2]] ~Flatten~ 1 ~Total~ {3} // MatrixForm
Refactored:
f[bins_] := Reap[Sow[{##2}, bins ~Nearest~ #]& ### #, bins, #2][[2]] &
bin2D[data_, X_, Y_] := f[X][data, f[Y][#2, #2~Total~2 &] &] ~Flatten~ 1 ~Total~ {3}
Use:
bin2D[data, xbins, ybins]
Here's my approach:
data = RandomReal[5, {500000, 3}]; (* 500k values *)
zvalues = data[[All, 3]];
epsilon = 1*^-10; (* prevent 101 index *)
(* rescale and round (x,y) coordinates to index pairs in the 1..100 range *)
indexes = 1 + Floor[(1 - epsilon) 100 Rescale[data[[All, {1, 2}]]]];
(* approach 1: create bin-matrix first, then fill up elements by adding zvalues *)
res1 = Module[
{result = ConstantArray[0, {100, 100}]},
Do[
AddTo[result[[##]], zvalues[[i]]] & ## indexes[[i]],
{i, Length[indexes]}
];
result
]; // Timing
(* approach 2: gather zvalues by indexes, add them up, convert them to a matrix *)
res2 = Module[{gb = GatherBy[Transpose[{indexes, zvalues}], First]},
SparseArray[gb[[All, 1, 1]] -> (Total /# gb[[All, All, 2]])]
]; // Timing
res1 == res2
These two approaches (res1 & res2) can handle 100k and 200k elements per second, respectively, on this machine. Is this sufficiently fast, or do you need to run this whole program in a loop?
Here's my approach using the function SelectEquivalents defined in What is in your Mathematica tool bag? which is perfect for a problem like this one.
data = RandomReal[100, {75, 3}];
bins = Range[0, 100, 20];
binMiddles = (Most#bins + Rest#bins)/2;
nearest = Nearest[binMiddles];
SelectEquivalents[
data
,
TagElement -> ({First#nearest[#[[1]]], First#nearest[#[[2]]]} &)
,
TransformElement -> (#[[3]] &)
,
TransformResults -> (Total[#2] &)
,
TagPattern -> Flatten[Outer[List, binMiddles, binMiddles], 1]
,
FinalFunction -> (Partition[Flatten[# /. {} -> 0], Length[binMiddles]] &)
]
If you would want to group according to more than two dimensions you could use in FinalFunction this function to give to the list result the desired dimension (I don't remember where I found it).
InverseFlatten[l_,dimensions_]:= Fold[Partition[#, #2] &, l, Most[Reverse[dimensions]]];

Memoized recursive functions. How to make them fool-proof?

Memoized functions are functions which remember values they have found.
Look in the doc center for some background on this in Mathematica, if necessary.
Suppose you have the following definition
f[0] = f[1] = 1
f[x_] := f[x] = f[x - 1] + f[x - 2]
in one of your packages. A user may load the package and start asking right away f[1000].
This will trigger a $RecursionLimit::reclim error message and abort.
Even if the user then tries something smaller, say f[20], by now the definition of f is corrupt and the result is not good anymore.Of course the package developer might increase the recursion limit and warn the user, but my question is:
How can you improve the f definition so that if the user asks for f[1000] he/she gets the answer without any problem? I am interested in a way to trap the user input, analyze it and take whatever steps are necessary to evaluate f[1000].
I can easily imagine that one can change the recursion limit if the input is more than 255 (and then bring it back to the original level), but what I would really like to see is, if there is a way for the f to find out how many values it "knows" (fknownvalues) and accept any input <=fknownvalues+$RecursionLimit without problems or increase the $RecursionLimit if the input is higher.
Thank you for your help
Here is the code assuming that you can determine a value of $RecursionLimit from the value of the input argument:
Clear[f];
Module[{ff},
ff[0] = ff[1] = 1;
ff[x_] := ff[x] = ff[x - 1] + ff[x - 2];
f[x_Integer] :=f[x] =
Block[{$RecursionLimit = x + 5},
ff[x]
]]
I am using a local function ff to do the main work, while f just calls it wrapped in Block with a proper value for $RecursionLimit:
In[1552]:= f[1000]
Out[1552]= 7033036771142281582183525487718354977018126983635873274260490508715453711819693357974224
9494562611733487750449241765991088186363265450223647106012053374121273867339111198139373125
598767690091902245245323403501
EDIT
If you want to be more precise with the setting of $RecursionLimit, you can modify the part of the code above as:
f[x_Integer] :=
f[x] =
Block[{$RecursionLimit = x - Length[DownValues[ff]] + 10},
Print["Current $RecursionLimit: ", $RecursionLimit];
ff[x]]]
The Print statement is here for illustration. The value 10 is rather arbitrary - to get a lower bound on it, one has to compute the necessary depth of recursion, and take into account that the number of known results is Length[DownValues[ff]] - 2 (since ff has 2 general definitions). Here is some usage:
In[1567]:= f[500]//Short
During evaluation of In[1567]:= Current $RecursionLimit: 507
Out[1567]//Short= 22559151616193633087251269<<53>>83405015987052796968498626
In[1568]:= f[800]//Short
During evaluation of In[1568]:= Current $RecursionLimit: 308
Out[1568]//Short= 11210238130165701975392213<<116>>44406006693244742562963426
If you also want to limit the maximal $RecursionLimit possible, this is also easy to do, along the same lines. Here, for example, we will limit it to 10000 (again, this goes inside Module):
f::tooLarge =
"The parameter value `1` is too large for single recursive step. \
Try building the result incrementally";
f[x_Integer] :=
With[{reclim = x - Length[DownValues[ff]] + 10},
(f[x] =
Block[{$RecursionLimit = reclim },
Print["Current $RecursionLimit: ", $RecursionLimit];
ff[x]]) /; reclim < 10000];
f[x_Integer] := "" /; Message[f::tooLarge, x]]
For example:
In[1581]:= f[11000]//Short
During evaluation of In[1581]:= f::tooLarge: The parameter value 11000 is too
large for single recursive step. Try building the result incrementally
Out[1581]//Short= f[11000]
In[1582]:=
f[9000];
f[11000]//Short
During evaluation of In[1582]:= Current $RecursionLimit: 9007
During evaluation of In[1582]:= Current $RecursionLimit: 2008
Out[1583]//Short= 5291092912053548874786829<<2248>>91481844337702018068766626
A slight modification on Leonid's code. I guess I should post it as a comment, but the lack of comment formatting makes it impossible.
Self adaptive Recursion Limit
Clear[f];
$RecursionLimit = 20;
Module[{ff},
ff[0] = ff[1] = 1;
ff[x_] :=
ff[x] = Block[{$RecursionLimit = $RecursionLimit + 2}, ff[x - 1] + ff[x - 2]];
f[x_Integer] := f[x] = ff[x]]
f[30]
(*
-> 1346269
*)
$RecursionLimit
(*
-> 20
*)
Edit
Trying to set $RecursionLimit sparsely:
Clear[f];
$RecursionLimit = 20;
Module[{ff}, ff[0] = ff[1] = 1;
ff[x_] := ff[x] =
Block[{$RecursionLimit =
If[Length#Stack[] > $RecursionLimit - 5, $RecursionLimit + 5, $RecursionLimit]},
ff[x - 1] + ff[x - 2]];
f[x_Integer] := f[x] = ff[x]]
Not sure how useful it is ...

Circular/Angular slider

A recent SO question reminded me of some code I tried to write a while back. The aim is to make a CircularSlider[] object that can be used for angle-like variables in dynamic objects.
The framework for my solution (below) comes from the ValueThumbSlider[] defined in the Advanced Manipulate Functionality tutorial. The main difference is that in ValueThumbSlider[] the value of the slider and the position of the LocatorPlane[] are the same thing, whilst in my CircularSlider[] they are not - and this leads to problems.
The first problem is that moving the Locator will not change the slider value. This is fixed by using the 2nd argument in the Dynamic: (x = #/Abs[Complex ## #]) &.
This in turn leads to the problem that if you externally set the value of the slider (t) from outside, it will immediately revert to its previous value. This is fixed by keeping the old value (t0) and comparing to t. If they don't match then it's assumed that t has changed and so the Locator position x is updated to its new position.
CircularSlider[t_] := CircularSlider[t, {0, 1}];
CircularSlider[Dynamic[t_], {min_, max_}] /; max > min :=
With[{d = (max - min)/(2. Pi)},
DynamicModule[{td = t/d, x, t0}, x = {Cos[td], Sin[td]};
LocatorPane[
Dynamic[If[!NumberQ[t], t = min; x = {Cos[td], Sin[td]}];
If[t != t0, t0 = t; x = {Cos[td], Sin[td]}];
t = Mod[Arg[Complex ## x] d, max, min]; t0 = t;
x, (x = #/Abs[Complex ## #]) &],
Graphics[{AbsoluteThickness[1.5], Circle[],
Dynamic[{Text[NumberForm[t, {3, 2}], {0, 0}]}]}],
ImageSize -> Small]]]
So my question is: can someone make this work with out the above kludges?
As for problem#1, I wouldn't consider the use of the second argument to Dynamic as a kludge -- that is what the second argument is for. Therefore, I don't have an alternative solution for that one.
Problem #2 can be avoided if you refrain from assigning t in the first argument to Dynamic.
With this in mind, here is another implementation:
CircularSlider2[Dynamic[t_], r:{min_, max_}:{0, 1}] :=
DynamicModule[{scale, toXY, fromXY},
scale = (max - min) / (2. Pi);
toXY[a_?NumberQ] := Through#{Cos, Sin}[a / scale];
toXY[a_] := {1, 0};
fromXY[{x_, y_}] := Mod[Arg[x + I y] scale, max, min];
LocatorPane[
Dynamic[toXY[t], (t = fromXY[#])&],
Graphics[{
AbsoluteThickness[1.5], Circle[],
Dynamic[{Text[NumberForm[t, {3,2}], {0, 0}]}]
}],
ImageSize -> Small
]
]
The only material difference between this version and the original version is that the first argument to Dynamic is an expresssion that is free of side-effects.
Edit
I just stumbled across this undocumented experimental feature in Mathematica 8:
DynamicModule[{x = RandomReal[{0, 50}]},
{Experimental`AngularSlider[Dynamic#x], Dynamic#x}
]

Resources