# Tag Info

37

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 ...

35

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, ...

22

Yes, there is, although the speed-up is not as dramatic as for 1D memoization: ClearAll[CharlierC]; CharlierC[0, a_, x_] := 1; CharlierC[1, a_, x_] := x - a; CharlierC[n_Integer, a_, x_] := Module[{al, xl}, Set @@ Hold[CharlierC[n, al_, xl_], Expand[(xl - al - n + 1) CharlierC[n - 1, al, xl] - al (n - 1) CharlierC[n - ...

18

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 ...

17

For issues with CompoundExpression, I refer to my answer here http://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 function ...

16

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 ...

15

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 ...

14

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 ...

13

Nice question. This is my suggested implementation. Evaluate all code at once. Clear[CharlierC, "CharlierC*"] CharlierC (* create symbol in current context *) Begin["CharlierC"]; implementation[0] := 1; implementation[1] := x - a; implementation[n_Integer] := implementation[n] = Expand[(x - a - n + 1) implementation[n - 1] - ...

13

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} *) ...

12

Why not just use a recursive definition like you would for a regular Fibonnaci function? ClearAll[fibjoin] fibjoin[0] = {1}; fibjoin[1] = {1, 0}; mem : fibjoin[n_] := mem = Join[fibjoin[n - 1], fibjoin[n - 2]] fibjoin[5] (* {1, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0} *)

11

Nest[Times[#, x] &, x, 5] or Nest[# x &, x, 5] or specifically for your times : Nest[times[x, #] &, x, 5] times[x, times[x, times[x, times[x, times[x, x]]]]]

11

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 ...

11

The error comes from the first line. I am not sure what the second does; finally, you differentiate with respect to s, but have a variable S, which is different. Perhaps you wanted to do this: v = v0*Sin[Pi*s/s0] D[v, s] which works. To see the problem with recursion, run this: ClearAll[v] v = Subscript[v, 0] What is happening is the same that ...

11

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 ...

11

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}]]]; ...

10

I would also suggest to use pure functions here: CharlierC[0] = 1 &; CharlierC[1] = #2 - #1 &; CharlierC[n_Integer] := (CharlierC[n] = Evaluate[ Expand[(#2 - #1 - n + 1) CharlierC[n - 1][#1, #2] - #1 (n - 1) CharlierC[n - 2][#1, #2]]] &); CharlierC[20][a, x] // AbsoluteTiming (* ==> {0.0312414, a^20 - ...

10

You can utilize Dynamic Programming in the following way: CharlierC[0, a_, x_] := 1 CharlierC[1, a_, x_] := x - a CharlierC[n_Integer, a_, x_] := CharlierC[n, a, x] = Expand[Expand[(x - a - n + 1) CharlierC[n - 1, a, x]] - Expand[a (n - 1) CharlieC[n - 2, a, x]]] It basically creates an in-memory store of previous evaluated function values instead of ...

10

I think this should work: ClearAll[r]; r[0, t_] := Exp[-k*t]*Cos[t]; r[n_, t_] := Integrate[r[0, t - td]*r[n - 1, td], {td, 0, t}] eg r[2,t] (* (\[ExponentialE]^(-k t) (2 \[ExponentialE]^(k t) k^2 - k (2 k + t + k^2 t) Cos[t] + (k - k^3 + t + k^2 t) Sin[t]))/(2 (1 + k^2)^2) *)

10

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: ...

10

Use Nest, to kill the recursion, as follows: ClearAll[getNewValues]; getNewValues[{hc_, fl_, out_, temp_}] := Module[{newhc, newfl, newout, newtemp}, newhc = hc + fl; newtemp = newhc/joulesToHeatWater; newout = boltzmanConstant*newtemp^4; newfl = (incomingFlux - newout)*timeStep; {newhc, newfl, newout, newtemp} ]; Then, ...

9

FindShortestTour can solve your problem. You need only choose the greedy algorithm. For example, using the same data as image_doctor: SeedRandom[6]; data = RandomReal[{-10, 10}, {10, 2}]; FindShortestTour[data, Method -> "Greedy"] {61.2702, {1, 7, 2, 3, 6, 4, 10, 5, 9, 8}} Show[ Graphics[{Line[data[[{1, 7, 2, 3, 6, 4, 10, 5, 9, 8}]]], ...

9

Your problem can be reduced to creating an increasing function, phase, and then use Sin[t + phase[t]]. Here is one way to do this by interpolating a sorted list of random numbers: tmax = 40; phase = Interpolation[Sort[RandomReal[10, tmax]]]; Plot[phase[t], {t, 1, tmax}] Plot[{Sin[t], Sin[t + phase[t]]}, {t, 1, tmax}]

9

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 ...

8

As already mentioned, this is a convolution. Luckily, there's a more natural function to use for this problem than Integrate[], and that function is called, appropriately enough, Convolve[]. Now, since Convolve[] assumes an infinite integration region, we need a UnitStep[] multiplier in both the functions being convolved to limit the integration region to a ...

8

If you don't have to program for very long schedules and need the smoothest production schedule, you can minimize the variance of the daily production. I'll show you a way to solve the problem without specifying the list length a priori. This "method" can be used also when there are an unspecified number of homogeneous equations and vars, and you want to ...

8

You can very simply compile if you specify explicitly that fc returns a real; this will get rid of the errors. As pointed out by @asim compilation to "C" does not increase speed in this case. wc = Compile[{{m, _Real, 3}, {a, _Real, 2}, {x, _Real, 1}}, Dot[m, x] + a (*, CompilationTarget -> "C"*)] fc = Compile[{{m, _Real, 3}, {a, _Real, 2}, {c, _Real, ...

8

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, ...

8

Your input is the frequencies at each generation. Let's write them down freq = {{1, 5.15}, {2, 1.47}, {3, 1.47}}; For convenience we might define one of your lines to be a Node[p,g] where p is the x-position and g is the generation. With this you can directly draw lines or use the positions with a Graph. Let's have a look how we can create the complete ...

8

As I attempted to explain here, recursion on lists is more involved in Mathematica than it may seem, in part because lists are implemented as arrays (rather than linked lists) in Mathematica. What I will suggest here is again a solution based on linked lists. It may be a bit harder to understand initially, but arguably it is closer to the true spirit of ...

Only top voted, non community-wiki answers of a minimum length are eligible