Nintegration of coupled function

Question

I have function Q[x,t]=p1[x]*u1[t]+p3[x]*u3[t]+p3[x]*u3[t]

where,

p1[x]= -Cos[4.73 x] +   Cosh[4.73 x] -   0.9825 (-Sin[4.73 x] +  Sinh[4.73 x]);
p2[x]= -Cos[7.85 x] +   Cosh[7.85 x] -   1.00077 (-Sin[7.85 x] + Sinh[7.85 x]);
p3[x]= -Cos[10.99 x] +   Cosh[10.99 x] -   0.99996 (-Sin[10.99 x] + Sinh[10.99 x]);

I need to evaluate NIntegrate[(Q[x,t])^3*(p1[x]+p2[x]*p3[x])^3,{x,0,1}]

the final result should be in terms of unknown functions u1[t], u2[t] and u3[t].

Note: using NIntegrate instead of Integrate is to save time because this is repeated many many time in different form. some how i need to do this u[t]*NIntegrate[f[x],{x,0,1}] for all the terms

Answer 1

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:

(*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*)

---

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}]
(*2910.71*)

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}
(*2910.71*)

Answer 2

What about using CoefficientList on the integrand in order to obtain the coefficients?

n = 3;
us = Array[u, n];
ps = {
   -Cos[4.73 x] + Cosh[4.73 x] - 0.9825 (-Sin[4.73 x] + Sinh[4.73 x])
   , -Cos[7.85 x] + Cosh[7.85 x] - 
    1.00077 (-Sin[7.85 x] + Sinh[7.85 x])
   , -Cos[10.99 x] + Cosh[10.99 x] - 
    0.99996 (-Sin[10.99 x] + Sinh[10.99 x])
   };
Q = us.ps;
exp = Q^3*Total[ps]^3;
cl = CoefficientList[exp, us];
integrals = NIntegrate[cl, {x, 0, 1}]; // AbsoluteTiming
integrals

It does not take very long and you can recreate the expression by considering the ordering of CoefficientList (see documentation)

EDIT

You can reconstruct the expression as a linear combination of the powers taken into consideration in CoefficientList as follows

temp = Table[
   us[[1]]^i*us[[2]]^j*us[[3]]^k, {i, 0, 3}, {j, 0, 3}, {k, 0, 3}];
res = Total[integrals*temp, Infinity]

In case you want to check, use random numbers for the us

ureplace = Table[u[i] -> RandomReal[], {i, 3}];
NIntegrate[exp /. ureplace, {x, 0, 1}]
res /. ureplace

10.2957

10.2957