Christian Wolinski

MaplePrimes Activity


These are replies submitted by Christian Wolinski

 

L:=[seq([seq(x^i*y^j,j=1..5)],i=1..5)];
[[op(-1,op(-1,L)),op(1..-2,op(1,L))],seq([op(-1,op(i-1,L)),op(1..-2,op(i,L))],i=2..nops(L))];;

Perhaps you want to try it using symmetric polynomials:

 

A := [(a+b+c+d)*(a*b+a*c+a*d+b*c+b*d+c*d)-12*sqrt((a^2+b^2+c^2+d^2)*a*b*c*d), [a+b+c+d-1]];
G := [-a*b*c*d+p14, -a^2*b-a^2*c-a^2*d-a*b^2-a*b*c-a*b*d-a*c^2-a*c*d-a*d^2-b^2*c-b^2*d-b*c^2-b*c*d-b*d^2-c^2*d-c*d^2+p23, -a^2-a*b-a*c-a*d-b^2-b*c-b*d-c^2-c*d-d^2+p22, -a-b-c-d+p11], [a, b, c, d, p11, p22, p23, p14];
simplify(A,G);
simplify(A,map(op,[G[1],A[2]]),G[2]);

 

Look for symmetric polynomials package.

@Carl Love I was supposing this could work:

 

R := {Product(g-i, i=-4..-3), Product(f-i, i=0..2)};
#R := {product(g-i, i=-4..-3), product(f-i, i=0..2)};

But now I think it would work only for small cases.

@Carl Love Maple 16 seems nicer.

What would this produce, 25 answers?

 

isolve({x>3/2, x<13/2, y>3/2, y<13/2});

Also

 

S := {-1/2 < 2/53*f+7/53*g, 7/53*f-2/53*g < 1/2, 2/53*f+7/53*g < -37/106, 3/106 < 7/53*f-2/53*g};

R := {(g+4)*(g+3), f*(f-1)*(f-2)};
isolve(S union R);

gives full solution. So a solution would be to first figure each variable's range. In observation it seems a false approach for isolve to produce over a cartesian product of ranges.

Does isolve accept inert Product expressions?

Dividing (c,d) plane with the polynomials involved this image is obtained. The range of x: -1..1 was not used.

Divisions.

@Carl Love The order of eliminations I employed:

{cos(p1), sin(p1), sin(p2), cos(p3), sin(p3), cos(p2)}, {cos(t3), sin(t3)}, {sin(t2)}, {cos(t2)}, {y}.

Eliminating cos(t2) gave the first occurence of RootOf. Eliminating y gave 3 cases, all quadratic in x. That is my previous post. Perhaps you could reproduce this.

@cuongtd Eliminating sequentially individual variables reduces the system to this:

 

proc()
local t264, t334, t309, t310, t336, t312, result, t337, t292, t339, t343, t321, t344, t346, t345, t323, t299, t347, t304, t324, t342, t325, t328, t307,
t326, t332, t331, t333, t306;
global x, y, eta1, eta3, eta2, Alpha1, Alpha2;
    t328 := Alpha2*eta3;
    t325 := 8*t328;
    t347 := t325 + 4;
    t326 := -4*t328;
    t333 := x*eta2;
    t346 := t326 - 4*t333;
    t309 := eta2^2;
    t310 := eta3^2;
    t304 := Alpha1^2;
    t336 := 4*t304;
    t306 := Alpha2^2;
    t345 := (-8*(Alpha1 - eta2)*x - 4*t310 - 4*t306 + t336 - 4*t309 + t347)*eta1;
    t332 := Alpha1*x;
    t292 := -4*t332;
    t344 := t292 + 4*t333 - 2*t309;
    t312 := x^2;
    t299 := 2*t304;
    t307 := eta1^2;
    t343 := 2*t309 + 4*t312 - 4*t307 - 2 + t299 + t292 + t346;
    t331 := t304 + t306;
    t342 := -t331 + 2*t332;
    t339 := -8*t312;
    t337 := 4*t309;
    t334 := - 1/2*1/(-eta3 + Alpha2);
    t324 := x*t325;
    t323 := -1 + t309 + t310 - 2*t333 + t342;
    t321 := 1 + t332*t337 + t299 + Alpha1*t324 + t347*t307 + (t339 + 4)*t328 + (Alpha1*t339 + t324)*eta2 + (t336 + t337)*t312 + (t309 + t346)*t309
         + (t326 + t304 + t344)*t304 + (t306 + t343)*t306 + (6*t306 + t310 + t343)*t310 + t344;
    t264 := -1 + t331;
    result := [[{y = (2*eta1 + t323)*t334}, {t264, t321 - t345}], [{y = eta3}, {t264, -2*t328 + t310 + t312 - t307 - t342}],
        [{y = (-2*eta1 + t323)*t334}, {t264, t321 + t345}]]
end proc(), {Alpha1 = cos(t1), eta3 = .995, eta2 = .575, eta1 = 1.35, Alpha2 = sin(t1)};

The above and the below is from the previous post.
Top view:

Solution attempt.

Most likely the elimination ran into trouble and substituted lesser cases(?).

@cuongtd Well, what I've found was done by elimination. Oddly enough, when I converted to pure symbolic and solved again I received a solution that has NO curves, and has only points termed in the constants of the equations. The following list has complex values removed:

 

[x, y, cos(t1), sin(t1)] = ([1.15, -.35, .5289398012, .8486593467], [1.15, -.35, -.3352457626e-1, -.9994378934], [1.15, .35, -.3352457626e-1, .9994378934], [1.15, .35, .5289398012, -.8486593467], [0, -.35, 0, 1.], [0, .35, 0, -1.], [0, -2.35, 0, -1.], [0, 2.35, 0, 1.], [.575, 1.345, -.6440493667, .7649839300], [.575, 1.345, .9980143844, .6298641560e-1], [.575, -1.355, .9973489646, -.7276704453e-1], [.575, -1.355, -.6406294899, -.7678501525], [.575, .645, -.7749377670, .6320375442], [.575, .645, .7165251908, -.6975612166])

@Declan 

Thomas Richard already covered this, but you might lke these:

f := () -> `@`(parse, cat, op, map)(convert, [args], string);
g := (L::{list, set}) -> `@`(parse, cat, op, map)(convert, L, string);

 

f(100.100, 3, 3, 2, 2, 1, 1, `535`);
g([100.100, 3, 3, 2, 2, 1, 1]);

@Carl Love I was suspecting that by now Maplesoft developed a feature for this.

@Majmaj Since precision is your issue the last line should be with increased Digits. Pick the appropriate setting; I used 2*Digits:


moreDigits:=2*Digits;
S:=evalf(`@`(f,op,map2)(op,1,B),moreDigits),`@`(op,map2)(op,3,B);

evalf((minimize..maximize)(S),moreDigits);

or in one line:

moreDigits:=2*Digits;
evalf((minimize..maximize)(`@`(f,op,map2)(op,1,B),`@`(op,map2)(op,3,B)),moreDigits);

To answer your question: floats are imprecise, treat them as ranges.

@Majmaj My version does it differently. This should work with current version:

 

vars:=a,b;
Aexpr:=a*b;
f:=unapply(Aexpr,vars);
A:=a=.123456789,b=.123456789;
B:=map(`@`([proc(r) local k; (rhs-lhs)(r)*k+lhs(r), k, k=0..1 end proc], `@`(op,shake)), subs([A], [vars]));
S:=`@`(f,op,map2)(op,1,B),`@`(op,map2)(op,3,B);
(minimize..maximize)(S);

What do you ge tfor value of S?

From the first set I specified:
`@`(rationalize,factor,simplify)(u,[Z^2*Omega^2*a^2-k*m],[k, Z]);

gives:
mul(i,i = (-1/4, 2^(1/2), add(i,i = (-1, mul(i,i = (-2, Z^2)), add(i,i = (1, mul(i,i = (4, Z^2))))^(1/2)))^(1/2), add(i,i = (1, add(i,i = (1, mul(i,i = (4, Z^2))))^(1/2))), 1/Z^2))


The rest follows.

@Markiyan Hirnyk You gave me a cause to look again. I dont recall my thoughts, so:

ee := proc() _EnvExplicit := false; op([1, 2], [eliminate](args)) end proc;
Q:=ee({P,-1+V=something},{V,Z});

#gives

Q:={4*k*m-2*Omega^2*a^2*something-Omega^2*a^2*something^2};

#and

assume(something<-2),`@`(normal,simplify)(u,Q,[k,something]);

#gives

-I

Q and something are well motivated and easier to see. So start over:

restart;
A := a, positive, k, positive, Omega, positive, m, positive, -something - 2, positive; assume(A);
Q := -4*k*m+2*Omega^2*a^2*something+Omega^2*a^2*something^2;
u:=-Omega*a*sqrt(2)*sqrt(-Omega^2*a^2-2*k*m+sqrt(Omega^2*a^2*(Omega^2*a^2+4*k*m)))/(-Omega^2*a^2+sqrt(Omega^2*a^2*(Omega^2*a^2+4*k*m)));

`@`(normal,simplify)(u,[Q],[k,something]);

#gives

-I

What is the actual system you are trying to solve?

First 17 18 19 20 21 Page 19 of 21