acer

32722 Reputation

29 Badges

20 years, 87 days
Ontario, Canada

Social Networks and Content at Maplesoft.com

MaplePrimes Activity


These are replies submitted by acer

@emendes Is this the kind of fix-up you're after? That is changing z*x back to x*z.

I added it as a late step in the Alt_monomialsGB procedure, but at the end of this worksheet I also show how you can apply it to an arbitrary list of expressions (of type polynom in your list of names). You could even make that a new small procedure.

The basic idea is that it simply forces re-ordering of the multiplicands in (only) the subexpressions of type `*`. Maple stores a single instance of such terms, in a special internal structure, and sort acts in-place on those; the sorted instance then appears (automatically) in any expression containing those terms.

restart;

Alt_monomialsGB := proc(p::algebraic, vars::list,
                        {ord::identical(plex,tdeg,grlex):=':-plex',
                         reverse::truefalse:=false})
local
     M, res,
     v:= indets(p, suffixed({vars[]})),
     C:= coeffs(expand(p), v, 'M'),
     P:= ord(ListTools:-Reverse([v[]])[]),
     S:= sort(`[]`~([C],[M]), (a,b)-> not Groebner:-TestOrder(a[2], b[2], P));
     S:= ifelse(reverse,ListTools:-Reverse(S),S);
     res:= (map2(op, 1, S), map2(op, 2, S));
     map(sort,indets([res],`*`),'order'=':-plex'(vars[]));
     return res;
end proc:

 

lorenz := [-sigma*x + sigma*y, rho*x - x*z - y, -beta*z + x*y,
           z^2+y*z+x*z+z+w*y^2+x*y+K*y+x^2+x+1];

[-sigma*x+sigma*y, rho*x-x*z-y, -beta*z+x*y, w*y^2+K*y+x^2+x*y+x*z+y*z+z^2+x+z+1]

vars := [x,y,z]:

 

map(w->Alt_monomialsGB(w,vars),lorenz);

[[sigma, -sigma], [y, x], [-1, -1, rho], [x*z, y, x], [-beta, 1], [z, x*y], [1, 1, 1, 1, w, 1, K, 1, 1, 1], [z^2, y*z, x*z, z, y^2, x*y, y, x^2, x, 1]]

map(w->Alt_monomialsGB(w,vars,ord=tdeg,reverse),lorenz);

[[-sigma, sigma], [x, y], [rho, -1, -1], [x, y, x*z], [-beta, 1], [z, x*y], [1, 1, K, 1, 1, 1, 1, w, 1, 1], [1, x, y, z, x^2, x*y, x*z, y^2, y*z, z^2]]

map(w->Alt_monomialsGB(w,vars,ord=tdeg),lorenz);

[[sigma, -sigma], [y, x], [-1, -1, rho], [x*z, y, x], [1, -beta], [x*y, z], [1, 1, w, 1, 1, 1, 1, K, 1, 1], [z^2, y*z, y^2, x*z, x*y, x^2, z, y, x, 1]]

map(w->Alt_monomialsGB(w,vars,ord=grlex),lorenz);

[[sigma, -sigma], [y, x], [-1, -1, rho], [x*z, y, x], [1, -beta], [x*y, z], [1, 1, 1, w, 1, 1, 1, K, 1, 1], [z^2, y*z, x*z, y^2, x*y, x^2, z, y, x, 1]]


You can do a similar fix-up, stand-alone. Eg,

foo := [z*y^2*x, z^4*y*x^3]; # only if created fresh in a session, out-of-order
map(sort,indets([foo],`*`),'order'=':-plex'(vars[])):
foo;

[z*y^2*x, z^4*y*x^3]

[x*y^2*z, x^3*y*z^4]

sort(z*x, order=plex(z,x)): # to forcibly get your problematic example
# Now this next example has the unwanted z*x subterm.
Q := [sigma*y, (-sigma - 1)*y + z*x, (rho - 1 - z)*beta - (x + y)*x];

[sigma*y, (-sigma-1)*y+z*x, (rho-1-z)*beta-(x+y)*x]

map(sort,indets([Q],`*`),'order'=':-plex'(x,y,z)):
Q;

[sigma*y, (-sigma-1)*y+x*z, (-z+rho-1)*beta-(x+y)*x]

fixup := proc(expr, vars)
  map(sort,indets([expr],`*`),'order'=':-plex'(vars[]));
  return expr;
end proc:

 

sort(z*x, order=plex(z,x)): # to forcibly get your problematic example
Q; # once again problematic

[sigma*y, (-sigma-1)*y+z*x, (-z+rho-1)*beta-(x+y)*x]

fixup(Q, vars); # using the order appearing in list vars

[sigma*y, (-sigma-1)*y+x*z, (-z+rho-1)*beta-(x+y)*x]

Download more_sort_fun2.mw

@emendes Yes, that's an artefact of some of the forced sorting orders.

As I mentioned in the initial text of my original Answer, that (somewhat cosmetic) effect can be adjusted by an additional `sort` applied separately to the individual terms. I can add that, maybe tonight.

Do you always want the individual product terms alwats to have their multiplicands in usual alphabetic/lexicographic order?

It is a bug; a regression introduced in Maple 2023.

The syntax a(1) and a[1] are only interchangeable for some flavours of rtable indexing.

@emendes Does this cover your flavours?

(Choices of ordering are plex,tdeg,grlex, with plex the default. And reverse=true/false, defaulting to false.)

tdeg, reversed, is what I did for your original examples in this Question.

restart;

lorenz := [-sigma*x + sigma*y, rho*x - x*z - y, -beta*z + x*y,
           z^2+y*z+x*z+z+w*y^2+x*y+K*y+x^2+x+1];

[-sigma*x+sigma*y, rho*x-x*z-y, -beta*z+x*y, w*y^2+K*y+x^2+x*y+x*z+y*z+z^2+x+z+1]

vars := [x,y,z]:

Alt_monomialsGB := proc(p::algebraic, vars::list,
                        {ord::identical(plex,tdeg,grlex):=':-plex',
                         reverse::truefalse:=false})
local
     M,
     v:= indets(p, suffixed({vars[]})),
     C:= coeffs(expand(p), v, 'M'),
     P:= ord(ListTools:-Reverse([v[]])[]),
     S:= sort(`[]`~([C],[M]), (a,b)-> not Groebner:-TestOrder(a[2], b[2], P));
     S:= ifelse(reverse,ListTools:-Reverse(S),S);
     (map2(op, 1, S), map2(op, 2, S));
end proc:

map(w->Alt_monomialsGB(w,vars),lorenz);

[[sigma, -sigma], [y, x], [-1, -1, rho], [x*z, y, x], [-beta, 1], [z, x*y], [1, 1, 1, 1, w, 1, K, 1, 1, 1], [z^2, y*z, x*z, z, y^2, x*y, y, x^2, x, 1]]

map(w->Alt_monomialsGB(w,vars,ord=tdeg,reverse),lorenz);

[[-sigma, sigma], [x, y], [rho, -1, -1], [x, y, x*z], [-beta, 1], [z, x*y], [1, 1, K, 1, 1, 1, 1, w, 1, 1], [1, x, y, z, x^2, x*y, x*z, y^2, y*z, z^2]]

map(w->Alt_monomialsGB(w,vars,ord=tdeg),lorenz);

[[sigma, -sigma], [y, x], [-1, -1, rho], [x*z, y, x], [1, -beta], [x*y, z], [1, 1, w, 1, 1, 1, 1, K, 1, 1], [z^2, y*z, y^2, x*z, x*y, x^2, z, y, x, 1]]

map(w->Alt_monomialsGB(w,vars,ord=grlex),lorenz);

[[sigma, -sigma], [y, x], [-1, -1, rho], [x*z, y, x], [1, -beta], [x*y, z], [1, 1, 1, w, 1, 1, 1, K, 1, 1], [z^2, y*z, x*z, y^2, x*y, x^2, z, y, x, 1]]


Download more_sort_fun.mw

@emendes Please give a brief but characteristic example of input and output for that procedure (which has Carl's "fist"), and a description of what it does, and how you want that changed.

@Andiguys I've updated my previous Reply, to cover your followup case involving
   c ≤ a and a ≤ b

I don't understand why you would wait so long to inform us that all the variables are positive. How does it help, to hold that back originally?

And now you've got some further, new variant example? Am I reading that rightly?

Is there some good reason that you couldn't give use all three different examples at the beginning?

@Andiguys The 2D Math display that looks like c ≤ a ≤ b is simply a conjunction of two inequalities, a ≤ b and c ≤ a . You might try dealing with those one at a time.

Does the following make sense,

restart

kernelopts(version)

`Maple 2019.2, X86 64 LINUX, Nov 26 2019, Build ID 1435526`

B := w+Ce; A := (1/3)*`ϕ`*(-beta*p1+a)-upsilon*Pu

ineq := -A/upsilon <= (B-A*(2*U*upsilon+1)/upsilon)/(2*(U*upsilon+1)) and (B-A*(2*U*upsilon+1)/upsilon)/(2*(U*upsilon+1)) <= (`&varphi;`*(-beta*p1+a)-A)/upsilon

 

You gave us the (new, updated) information that all variables
are positive. Literally, that means p1 as well (unless you now exclude it).

extra := indets(ineq,And(name,Not(constant))) >~ 0;

{0 < Ce, 0 < Pu, 0 < U, 0 < a, 0 < beta, 0 < p1, 0 < upsilon, 0 < varphi, 0 < w}

 

ineq1 := op(1,ineq):

R1 := op(solve({ineq1},p1)) assuming extra[];

p1 <= (3*Ce*upsilon-3*Pu*upsilon+a*varphi+3*upsilon*w)/(beta*varphi)

ineq2 := op(2,ineq):

R2 := op(solve({ineq2},p1) assuming extra[]);

p1 <= -(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/((6*U*upsilon+5)*beta*varphi)

Maybe this is all you are after...

`and`(R1, R2, p1>0);

p1 <= (3*Ce*upsilon-3*Pu*upsilon+a*varphi+3*upsilon*w)/(beta*varphi) and p1 <= -(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/((6*U*upsilon+5)*beta*varphi) and 0 < p1

Or maybe something like this...

p1>0 and p1 <= min(rhs(R1),rhs(R2));

0 < p1 and p1 <= min((3*Ce*upsilon-3*Pu*upsilon+a*varphi+3*upsilon*w)/(beta*varphi), -(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/((6*U*upsilon+5)*beta*varphi))

Or maybe something like this...
simplify(solve(`and`(R1, R2, p1>0), p1)) assuming extra[];

piecewise(`and`(Pu-w < Ce, Ce < ((6*U*a*`&varphi;`+3*Pu-3*w)*upsilon+5*a*`&varphi;`)/(3*upsilon)), [{p1 <= ((6*U*a*`&varphi;`-3*Ce+3*Pu-3*w)*upsilon+5*a*`&varphi;`)/((6*U*upsilon+5)*beta*`&varphi;`), 0 < p1}], `and`(((-3*w+3*Pu)*upsilon-a*`&varphi;`)/(3*upsilon) < Ce, Ce <= Pu-w), [{p1 <= ((3*w+3*Ce-3*Pu)*upsilon+a*`&varphi;`)/(beta*`&varphi;`), 0 < p1}], [])

Download Q_isolate_acc_2.mw

@emendes With repeats,

restart;

P := (LL::list, VV::list(name)) ->
       map(u->seq(sort(u/icontent(u),'order'=':-plex'(sort(VV)[])),icontent(u)),
           [op(sort(`+`(op(LL)),order=':-tdeg'(VV[]),':-ascending'))]):

 

V := [z,y,x]:

 

L1 := [z^2, y*z, x*z, z, y^2, x*y, y, x^2, x, 1]:

 

P(L1, V);

[1, x, y, z, x^2, x*y, x*z, y^2, y*z, z^2]

 

L2 := [z^2, y*z, y, x*z, y, z^2, y, x*z, z, y^2, x*y, y, x*z, x^2, x, 1, x]:

 

P(L2, V);

[1, x, x, y, y, y, y, z, x^2, x*y, x*z, x*z, x*z, y^2, y*z, z^2, z^2]

Download sort_lex_fun2.mw

Here I put the plex sorting (of multiplicands in each separate monomial) as an inside rather than outside job. That aspect might not even be of interest/use to you; and I can only guess at what order you might prefer for them.) Without that touch it can come out like this:

restart;

P := (LL::list, VV::list(name)) ->
       map(u->seq(u/icontent(u),icontent(u)),
           [op(sort(`+`(op(LL)),order=':-tdeg'(VV[]),':-ascending'))]):

V := [z,y,x]:

L1 := [z^2, y*z, x*z, z, y^2, x*y, y, x^2, x, 1]:

P(L1, V);

[1, x, y, z, x^2, y*x, z*x, y^2, z*y, z^2]

L2 := [z^2, y*z, y, x*z, y, z^2, y, x*z, z, y^2, x*y, y, x*z, x^2, x, 1, x]:

P(L2, V);

[1, x, x, y, y, y, y, z, x^2, y*x, z*x, z*x, z*x, y^2, z*y, z^2, z^2]

@emendes Would you rather see the original z,z,z,z in the output list, or 4*z? (both are easy to accomodate)

@salim-barzani It's not clear what you might be trying to say about conjugates.

I really do suggest that you try to understand how the code parts work. How else would you be able to tell that parts of some AI-generated code is trash? (I don't mean mmcdara's and dharr's code...)

@mmcdara Yes, I saw that too. And simplify doesn't reduce the contradiction, as well (in M2024.2 at least). I'll check M2025 and submit a report (against both solve and simplify).

@mmcdara In the member's Maple 2019 the conditions in that piecewise result from that solve call are awkward (and weird).

restart

B := w+Ce; A := (1/3)*`&varphi;`*(-beta*p1+a)-upsilon*Pu

ineq := (B-A*(2*U*upsilon+1)/upsilon)/(2*(U*upsilon+1)) <= (`&varphi;`*(-beta*p1+a)-A)/upsilon

(w+Ce-((1/3)*varphi*(-beta*p1+a)-upsilon*Pu)*(2*U*upsilon+1)/upsilon)/(2*U*upsilon+2) <= ((2/3)*varphi*(-beta*p1+a)+upsilon*Pu)/upsilon

solve(ineq, p1)

piecewise(And(2*varphi*beta+varphi*beta*(2*U*upsilon+1)/(2*U*upsilon+2) = 0, 0 <= -(1/6)*(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/(upsilon*(U*upsilon+1))), [{p1 = p1}], And(0 < (1/6)*varphi*beta*(6*U*upsilon+5)/(upsilon*(U*upsilon+1)), 0 <= (1/6)*varphi*beta*(6*U*upsilon+5)/(upsilon*(U*upsilon+1))), [{p1 <= -(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/((6*U*upsilon+5)*beta*varphi)}], And(0 < (1/6)*varphi*beta*(6*U*upsilon+5)/(upsilon*(U*upsilon+1)), (1/6)*varphi*beta*(6*U*upsilon+5)/(upsilon*(U*upsilon+1)) < 0), [{p1 <= -(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/((6*U*upsilon+5)*beta*varphi)}, {-(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/((6*U*upsilon+5)*beta*varphi) <= p1}], And((1/6)*varphi*beta*(6*U*upsilon+5)/(upsilon*(U*upsilon+1)) < 0, (1/6)*varphi*beta*(6*U*upsilon+5)/(upsilon*(U*upsilon+1)) <= 0), [{-(-6*U*a*upsilon*varphi+3*Ce*upsilon-3*Pu*upsilon-5*a*varphi+3*upsilon*w)/((6*U*upsilon+5)*beta*varphi) <= p1}], [])

Download Q_solve_oof_M2019.mw

That first Error message in your worksheet (in magenta) is a URL that can take you to this webpage.

Not all (few) Error messages link to useful information, but this one does.

I had to tell it how to find my web-browser, the first time I clicked on such a link.

@emendes I don't think that you've explicitly clarified whether an entry in any given inner list/set has to have all its own member lists/sets have the same depth of nesting as each other. Ie, you haven't (as yet, explicitly, AFAICS) disallowed, say,
   [  [1, 2], [ [4,5], [[6,7],[a,b]] ] ]
or,
   [ [1, 2], [ [4,5], [[[[[6,7]]]]] ] ]
where it's unclear whether the "depth" rating of [ [4,5], [[6,7],[a,b]] ] ought to return as 2 or 3 (or error).

But perhaps you don't expect such a case. So far, that was my guess.

Or perhaps you mean to convey instead that you wanted the maximal nesting depth for the members of parent L.  So here's another guess for the depth (though I don't know always what you might mean by "flatten" in some examples),

restart;

 

H := proc(L::{set,list},N::nonnegint) local i,K,LL;
  if L::And({set,list}, positive &under nops) then
  K := select(type,L,And(satisfies(u->(nops(u)>0)),
                         {list,set}));
    N+ifelse(nops(K)>0,
             max(seq(H(LL,N), LL=K)),0);
  else
    N;
  end if;
end proc:

 

H2 := proc(LL)
  subsindets(LL,And({set,list},
                    satisfies(u->(nops(u)>0 and u::{set,list}({set,list})))),
             op);
end proc:

 

L := [[1, 2, 3], [], [[1, 2], [3, 4], [5, 6]], [[[1, 2], [3, 4]], [[5, 6], [7, 8]]]];

[[1, 2, 3], [], [[1, 2], [3, 4], [5, 6]], [[[1, 2], [3, 4]], [[5, 6], [7, 8]]]]

map(H,L,1);

[1, 1, 2, 3]

map(H2,L);

[[1, 2, 3], [], [1, 2], [3, 4], [5, 6], [1, 2], [3, 4], [5, 6], [7, 8]]

L := [ [1, 2, 3],
       [],
       [[[{71,72}, [92,93]]]],
       [[1, 2], [3, 4], [5, 6]],
       {[{[1, 2], [3, 4]}, [[5, 6], [7, 8]] ]}];

[[1, 2, 3], [], [[[{71, 72}, [92, 93]]]], [[1, 2], [3, 4], [5, 6]], {[{[1, 2], [3, 4]}, [[5, 6], [7, 8]]]}]

map(H,L,1);

[1, 1, 4, 2, 4]

map(H2,L);

[[1, 2, 3], [], {71, 72}, [92, 93], [1, 2], [3, 4], [5, 6], [1, 2], [3, 4], [5, 6], [7, 8]]

L := [ [1, 2, 3],
       [],
       [[[{71,72}, [92,93]]]],
       [[1, 2], [[4,5], [[6,[[7,[8,p]]]],[a,b]]]],
       {[{[1, 2], [3, 4]}, [[5, 6], [7, 8]] ]}];

 

[[1, 2, 3], [], [[[{71, 72}, [92, 93]]]], [[1, 2], [[4, 5], [[6, [[7, [8, p]]]], [a, b]]]], {[{[1, 2], [3, 4]}, [[5, 6], [7, 8]]]}]

map(H,L,1);

[1, 1, 4, 7, 4]

I don't know exactly what you might mean by "flatten" here.
map(H2,L);

[[1, 2, 3], [], {71, 72}, [92, 93], [1, 2], [4, 5], [6, [7, [8, p]]], [a, b], [1, 2], [3, 4], [5, 6], [7, 8]]

 

L := [ [1, 2], [ [4,5], [[[[[6,7]]]]] ] ]

[[1, 2], [[4, 5], [[[[[6, 7]]]]]]]

map(H,L,1);

[1, 6]

map(H2,L);

[[1, 2], [4, 5], [6, 7]]

Download some_list_set_stuff_2.mw

@emendes To start with, your claim, "After the first outer list, entries are either lists or sets." is not true of the examples you've shown. Some entries are integers.

Moreover, even if you complete your characterization to allow lists or sets or scalars(or integers), it could still not be specified whether the entries of any sublist list have to all be all-integers, or all-sets or all-lists, or all sets-or-lists, or possibly a mix. If a mix of integers and lists/sets, then it's not explicitly clear what you might mean by "flatten", and you haven't clarified that case through example -- or prevented it (so far) with words.

It may be that an natural interpretation is obvious to you (or others). But, based purely on what you have written, the problem is (literally, indeed) under-specified.

First 10 11 12 13 14 15 16 Last Page 12 of 599