I have given a Set A I have to find the sum of Fibonacci Sum of All the Subsets of A.
Fibonacci(X) - Is the Xth Element of Fibonacci Series
For example, for A = {1,2,3}:
Fibonacci(1) + Fibonacci(2) + Fibonacci(3) + Fibonacci(1+2) + Fibonacci(2+3) + Fibonacci(1+3) + Fibonacci(1+2+3)
1 + 1 + 2 + 2 + 5 + 3 + 8 = 22
Is there any way I can find the sum without generating the subset?
Since I find the Sum of all subset easily
i.e. Sum of All Subset - (1+2+3)*(pow(2,length of set-1))
There surely is.
First, let's recall that the nth Fibonacci number equals
φ(n) = [φ^n - (-φ)^(-n)]/√5
where φ = (√5 + 1)/2 (Golden Ratio) and (-φ)^(-1) = (1-√5)/2. But to make this shorter, let me denote φ as A and (-φ)^(-1) as B.
Next, let's notice that a sum of Fibonacci numbers is a sum of powers of A and B:
[φ(n) + φ(m)]*√5 = A^n + A^m - B^n - B^m
Now what is enough to calc (in the {1,2,3} example) is
A^1 + A^2 + A^3 + A^{1+2} + A^{1+3} + A^{2+3} + A^{1+2+3}.
But hey, there's a simpler expression for this:
(A^1 + 1)(A^2 + 1)(A^3 + 1) - 1
Now, it is time to get the whole result.
Let our set be {n1, n2, ..., nk}. Then our sum will be equal to
Sum = 1/√5 * [(A^n1 + 1)(A^n2 + 1)...(A^nk + 1) - (B^n1 + 1)(B^n2 + 1)...(B^nk + 1)]
I think, mathematically, this is the "simplest" form of the answer as there's no relation between n_i. However, there could be some room for computative optimization of this expression. In fact, I'm not sure at all if this (using real numbers) will work faster than the "straightforward" summing, but the question was about avoiding subsets generation, so here's the answer.
I tested the answer from YakovL using Python 2.7. It works very well and is plenty quick. I cannot imagine that summing the sequence values would be quicker. Here's the implementation.
_phi = (5.**0.5 + 1.)/2.
A = lambda n: _phi**n
B = lambda n: (-_phi)**(-n)
prod = lambda it: reduce(lambda x, y: x*y, it)
subset_sum = lambda s: (prod(A(n)+1 for n in s) - prod(B(n)+1 for n in s))/5**0.5
And here are some test results:
print subset_sum({1, 2, 3})
# 22.0
# [Finished in 0.1s]
print subset_sum({1, 2, 4, 8, 16, 32, 64, 128, 256, 512})
# 7.29199318438e+213
# [Finished in 0.1s]
I have a nasty expression that I am playing around with on Mathematica.
(-X + (2 X - X^2)/(
2 (-1 + X)^2 ((1 + 2 (-1 + p) X - (-1 + p) X^2)/(-1 + X)^2)^(3/2)))/X
I graphed it along with the plane z = 0 where X and p are both restricted from 0 to 1:
Plot3D[{nasty equation is here, 0}, {p , 0, 1}, {X, 0, 1}]
I decided it would be interesting to obtain the equation for the intersection of the plane generated from the nasty equation and z = 0. So I used solve:
Solve[{that nasty equation == 0}, {p, X}, Reals]
and the output was even nastier with some results having the # symbol in it ( I have no idea what it is, and I am new to Mathematica). Is there a way to get an equation for the nice line of intersection between the nasty equation and z = 0 where p and X are restricted from 0 to 1? In the graph generated from Plot3D I see that the line of intersection appears to be some nice looking half parabola looking thing. I would like the equation for that if possible. Thank you!
For complicated nasty equations Reduce is often more powerful and less likely to give you something that you will later find has hidden assumptions inside the result. Notice I include your constraint about the range of p and X to give Reduce the maximum amount of
information that I can to help it produce the simplest possible solution for you.
In[1]:= Reduce[(-X + (2 X-X^2)/(2 (-1 + X)^2 ((1 + 2 (-1 + p) X - (-1 + p) X^2)/
(-1 + X)^2)^(3/2)))/X == 0 && 0 < X < 1 && 0 < p < 1, {X, p}]
Out[1]= 0<X<1 && p == Root[12 - 47*X + 74*X^2 - 59*X^3 + 24*X^4 - 4*X^5 + (-24 +
108*X - 192*X^2 + 168*X^3 - 72*X^4 + 12*X^5)*#1 + (-48*X + 144*X^2 - 156*X^3 +
72*X^4 - 12*X^5)*#1^2 + (-32*X^2 + 48*X^3 - 24*X^4 + 4*X^5)*#1^3 & , 1]
Root is a Mathematica function representing a root of a usually complicated polynomial
that would often be much larger if the actual root were written out in algebra, but we
can see whether the result is understandable enough to be useful by using ToRadicals.
Often Reduce will return several different alternatives using && (and) and || (or) to
let you see the details you must understand to correctly use the result. See how I
copy the entire Root[...] and put that inside ToRadicals. Notice how Reduce returns
answers that include information about the ranges of variables. And see how I give Simplify the domain information about X to allow it to provide the greatest possible simplification.
In[2]:= Simplify[ToRadicals[Root[12 - 47 X + 74 X^2 - 59 X^3 + 24 X^4 - 4 X^5 +
(-24 + 108 X - 192 X^2 + 168 X^3 - 72 X^4 + 12 X^5) #1 + (-48 X + 144 X^2 -
156 X^3 + 72 X^4 - 12 X^5) #1^2 + (-32 X^2 + 48 X^3 - 24 X^4+ 4 X^5)#1^3&,1]],
0 < X < 1]
Out[2]= (8*X - 24*X^2 + 26*X^3 - 12*X^4 + 2*X^5 + 2^(1/3)*(-((-2 + X)^8*(-1 +
X)^2*X^3))^(1/3))/(2*(-2 + X)^3*X^2)
So your desired answer of where z= 0 will be where X is not zero, to avoid 0/0 in
your original equation, and where 0 < X < 1, 0 < p < 1 and where p is a root of that
final complicated expression in X. That result is a fraction and to be a root you
might take a look at where the numerator is zero to see if you can get any more
information about what you are looking for.
Sometimes you can learn something by plotting an expression. If you try to plot that final result you may end up with axes, but no plot. Perhaps the denominator is causing problems. You can try plotting just the numerator. You may again get an empty plot. Perhaps it is your cube root giving complex values. So you can put your numerator inside Re[] and plot that, then repeat that but using Im[]. Those will let you plot just the real and imaginary parts. You are doing this to try to understand where the roots might be. You should be cautious with plots because sometimes, particularly for complicated nasty expressions, the plot can make mistakes or hide desired information from you, but when used with care you can often learn something from this.
And, as always, test this and everything else very carefully to try to make sure that no mistakes have been made. It is too easy to "type some stuff into Mathematica, get some stuff out", think you have the answer and have no idea that there are significant errors hidden.
In an interview today, I was given this sequence, which is sort of a modified Fibonacci:
1, 1, 2, 4, 6, 13, 19, 42, 61, 135, ...,
I was asked to write a function to return the number at place n.
So, if n = 4, the function should return 4, n = 6 return 13, etc.
As I'm sure you already noticed, the difference is that even items equal the previous 4 items, while odd items equal the previous 2.
It isn't a problem if you use recursion. That's what I did, but it's not the approach I would have liked.
The Fibonacci calculation goes something like this (in PHP):
$n = 17;
$phi = (1 + sqrt(5)) / 2;
$u = (pow($phi, $n) - pow(1 - $phi, $n)) / sqrt(5);
$u being, in this case, 1597.
However, I have no idea how to solve it with a modified version of a Fibonacci sequence like this one.
If I understand you correctly, you want to compute efficiently [i.e. in O( log(n) )] sequence defined as:
a[2n + 5] = a[2n + 4] + a[2n + 3] + a[2n + 2] + a[2n + 1]
a[2n + 2] = a[2n + 1] + a[2n]
Let's define two new sequences. First one will correspond to the values of a on even positions, the second one to the values on even positions:
b[n] = a[2n]
c[n] = a[2n + 1]
Now we have:
c[n] = b[n] + c[n - 1] + b[n - 1] + c[n - 2]
b[n] = c[n - 1] + b[n - 1]
Subtracting the second equation from the first we get (after some transformation):
b[n] = ( c[n] - c[n-1] ) /2
Next substitute this formula into first equation to get formula for c:
c[n] = 2 c[n-1] + c[n-2]
Notice that this equation involves only elements from c. Therefore now it is possible to compute elements of c, using techniques described here. By transforming equations a little bit further you will be able to compute b efficiently as well.
Like every sequence defined by a linear recurrence with constant coefficients, the Fibonacci numbers have a closed-form solution.
http://en.wikipedia.org/wiki/Fibonacci_number#Closed-form_expression
However, I do not know how to create a closed form expression for this particular sequence.
What I can add is that you can solve Fibonacci or any similar sequence without recursion, e.g.:
http://forum.codecall.net/topic/41540-fibonacci-with-no-recursion-for-fun/
So you can solve the problem using a loop rather than the stack.
I'm writing a program to do cubic spline interpolation. Basically the program will piece together cubic polynomials over certain intervals. I would like to graph this result if all possible with piecewise[] or another similar function.
In my code I have my equations in an array that outputs like this (for example):
{2+3/4 (-1+X$6836)+1/4 (-1+X$6836)^3,3+3/2 (-2+X$6836)+3/4 (-2+X$6836)^2-1/4 (-2+X$6836)^3}
I also have another array that stores the specific intervals to graph over for each equation above, respectively:
{{1<=X$6836<=2},{2<=X$6836<=3}}
The number of equations in both arrays can be variable so I need to be able to account for this in piecewise[].
Just to make sure I understand you, you mean something like this?
eq = {2 + 3/4 (-1 + x) + 1/4 (-1 + x)^3,
3 + 3/2 (-2 + x) + 3/4 (-2 + x)^2 - 1/4 (-2 + x)^3};
cond = {{1 <= x <= 2}, {2 <= x <= 3}};
p = Piecewise[Thread[{eq, cond}]]
Background. I want to print a table of convergents for 31^(1/2). I made the following recursive definition of the table. ( Exchange 31^(1/2) with the golden ratio and the table below would contain the Fibonacci series ).
cf := ContinuedFraction
tf := TableForm
p[-1] = 0; p[0] = 1; q[-1] = 1; q[0] = 0;
a[k_] := cf[Sqrt[31], k][[k]]
p[k_] := a[k]*p[k - 1] + p[k - 2]
q[k_] := a[k]*q[k - 1] + q[k - 2]
s[n_] := Timing[Table[{k, a[k], p[k], q[k]}, {k, 8, 8 n, 8}]] // tf
Timing increases exponentially fast. I had to alt+. (abort) for s[4].
Question: How to improve ( mathematica ) performance when dealing with recursive functions?
From a quick (not thorough, to admit it) look at your code, it looks like both p and q are defined recursively in terms of two previous values. This means that to calculate the nth value of p, ~2^n evaluations are needed (every step doubles the number). So yes, complexity is exponential, regardless of Mathematica or any other language being used.
If you insist on using a recursive formulation of the problem (e.g. for simplicity), then the simplest way to reduce the performance penalty is using memoization, i.e. doing something like
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
Don't forget to Clear[p] before any redefinition.
In short, memoization means having the function remember the computation result for each input, so subsequent evaluations are faster. It's very likely faster, but more complicated, to compute two values (p_(n+1) and p_(n)) from two previous values (p_(n) and p_(n-1)), then the complexity will be linear instead of exponential.
I hope this helps. I don't have Mathematica here to test right now.
Here is a small further refinement. Since this is a quadratic irrational you can also compute the a[k] coefficients more directly.
In[499]:= Clear[a, p, q, cf]
cf = ContinuedFraction[Sqrt[31]];
cf2len = Length[cf[[2]]];
a[1] = cf[[1]];
a[k_] := cf[[2, Mod[k - 1, cf2len, 1]]]
p[-1] = 0; p[0] = 1; q[-1] = 1; q[0] = 0;
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
q[k_] := q[k] = a[k]*q[k - 1] + q[k - 2]
s[n_] := Timing[Table[{k, a[k], p[k], q[k]}, {k, 8, 8 n, 8}];]
In[508]:= s[1000]
Out[508]= {0.12, Null}
In[509]:= Clear[a, p, q, cf]
cf := ContinuedFraction
p[-1] = 0; p[0] = 1; q[-1] = 1; q[0] = 0;
a[k_] := a[k] = cf[Sqrt[31], k][[k]]
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
q[k_] := q[k] = a[k]*q[k - 1] + q[k - 2]
s[n_] := Timing[Table[{k, a[k], p[k], q[k]}, {k, 8, 8 n, 8}];]
In[516]:= s[1000]
Out[516]= {6.08, Null}
Also you can get a[k] in closed form, though it is not terribly pretty.
In[586]:= Clear[a];
asoln[k_] =
FullSimplify[
a[k] /. First[
RSolve[Join[
Table[a[k] == cf[[2, Mod[k - 1, cf2len, 1]]], {k,
cf2len}], {a[k] == a[k - 8]}], a[k], k]], Assumptions -> k > 0]
Out[587]= (1/(8*Sqrt[2]))*(4*(Cos[(k*Pi)/4] + Sin[(k*Pi)/4])*
(-2*Sqrt[2] + (5 + 2*Sqrt[2])*Sin[(k*Pi)/2]) +
Sqrt[2]*(25 - 9*Cos[k*Pi] + 26*Sin[(k*Pi)/2] - 9*I*Sin[k*Pi]))
Offhand I do not know whether this can be used to get a direct solution for p[k] and q[k]. RSolve seems unable to do that.
--- edit ---
As others have mentioned, it can be cleaner to just build the list from first to last. Here is the handling of p[k], using memoization as above vs NestList.
Clear[a, p, q, cf]
cf = ContinuedFraction[Sqrt[31]];
cf2len = Length[cf[[2]]];
a[1] = cf[[1]];
a[k_] := cf[[2, Mod[k - 1, cf2len, 1]]]
p[-1] = 0; p[0] = 1;
p[k_] := p[k] = a[k]*p[k - 1] + p[k - 2]
s[n_] := Timing[Table[p[k], {k, n}];]
In[10]:= s[100000]
Out[10]= {1.64, Null}
In[153]:= s2[n_] := Timing[ll = Module[{k = 0},
NestList[(k++; {#[[2]], a[k]*#[[2]] + #[[1]]}) &, {0, 1},
n]][[All, 2]];]
In[154]:= s2[100000]
Out[154]= {0.78, Null}
In addition to being somewhat faster, this second approach does not keep a large number of definitions around. And you do not really need them in order to generate more elements, because this iteration can be resumed using a pair from the last elements (make sure they start at 0 and 1 modulo 8).
I will mention that one can obtain a closed form for p[k]. I found it convenient to break the solution into 8 (that is, cf2len) pieces and link them via recurrences. The reasoning behind the scenes comes from basic generating function manipulation. I did some slightly special handling of one equation and one initial condition to finesse the fact that a[1] is not part of the repeating sequence.
In[194]:= func = Array[f, cf2len];
args = Through[func[n]];
firsteqns = {f[2][n] == a[2]*f[1][n] + f[cf2len][n - 1],
f[1][n] == a[9]*f[cf2len][n - 1] + f[cf2len - 1][n - 1]};
resteqns =
Table[f[j][n] == a[j]*f[j - 1][n] + f[j - 2][n], {j, 3, cf2len}];
inits = {f[8][0] == 1, f[1][1] == 5};
eqns = Join[firsteqns, resteqns, inits];
In[200]:=
soln = FullSimplify[args /. First[RSolve[eqns, args, n]],
Assumptions -> n > 0];
In[201]:= FullSimplify[Table[soln, {n, 1, 3}]]
Out[201]= {{5, 6, 11, 39, 206, 657, 863, 1520}, {16063, 17583, 33646,
118521, 626251, 1997274, 2623525, 4620799}, {48831515, 53452314,
102283829, 360303801, 1903802834, 6071712303, 7975515137,
14047227440}}
Quick check:
In[167]:= s2[16]; ll
Out[167]= {1, 5, 6, 11, 39, 206, 657, 863, 1520, 16063, 17583, 33646, \
118521, 626251, 1997274, 2623525, 4620799}
We can now define a function from this.
In[165]:=
p2[k_Integer] := soln[[Mod[k, cf2len, 1]]] /. n -> Ceiling[k/cf2len]
In[166]:= Simplify[p2[4]]
Out[166]= 39
I do not claim that this is particularly useful, just wanted to see if I could actually get something to work.
--- end edit ---
Daniel Lichtblau