Skip to main content

differential equations - Numerically integrating solution obtained from NDSolve method


In the following example, $u(x)$ is found numerically using NDSolve method.


 F = 1/1000

h = 12000/1000
d = 10/10
L = 1000
W = 3
phi[x_] :=
Piecewise[{{(1/2)*(1 - Tanh[((L*x)/(d))]),
x <= 1/2}, {(1/2)*(1 + Tanh[((L*(x - L/L))/(d))]), x > 1/2}}]
vE[x_] := x*(1 - x)*4
s = NDSolve[{u''[x] == (h*L*L/(d*d))*phi[x]*phi[x]*u[x] -
F*L*L*(1 - phi[x]), u[-W*d/L] == 0, u[1 + W*d/L] == 0},

u, {x, -W*d/L, 1 + W*d/L}, Method -> "StiffnessSwitching",
WorkingPrecision -> 40, InterpolationOrder -> All]
diff[x_] := (u[x] - vE[x])*(u[x] - vE[x])
Plot[Evaluate[{diff[x]} /. s], {x, W*d/L, 1 - W*d/L},
PlotRange -> All]

Which works perfectly. I need to see what is mean square error between obtained solution and another function $vE(x)$.


sum = 0;
Do[
first = W*d/L;

second = 1 - W*d/L;
{sum = sum + diff[first + (i/100)*(second - first)]},
{i, 0, 100, 1}]
Evaluate[sum]

but this gives only expression but not value. I think this is because $u(x)$ is obtained at discrete points only and is not defined on the points on which I have calculated error. I also tried using integration,


intVal = NIntegrate[({u[x]} /. s - vE[x])*({u[x]} /. s - vE[x]), {x, 
W*d/L, 1 - W*d/L}]

but this gives long error message ending with,



 "...is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing"

How can I evaluate this integral?



Answer



You can integrate the mean square error mse at the same time as computing u[x].


s = NDSolve[{
u''[x] == (h*L*L/(d*d))*phi[x]*phi[x]*u[x] - F*L*L*(1 - phi[x]),
u[-W*d/L] == 0, u[1 + W*d/L] == 0,
mse'[x] == (u[x] - vE[x])^2, mse[-W*d/L] == 0},
{u, mse}, {x, -W*d/L, 1 + W*d/L}, Method -> "StiffnessSwitching",

WorkingPrecision -> 40, InterpolationOrder -> All];

Plot[Evaluate[mse[x] /. s], {x, W*d/L, 1 - W*d/L}, PlotRange -> All]

Mathematica graphics


You seem to be interested in this change:


mse[1 - W*d/L] - mse[W*d/L] /. First@s

(* 8198.070964448656291179158359833465311096 *)




The problem with the code


 intVal = NIntegrate[({u[x]} /. s - vE[x])*({u[x]} /. s - vE[x]), {x, W*d/L, 1 - W*d/L}]

is a syntax issue. The expression that /. tries to apply is s - vE[x]. This can be seen from the TreeForm of the expression:


Hold[({u[x]} /. s - vE[x])] // TreeForm

Mathematica graphics


In other words, ReplaceAll has lower precedence than Plus (represented by the minus sign). The proper code is


intVal = NIntegrate[((u[x] /. First@s) - vE[x])^2, {x, W*d/L, 1 - W*d/L},

WorkingPrecision -> 40]

(* 8198.070964448656291179224357022321689725 *)

Comments

Popular posts from this blog

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-...

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...

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...