Related
Given an integer n, and 2 real sequences {a_1, ..., a_n} and {b_1, ..., b_n}, with a_i, b_i > 0, for all i. For a given fixed m < n let {P_1, ..., P_m} be a partition of the set {1, ..., n} as in P_1 U ... U P_n = {1, ..., n}, with the P_i's pairwise disjoint (empty intersection). I wish to find a partition of size m that maximizes the expression
The number of partitions of the set is n choose m, prohibitively large to do by brute force. Is there an iterative or approximate solution that does better?
For insight into this problem the code block at the end solves via brute-force. For realistic size problems (n ~ 1e6, k ~ 20) it is unusable as is, but easily distrubuted.
Edit: Presorting a, b by the values of a^2/b always gives increasing partition indices:
a = rng.uniform(low=0.0, high=10.0, size=NUM_POINTS)
b = rng.uniform(low=0.0, high=10.0, size=NUM_POINTS)
ind = np.argsort(a/b)
(a,b) = (seq[ind] for seq in (a,b))
a sample run with
NUM_POINTS = 16
PARTITION_SIZE = 3
gives an optimal partition of
[[0, 1, 2, 3, 4, 5, 6, 7], [8, 9], [10, 11]]
which is monotonic in the indices. I think I can prove this. If so, the brute-force search could be improved to n choose k-1 time, still long, but a significant savings.
import numpy as np
import multiprocessing
import concurrent.futures
from functools import partial
from itertools import islice
rng = np.random.RandomState(55)
def knuth_partition(ns, m):
def visit(n, a):
ps = [[] for i in range(m)]
for j in range(n):
ps[a[j + 1]].append(ns[j])
return ps
def f(mu, nu, sigma, n, a):
if mu == 2:
yield visit(n, a)
else:
for v in f(mu - 1, nu - 1, (mu + sigma) % 2, n, a):
yield v
if nu == mu + 1:
a[mu] = mu - 1
yield visit(n, a)
while a[nu] > 0:
a[nu] = a[nu] - 1
yield visit(n, a)
elif nu > mu + 1:
if (mu + sigma) % 2 == 1:
a[nu - 1] = mu - 1
else:
a[mu] = mu - 1
if (a[nu] + sigma) % 2 == 1:
for v in b(mu, nu - 1, 0, n, a):
yield v
else:
for v in f(mu, nu - 1, 0, n, a):
yield v
while a[nu] > 0:
a[nu] = a[nu] - 1
if (a[nu] + sigma) % 2 == 1:
for v in b(mu, nu - 1, 0, n, a):
yield v
else:
for v in f(mu, nu - 1, 0, n, a):
yield v
def b(mu, nu, sigma, n, a):
if nu == mu + 1:
while a[nu] < mu - 1:
yield visit(n, a)
a[nu] = a[nu] + 1
yield visit(n, a)
a[mu] = 0
elif nu > mu + 1:
if (a[nu] + sigma) % 2 == 1:
for v in f(mu, nu - 1, 0, n, a):
yield v
else:
for v in b(mu, nu - 1, 0, n, a):
yield v
while a[nu] < mu - 1:
a[nu] = a[nu] + 1
if (a[nu] + sigma) % 2 == 1:
for v in f(mu, nu - 1, 0, n, a):
yield v
else:
for v in b(mu, nu - 1, 0, n, a):
yield v
if (mu + sigma) % 2 == 1:
a[nu - 1] = 0
else:
a[mu] = 0
if mu == 2:
yield visit(n, a)
else:
for v in b(mu - 1, nu - 1, (mu + sigma) % 2, n, a):
yield v
n = len(ns)
a = [0] * (n + 1)
for j in range(1, m + 1):
a[n - m + j] = j - 1
return f(m, n, 0, n, a)
def Bell_n_k(n, k):
''' Number of partitions of {1,...,n} into
k subsets, a restricted Bell number
'''
if (n == 0 or k == 0 or k > n):
return 0
if (k == 1 or k == n):
return 1
return (k * Bell_n_k(n - 1, k) +
Bell_n_k(n - 1, k - 1))
NUM_POINTS = 13
PARTITION_SIZE = 4
NUM_WORKERS = multiprocessing.cpu_count()
INT_LIST= range(0, NUM_POINTS)
REPORT_EACH = 10000
partitions = knuth_partition(INT_LIST, PARTITION_SIZE)
# Theoretical number of partitions, for accurate
# division of labor
num_partitions = Bell_n_k(NUM_POINTS, PARTITION_SIZE)
bin_ends = list(range(0,num_partitions,int(num_partitions/NUM_WORKERS)))
bin_ends = bin_ends + [num_partitions] if num_partitions/NUM_WORKERS else bin_ends
islice_on = list(zip(bin_ends[:-1], bin_ends[1:]))
# Have to consume it; can't split work on generator
partitions = list(partitions)
rng.shuffle(partitions)
slices = [list(islice(partitions, *ind)) for ind in islice_on]
return_values = [None] * len(slices)
futures = [None] * len(slices)
a = rng.uniform(low=0.0, high=10.0, size=NUM_POINTS)
b = rng.uniform(low=0.0, high=10.0, size=NUM_POINTS)
ind = np.argsort(a/b)
(a,b) = (seq[ind] for seq in (a,b))
def start_task():
print('Starting ', multiprocessing.current_process().name)
def _task(a, b, partitions, report_each=REPORT_EACH):
max_sum = float('-inf')
arg_max = -1
for ind,part in enumerate(partitions):
val = 0
for p in part:
val += sum(a[p])**2/sum(b[p])
if val > max_sum:
max_sum = val
arg_max = part
if not ind%report_each:
print('Percent complete: {:.{prec}f}'.
format(100*len(slices)*ind/num_partitions, prec=2))
return (max_sum, arg_max)
def reduce(return_values):
return max(return_values, key=lambda x: x[0])
task = partial(_task, a, b)
with concurrent.futures.ThreadPoolExecutor() as executor:
for ind,slice in enumerate(slices):
futures[ind] = executor.submit(task, slice)
return_values[ind] = futures[ind].result()
reduce(return_values)
I'm trying to simply re-phrase the problem with sample input, let me know if I missed anything.
A = [1, 3, 2, 1, 4]
B = [2, 1, 5, 3, 1]
n = length(A) = length(B) = 5
We have two lists with positive integers.
We need to find a set of indices S (a subset of N = {1,2,3,..n}), let's assume it's {2,3,5}. Now, we get a new set S' = N - S = {1, 4}
For S and S', (sum(A[S]))^2/(sum(B[S'])) needs to be maximized.
As you said, the approximation solution will work too. One of the heuristics we can use is we need to choose such S so that the values of A list is high and values of B list is
low.
As we take the square of the sum on the subset of A, let's just sort A and choose a sublist so that we get the max score.
import numpy as np
A = np.array([1, 2, 3, 4, 1, 2, 3])
B = np.array([3, 3, 1, 2, 1, 3, 1])
sorted_idx = sorted(range(len(A)), key=lambda k: A[k]) # also other sorting strategy can be used, A[k]/B[k]
A_p = A[sorted_idx]
B_p = B[sorted_idx]
max_s = 0
part_ans = -1
for i in range(len(A_p)):
cur_s = (sum(A_p[:i])**2)/sum(B_p[i:])
if cur_s >= max_s:
print(cur_s)
max_s = cur_s
part_ans = i
print(f'The partitions are: {sorted_idx[:i]} and {sorted_idx[i:]}')
I'm trying to use Ruby's inject to sum an array representing a finite continued fraction, where
[a, b, c, d, e, ... , x] = a + 1/(b + 1/(c + 1/(d + 1/(e + ... 1/x)...)))
I can't figure out how to get the proper nested evaluation to return the correct value using inject.
Instead, what I've written just returns the flat sum of the terms rather than a nested sum. For example,
total = [0, 2, 1, 12, 8].inject do |sum,x|
sum = sum + Rational(1,x)
end
puts total
#=> 41/24
That is,
0 + 1/2 + 1/1 + 1/12 + 1/8 #=> 41/24
instead of
0 + 1/(2 + 1/(1 + 1/(12+1/8))) #=> 105/307, which is the correct value.
Is it possible to compute this type of sum using the inject method?
If not, how can I compute it correctly?
arr = [0, 2, 1, 12, 8]
arr.reverse.reduce { |tot, n| n + Rational(1, tot) }
#=> 105/307
The steps:
a = arr.reverse
#=> [8, 12, 1, 2, 0]
b = a.reduce do |tot ,n|
puts "tot=#{tot}, n=#{n}"
(n + Rational(1, tot)).tap { |r| puts " tot=#{r}" }
end
#=> (105/307)
This prints:
tot=8, n=12
tot=97/8
tot=97/8, n=1
tot=105/97
tot=105/97, n=2
tot=307/105
tot=307/105, n=0
tot=105/307
Alternatively, recursion could be used.
def recurse(arr)
arr.size == 1 ? arr.first : arr.first + Rational(1, recurse(arr.drop(1)))
end
recurse arr
#=> (105/307)
This is an example. I want to know if there is a general way to deal with this kind of problems.
Suppose I have a function (a ε ℜ) :
f[a_, n_Integer, m_Integer] := Sum[a^i k[i],{i,0,n}]^m
And I need a closed form for the coefficient a^p. What is the better way to proceed?
Note 1:In this particular case, one could go manually trying to represent the sum through Multinomial[ ], but it seems difficult to write down the Multinomial terms for a variable number of arguments, and besides, I want Mma to do it.
Note 2: Of course
Collect[f[a, 3, 4], a]
Will do, but only for a given m and n.
Note 3: This question is related to this other one. My application is different, but probably the same methods apply. So, feel free to answer both with a single shot.
Note 4:
You can model the multinomial theorem with a function like:
f[n_, m_] :=
Sum[KroneckerDelta[m - Sum[r[i], {i, n}]]
(Multinomial ## Sequence#Array[r, n])
Product[x[i]^r[i], {i, n}],
Evaluate#(Sequence ## Table[{r[i], 0, m}, {i, 1, n}])];
So, for example
f[2,3]
is the cube of a binomial
x[1]^3+ 3 x[1]^2 x[2]+ 3 x[1] x[2]^2+ x[2]^3
The coefficient by a^k can be viewed as derivative of order k at zero divided by k!. In version 8, there is a function BellY, which allows to construct a derivative at a point for composition of functions, out of derivatives of individual components. Basically, for f[g[x]] and expanding around x==0 we find Derivative[p][Function[x,f[g[x]]][0] as
BellY[ Table[ { Derivative[k][f][g[0]], Derivative[k][g][0]}, {k, 1, p} ] ]/p!
This is also known as generalized Bell polynomial, see wiki.
In the case at hand:
f[a_, n_Integer, m_Integer] := Sum[a^i k[i], {i, 0, n}]^m
With[{n = 3, m = 4, p = 7},
BellY[ Table[{FactorialPower[m, s] k[0]^(m - s),
If[s <= n, s! k[s], 0]}, {s, 1, p}]]/p!] // Distribute
(*
Out[80]= 4 k[1] k[2]^3 + 12 k[1]^2 k[2] k[3] + 12 k[0] k[2]^2 k[3] +
12 k[0] k[1] k[3]^2
*)
With[{n = 3, m = 4, p = 7}, Coefficient[f[a, n, m], a, p]]
(*
Out[81]= 4 k[1] k[2]^3 + 12 k[1]^2 k[2] k[3] + 12 k[0] k[2]^2 k[3] +
12 k[0] k[1] k[3]^2
*)
Doing it this way is more computationally efficient than building the entire expression and extracting coefficients.
EDIT The approach here outlined will work for symbolic orders n and m, but requires explicit value for p. When using it is this circumstances, it is better to replace If with its Piecewise analog, e.g. Boole:
With[{p = 2},
BellY[Table[{FactorialPower[m, s] k[0]^(m - s),
Boole[s <= n] s! k[s]}, {s, 1, p}]]/p!]
(* 1/2 (Boole[1 <= n]^2 FactorialPower[m, 2] k[0]^(-2 + m)
k[1]^2 + 2 m Boole[2 <= n] k[0]^(-1 + m) k[2]) *)
What's the best way of getting Mathematica 7 or 8 to do the integral
NIntegrate[Exp[-x]/Sin[Pi x], {x, 0, 50}]
There are poles at every integer - and we want the Cauchy principle value.
The idea is to get a good approximation for the integral from 0 to infinity.
With Integrate there is the option PrincipleValue -> True.
With NIntegrate I can give it the option Exclusions -> (Sin[Pi x] == 0), or manually give it the poles by
NIntegrate[Exp[-x]/Sin[Pi x], Evaluate[{x, 0, Sequence##Range[50], 50}]]
The original command and the above two NIntegrate tricks give the result 60980 +/- 10. But they all spit out errors. What is the best way of getting a quick reliable result for this integral without Mathematica wanting to give errors?
Simon, is there reason to believe your integral is convergent ?
In[52]:= f[k_Integer, eps_Real] :=
NIntegrate[Exp[-x]/Sin[Pi x], {x, k + eps, k + 1 - eps}]
In[53]:= Sum[f[k, 1.0*10^-4], {k, 0, 50}]
Out[53]= 2.72613
In[54]:= Sum[f[k, 1.0*10^-5], {k, 0, 50}]
Out[54]= 3.45906
In[55]:= Sum[f[k, 1.0*10^-6], {k, 0, 50}]
Out[55]= 4.19199
It looks like the problem is at x==0. Splitting integrand k+eps to k+1-eps for integer values of k:
In[65]:= int =
Sum[(-1)^k Exp[-k ], {k, 0, Infinity}] Integrate[
Exp[-x]/Sin[Pi x], {x, eps, 1 - eps}, Assumptions -> 0 < eps < 1/2]
Out[65]= (1/((1 +
E) (I + \[Pi])))E (2 E^(-1 + eps - I eps \[Pi])
Hypergeometric2F1[1, (I + \[Pi])/(2 \[Pi]), 3/2 + I/(2 \[Pi]),
E^(-2 I eps \[Pi])] +
2 E^(I eps (I + \[Pi]))
Hypergeometric2F1[1, (I + \[Pi])/(2 \[Pi]), 3/2 + I/(2 \[Pi]),
E^(2 I eps \[Pi])])
In[73]:= N[int /. eps -> 10^-6, 20]
Out[73]= 4.1919897038160855098 + 0.*10^-20 I
In[74]:= N[int /. eps -> 10^-4, 20]
Out[74]= 2.7261330651934049862 + 0.*10^-20 I
In[75]:= N[int /. eps -> 10^-5, 20]
Out[75]= 3.4590554287709991277 + 0.*10^-20 I
As you see there is a logarithmic singularity.
In[79]:= ser =
Assuming[0 < eps < 1/32, FullSimplify[Series[int, {eps, 0, 1}]]]
Out[79]= SeriesData[eps, 0, {(I*(-1 + E)*Pi -
2*(1 + E)*HarmonicNumber[-(-I + Pi)/(2*Pi)] +
Log[1/(4*eps^2*Pi^2)] - 2*E*Log[2*eps*Pi])/(2*(1 + E)*Pi),
(-1 + E)/((1 + E)*Pi)}, 0, 2, 1]
In[80]:= Normal[
ser] /. {{eps -> 1.*^-6}, {eps -> 0.00001}, {eps -> 0.0001}}
Out[80]= {4.191989703816426 - 7.603403526913691*^-17*I,
3.459055428805136 -
7.603403526913691*^-17*I,
2.726133068607085 - 7.603403526913691*^-17*I}
EDIT
Out[79] of the code above gives the series expansion for eps->0, and if these two logarithmic terms get combined, we get
In[7]:= ser = SeriesData[eps, 0,
{(I*(-1 + E)*Pi - 2*(1 + E)*HarmonicNumber[-(-I + Pi)/(2*Pi)] +
Log[1/(4*eps^2*Pi^2)] - 2*E*Log[2*eps*Pi])/(2*(1 + E)*
Pi),
(-1 + E)/((1 + E)*Pi)}, 0, 2, 1];
In[8]:= Collect[Normal[PowerExpand //# (ser + O[eps])],
Log[eps], FullSimplify]
Out[8]= -(Log[eps]/\[Pi]) + (
I (-1 + E) \[Pi] -
2 (1 + E) (HarmonicNumber[-((-I + \[Pi])/(2 \[Pi]))] +
Log[2 \[Pi]]))/(2 (1 + E) \[Pi])
Clearly the -Log[eps]/Pi came from the pole at x==0. So if one subtracts this, just like principle value method does this for other poles you end up with a finitely value:
In[9]:= % /. Log[eps] -> 0
Out[9]= (I (-1 + E) \[Pi] -
2 (1 + E) (HarmonicNumber[-((-I + \[Pi])/(2 \[Pi]))] +
Log[2 \[Pi]]))/(2 (1 + E) \[Pi])
In[10]:= N[%, 20]
Out[10]= -0.20562403655659928968 + 0.*10^-21 I
Of course, this result is difficult to verify numerically, but you might know more that I do about your problem.
EDIT 2
This edit is to justify In[65] input that computes the original regularized integral. We are computing
Sum[ Integrate[ Exp[-x]/Sin[Pi*x], {x, k+eps, k+1-eps}], {k, 0, Infinity}] ==
Sum[ Integrate[ Exp[-x-k]/Sin[Pi*(k+x)], {x, eps, 1-eps}], {k, 0, Infinity}] ==
Sum[ (-1)^k*Exp[-k]*Integrate[ Exp[-x]/Sin[Pi*x], {x, eps, 1-eps}],
{k, 0, Infinity}] ==
Sum[ (-1)^k*Exp[-k], {k, 0, Infinity}] *
Integrate[ Exp[-x]/Sin[Pi*x], {x, eps, 1-eps}]
In the third line Sin[Pi*(k+x)] == (-1)^k*Sin[Pi*x] for integer k was used.
Simon, I haven't spent much time with your integral, but you should try looking at stationary phase approximation. What you have is a smooth function (exp), and a highly oscillatory function (sine). The work involved is now in brow-beating the 1/sin(x) into the form exp(if(x))
Alternatively, you could use the series expansion of the cosecant (not valid at poles):
In[1]:=Series[Csc[x], {x, 0, 5}]
(formatted) Out[1]=1/x + x/6 + 7/360 x^3 + 31/15120 x^5 +O[x]^6
Note that for all m>-1, you have the following:
In[2]:=Integrate[x^m Exp[-x], {x, 0, Infinity}, Assumptions -> m > -1]
Out[2]=Gamma[1+m]
However, summing the series with the coefficients of cosecant (from wikipedia), not including 1/x Exp[-x] case, which doesn't converge on [0,Infinity].
c[m_] := (-1)^(m + 1) 2 (2^(2 m - 1) - 1) BernoulliB[2 m]/Factorial[2 m];
Sum[c[m] Gamma[1 + 2 m - 1], {m, 1, Infinity}]
does not converge either...
So, I'm not sure that you can work out an approximation for the integral to infinity, but I if you're satisfied with a solution upto some large N, I hope these help.
I have to agree with Sasha, the integral does not appear to be convergent. However, if you exclude x == 0 and break the integral into pieces
Integrate[Exp[-x]/Sin[Pi x], {x, n + 1/2, n + 3/2}, PrincipalValue -> True]
where n >= 0 && Element[n, Integers], then it seems you may get an alternating series
I Sum[ (-1/E)^n, {n, 1, Infinity}] == - I / (1 + E )
Now, I only took it out to n == 4, but it looks reasonable. However, for the integral above with Assumptions -> Element[n, Integers] && n >= 0 Mathematica gives
If[ 2 n >= 1, - I / E, Integrate[ ... ] ]
which just doesn't conform to the individual cases. As an additional note, if the pole lies at the boundary of the integration region, i.e. your limits are {x, n, n + 1}, you only get DirectedInfinitys. A quick look at the plot implies that you with the limits {x, n, n + 1} you only have a strictly positive or negative integrand, so the infinite value may be due to the lack of compensation which {x, n + 1/2, n + 3/2} gives you. Checking with {x, n, n + 2}, however it only spits out the unevaluated integral.
I have a polynomial in x, for example,
x^4/s + x^3 + x^2*s + x^3*s^2 + x
What I want to do is:
based on the result of (the exponent of x) mod 3,
if it's 0, change the x^* to 1;
if it's 1, change the x^* to 2;
if it is 2, change x^* to 3.
So I want to get:
x^4 => 2
x^3 => 1
x^2 => 3
x^1 => 2
therefore, for the given example, I get
2/s+1+3s+s^2+2
How to do this programmably? Thanks!
The following:
(x^4/s + x^3 + x^2*s + x^3*s^2 + x) /. x^(a : _ : 1) :> (Mod[a, 3] + 1)
seems to do it.
Edit: Answering the comment:
In[4]:= (x^4/s + x^3 + x^2*s + x^3*s^2 + x) /.
x^(a : _ : 1) :> (Mod[a, 3] /. {0 :> m, 1 :> n, 2 :> p})
Out[4]= m + n + n/s + p s + m s^2