Skip to main content

numerical integration - Help For Solving Complicated Function


I have a piece-wise defined function:


a1[x_] = -0.30744074406928307` Cos[1.0065881856430914` x] + 
   0.30744074406928307` Cosh[1.0065881856430914` x] + 
   Sin[1.0065881856430914` x] - Sinh[1.0065881856430914` x];


a2[x_] = 0.0384058298228355` Cos[1.7899950449175461` x] + 
 0.008258500530147013` Cosh[1.7899950449175461` x];

param = {u -> 6/11, y -> 5/11};

\[Phi][x] = 
 Piecewise[{{a1[x], 0 <= x <= u}, {a2[1 - x], u < x <= 1}}, {x, 0, 
    1}] /. param


I can plot it:


Plot[\[Phi][x], {x, 0, 1}]

enter image description here


Now I would like to calculate $n_{PI}$. See here for more details: How to solve this equation numerically or analytically


So... I define some constants:


b = 1;
g = 1;
h = 1;


And try to compute $n_{PI}$:


nom[n_?NumericQ] := 
 NIntegrate[(b \[Phi][x])/(g - n \[Phi][x])^2 + 
   53/100*(h^(1/2) \[Phi][x])/(g - n \[Phi][x])^(3/2) + 
   53/200*(b^(1/4) \[Phi][x])/(g - n \[Phi][x])^(5/4), {x, 0, 1}, 
  Method -> "LocalAdaptive"]

denom[n_?NumericQ] := 
 NIntegrate[(2 b \[Phi][x]^2)/(g - n \[Phi][x])^3 + 
   159/200*(h^(1/2) \[Phi][x]^2)/(g - n \[Phi][x])^(5/2) + 

   53/160*(b^(1/4) \[Phi][x]^2)/(g - n \[Phi][x])^(9/4), {x, 0, 1}, 
  Method -> "LocalAdaptive"]

nPI = FindRoot[n - nom[n]/denom[n] == 0, {n, 0.01}, 
  Method -> {"Newton", "UpdateJacobian" -> 3}]

So far, it seems to work. But then I also want to change the constant b with respect to the x-position so I introduce b as:


b=Piecewise[{{5*10^-6, 0 <= x <= u}, {50*10^-6, u < x <= 1}}, {x, 0, 
    1}] /. param;


But I get the error:



NIntegrate::inumr: The integrand (2 ([Piecewise] Times[<<2>>]+Times[<<2>>]+Sin[<<1>>]+Times[<<2>>] 0<=x<=6/11 1[Plus[<<2>>]] 6/11


)^2)/(1-0.01 Piecewise[{{<<2>>},{<<2>>}},{x,0,1}])^3+(159 ([Piecewise] <<1>>)^2)/(200 (1-0.01 Piecewise[{{<<2>>},{<<2>>}},{x,0,1}])^(5/2))+(53 ([Piecewise] Times[<<2>>]+Times[<<2>>]+Sin[<<1>>]+Times[<<2>>] 0<=x<=6/11 1[Plus[<<2>>]] 6/11


)^2)/(160 (1-0.01 Piecewise[{{<<2>>},{<<2>>}},{x,0,1}])^(9/4)) has evaluated to non-numerical values for all sampling points in the region with boundaries {{6/11,1}}.



Any help would be highly appreciated !!


For easier copy and paste:


a[x_] = -0.30744074406928307` Cos[1.0065881856430914` x] + 
       0.30744074406928307` Cosh[1.0065881856430914` x] + 

       Sin[1.0065881856430914` x] - Sinh[1.0065881856430914` x];

b[x_] = 0.0384058298228355` Cos[1.7899950449175461` x] + 
0.008258500530147013` Cosh[1.7899950449175461` x];
    param = {u -> 6/11, y -> 5/11};

\[Phi][x] = 
     Piecewise[{{a[x], 0 <= x <= u}, {b[1 - x], u < x <= 1}}, {x, 0, 
        1}] /. param


b = Piecewise[{{5*10^-6, 0 <= x <= u}, {50*10^-6, u < x <= 1}}, {x, 0, 
1}] /. param;
g = 1;
h = 1;

nom[n_?NumericQ] := 
     NIntegrate[(b \[Phi][x])/(g - n \[Phi][x])^2 + 
       53/100*(h^(1/2) \[Phi][x])/(g - n \[Phi][x])^(3/2) + 
       53/200*(b^(1/4) \[Phi][x])/(g - n \[Phi][x])^(5/4), {x, 0, 1}, 
      Method -> "LocalAdaptive"]


denom[n_?NumericQ] := 
  NIntegrate[(2 b \[Phi][x]^2)/(g - n \[Phi][x])^3 + 
    159/200*(h^(1/2) \[Phi][x]^2)/(g - n \[Phi][x])^(5/2) + 
    53/160*(b^(1/4) \[Phi][x]^2)/(g - n \[Phi][x])^(9/4), {x, 0, 1}, 
    Method -> "LocalAdaptive"]

 nPI = FindRoot[n - nom[n]/denom[n] == 0, {n, 0.01}, 
    Method -> {"Newton", "UpdateJacobian" -> 3}]

Answer




a1[x_] = -0.30744074406928307` Cos[1.0065881856430914` x] + 
0.30744074406928307` Cosh[1.0065881856430914` x] + 
Sin[1.0065881856430914` x] - Sinh[1.0065881856430914` x];

a2[x_] = 0.0384058298228355` Cos[1.7899950449175461` x] + 
0.008258500530147013` Cosh[1.7899950449175461` x];

param = u -> 6/11;

Ï•[x_] := Piecewise[{{a1[x], 0 <= x <= u}, {a2[1 - x], u < x <= 1}}, {x, 0, 1}] /. param;


b[x_] := Piecewise[{{5*10^-6, 0 <= x <= u}, {50*10^-6, u < x <= 1}}, {x, 0, 1}] /. param;
g = 1;
h = 1;

nom[n_?NumericQ] := 
NIntegrate[(b[x] Ï•[x])/(g - n Ï•[x])^2 + 
53/100*(h^(1/2) Ï•[x])/(g - n Ï•[x])^(3/2) + 
53/200*(b[x]^(1/4) Ï•[x])/(g - n Ï•[x])^(5/4), {x, 0, 1}, 
Method -> "LocalAdaptive"]


denom[n_?NumericQ] := 
NIntegrate[(2 b[x] Ï•[x]^2)/(g - n Ï•[x])^3 + 
159/200*(h^(1/2) Ï•[x]^2)/(g - n Ï•[x])^(5/2) + 
53/160*(b[x]^(1/4) Ï•[x]^2)/(g - n Ï•[x])^(9/4), {x, 0, 1},
Method -> "LocalAdaptive"]

nPI = FindRoot[n - nom[n]/denom[n] == 0, {n, 10}, 
Method -> {"Newton", "UpdateJacobian" -> 3}]


(* {n -> 9.81491} *)

Comments

Post a Comment

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...
Post a Comment
Read more

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...
Post a Comment
Read more