Christian Wolinski

MaplePrimes Activity


These are answers submitted by Christian Wolinski

Use this code:


f := (x) -> piecewise(x <= 0, -3, 0 < x and x <= 1, x^2, -x);
e := a < f(x);
c := table([1 = (x <= 0), 2 = (0 < x and x <= 1), 3 = (1 < x)]);
d := (() -> ({e assuming args}, solve({args}, {x}))) ~ (c);
s := (() -> SolveTools:-SemiAlgebraic(`union`(args), [a, x])) ~ (d);
solution := (op@op) ~ ([entries](s));
plot(f, -4..4, labels=[x, 'f(x)'], axes = boxed, discont = true, scaling=constrained);



plots[display](
[seq(
plots[display]([
plot(f, -4..4, discont = true, thickness = 2, transparency = 0.75), 
plots:-inequal(S, x = -4..4, a = -4..2, color = grey, transparency = 0.5, thickness = 1)]
),
S = solution)],
labels=["x", "a"], axes = boxed,  scaling=constrained, insequence = true);

Thumb if You like.

You may want to try the function "function_coeffs" in this post:
https://www.mapleprimes.com/questions/209926-How-To-Extract-Symbolic-Coefficient#answer225361

It is intended precisely for your task. Example:
P:=randpoly({sin(x),cos(x),sin(z),tan(y),1});
function_coeffs(P,{x});


Thumb if you like.

 

combine(convert(f,tanh)) assuming tanh(x)>0;

Consider these codes:

assume(a1, real, a2, real, b1, real, b2, real, a3 = a1 - a2, b3 = b1 - b2);
is(a1 - a2, real), is(b1 - b2, real);
is((a1 - a2)^2 + (b1 - b2)^2 >= 0);
is(a3, real), is(b3, real);
is(a3^2 + b3^2 >= 0);

and

assume(a1, real, a2, real, b1, real, b2, real, a3 = a1 - a2, b3 = b1 - b2, a3, real, b3, real);
is(a1 - a2, real), is(b1 - b2, real);
is((a1 - a2)^2 + (b1 - b2)^2 >=0);
is(a3^2 + b3^2 >= 0);

It is now plain to see "a1 - a2 is real" (or "a3 is real") is not a statement generated by the is/assume facility (1st code). This is because "(a1 - a2)^2" is never idealized. I believe the derivation "Polynomial P -> Sum of arbitrary polynomials" is not done, but for the explicit case that is the P = sum of (expanded) P's monomials. I expect P = sum positive multiples of even powers of reals would be identified nonnegative. The query you are trying to implement is a broadstroke. The is/assume facility acts much reserved in such cases.

There is a typo and also your assumptions are improperly declared.

 

A := 0 < T, 0 < tau, 0 < beta, 0 < N, 0 < k, 0 < nu, k < N, m < N, beta <= 1, 0 < n;
assume(A);
EQ := rho1^k*beta^k = (N*beta*rho2-N-1+((-2*N*beta^2+N*beta)*rho2+2*N*beta-N+2*beta+((N*beta^3-N*beta^2)*rho2-N*beta^2+N*beta-beta^2+beta)*rho1)*rho1)/(((N-k)*rho2+((-N*beta+2*beta*k)*rho2-N+k+(-beta^2*k*rho2+N*beta-beta*k+beta)*rho1)*rho1)), rho2^k/rho2^N*beta^k = (-N-1+(2*N*beta-N+2*beta+(-N*beta^2+N*beta-beta^2+beta)*rho1)*rho1+(N*beta+(-2*N*beta^2+N*beta+(N*beta^3-N*beta^2)*rho1)*rho1)*rho2)/(((-N+k+(N*beta-beta*k+beta)*rho1)*rho1+(N-k+(-beta^2*k*rho1-N*beta+2*beta*k)*rho1)*rho2));


Do you recognize your equations in the above?


Thumb if you like.

I do not entirely understand why this would give the correct answer, but it works:
 

 

A := x^2 + y^2 + z^2 - 4*x + 6*y - 2*z - 11 = 0, 2*x + 2*y - z = -18;
V := x, y, z;
EQ := {A} union D({A});
S := {solve}(EQ, indets(EQ, {name, function}), explicit);
S := map(subs, S, [V]);
S := {seq(subs(solve((map(Im, E) assuming real), {V}), E), E = S)};


Thumb if you like.

A pure algebraic equation. You should try it with Groebner package:

S:={ x^2=2, x^3=2*sqrt(2) } ;
Groebner:-Solve(map(lhs-rhs, S));

Thumb if you like.

Maybe this works:

 

nmSphere := proc(L::list, x::list)
   local n, m, mu, v, F, E;
   description "Convert n distinct points:(L) in m-space:(x) into equations about (n-1)-sphere in m-space";
   n := nops(L);
   m := nops(x);
   F := map(unapply, [add(v[i]^2, i = 1 .. m), seq(v[i], i = 1 .. m), 1], v);
   E := [seq(F[i](x) - add(F[i](L[j])*mu[j], j = 1 .. n), i = 1 .. m + 2)], [seq(mu[j], j = 1 .. n)];
   eliminate(E)[2];
end proc:

nmSphere([[-1,0,0], [0,1,0], [0,0,1]], [x,y,z]);

V := [x, y, z];
P := [-1, 0, 0], [0, 1, 0], [0, 0, 1];
E := nmSphere([P], V);
S := map(subs, ([solve])(E, {x, y}, explicit), V);
R := z = (proc (R) options operator, arrow; op([1, 1], R) .. op([2, 1], R) end proc)(solve(0 < discrim(eliminate(E, {y})[2][1], x), z));

plots[display](plots[pointplot3d]([P], symbol = CIRCLE, color = red), seq(plots[spacecurve](L, evalf(R), color = grey, thickness = 3, transparency = .5), L = S), axes = boxed, scaling = constrained, orientation = [-150, 60, 60], labels = ["x", "y", "z"]);

V := [x, y];
P := [-1, 0], [0, 1], [0, 0];
E := nmSphere([P], V);
S := map(subs, ([solve])(E, {x}, explicit), V);
R := y = (proc (R) options operator, arrow; op([1, 1], R) .. op([2, 1], R) end proc)(solve(0 < discrim(E[1], x), y));

plots[display](plots[pointplot]([P], symbol = CIRCLE, color = red), plot([[S[1][], R], [S[2][], R]], color = grey, thickness = 3, transparency = .5), axes = boxed);


;;


Thumb if you like.

You are given a rational polynomial so this is the basic for Maple. Manipulate directly.

    A := - lv*(dw - lw)/(dw - hw);
    - A*(dw - hw)/(hw - dw);

But most likely you are considering an automated method. Consider the code that follows with different values of S, like [lw,dw], [dw,lw] and other.

    A := solve(hv*hw + lv*lw = dw*(lv + hv), hv);
    T := table([(i = op(i, A)) $ (i = 1 .. nops(A))]);
    T := map(proc(x) if type(x, anything^integer) then op(x) else x, 1 fi end, T);
#make changes here:
    S := [lw, dw];
    T := map(proc(x, p, S) local l; l := lcoeff(x, S); l, normal(x/l), p end, T, S);
    mul(T[i][1]^T[i][3], i = 1 .. nops(A)), mul(T[i][2]^T[i][3], i = 1 .. nops(A))

 

 

Look up:

?issqr
?isqrt

If you want a random, uniform distribution then use: "stats[random,uniform[0,1]](10);"
About your method, it should be "r:=rand(1..2)()" which will give you a randomly selected integer in range 1..2 and "r:=rand(1..2)" would give you the generator for said toss. So: "f(1):=H;f(2):=T; a:=map(f@rand(1..2),Vector[row](10));" is your method.

 

 

Thumb it if you like.


Simply:

 

expand(applyop(radnormal, 1, f));
evalc(applyop(radnormal, 1, f));

#for the larger samples:
F := f -> evalc(applyop(radnormal, 1, f));
G := ((x, s) -> map(collect, x, s, distributed)), (x, s) -> collect(x, s, distributed);
t := ln(anything);

factor(evalindets(f, t, F));
G[1]('%', indets('%', t));


Thumb if you like.


Before "GCD3:=" you have the "proc". Delete it.

A very low order test is implemented in `combine/polylog`.

You can see it with:
stopat(`combine/polylog`, 17);
showstat(`combine/polylog`);

Line 17 in "type(x,'complex(numeric)') and 1 <= abs(x) or is(1 <= x) or is(x <= -1)" replace with
with say "1<=abs(x)^2" or "signum(1-abs(x))=-1" or "is(1<=abs(x))", whichever is preferred.

Look at the line:

 

x[2] := unapply(invlaplace(laplace(t^(alpha-1), t, s)*laplace(y[2](t)-20*y[13](t)+(19/2)*y[14]-60*y[16](t)+21*y[17](t)-y[13](t)*(6*(3*y[2](t)-y[5](t)))+y[15](t)*(12*(3*y[1](t)-y[4](t))-2*(2*y[1](t)-y[4](t)))-y[16](t)*(12*(3*y[2](t)-y[5](t)))+y[18](t)*(24*(3*y[1](t)-y[4](t))-6*(2*y[1](t)-y[4](t))), t, s), s, t), t);


Instead of (19/2)*y[14] it should be (19/2)*y[14](t). This is my best bet. Replace with:

 

x[2] := unapply((subs(y[14] = y[14](t), eval(x[2])))(t), t);
#or simply
x[2] := unapply(invlaplace(laplace(t^(alpha-1), t, s)*laplace(y[2](t)-20*y[13](t)+(19/2)*y[14](t)-60*y[16](t)+21*y[17](t)-y[13](t)*(6*(3*y[2](t)-y[5](t)))+y[15](t)*(12*(3*y[1](t)-y[4](t))-2*(2*y[1](t)-y[4](t)))-y[16](t)*(12*(3*y[2](t)-y[5](t)))+y[18](t)*(24*(3*y[1](t)-y[4](t))-6*(2*y[1](t)-y[4](t))), t, s), s, t), t);


Thumb if you like.

3 4 5 6 7 8 9 Page 5 of 10