Revisions to Nintegration of coupled function

replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/

Source Link

edited Apr 13, 2017 at 12:55

1

I thought of a slightly different approach using the general method proposed here here. I'm not great with Mathematica shortcuts so I'm sure that the code can be simplified, but start by splitting the expression into lists.

typo

Source Link

edited Nov 22, 2016 at 17:54

Marchi

1.9k
10
7

exp = qxt^3*(p1[x] + p2[x]*p3[x]p2[x]+p3[x])^3;
expandexp = Expand@exp;

(*6*8.7796943022 u1[t]^3 + 431.64391985 u1[t]^2 u2[t] + 1744.67136085 u1[t] u2[t]^2 + 
 721.278083727 u2[t]^3 -+ 217.305281899 u1[t]^2 u3[t] + 
 3056.34239567 u1[t] u2[t] u3[t] + 1648.45349372 u2[t]^2 u3[t] + 
 1627.5269564 u1[t] u3[t]^2 + 1845.0886872 u2[t] u3[t]^2 + 415.001219643 u3[t]^3*)

NIntegrate[(p1[x] + p2[x] + p3[x])^3 (p1[x] 1 + p2[x] 2 + p3[x] 3)^3 /. 
    p1 -> p1num /. p2 -> p2num /. p3 -> p3num, {x, 0, 1}]
(*1099*2910.92*71*)

NIntegrate[
   Table[Times @@ 
        Flatten[ints[[i, ;; (Length[ints[[i]]] - 1)]], 1], {i, 1, 
        Length@ints}] /. p1 -> p1num /. p2 -> p2num /. 
    p3 -> p3num, {x, 0, 1}].Table[
   Times @@ Last@ints[[i]], {i, 1, Length@ints}] /. {u1[t] -> 1, 
  u2[t] -> 2, u3[t] -> 3}
(*1099*2910.92*71*)

exp = qxt^3*(p1[x] + p2[x]*p3[x])^3;
expandexp = Expand@exp;

(*6.77969 u1[t]^3 + 4.64391 u1[t]^2 u2[t] + 17.6713 u1[t] u2[t]^2 + 
 7.27808 u2[t]^3 - 2.30528 u1[t]^2 u3[t] + 
 30.3423 u1[t] u2[t] u3[t] + 16.4534 u2[t]^2 u3[t] + 
 16.526 u1[t] u3[t]^2 + 18.0886 u2[t] u3[t]^2 + 4.00121 u3[t]^3*)

NIntegrate[(p1[x] + p2[x] p3[x])^3 (p1[x] 1 + p2[x] 2 + p3[x] 3)^3 /. 
    p1 -> p1num /. p2 -> p2num /. p3 -> p3num, {x, 0, 1}]
(*1099.92*)

NIntegrate[
   Table[Times @@ 
        Flatten[ints[[i, ;; (Length[ints[[i]]] - 1)]], 1], {i, 1, 
        Length@ints}] /. p1 -> p1num /. p2 -> p2num /. 
    p3 -> p3num, {x, 0, 1}].Table[
   Times @@ Last@ints[[i]], {i, 1, Length@ints}] /. {u1[t] -> 1, 
  u2[t] -> 2, u3[t] -> 3}
(*1099.92*)

exp = qxt^3*(p1[x] + p2[x]+p3[x])^3;
expandexp = Expand@exp;

(*8.43022 u1[t]^3 + 31.985 u1[t]^2 u2[t] + 44.6085 u1[t] u2[t]^2 + 
 21.3727 u2[t]^3 + 17.1899 u1[t]^2 u3[t] + 
 56.9567 u1[t] u2[t] u3[t] + 48.9372 u2[t]^2 u3[t] + 
 27.9564 u1[t] u3[t]^2 + 45.872 u2[t] u3[t]^2 + 15.9643 u3[t]^3*)

NIntegrate[(p1[x] + p2[x] + p3[x])^3 (p1[x] 1 + p2[x] 2 + p3[x] 3)^3 /. 
    p1 -> p1num /. p2 -> p2num /. p3 -> p3num, {x, 0, 1}]
(*2910.71*)

NIntegrate[
   Table[Times @@ 
        Flatten[ints[[i, ;; (Length[ints[[i]]] - 1)]], 1], {i, 1, 
        Length@ints}] /. p1 -> p1num /. p2 -> p2num /. 
    p3 -> p3num, {x, 0, 1}].Table[
   Times @@ Last@ints[[i]], {i, 1, Length@ints}] /. {u1[t] -> 1, 
  u2[t] -> 2, u3[t] -> 3}
(*2910.71*)

Source Link

created Nov 22, 2016 at 16:53

Marchi

1.9k
10
7

I thought of a slightly different approach using the general method proposed here. I'm not great with Mathematica shortcuts so I'm sure that the code can be simplified, but start by splitting the expression into lists.

I should mentioned that I assumed Q[x,t] should be:

qxt = p1[x]*u1[t] + p2[x]*u2[t] + p3[x]*u3[t]

though it can easily be changed to the form originally written. The total integrand is

exp = qxt^3*(p1[x] + p2[x]*p3[x])^3;
expandexp = Expand@exp;

Listing the terms:

terms = List @@@ List @@ expandexp;

Split the list based on function type:

elemtest[k_] := MemberQ[k, x, Infinity]
ints = SplitBy[#, elemtest] & /@ terms;

Function definitions:

p1num[x_]:=-Cos[4.73 x]+Cosh[4.73 x]-0.9825 (-Sin[4.73 x]+Sinh[4.73 x])
p2num[x_]:=-Cos[7.85 x]+Cosh[7.85 x]-1.00077 (-Sin[7.85 x]+Sinh[7.85 x])
p3num[x_]:=-Cos[10.99 x]+Cosh[10.99 x]-0.99996 (-Sin[10.99 x]+Sinh[10.99 x])

Now solving the integral:

NIntegrate[
  Table[Times @@ 
       Flatten[ints[[i, ;; (Length[ints[[i]]] - 1)]], 1], {i, 1, 
       Length@ints}] /. p1 -> p1num /. p2 -> p2num /. p3 -> p3num, {x,
    0, 1}].Table[Times @@ Last@ints[[i]], {i, 1, Length@ints}]

Yielding:

(*6.77969 u1[t]^3 + 4.64391 u1[t]^2 u2[t] + 17.6713 u1[t] u2[t]^2 + 
 7.27808 u2[t]^3 - 2.30528 u1[t]^2 u3[t] + 
 30.3423 u1[t] u2[t] u3[t] + 16.4534 u2[t]^2 u3[t] + 
 16.526 u1[t] u3[t]^2 + 18.0886 u2[t] u3[t]^2 + 4.00121 u3[t]^3*)

Verifying the solution:

Checking for u1[t]==1, u2[t]==2, and u3[t]==3 directly:

NIntegrate[(p1[x] + p2[x] p3[x])^3 (p1[x] 1 + p2[x] 2 + p3[x] 3)^3 /. 
    p1 -> p1num /. p2 -> p2num /. p3 -> p3num, {x, 0, 1}]
(*1099.92*)

and using the extraction method:

NIntegrate[
   Table[Times @@ 
        Flatten[ints[[i, ;; (Length[ints[[i]]] - 1)]], 1], {i, 1, 
        Length@ints}] /. p1 -> p1num /. p2 -> p2num /. 
    p3 -> p3num, {x, 0, 1}].Table[
   Times @@ Last@ints[[i]], {i, 1, Length@ints}] /. {u1[t] -> 1, 
  u2[t] -> 2, u3[t] -> 3}
(*1099.92*)

Stack Exchange Network

Return to Answer