56
Preview and comparative results
The implementation below may be not the most "minimal" one, because I don't use any of the built-in functionality (DictionaryLookup with patterns, Graph-related functions, etc), except the core language functions. However, it uses efficient data structures, such as Trie, linked lists, and hash tables, and arguably maximally ...
49
My solution is a recursive tree traversal algorithm which seeks and searches neighbouring vertices only if it will lead to a word (e.g., Something starting with ZQ is immediately disqualified), but it's faster than yours because I construct the adjacent vertices list from the adjacency matrix rather than calling NeighborhoodGraph each time. On my machine, ...
34
UPDATE
I thought it would be neat to try and animate the thing, so I let the $a$ parameter run between $-\pi$ and $\pi$. I generated 600 images and put them together using ffmpeg. Check it out on youtube.
It might not be in the spirit of Mathematica Stack Exchange, but allow me an objection - stuff that is slow in Mathematica should be kept out of it. To ...
34
Let you have a function and an initial point
f[x_] := Cos[x]
x0 = 0.2;
Then you can calculate a sequence
seq = NestList[f, x0, 10]
(* {0.2, 0.980067, 0.556967, 0.848862, 0.660838, 0.789478, \
0.704216, 0.76212, 0.723374, 0.749577, 0.731977} *)
and vizualize it with a so-called Cobweb plot
p = Join @@ ({{#, #}, {##}} & @@@ Partition[seq, 2, 1]);
...
33
As @RahulNarain says, forming the image point by point saves significant
memory because the number of image pixels is typically much smaller than
the hundreds of millions of iterations that compose it. Therefore, iterate
the attractor equations, and for each point generated, find its location
within the image matrix. Colour coding of the number of hits in ...
30
This is quite easy to achieve by direct manipulation of downvalues. Here's a simple example:
ClearAll[removeDownValues];
SetAttributes[removeDownValues, HoldAllComplete];
removeDownValues[p : f_[___]] :=
DownValues[f] = DeleteCases[
DownValues[f, Sort -> False],
HoldPattern[Verbatim[HoldPattern][p] :> _]
];
Now let's memoize some values:
...
26
str = First@
SubstitutionSystem[{"A" -> "AB+BA+B", "B" -> "B+AAB"}, "A", {7}];
asc = <|"A" -> {1, 0}, "B" -> {0, Pi/2}, "+" -> {0, -Pi/2}|>;
Here {1,0} means go forward 1 step and turn 0 radians. The turtle graphics substitute in Mathematica is AnglePath.
Graphics[
Line@AnglePath@Lookup[asc, Characters[str]]
]
Thanks to @Pillsy, ...
25
What you need is something like this:
patt = Null | (x_ /; MatchQ[x, {_Integer, patt}] )
The trick is to delay the evaluation for the recursive part, until run-time (match attempt), and Condition is one way to do it. So:
MatchQ[#, patt] & /@ {Null, {4, Null}, {3, {4, Null}}, {2, {3, {4, Null}}}, {1, {2, {3, {4, Null}}}}}
(* {True, True, True, True, ...
23
For issues with CompoundExpression, I refer to my answer here
https://stackoverflow.com/questions/4481301/tail-call-optimization-in-mathematica/15292525#15292525
In this answer, I define a function called wrapper, acting as a replacement for CompoundExpression. Also follow this link for a nice answer on tail recursion by Leonid.
I have also made a ...
23
The idea: using continuations
I was preparing my answer when I saw the one by Mr.Wizard, which turns out to be a special case of what I am to offer (and which is generally a common trick that many of us used many times for some recursive problems). I still decided to post it however, since I believe it adds some value. What I will describe here is a version ...
22
One way is to use an extra argument that acts as a switch.
Clear[f];
f[0] = 1;
f[1] = 1;
f[n_, True] := f[n - 1] + f[n - 2]
Example:
f7 = f[7, True]
(* Out[329]= f[5] + f[6] *)
To proceed another step, can do a replacement.
f7 /. f[aa_] :> f[aa, True]
(* Out[330]= f[3] + 2 f[4] + f[5] *)
Can use Nest to repeat this n times.
Nest[# /. f[aa_] :> ...
21
While you've already been told how you can do it, you haven't been told yet why your way doesn't work.
When you write f[something] := something_else what you define is not actually a function, but a pattern replacement rule. Let's look for example at your first try:
f[1] := 1
f[2 n_] := If[Mod[n, 2] == 0, f[n], 2 f[n]]
f[2 n_ + 1] := If[Mod[n, 2] == 0, 2 f[...
21
I revisited this problem - this time in pure Mathematica. The trick to any kind of performance is the Compile[] function, which in itself can be a bit moody - so you need to set global options to warn you when it refuses compilation and work around that. The performance I'm seeing is on the order of magnitude slower than that I get from C++, and two orders ...
20
What you have is what's known in some circles as a linear recurrence. That is, you have a sequence where the general term can be expressed as an appropriate combination of previous terms.
The simplest way of going about it, as has been previously noted, is to use either of Nest[]/NestList[], like so:
NestList[Append[#, Total[Take[#, -2]]] &, {0, 2, 2, ...
answered Oct 23 '15 at 12:01
17
Preamble
I will present a sort of a packaged and automated solution, which uses deques and metaprogramming to automate caching. This should work for most normal pattern-based functions.
Deques
I will use Daniel Lichtblau's implementation for a deque, taken from his great account on Data Structures and Efficient Algorithms in Mathematica. Here it is:
...
17
I'm pretty sure this is a duplicate but I spent 15 minutes looking for it and couldn't find it, so I'm just going to answer for now.
Instead of using Listable you can manually map over non-vector lists:
f[v_?VectorQ] := oper[v]
f[ls_List] := f /@ ls;
f[{{1, 2}, {3, 4}, {5, 6, 7}}]
{oper[{1, 2}], oper[{3, 4}], oper[{5, 6, 7}]}
Extension
In an attempt to ...
16
I'd have done something like this:
f[1] = 1;
f[n_Integer?EvenQ] := f[n] =
Block[{m = n/2}, (1 + Boole[Mod[m, 2] == 1]) f[m]];
f[n_Integer?OddQ] := f[n] =
Block[{m = (n - 1)/2, t}, t = Boole[Mod[m, 2] == 0]; (1 + t) f[m] + t]
The use of both := and = in the odd and even cases is sometimes referred to as memoization; there are a number of threads on this ...
answered Jun 13 '12 at 14:27
16
The kernel crashes due to stack overflow. It is not safe to recurse too deeply. Increasing $RecursionLimit to values that are too great (and actually recursing that deep) risks a crash.
(So yes, in a way it's due to insufficient memory, but it has nothing to do with memoization. It is due to insufficient stack space.)
From the documentation:
On most ...
15
For individual cases I believe the most straight forward solution is simply using Unset:
For instance:
f[x_] := f[x] = x
f[1];
f[2];
f[5];
DownValues[f]
f[5] =.
f[3];
DownValues[f]
(* {HoldPattern[f[1]] :> 1, HoldPattern[f[2]] :> 2, HoldPattern[f[5]] :> 5,
HoldPattern[f[x_]] :> (f[x] = x)} *)
(* {HoldPattern[f[1]] :> 1, ...
15
If you can rewrite the recursion to be tail recursive, you will not run into recursion limits.
Here is an example of a tail-recursive implementation of factorial.
factorial[1, val_: 1] = val;
factorial[k_Integer /; k > 1, val_: 1] := factorial[k - 1, k val]
factorial /@ Range[10]
{1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800}
Block[{$...
15
Is Tribonacci defined?
First you should notice that Tribonacci is not already defined by Mathematica. Compare the defined Fibonacci
?Fibonacci
with
?Tribonacci
You could have guessed by the color of the function in the front-end display, black for defined and blue for undefined.
Fibonacci n-Step Number
Now we can define the even more general ...
15
Using Annuity:
pmt /.Solve[TimeValue[Annuity[pmt, 52, 1], .02, 0] == 5000, pmt]
155.545
Exercise left for the reader...
14
The reason for this message is that the compiled function is called with the symbolic argument SR[n] in the definition of the recurrence relation:
SAcceleration[SR[n]]
CompiledFunction::cfta: "Argument SR[n] at position 1 should be a rank 1 tensor of machine-size real numbers."
-((8980. SR[n])/(4. + SR[n].SR[n])^(3/2))
The recurrence is then evaluated ...
14
You were pretty close.
Here's what I have sticking to your basic construct.
Clear[recurPartition]
recurPartition[l_List, k_Integer] :=
If[Length[l] >= k, Join[{Take[l, k]}, recurPartition[Drop[l, k], k]]]
recurPartition[{1, 2, 3, 4, 5, 6}, 2]
{{1, 2}, {3, 4}, {5, 6}}
Your condition Length[l] >= k is your terminating condition.
To use a ...
14
You are using the same dummy variable for all integrals.
Extended answer
Modify your code slightly and note that all integrals use the same dummy:
BallVolume[dimension_, radius_] :=
If[dimension == 0, 2*radius,
Assuming[radius > 0,
testIntegrate[
BallVolume[dimension - 1, Sqrt[radius^2 - x^2]], {x, -radius,
radius}]]];
BallVolume[2, ...
14
It is so-called Rabbit sequence. One can notice that at each step
$$
0 \to 1, \quad 1 \to 10.
$$
The substitution $0\to1$ corresponds to young rabbits growing old, and $1\to10$ corresponds to old rabbits producing young rabbits.
fib[n_] := Nest[Flatten[# /. {0 -> {1}, 1 -> {1, 0}}] &, {1}, n]
fib[5]
(* {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0} *)
...
14
Since you are using this as an excuse to learn to code in Mathematica, I'll try to help with that in mind. Sometimes I find it nice to design "from the top down", document from the top down, split in many small functions with no state, and go testing them "from the bottom up". As you gain confidence, you will perhaps use coarser functions, and not test every ...
14
A number of points:
First, if you need to compute several values of your sequence, your intial memo-ized implementation will NOT run into recursion limit problems.
Second, if you need to compute very few values, this method is extremely inefficient - the $n$-th Fibonacci number (or the $n$-th term of a linear recurrence in general) can be computed in $\...
14
Not sure if this is what you are looking for, but let´s see (wash, rinse, repeat):
test = {Null, {4,Null}, {3, {4,Null}}, {2, {3, {4,Null}}}, {1, {2, {3, {4, Null}}}},
{}, {Null}, {Null, Null}, {3,4, Null}};
MatchQ[Null, # //. {_Integer, Null} -> Null] & /@ test
(*{True, True, True, True, True, False, False, False, False}*)
Only top voted, non community-wiki answers of a minimum length are eligible
