I am a very novice Mathematica user and still can't get my head around its evaluation control, all possible constructs related to it (e.g. Hold, Unevaluated, etc.) and how they work, despite the thorough documentation and the numerous StackExchange and StackOverflow questions discussing this topic. So, apologies for any possible duplicates.
My use case is the following: I have a function (say f) defined by thousands of rules and patterns (DownValues). I want to start from an unrolled representation of f[expr] (for some expr) and get the result of applying a single, particular rule to f[expr]. I want the result to stay unrolled as well.
As a particular example, suppose we have the following:
In[1]: nat[0] := 0
In[2]: nat[n_] := 1 + nat[n - 1]
In[3]: DownValues[nat]
Out[3]: {HoldPattern[nat[0]] :> 0, HoldPattern[nat[n_]] :> 1 + nat[n - 1]}
In[4]: nat[10]
Out[4]: 10
Now, I want to start from an expression represented as nat[10] (unevaluated!) and want to specifically apply the second rule (HoldPattern[nat[n_]] :> 1 + nat[n - 1]) to obtain the expression in the form of 1 + nat[9]. Analogously, shall I wish to apply the first rule (HoldPattern[nat[0]] :> 0), I would expect the result to stay unchanged in its original form, i.e. nat[10].
Thank you for your help!
This should help with your understanding of Mathematica's method of operation.
Wolfram reference : The Ordering of Definitions
I.e. Mathematica "looks for the value of an expression of the form f[n], it tries the special case f[1] first, and only if this does not apply, it tries the general case f[n_]."
So with the functions below nat[0] is always tried first, but of course it only evaluates if the argument is 0. Then nat[n_] is tried.
nat[0] := 0
nat[n_] := 1 + nat[n - 1]
For your question as to obtaining 1 + nat[9] here is one way
Clear[nat]
nat[0] := 0
nat[n_] := HoldForm[1 + nat[o]] /. o -> n - 1
ans = nat[10]
1 + nat[9]
Do[ans = ReleaseHold[ans], 10]
ans
10
Alternatively (and better)
Clear[nat]
nat[0] := 0
nat[n_] := With[{m = n - 1}, HoldForm[1 + nat[m]]]
ans = nat[10]
1 + nat[9]
Do[ans = ReleaseHold[ans], 9]
ans
9 + (1 + nat[0])
Note this is the result after 10 iterations. The final ReleaseHold results in nat[0] evaluating to 0.
ReleaseHold[ans]
10
You might find it easier to see what is happening if you use Hold instead of HoldForm in the above demonstration.
As posted as a reply in a parallel discussion in Mathematica's StackExchange, I found a relatively more direct and straightforward way of dealing with the problem:
In[6] rules = DownValues[nat]
Out[6] {HoldPattern[nat[0]] :> 0, HoldPattern[nat[n_]] :> 1 + nat[n - 1]}
In[7] DownValues[nat] = {}
Out[7] {}
In[8] nat[10]
Out[8] nat[10]
In[9] nat[10] /. rules[[1]]
Out[9] nat[10]
In[10] nat[10] /. rules[[2]]
Out[10] 1 + nat[9]
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.
I'm trying to solve the following problem using Mathematica:
What is the smallest positive integer not obtainable from the set {2,3,4,5,6,7,8} via arithmetic operations {+,-,*,/}, exponentiation, and parentheses. Each number in the set must be used exactly once. Unary operations are NOT allowed (1 cannot be converted to -1 with without using a 0, for example).
For example, the number 1073741824000000000000000 is obtainable via (((3+2)*(5+4))/6)^(8+7).
I am a beginner with Mathematica. I have written code that I believe solves the problems for the set {2,3,4,5,6,7} (I obtained 2249 as my answer), but my code is not efficient enough to work with the set {2,3,4,5,6,7,8}. (My code already takes 71 seconds to run on the set {2,3,4,5,6,7})
I would very much appreciate any tips or solutions to solving this harder problem with Mathematica, or general insights as to how I could speed my existing code.
My existing code uses a brute force, recursive approach:
(* this defines combinations for a set of 1 number as the set of that 1 number *)
combinations[list_ /; Length[list] == 1] := list
(* this tests whether it's ok to exponentiate two numbers including (somewhat) arbitrary restrictions to prevent overflow *)
oktoexponent[number1_, number2_] :=
If[number1 == 0, number2 >= 0,
If[number1 < 0,
(-number1)^number2 < 10000 \[And] IntegerQ[number2],
number1^number2 < 10000 \[And] IntegerQ[number2]]]
(* this takes a list and removes fractions with denominators greater than 100000 *)
cleanup[list_] := Select[list, Denominator[#] < 100000 &]
(* this defines combinations for a set of 2 numbers - and returns a set of all possible numbers obtained via applications of + - * / filtered by oktoexponent and cleanup rules *)
combinations[list_ /; Length[list] == 2 && Depth[list] == 2] :=
cleanup[DeleteCases[#, Null] &#DeleteDuplicates#
{list[[1]] + list[[2]],
list[[1]] - list[[2]],
list[[2]] - list[[1]],
list[[1]]*list[[2]],
If[oktoexponent[list[[1]], list[[2]]], list[[1]]^list[[2]],],
If[oktoexponent[list[[2]], list[[1]]], list[[2]]^list[[1]],],
If[list[[2]] != 0, list[[1]]/list[[2]],],
If[list[[1]] != 0, list[[2]]/list[[1]],]}]
(* this extends combinations to work with sets of sets *)
combinations[
list_ /; Length[list] == 2 && Depth[list] == 3] :=
Module[{m, n, list1, list2},
list1 = list[[1]];
list2 = list[[2]];
m = Length[list1]; n = Length[list2];
cleanup[
DeleteDuplicates#
Flatten#Table[
combinations[{list1[[i]], list2[[j]]}], {i, m}, {j, n}]]]
(* for a given set, partition returns the set of all partitions into two non-empty subsets *)
partition[list_] := Module[{subsets},
subsets = Select[Subsets[list], # != {} && # != list &];
DeleteDuplicates#
Table[Sort#{subsets[[i]], Complement[list, subsets[[i]]]}, {i,
Length[subsets]}]]
(* this finally extends combinations to work with sets of any size *)
combinations[list_ /; Length[list] > 2] :=
Module[{partitions, k},
partitions = partition[list];
k = Length[partitions];
cleanup[Sort#
DeleteDuplicates#
Flatten#(combinations /#
Table[{combinations[partitions[[i]][[1]]],
combinations[partitions[[i]][[2]]]}, {i, k}])]]
Timing[desiredset = combinations[{2, 3, 4, 5, 6, 7}];]
{71.5454, Null}
Complement[
Range[1, 3000], #] &#(Cases[#, x_Integer /; x > 0 && x <= 3000] &#
desiredset)
{2249, 2258, 2327, 2509, 2517, 2654, 2789, 2817, 2841, 2857, 2990, 2998}
This is unhelpful, but I'm under my quota for useless babbling today:
(* it turns out the symbolizing + * is not that useful after all *)
f[x_,y_] = x+y
fm[x_,y_] = x-y
g[x_,y_] = x*y
gd[x_,y_] = x/y
(* power properties *)
h[h[a_,b_],c_] = h[a,b*c]
h[a_/b_,n_] = h[a,n]/h[b,n]
h[1,n_] = 1
(* expand simple powers only! *)
(* does this make things worse? *)
h[a_,2] = a*a
h[a_,3] = a*a*a
(* all symbols for two numbers *)
allsyms[x_,y_] := allsyms[x,y] =
DeleteDuplicates[Flatten[{f[x,y], fm[x,y], fm[y,x],
g[x,y], gd[x,y], gd[y,x], h[x,y], h[y,x]}]]
allsymops[s_,t_] := allsymops[s,t] =
DeleteDuplicates[Flatten[Outer[allsyms[#1,#2]&,s,t]]]
Clear[reach];
reach[{}] = {}
reach[{n_}] := reach[n] = {n}
reach[s_] := reach[s] = DeleteDuplicates[Flatten[
Table[allsymops[reach[i],reach[Complement[s,i]]],
{i,Complement[Subsets[s],{ {},s}]}]]]
The general idea here is to avoid calculating powers (which are
expensive and non-commutative), while at the same time using the
commutativity/associativity of addition/multiplication to reduce the
cardinality of reach[].
Code above also available at:
https://github.com/barrycarter/bcapps/blob/master/playground.m#L20
along with literally gigabytes of other useless code, data, and humor.
I think the answer to your question lays in the command Groupings. This allows you to create a binary tree of a list. The binary tree is very usefull as each of the operations you allow Plus, Subtract, Times, Divide, Power take two arguments. Eg.
In> Groupings[3,2]
Out> {List[List[1,2],3],List[1,List[2,3]]}
Thus all we need to do is replace List with any combination of the allowed operations.
However, Groupings seems to be almighty as it has an option to do this. Imagine you have two functions foo and bar and both take 2 arguments, then you can make all combinations as :
In> Groupings[3,{foo->2,bar->2}]
Out> {foo[foo[1,2],3],foo[1,foo[2,3]],foo[bar[1,2],3],foo[1,bar[2,3]],
bar[foo[1,2],3],bar[1,foo[2,3]],bar[bar[1,2],3],bar[1,bar[2,3]]}
Now it is possible to count the amount of combinations we have :
In> Groupings[Permutations[#],
{Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
] &# {a,b,c,d,e};
In> Length#%
In> DeleteDuplicates#%%
In> Length#%
Out> 1050000
Out> 219352
This means that for 5 distinct numbers, we have 219352 unique combinations.
Sadly, many of these combinations cannot be evaluated due to overflow, division by zero or underflow. However, it is not evident which ones to remove. The value a^(b^(c^(d^e))) could be humongous, or just small. Fractional powers could result in perfect roots and divisions by large numbers can become perfect.
In> Groupings[Permutations[#],
{Plus->2,Subtract->2,Times->2,Divide->2,Power->2}
] &# {2, 3, 4};
In> Union[Cases[%, _?(IntegerQ[#] && # >= 0 &)]];
In> Split[%, #2 - #1 <= 1 &][[1]]
Out> {1, 2, 3, 4, 5, 6}
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
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 ...