0
$\begingroup$

I am giving my actual problem, but I would also like to understand how to solve such problems in general. I am neither a mathematician nor do I know a lot about Mathematica.

I am looking for a function $y(x,n,q)$ and I have the following equation solving $\overline x$ $$ \frac{2}{3} = \sum_{k=0}^{q-1} {n \choose k} (1-\overline x)^k (\overline x)^{n-k}, $$ and $y(x,n,q)$ should be equal to $$\frac{1}{1- \sum_{k=0}^{q-1} {n \choose k} (1-\overline x+ \int_x^{\overline x}\frac{3-y(z,n,q)}{3} dz )^k (\overline x- \int_x^{\overline x}\frac{3-y(z,n,q)}{3} dz )^{n-k}},$$ and combined these two then yield $y(\overline x,n,q)=3$.

My approach was to convert this into the following differential equation with $\frac{\partial u(x,n,q)}{\partial x}=y(x,n,q)$, i.e, using

$$ \int_x^{\overline x}\frac{3-y(z,n,q)}{3} dz = \overline{x} - x -\frac{u(\overline x,n,q)-u(x,n,q)}{3}, $$

such that

$$ \frac{\partial u(x,n,q)}{\partial x} = \frac{1}{1- \sum_{k=0}^{q-1} {n \choose k} (1- x - \frac{u(\overline{x},n,q)-u(x,n,q)}{3} )^k (x + \frac{u(\overline{x},n,q)-u(x,n,q)}{3})^{n-k}}. $$

Let us say I want to solve this for $q=2$ and $n=10$.

NSolve[{2/3 ==    Sum[Binomial[10, k] (1 - xbar)^k (xbar)^(10 - k), {k, 0, 2 - 1}],   1 >= wbar >= 0}, xbar, Reals]

gives me 0.8821589036184635` and

NDSolve[{y'[x] == 
1/(1 - Sum[
    Binomial[10, k] (1 - x - (y[0.8821589036184635`] - y[x])/3)^
     k (x + (y[0.8821589036184635`] - y[x])/3)^(10 - k), {k, 0, 
     2 - 1}]), y'[0.8821589036184635`] == 3},   y, {x, 0, 1}] // Simplify

NDSolve::icordinit: The initial values for all the dependent variables are not explicitly specified. NDSolve will attempt to find consistent initial conditions for all the variables. NDSolve::idelay: Initial history needs to be specified for all variables for delay-differential equations.

while the same with DSolve gives me

DSolve::bvnul: For some branches of the general solution, the given boundary conditions lead to an empty solution.

However, at least in my imagination, the function I am looking for should not be that complicated. So I am at a loss why Mathematica has an issue here. What am I doing wrong?

EDIT: The curve I am looking for should intuitively look like this enter image description here This is how it would look like in MatLab, but I would love to play with it in Mathematica. q=3; n=10;

syms C k;
summand = nchoosek(n, k)*(1-C)^k * C^(n-k);
C_sum = sum(subs(summand, k, 0:q-1))-2/3; 

assume(C, 'real');
assume(C > 0);
C_sol = solve(C_sum, C);
C = C_sol

syms L x;
summand_nom = nchoosek(n, k)* (1-C+int((3-L)/3, x, C))^k * (C-int((3-L)/3, x, C))^(n-k);
nom = 1 - sum(subs(summand_nom, k, 0:q-1));
L = 1/nom;

figure()
eval_x = linspace(0,1,100);
plot(eval_x, subs(L, x, eval_x))
$\endgroup$
  • $\begingroup$ Using Root[2 - 30 #1^9 + 27 #1^10 &, 1] instead of 0.88215... also doesn't seem to help. $\endgroup$ – Bayesian Nov 19 '19 at 13:32
1
$\begingroup$

Here is a problem with a parameter that can be solved using ParametricNDSolve[]

x0 = 
 xbar /. First[
   NSolve[{2/3 == 
      Sum[Binomial[10, k] (1 - xbar)^k (xbar)^(10 - k), {k, 0, 
        2 - 1}], 1 >= xbar >= 0}, xbar, Reals]]

(*Out[]= 0.882159*)
sol = ParametricNDSolve[{u'[x] == 
    1/(1 - Sum[
        Binomial[10, k] (1 - x - (p - u[x])/3)^
          k (x + (p - u[x])/3)^(10 - k), {k, 0, 2 - 1}]), u[0] == 0}, 
  u, {x, 0, 1}, {p}];
p0 = p /. FindRoot[Evaluate[u[p][x0] /. sol] == p, {p, 1}]

(*Out[]= 2.64648*)
Plot[u[p0][x] /. sol, {x, 0, 1}, AxesLabel -> {"x", "u"}, 
 Epilog -> {Red, PointSize[Medium], Point[{x0, p0}]}]

Figure 1

|improve this answer|||||
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.