1
$\begingroup$

I am working to solve "numerically" the following integral equation IE:

u[x]=f[x]+Integrate[(1/(x-t)^(1/4))*u[t],{t,0,x}]+Integrate[(1/(x-t)^(1/4))*u[t],{t,0,1}]

where

f[x]=(112 (-1 + x)^(3/4) + x(144 (-1 + x)^(3/4) + x (1155 + 256 (-1 + x)^(3/4) -1280 x^(3/4) - (1155 + 512 (-1 + x)^(3/4)) x + 1024 x^(7/4))))/1155

The exact solution for this IE is u[x]=(x^2)*(1-x).

The idea is the use of wavelet expansion as follows:

Any function, as u[x], can be written in the form:

u[x]= Sum[C[j, k]*psijk[x, j, k], Element[j, Integers], Element[k, Integers]]  (Eqn 1)

where

phi[x_] := Piecewise[{{1, 0 <= x < 1}, {0, x < 0}, {0, x >= 1}}]

psi1[x_] := (phi[2 x] - phi[2 x - 1]);

psijk[x_, j_, k_] :=Piecewise[{{(Sqrt[2])^j psi1[2^j x - k],0 <= j}, {(2)^j psi1[2^j (x - k)], j < 0}}];

Eqn 1 can be truncated as

approxsoln[x_] := Sum[C[j, k]*psijk[x, j, k], {j, -n, n}, {k, -m, m}]

I tried for n=2, then k ranges from -4 to 3 (this is from the compact support). So the approximated solution became:

approxsoln[x_] := Sum[C[j, k]*psijk[x, j, k], {j, -2, 2}, {k, -4, 3}]

We need to approximate this IE using the collocation method by choosing 'nice' mesh points as of singularities. Can anybody please help to write a code for solving such integral equation?

Thanks!

$\endgroup$
1
$\begingroup$

To close the question, I will add here a modification of the algorithm, which is described in my answer here.

phi[x_] := Piecewise[{{1, 0 <= x < 1}}, 0]
psi1[x_] := (phi[2 x] - phi[2 x - 1]);
psijk[x_, j_, k_] := 
 Piecewise[{{(Sqrt[2])^j psi1[2^j x - k], 
    0 <= j}, {2^j psi1[2^j (x - k)], j < 0}}]
f[x_] := 1/
    1155 (112 (-1 + x)^(3/4) + 
     x (144 (-1 + x)^(3/4) + 
        x (1155 + 256 (-1 + x)^(3/4) - 
           1280 x^(3/4) - (1155 + 512 (-1 + x)^(3/4)) x + 
           1024 x^(7/4))));
exactsoln[x_] := x^2 (1 - x);
(*u[x]-Integrate[(x-t)^(-1/4)*u[t],{t,0,x}]-Integrate[(x-t)^(-1/4)*u[\
t],{t,0,1}]=f[x];*)
sol[x_, n_] := 
 Sum[c[j, k]*psijk[x, j, k], {j, -n, n}, {k, -2^n, 2^n - 1}]
n = 3; var = 
 Flatten[Table[c[j, k], {j, -n, n, 1}, {k, -2^n, 2^n - 1, 1}]]; np = 
 Length[var]; points = Table[Null, {np}];
Table[points[[i]] = i/np, {i, np}];
eq = ParallelTable[
   sol[points[[i]], n] - 
     Sum[c[j, k]*
       NIntegrate[(points[[i]] - t)^(-1/4)*psijk[t, j, k], {t, 0, 
         points[[i]]}, Exclusions -> {points[[i]] - t == 0}, 
        PrecisionGoal -> 2, WorkingPrecision -> 20, 
        AccuracyGoal -> 2, MaxPoints -> 20], {j, -n, n}, {k, -2^n, 
       2^n - 1}] - 
     Sum[c[j, k]*
       NIntegrate[(points[[i]] - t)^(-1/4)*psijk[t, j, k], {t, 0, 1}, 
        Exclusions -> {points[[i]] - t == 0}, PrecisionGoal -> 2, 
        WorkingPrecision -> 20, AccuracyGoal -> 2, 
        MaxPoints -> 20], {j, -n, n}, {k, -2^n, 2^n - 1}] == 
    f[points[[i]]], {i, 1, np}];
{b, m} = N[CoefficientArrays[eq, var]];
sol1 = LinearSolve[m, -b];
u = Sum[c[j, k]*psijk[x, j, k], {j, -n, n}, {k, -2^n, 2^n - 1}] /. 
   Table[var[[i]] -> sol1[[i]], {i, Length[var]}];
Show[Plot[x^2*(1 - x), {x, 0, 1}, AxesLabel -> {"x", "u"}, 
  PlotStyle -> Blue, PlotLabel -> Row[{"n = ", n}]], 
 Plot[Re[u], {x, 0, 1}, PlotStyle -> Orange]]

fig1

$\endgroup$
  • $\begingroup$ @ Alex why the approximation on the half-right side is not accurate? $\endgroup$ – Mutaz Jun 27 at 6:30
  • $\begingroup$ @Mutaz It is necessary to increase the accuracy of integration. Generally speaking, in the colocation method, integration is replaced by summation. Here I use numerical integration, but this is not effective. $\endgroup$ – Alex Trounev Jun 27 at 16:25

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.