2
$\begingroup$

I have a integral equation like following:

pts5 = {{2.4934, 1.2025}, {-2.1256, 
    1.0822}, {-1.3121, -0.5164}, {-2.5570, -2.5323}, {2.6419, -2.1715}};
angles = PolygonAngle[Polygon[pts5], #, "Exterior"]/Pi & /@ pts5;


(*Random Pick two random points on the X-axis*)
x1 = -1;
x2 = 0.4175;

expr1 = (s - x1)^(-angles[[1]])  (s - x2)^(-angles[[2]])  (s - 
      x3)^(-angles[[3]])  (s - x4)^(-angles[[4]]);
dist12 = EuclideanDistance[pts5[[1]], pts5[[2]]];
dist23 = EuclideanDistance[pts5[[2]], pts5[[3]]];
dist34 = EuclideanDistance[pts5[[3]], pts5[[4]]];


NSolve[{Abs[Integrate[expr1, {s, x2, x3}]]/Abs[Integrate[expr1, {s, x1, x2}]] == dist23/dist12, 
  Abs[Integrate[expr1, {s, x3, x4}]]/Abs[Integrate[expr1, {s, x1, x2}]] == dist34/dist12}, {x3, 
  x4}, Reals]

But I cannot solve it, I have tried FindInstance, or even FindRoot. I still fail to solve it. Maybe I need to replace Integrate with NIntegrate, but there are unknown variables in the integrand, so that doesn't work either


Actually I know x3=0.6707 and x4=1. But I don't know hot to get it with MMA..


To further illustrate the problem, I offer a larger set of equations in follwing:

pts36 = {{-0.7279`, 0.5299`}, {-0.6357`, 0.4041`}, {-0.5435`, 
    0.2954`}, {-0.4514`, 0.2038`}, {-0.3595`, 0.1292`}, {-0.2679`, 
    0.07177`}, {-0.1769`, 0.0313`}, {-0.08719`, 0.007603`}, {0, 
    0}, {0.09223`, 0.008507`}, {0.1845`, 0.03403`}, {0.2767`, 
    0.07655`}, {0.3689`, 0.1361`}, {0.461`, 0.2125`}, {0.553`, 
    0.3058`}, {0.6448`, 0.4158`}, {0.7361`, 0.5419`}, {0.8265`, 
    0.6832`}, {0.9151`, 0.8374`}, {1.`, 1.`}, {0.8825`, 
    1.069`}, {0.7474`, 1.13`}, {0.6032`, 1.178`}, {0.4232`, 
    1.221`}, {0.3061`, 1.24`}, {0.1315`, 1.256`}, {0.`, 
    1.26`}, {-0.176`, 1.253`}, {-0.3484`, 1.234`}, {-0.4941`, 
    1.206`}, {-0.6206`, 1.173`}, {-0.7588`, 1.125`}, {-0.8877`, 
    1.066`}, {-1.`, 1.`}, {-0.9124`, 0.8324`}, {-0.8201`, 0.6726`}};
angles = Most[PolygonAngle[Polygon[pts36], #, "Exterior"]/Pi & /@ pts36];

vars = Table[Symbol[TemplateApply["x<*i*>"]], {i, 1, Length[angles]}];
x1 = -1;
x2 = -0.5616;
exprint = Times @@ MapThread[(s - #1)^(-#2) &, {vars, angles}];
dist[index1_, index2_] := EuclideanDistance[pts36[[index1]], pts36[[index2]]];
intfun[x1_, x2_] := With[{exprint = exprint}, NIntegrate[exprint, {s, x1, x2}]];


NSolve[Table[
  Abs[intfun[vars[[th]], vars[[th + 1]]]]/
    Abs[intfun[vars[[1]], vars[[2]]]] == 
   Abs[dist[th, th + 1]]/Abs[dist[1, 2]], {th, 2, 
   Length[angles] - 1}], vars[[3 ;;]]]

And I know that the solution to this equation is:

{-0.4274, -0.3660, -0.3320, -0.3108, -0.2964, -0.2856, -0.2771, \
-0.2690, -0.2612, -0.2532, -0.2448, -0.2360, -0.2269, -0.2180, \
-0.2100, -0.2036, -0.1994, -0.1980, -0.1972, -0.1948, -0.1902, \
-0.1809, -0.1721, -0.1525, -0.1309, -0.0866, -0.0154, 0.0807, 0.2048, \
0.3949, 0.5952, 0.6896, 1.0000}
$\endgroup$
7
  • 1
    $\begingroup$ V 14 gives SystemException["MemoryAllocationFailure"] when trying to do even the indefinite integrate Integrate[expr1,s] so this is hopeless to try to do it this way. $\endgroup$
    – Nasser
    Jan 27 at 8:36
  • $\begingroup$ Can you present your " the system I am dealing with consists of 32 equations"? In another case it's just empty talk. $\endgroup$
    – user64494
    Jan 29 at 17:50
  • $\begingroup$ BTW, I see neither " differential equations" nor "integral equations" in your current question. Integral equations include unknown functions. $\endgroup$
    – user64494
    Jan 29 at 17:56
  • $\begingroup$ @user64494 Thanks for your solution and I updated the question as your comment $\endgroup$
    – yode
    Jan 29 at 19:11
  • $\begingroup$ As far as I understand it, your question is related to a Schwarz–Christoffel map. $\endgroup$
    – user64494
    Jan 30 at 8:41

2 Answers 2

2
$\begingroup$

Replacing your NSolve[...] by

FindMinimum[(Abs[
   NIntegrate[Evaluate[expr1], {s, x2, x3}, AccuracyGoal -> 4, 
    PrecisionGoal -> 4]]/
  Abs[NIntegrate[Evaluate[expr1], {s, x1, x2}, AccuracyGoal -> 4, 
    PrecisionGoal -> 4]] - 
 dist23/dist12)^2 + (Abs[
   NIntegrate[Evaluate[expr1], {s, x3, x4}, AccuracyGoal -> 4, 
    PrecisionGoal -> 4]]/
  Abs[NIntegrate[Evaluate[expr1], {s, x1, x2}, AccuracyGoal -> 4, 
    PrecisionGoal -> 4]] - dist34/dist12)^2, {x3, 1}, {x4, 1}, 
 WorkingPrecision -> 13]

{1.389040764948*10^-14, {x3 -> 0.6708043198243, x4 -> 1.000158525324}}

and 11 warnings (not errors).

$\endgroup$
2
  • $\begingroup$ Do you get a lot of error messages while your code is running? Is there a way to stop them? $\endgroup$
    – yode
    Jan 27 at 16:42
  • $\begingroup$ @yode: Thank you, Decreasing AccuracyGoal -> 5, PrecisionGoal -> 5 to AccuracyGoal -> 4, PrecisionGoal -> 4, I obtain {1.389040764948*10^-14, {x3 -> 0.6708043198243, x4 -> 1.000158525324}} and 11 warnings (not errors). I edited my answer. $\endgroup$
    – user64494
    Jan 27 at 16:47
1
+100
$\begingroup$

For small set of equations we can solve this problem using FindRoot (without error messages) as follows

pts5 = {{2.4934, 1.2025}, {-2.1256, 
    1.0822}, {-1.3121, -0.5164}, {-2.5570, -2.5323}, {2.6419, \
-2.1715}};
angles = 
  Rationalize[PolygonAngle[Polygon[pts5], #, "Exterior"]/Pi & /@ pts5,
    10^-15];


(*Random Pick two random points on the X-axis*)
x1 = -1;
x2 = 0.4175;

expr[x1_, x2_, x3_, 
   x4_] := (s - x1)^(-angles[[1]])   (s - x2)^(-angles[[2]])   (s - 
      x3)^(-angles[[3]])   (s - x4)^(-angles[[4]]);
int12[x3_?NumericQ, x4_?NumericQ] := 
  NIntegrate[expr[x1, x2, x3, x4], {s, x1, x2}, 
   Method -> "LocalAdaptive", AccuracyGoal -> 5, PrecisionGoal -> 5];
int23[x3_?NumericQ, x4_?NumericQ] := 
  NIntegrate[expr[x1, x2, x3, x4], {s, x2, x3}, 
   Method -> "LocalAdaptive", AccuracyGoal -> 5, PrecisionGoal -> 5];
int34[x3_?NumericQ, x4_?NumericQ] := 
  NIntegrate[expr[x1, x2, x3, x4], {s, x3, x4}, 
   Method -> "LocalAdaptive", AccuracyGoal -> 5, PrecisionGoal -> 5];
dist12 = EuclideanDistance[pts5[[1]], pts5[[2]]];
dist23 = EuclideanDistance[pts5[[2]], pts5[[3]]];
dist34 = EuclideanDistance[pts5[[3]], pts5[[4]]];


eq = {Abs[int23[x3, x4]] dist12 - Abs[int12[x3, x4]] dist23, 
   Abs[int34[x3, x4]] dist12 - Abs[int12[x3, x4]] dist34};


FindRoot[eq, {{x3, 1}, {x4, 1}}]
{x3 -> 0.670787, x4 -> 1.00009}
$\endgroup$
2
  • $\begingroup$ It doesn't seem to apply to that larger set of problems $\endgroup$
    – yode
    Feb 5 at 4:44
  • $\begingroup$ @yode Could you show the problem to implement FindRoot to a large set of equations? $\endgroup$ Feb 5 at 10:58

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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