dharr

Dr. David Harrington

8477 Reputation

22 Badges

21 years, 33 days
University of Victoria
Professor or university staff
Victoria, British Columbia, Canada

Social Networks and Content at Maplesoft.com

Maple Application Center
I am a retired professor of chemistry at the University of Victoria, BC, Canada. My research areas are electrochemistry and surface science. I have been a user of Maple since about 1990.

MaplePrimes Activity


These are answers submitted by dharr

I'm not sure why it is so slow. Note you should always use add instead of sum (convert to 1-D notation to see that you have sum).

Here's a simple way that just uses coeff. You could modify it to add conjugate etc, but it might be more efficient to substitute these in later.

restart

N := 6

6

NN := U^5*V^4

U^5*V^4

NN2 := eval(NN, {U = add(u[i]*lambda^i, i = 0 .. N), V = add(v[i]*lambda^i, i = 0 .. N)})

(lambda^6*u[6]+lambda^5*u[5]+lambda^4*u[4]+lambda^3*u[3]+lambda^2*u[2]+lambda*u[1]+u[0])^5*(lambda^6*v[6]+lambda^5*v[5]+lambda^4*v[4]+lambda^3*v[3]+lambda^2*v[2]+lambda*v[1]+v[0])^4

NN3 := collect(expand(NN2), lambda); length(NN3); nops(NN3); d := degree(NN3, lambda)

6292164

55

54

for i from 0 to N do A[i] := coeff(NN3, lambda, i); print(i, nops(A[i])) end do

0, 2

1, 2

2, 5

3, 10

4, 20

5, 35

6, 61

A[4]

4*u[0]^5*v[0]^3*v[4]+12*u[0]^5*v[0]^2*v[1]*v[3]+6*u[0]^5*v[0]^2*v[2]^2+12*u[0]^5*v[0]*v[1]^2*v[2]+u[0]^5*v[1]^4+20*u[0]^4*u[1]*v[0]^3*v[3]+60*u[0]^4*u[1]*v[0]^2*v[1]*v[2]+20*u[0]^4*u[1]*v[0]*v[1]^3+20*u[0]^4*u[2]*v[0]^3*v[2]+30*u[0]^4*u[2]*v[0]^2*v[1]^2+20*u[0]^4*u[3]*v[0]^3*v[1]+5*u[0]^4*u[4]*v[0]^4+40*u[0]^3*u[1]^2*v[0]^3*v[2]+60*u[0]^3*u[1]^2*v[0]^2*v[1]^2+80*u[0]^3*u[1]*u[2]*v[0]^3*v[1]+20*u[0]^3*u[1]*u[3]*v[0]^4+10*u[0]^3*u[2]^2*v[0]^4+40*u[0]^2*u[1]^3*v[0]^3*v[1]+30*u[0]^2*u[1]^2*u[2]*v[0]^4+5*u[0]*u[1]^4*v[0]^4

(eval(diff(NN3, `$`(lambda, 4)), lambda = 0))/factorial(4)

4*u[0]^5*v[0]^3*v[4]+12*u[0]^5*v[0]^2*v[1]*v[3]+6*u[0]^5*v[0]^2*v[2]^2+12*u[0]^5*v[0]*v[1]^2*v[2]+u[0]^5*v[1]^4+20*u[0]^4*u[1]*v[0]^3*v[3]+60*u[0]^4*u[1]*v[0]^2*v[1]*v[2]+20*u[0]^4*u[1]*v[0]*v[1]^3+20*u[0]^4*u[2]*v[0]^3*v[2]+30*u[0]^4*u[2]*v[0]^2*v[1]^2+20*u[0]^4*u[3]*v[0]^3*v[1]+5*u[0]^4*u[4]*v[0]^4+40*u[0]^3*u[1]^2*v[0]^3*v[2]+60*u[0]^3*u[1]^2*v[0]^2*v[1]^2+80*u[0]^3*u[1]*u[2]*v[0]^3*v[1]+20*u[0]^3*u[1]*u[3]*v[0]^4+10*u[0]^3*u[2]^2*v[0]^4+40*u[0]^2*u[1]^3*v[0]^3*v[1]+30*u[0]^2*u[1]^2*u[2]*v[0]^4+5*u[0]*u[1]^4*v[0]^4

NULL

Download Adom.mw

 

Entering control key (command on Mac) and = in the region with the integral generates the following output, so gives part of what you want. This is also available on the right-click context menu as "evaluate and display inline".

int(x^2, x = 0 .. a) = (1/3)*a^3

NULL

Download 5.3-Definite-Integral.mw

I ran this system with the latest version of my code, with roughly similar times to yours (and same results).

There are three calculations in the main loop - the laplace calculations, calculating and substituting into the Adomian polynomials, and evaluating the linear part. Code profiling shows that for the non-fractional order case, most of the time is spent evaluating the linear part, much to my surprise. (I'd expected the laplace calcs would be limiting.) At the moment, I can't see a way to speed this up - you need to take derivatives and simplify - if you don't simplify at each iteration then, as @acer pointed out, the u[i] components quickly become too large.

For the fractional-order case the time is divided between the linear part and the Adomian polynomials. The Adomian procedure can perhaps be speeded up; I'll look a bit more closely at that.

LAD code in startup region

restart

pde0 := I*(diff(U(x, t), t))+diff(U(x, t), `$`(x, 2))+U(x, t)^2*conjugate(U(x, t)) = 0

I*(diff(U(x, t), t))+diff(diff(U(x, t), x), x)+U(x, t)^2*conjugate(U(x, t)) = 0

exact := -sqrt(-2*C)*sqrt(-B/C)*sech(sqrt(B)*(-2*k*t+`ξ__0`+x))*exp(I*(k*x+(-k^2+B)*t)); `assuming`([pdetest(U(x, t) = exact, pde0)], [real, B > 0, C > 0])

-(-2*C)^(1/2)*(-B/C)^(1/2)*sech(B^(1/2)*(-2*k*t+x+xi__0))*exp(I*(k*x+(-k^2+B)*t))

0

params := convert({`ξ__0` = -6.27, B = 1.98, C = 1.53, k = -.51}, rational)

{B = 99/50, C = 153/100, k = -51/100, xi__0 = -627/100}

exactnum := eval(exact, params)

inx := eval(exact, `union`({t = 0}, params)); evalf(inx)

-(1/850)*(-153)^(1/2)*50^(1/2)*(-22)^(1/2)*17^(1/2)*sech((1/50)*99^(1/2)*50^(1/2)*(x-627/100))*exp(-((51/100)*I)*x)

1.989974874*sech(1.407124728*x-8.822672044)*exp(-(.5100000000*I)*x)

infolevel[LAD] := 3

First try the non-fractional order case

approx := LAD(pde0, U(x, t), inx, t, 20)

LAD: L = I*U[t]; R = -U[x,x]; N = -U^2*C; G = 0.

LAD: nonlinear expansion variables (conjugated functions denoted by C) are: [C, U]

LAD: calculating component 1 at time 0.

LAD: calculating component 2 at time .457

LAD: calculating component 3 at time 1.052

LAD: calculating component 4 at time 1.910

LAD: calculating component 5 at time 2.871

LAD: calculating component 6 at time 4.030

LAD: calculating component 7 at time 5.190

LAD: calculating component 8 at time 6.865

LAD: calculating component 9 at time 8.275

LAD: calculating component 10 at time 10.140

LAD: calculating component 11 at time 12.150

LAD: calculating component 12 at time 14.456

LAD: calculating component 13 at time 16.663

LAD: calculating component 14 at time 19.535

LAD: calculating component 15 at time 22.181

LAD: calculating component 16 at time 25.788

LAD: calculating component 17 at time 29.121

LAD: calculating component 18 at time 33.699

LAD: calculating component 19 at time 37.828

LAD: calculating component 20 at time 43.992

LAD: completed at time 49.084

plot3d([abs(exactnum), abs(approx)], x = -2 .. 2, t = 0 .. 5, color = [red, blue], view = [default, default, 0 .. 4])

Plot with 10 components - worse agreement

Fractional order case

approx := LAD(pde0, U(x, t), inx, t, 5, fracorder = .6)

LAD: L = I*U[t]; R = -U[x,x]; N = -U^2*C; G = 0.

LAD: nonlinear expansion variables (conjugated functions denoted by C) are: [C, U]

LAD: calculating component 1 at time 0.

LAD: calculating component 2 at time .410

LAD: calculating component 3 at time 2.040

LAD: calculating component 4 at time 7.263

LAD: calculating component 5 at time 19.797

LAD: completed at time 57.948

Look at the first few components - agree with OP's calc.

infolevel[LAD] := 4

approx := LAD(pde0, U(x, t), inx, t, 2, fracorder = .6)

LAD: L = I*U[t]; R = -U[x,x]; N = -U^2*C; G = 0.

LAD: nonlinear expansion variables (conjugated functions denoted by C) are: [C, U]

LAD: component 0 = 3/5*11^(1/2)*sech(3/1000*22^(1/2)*(100*x-627))*exp(-51/100*I*x)

LAD: calculating component 1 at time 0.

LAD: component 1 = 9/10000*11^(1/2)/GAMMA(3/5)*(-340*tanh(3/1000*22^(1/2)*(100*x-627))*22^(1/2)+1911*I)*sech(3/1000*22^(1/2)*(100*x-627))*exp(-51/100*I*x)*t^(3/5)

LAD: calculating component 2 at time .594

LAD: component 2 = -81/80000000*2^(1/2)*sech(3/1000*22^(1/2)*(100*x-627))*(5086400*2^(1/2)*11^(1/2)*sech(3/1000*22^(1/2)*(100*x-627))^2+28588560*I*tanh(3/1000*22^(1/2)*(100*x-627))+1108721*11^(1/2)*2^(1/2))*exp(-51/100*I*x)*t^(6/5)/Pi*GAMMA(4/5)*sin(1/5*Pi)

LAD: completed at time 1.560

NULL

Download LADtest.mw

restart

You didn't specify a value for n so Maple gave you a general formula valid for any n.

z := sum((-2)^j/(j-2)^2, j = 3 .. n)

4*polylog(2, -2)+2^(n+1)*(1+(-2*n^2+4*n-2)*LerchPhi(-2, 2, n))*(-1)^n/(-1+n)^2

The polylog and LerchPhi functions are mathematical functions described on their respective help pages. Highlight polylog and hit the F2 finction key or type ?polylog to see the help page.
You could, for example plot your result as a function of n.

plots:-pointplot([seq([n, z], n = 3 .. 15)])

Sometimes, results like these can be converted to simpler functions, but not here.

convert(z, elementary)

4*polylog(2, -2)+2^(n+1)*(1+(-2*n^2+4*n-2)*LerchPhi(-2, 2, n))*(-1)^n/(-1+n)^2

If we want the value for a particular value of n:

simplify(eval(z, n = 6))

-32/9

Which we could have obtained directly.

sum((-2)^j/(j-2)^2, j = 3 .. 6)

-32/9

NULL

Download polylog.mw

Perhaps there is some error in pdetest, or you have a better method of verifying the solution, but my guess is the exact solution is incorrect.

restart

pde := I*(diff(U(x, t), t))+diff(U(x, t), `$`(x, 2))+U(x, t)^2*conjugate(U(x, t)); exact := -I*sqrt(2)*tanh(2*k*t-x)*exp(I*(k*x+(-k^2-2)*t)); `assuming`([simplify(pdetest(U(x, t) = exact, pde))], [real])

I*(diff(U(x, t), t))+diff(diff(U(x, t), x), x)+U(x, t)^2*conjugate(U(x, t))

-I*2^(1/2)*tanh(2*k*t-x)*exp(I*(k*x+(-k^2-2)*t))

(4*I)*2^(1/2)*exp(-I*(k^2*t-k*x+2*t))*(-exp(12*k*t)+3*exp(8*k*t+2*x)-3*exp(4*k*t+4*x)+exp(6*x))/(exp(4*k*t)+exp(2*x))^3

For this to be zero, we must have -exp(12*k*t)+3*exp(8*k*t+2*x)-3*exp(4*k*t+4*x)+exp(6*x) = 0.  For this to be true, k must be

solve(exact, k)

(1/2)*x/t

suggesting we cannot have a k value which gives a valid solution over all x,t.

`assuming`([simplify(eval(subs(U(x, t) = exact, pde)))], [real]); solve(%, k)

-(4*I)*2^(1/2)*exp(-I*(k^2*t-k*x+2*t))*tanh(2*k*t-x)^3

(1/2)*x/t

NULL

Download num-Ex1_soln.mw

To plot the exact and approx solutions together in 3d

plot3d([abs(exact_soln), abs(approx_soln)], x = -2 .. 2, t = 0 .. 1, color = [red, blue]);

or Re or Im instead of abs.

For 2d, set one of x or t to a given value and do similarly with plot.

Inverse Laplace transforms often require assumptions to work. Here assuming alpha is positive works, at least for Ex 1.

Ex1.mw

file menu, bottom right corner - labeled options.

@salim-barzani I didn't use your ugly code because you did not have the correct x,t dependence in it at the time, though you since fixed that. But I also wanted general code - there is no reason to have special P,Q,R for every case when you can go directly to A[n].

Thanks for pointing out the missing factorial. You may be suggesting something else is missing but if so I didn't understand what you meant. So I think this code is correct now. The conclusion is now the same as @acer's in the thread here, i.e., that the paper has an error.

Laplace Adomian Decomposition method.

restart

with(Physics); with(inttrans); PDEtools:-declare(U(x, t), quiet)

pde0 := I*(diff(U(x, t), t))+diff(U(x, t), `$`(x, 2))+2*(diff(U(x, t)*conjugate(U(x, t)), x))*U(x, t)+U(x, t)^2*conjugate(U(x, t))^2*U(x, t)

I*(diff(U(x, t), t))+diff(diff(U(x, t), x), x)+(2*(diff(U(x, t), x))*conjugate(U(x, t))+2*U(x, t)*(diff(conjugate(U(x, t)), x)))*U(x, t)+U(x, t)^3*conjugate(U(x, t))^2

pde := expand(-I*pde0)

diff(U(x, t), t)-I*(diff(diff(U(x, t), x), x))-(2*I)*U(x, t)*(diff(U(x, t), x))*conjugate(U(x, t))-(2*I)*U(x, t)^2*(diff(conjugate(U(x, t)), x))-I*U(x, t)^3*conjugate(U(x, t))^2

Operator parts

LLu := diff(U(x, t), t); RRu := I*(diff(U(x, t), x, x)); NNu := -pde+LLu-RRu

diff(U(x, t), t)

I*(diff(diff(U(x, t), x), x))

(2*I)*U(x, t)*(diff(U(x, t), x))*conjugate(U(x, t))+(2*I)*U(x, t)^2*(diff(conjugate(U(x, t)), x))+I*U(x, t)^3*conjugate(U(x, t))^2

We treat each [U(x, t), diff(U(x, t), x), diff(conjugate(U(x, t)), x), conjugate(U(x, t))]like a simple variable v[1],..,v[4].

vars := [op(`minus`(indets(NNu), {t, x}))]; nvars := nops(vars); vvars := [seq(v[i], i = 1 .. nvars)]; NNv := subs(`~`[`=`](vars, vvars), NNu)

[U(x, t), diff(U(x, t), x), diff(conjugate(U(x, t)), x), conjugate(U(x, t))]

4

[v[1], v[2], v[3], v[4]]

(2*I)*v[1]*v[2]*v[4]+(2*I)*v[1]^2*v[3]+I*v[1]^3*v[4]^2

u[0] starts as the initial condition, form which we find A[0] and Ru[0]. vals[0] are the values of the 4 vvars corresponding to u[0]

u[0] := beta*exp(I*x); vals[0] := `assuming`([simplify(eval(subs(conjugate(U(x, t)) = conjugate(u[0]), U(x, t) = u[0], vars)))], [real]); Asym[0] := subs({seq(v[j] = vars[j][0], j = 1 .. nvars)}, NNv); A[0] := `assuming`([simplify(eval(NNv, `~`[`=`](vvars, vals[0])))], [real]); Ru[0] := `assuming`([simplify(eval(RRu, U(x, t) = u[0]))], [real])

beta*exp(I*x)

[beta*exp(I*x), I*beta*exp(I*x), -I*beta*exp(-I*x), beta*exp(-I*x)]

(2*I)*U(x, t)[0]*(diff(U(x, t), x))[0]*conjugate(U(x, t))[0]+(2*I)*U(x, t)[0]^2*(diff(conjugate(U(x, t)), x))[0]+I*U(x, t)[0]^3*conjugate(U(x, t))[0]^2

I*beta^5*exp(I*x)

-I*beta*exp(I*x)

Next iteration.
u[1] becomes a function of t for the next Laplace transform. Asym is redundant here, jus to check.  At least the last term here and the second term in the paper (only ones with u[0]^3) are different.
A[1] here does not agree with the result in the numerical example.

n := 1; u[n] := invlaplace(laplace(Ru[n-1]+A[n-1], t, s)/s, s, t); vals[n] := `assuming`([simplify(eval(subs(conjugate(U(x, t)) = conjugate(u[n]), U(x, t) = u[n], vars)))], [real]); Asym[n] := eval((diff(subs({seq(v[j] = add(vars[j][i]*lambda^i, i = 0 .. n), j = 1 .. nvars)}, NNv), `$`(lambda, n)))/factorial(n), lambda = 0); A[n] := simplify(eval((diff(subs({seq(v[j] = add(vals[i][j]*lambda^i, i = 0 .. n), j = 1 .. nvars)}, NNv), `$`(lambda, n)))/factorial(n), lambda = 0)); Ru[n] := `assuming`([simplify(eval(RRu, U(x, t) = u[n]))], [real])

1

I*exp(I*x)*(beta^5-beta)*t

[I*exp(I*x)*beta*(beta^4-1)*t, t*(-beta^5+beta)*exp(I*x), t*(-beta^5+beta)*exp(-I*x), -I*exp(-I*x)*beta*(beta^4-1)*t]

(2*I)*U(x, t)[1]*(diff(U(x, t), x))[0]*conjugate(U(x, t))[0]+(2*I)*U(x, t)[0]*(diff(U(x, t), x))[1]*conjugate(U(x, t))[0]+(2*I)*U(x, t)[0]*(diff(U(x, t), x))[0]*conjugate(U(x, t))[1]+(4*I)*U(x, t)[0]*(diff(conjugate(U(x, t)), x))[0]*U(x, t)[1]+(2*I)*U(x, t)[0]^2*(diff(conjugate(U(x, t)), x))[1]+(3*I)*U(x, t)[0]^2*conjugate(U(x, t))[0]^2*U(x, t)[1]+(2*I)*U(x, t)[0]^3*conjugate(U(x, t))[0]*conjugate(U(x, t))[1]

exp(I*x)*t*(-beta^9+beta^5)

exp(I*x)*beta*(beta^4-1)*t

In a loop it is quite fast

for n to 5 do u[n] := invlaplace(laplace(Ru[n-1]+A[n-1], t, s)/s, s, t); vals[n] := `assuming`([simplify(eval(subs(conjugate(U(x, t)) = conjugate(u[n]), U(x, t) = u[n], vars)))], [real]); A[n] := simplify(eval((diff(subs({seq(v[j] = add(vals[i][j]*lambda^i, i = 0 .. n), j = 1 .. nvars)}, NNv), `$`(lambda, n)))/factorial(n), lambda = 0)); Ru[n] := `assuming`([simplify(eval(RRu, U(x, t) = u[n]))], [real]) end do

I*exp(I*x)*(beta^5-beta)*t

[I*exp(I*x)*beta*(beta^4-1)*t, t*(-beta^5+beta)*exp(I*x), t*(-beta^5+beta)*exp(-I*x), -I*exp(-I*x)*beta*(beta^4-1)*t]

exp(I*x)*t*(-beta^9+beta^5)

exp(I*x)*beta*(beta^4-1)*t

-(1/2)*exp(I*x)*(beta^9-2*beta^5+beta)*t^2

[-(1/2)*exp(I*x)*beta*(beta^8-2*beta^4+1)*t^2, -((1/2)*I)*exp(I*x)*beta*(beta^8-2*beta^4+1)*t^2, ((1/2)*I)*exp(-I*x)*beta*(beta^8-2*beta^4+1)*t^2, -(1/2)*exp(-I*x)*beta*(beta^8-2*beta^4+1)*t^2]

-((1/2)*I)*exp(I*x)*t^2*beta^5*(beta^8-2*beta^4+1)

((1/2)*I)*exp(I*x)*beta*(beta^8-2*beta^4+1)*t^2

-((1/6)*I)*exp(I*x)*(beta^4-1)^3*beta*t^3

[-((1/6)*I)*exp(I*x)*(beta^4-1)^3*beta*t^3, (1/6)*exp(I*x)*(beta^4-1)^3*beta*t^3, (1/6)*exp(-I*x)*(beta^4-1)^3*beta*t^3, ((1/6)*I)*exp(-I*x)*(beta^4-1)^3*beta*t^3]

(1/6)*exp(I*x)*t^3*beta^5*(beta^12-3*beta^8+3*beta^4-1)

-(1/6)*exp(I*x)*(beta^4-1)^3*beta*t^3

(1/24)*exp(I*x)*(beta^4-1)^4*beta*t^4

[(1/24)*exp(I*x)*(beta^4-1)^4*beta*t^4, ((1/24)*I)*exp(I*x)*(beta^4-1)^4*beta*t^4, -((1/24)*I)*exp(-I*x)*(beta^4-1)^4*beta*t^4, (1/24)*exp(-I*x)*(beta^4-1)^4*beta*t^4]

((1/24)*I)*exp(I*x)*t^4*(beta^2+1)^4*(beta-1)^4*beta^5*(beta+1)^4

-((1/24)*I)*exp(I*x)*(beta^4-1)^4*beta*t^4

((1/120)*I)*exp(I*x)*(beta^4-1)^5*beta*t^5

[((1/120)*I)*exp(I*x)*(beta^4-1)^5*beta*t^5, -(1/120)*exp(I*x)*(beta^4-1)^5*beta*t^5, -(1/120)*exp(-I*x)*(beta^4-1)^5*beta*t^5, -((1/120)*I)*exp(-I*x)*(beta^4-1)^5*beta*t^5]

-(1/120)*exp(I*x)*t^5*beta^5*(beta-1)^5*(beta+1)^5*(beta^2+1)^5

(1/120)*exp(I*x)*(beta^4-1)^5*beta*t^5

 

NULL

Download Laplace_Adomiian_Decomposition_method_4.mw

The error message indicates a problem with floats. Ideally, you should do the whole thing symbolically and then substitute in values, but that takes too long, probably because the expressions get too complicated. So you can convert the float parameters to rational; run through the loop and then evalf the results. Then you will need to change the parameters and run it again. It's possible that with numerical parameters you don't need the assumptions and/or the simplify (one or both), you you could try that for faster operation.

error-problem2.mw

It means there are some assumptions involving these variables. You can avoid displaying them with Options->Display->Assumed variables and choose No Annotation (or you might prefer Phrase).

There is no BlockDiagonalMatrix command. When the output of a command has the same command in it, that is a hint that the command does not exist. However, DiagonalMatrix does what you want.

Y8 := DiagonalMatrix([Y4, Y4_R]);

I don't understand the logic of what you are trying to do well enough to answer your other questions.

"f(p,n)= "the number of partions of a positive integer n into p parts. possible parts are only 0,1,4,6,8,9. these parts can be used several times. the order is not important.

restart

with(combstruct)

A word w is a multiset of letters (can have repeats, order doesn't matter) from s0,s1,s4,s6,s8,s9.

sys := {letters = Union(s0, s1, s4, s6, s8, s9), s0 = Atom, s1 = Atom, s4 = Atom, s6 = Atom, s8 = Atom, s9 = Atom, w = Set(letters)}

{letters = Union(s0, s1, s4, s6, s8, s9), s0 = Atom, s1 = Atom, s4 = Atom, s6 = Atom, s8 = Atom, s9 = Atom, w = Set(letters)}

Attribute grammar to calculate the sum s of the letters/numbers in the word

addition := {s(s0) = 0, s(s1) = 1, s(s4) = 4, s(s6) = 6, s(s8) = 8, s(s9) = 9, s(w) = Set(s(letters))}

{s(s0) = 0, s(s1) = 1, s(s4) = 4, s(s6) = 6, s(s8) = 8, s(s9) = 9, s(w) = Set(s(letters))}

Let z mark the number of letters (parts) in a word, and let u mark the value (sum).
The first few terms in the multivariate generating function are:

NULL
Order := 4; ser := agfseries(sys, addition, unlabeled, z, [[u, s]])[w(z, u)]

series(1+(u^9+u^8+u^6+u^4+u+1)*z+(u^18+u^17+u^16+u^15+u^14+u^13+2*u^12+2*u^10+2*u^9+2*u^8+u^7+u^6+u^5+u^4+u^2+u+1)*z^2+(u^27+u^26+u^25+2*u^24+u^23+2*u^22+2*u^21+2*u^20+2*u^19+4*u^18+3*u^17+4*u^16+2*u^15+3*u^14+3*u^13+3*u^12+2*u^11+3*u^10+3*u^9+3*u^8+u^7+2*u^6+u^5+u^4+u^3+u^2+u+1)*z^3+O(z^4),z,4)

f(p, n) is the coefficient of  of the term u^n*z^p, e.g. f(3, 8) is  the coefficient of u^8*z^3, which is 3.

If you are going to calculate many f(p, n) then you may as well just calculate the series once.

But for a procedure we have

f := proc(p::posint, n::posint)
  local sys, letters, s0, s1, s4, s6, s8, s9, s, w, addition, ser, z, u;
  sys := {letters = 'Union'(s0, s1, s4, s6, s8, s9),
         s0 = 'Atom', s1 = 'Atom', s4 = 'Atom', s6 = 'Atom', s8 = 'Atom', s9 = 'Atom', w = 'Set'(letters)};
  addition := {s(s0) = 0, s(s1) = 1, s(s4) = 4, s(s6) = 6, s(s8) = 8, s(s9) = 9, s(w) = 'Set'(s(letters))};
  Order := p + 1;
  ser := combstruct:-agfseries(sys, addition, 'unlabeled', z, [[u, s]])[w(z, u)];
  ser := collect(convert(ser, 'polynom'), [z,u], 'recursive');
  coeff(coeff(ser, z, p), u, n);
end proc:
  

f(3, 8)

3

CodeTools:-Usage(f(240, 540))

memory used=2.42GiB, alloc change=323.50MiB, cpu time=23.64s, real time=10.31s, gc time=17.11s

1807141

 

 

Download parts.mw

Edit: version that accepts the set of parts as a third argument

f := proc(p::posint, n::{posint, range(posint), list(posint)}, parts::set(nonnegint))
  local sys, letters, s, w, addition, ser, z, u, letts, _s, i, cu;
  letts := seq(cat(_s, i), i in parts);
  sys := {letters = 'Union'(letts), w = 'Set'(letters), letts =~ 'Atom'};
  addition := (map2(apply, s, {letts}) =~ parts) union {s(w) = 'Set'(s(letters))};
  Order := p + 1;
  ser := combstruct:-agfseries(sys, addition, 'unlabeled', z, [[u, s]])[w(z, u)];
  ser := collect(convert(ser, 'polynom'), [z,u], 'recursive');
  cu := coeff(ser, z, p);
  if n::posint then
    coeff(cu, u, n)
  else
    [seq(coeff(cu, u, i), i = n)]
  end if
end proc:

e.g., f(15, 100, {0, 1, 4, 6, 8, 9}); gives 129.

f(15, 90 .. 100, {0, 1, 4, 6, 8, 9}); gives [201, 187, 186, 175, 172, 159, 158, 147, 143, 133, 129]

f(15, [90, 92, 100], {0, 1, 4, 6, 8, 9}); gives [201, 186, 129]

The following is just a programatic version of how you made U. When you say "generalize to higher dimensions" I'm assuming you mean larger matrices, not things in more than two dimensions that wouldn't be matrices.

MMflatten := proc(Q::Matrix(Matrix))
  local m, n, i, j;
  m, n := op(1, Q);
  <seq(`<|>`(seq(Q[i, j], j = 1 .. n)), i = 1 .. m)>
end proc:

 

The first error message says "Warning, expecting only range variable x1 in expression 29239.76608*Ex*x1+794956140.3-29239.76608*Ma-131578.9474*Ey to be plotted but found names [Ex, Ey, Ma]". So you have not given numerical values to Ma, Ex, and Ey. The thing you are trying to plot is

29239.76608*Ex*x1 + 7.949561403*10^8 - 29239.76608*Ma - 131578.9474*Ey

but it can have only the name x1 in. You can try, say 

and you do get a plot, but I don't know what values of these parameters would be sensible.

2 3 4 5 6 7 8 Last Page 4 of 83