Christian Wolinski

MaplePrimes Activity


These are answers submitted by Christian Wolinski

Example:

 

member((a-2*b-2*c)^2*(2*a-b+2*c)^2, M, 'i'), i;

 

A := log[12](27) = a, log[36](24) = b;
B := seq(simplify(e), e = A);
C := frontend(eliminate, [{B}, {b, ln(2)}], [{Non(function)}, {}]);
b = convert(subs(C[1], b), parfrac, a);


Thumb if you like.



Edit:
Final revision:

 

F := proc(S, T)
   local A, n, m, x, y, v, w, V, W, i, f, g;
   n := `$`(1 .. nops(S));
   m := `$`(1 .. nops(T));
   f := () -> args[1];
   g := `@`(assign, op, map);

   g(V @ f = op, [n], 'S');
   g(W @ f = op, [m], 'T');
   g(v = `@`(simplify, eval, V), [n]);
   g(w = `@`(simplify, eval, W), [m]);

   A := frontend([solve], [(x = 'v')~({n}) union (y = w)~({m}), indets(w~({m}), function) union y~({m})], [{Non(function)}, {}]);
   A := (x = V) ~ ([n]), subs(A[1], y~([m]));

   (W ~ ([m])) =~ (subs(A))
end;

F('{log[12](27)}, {log[36](24)}');
F('{log[2](3), log[3](5), log[7](2)}, {log[140](63)}');

All is fine:

 

plots[display](
plot3d(arctan(y, x), y = -1 .. 1, x = -1 .. 1, style = point, grid = [121, 121], symbol = POINT, color = black),
plots[display](plottools[cuboid](evalf([-1, -1, -Pi]), evalf([1, 1, Pi]), color = red, thickness = 3), style = wireframe),
plots[spacecurve]([0, x, arctan(0, x)], x = -1 .. 1, color = blue, thickness = 3, numpoints = 61), axes = boxed, scaling = unconstrained, orientation = [125, 35]);

 

Output list from op Command.

That is : http://www.mapleprimes.com/questions/210560-Output-List-From-Op-Command#answer226062
...how odd the linking did not work first time...

I meant this :

 

judge:=proc(x,y,t) if not x = y then t := evalb(x < y) end if end proc;
W := proc(L1, L2)
   local i, t, X;
   if nops(L1) = nops(L2) then
      X := 'judge(op(i, L1), op(i, L2), 't')';
      for i while not assigned(t) do eval(X) end do;
      t
   else evalb(nops(L1) < nops(L2)) end if
end proc;
ops := m -> sort(op(2, OperandsTable(m)), (a, b) -> W([lhs](a), [lhs](b)));
ops(m);;

A very frequent query. As in the previous post:
http://www.mapleprimes.com/questions/215900-How-To-Find-Selected-Coefficient-In#answer230884

 

function_coeffs := proc(A, n::set(name))
local S, T, v;
   S := indets(A, {function});
   if nargs < 2 then v := {} else v := n; S := select(has, S, v); end if;
   T := {Non(map(identical, S))};
   frontend(proc(A, S) local V; [coeffs](collect(A, S, distributed), S, 'V'), [V] end proc, [A, S union v], [T, {}])
end proc;

eq2 := -4*A[2]*cos(2*x)-16*A[4]*cos(4*x)-36*A[6]*cos(6*x)-64*A[8]*cos(8*x)+a*A[0]+cos(8*x)*a*A[8]+cos(6*x)*a*A[6]+cos(4*x)*a*A[4]+2*cos(2*x)*q*A[0]+cos(2*x)*a*A[2]+q*A[8]*cos(6*x)+q*A[8]*cos(10*x)+q*A[6]*cos(4*x)+q*A[6]*cos(8*x)+q*A[4]*cos(2*x)+q*A[4]*cos(6*x)+q*A[2]*cos(4*x)+q*A[2];

 

zip(proc(C,F) if not hastype(F, trig) then C * F fi end, function_coeffs(eq2));

You can set the second parameter to pick variables, functions not in those variables will be overlooked, Example:

 

function_coeffs(sin(x)+cos(y)+x^2+x*y+y^2+2*x+1, {y});

in Student[LinearAlgebra] package or the LinearAlgebra package.


You must convert every datapoint [x,y,f1(x,y),f2(x,y)] into the pair of equations. Compute the union of all these equations and submit to LeastSquares with {a1, a2, a3, a4, a5, b1, b2, b3} as second parameter.

Perhaps your variables a, x were already assigned(?). If not then you can always try with typematch:

 

typematch(Heaviside(x),'Heaviside(a::algebraic)');

 

epsilon:=0.01;
display(
seq(spacecurve([cot(phi)/sin(phi), 1.61, phi], phi = r, numpoints = 3000, axes = normal, coords = spherical, color = red, axes = boxed),r=(-Pi+epsilon .. -epsilon,epsilon..Pi-epsilon))
);

 

simplify([f0,f1,f2],{a*b},[a,b]);
#simplify(simplify([f0,f1,f2],{a^2-q1,b^2-q2,a*b},[a,b,q1,q2]),{a^2-q1,b^2-q2,a*b},[q2,q1,b,a]);
#subs(q1=a^2,q2=b^2,map(limit,simplify([f0,f1,f2],{a^2-q1,b^2-q2,a*b-r},[a,b,q1,q2,r]),r=0));

for rational expressions?
Thumb it if you like.

This is not precisely the answer you seek, but these two examples might interest you:

Edited per Carl Love's pointer:

 

x||(1..4)||y||(1..4);
``||(a,b,c,d)||(1..4);

#old syntax
#x.(1..4).y.(1..4);
#``.(a,b,c,d).(1..4);

The following is excessive, but it does achieve the goal:

 

e:= g^((2*(-sigma+k+1))/(-1+sigma))-tau^2;
`@`(factor, x -> combine(x, power), factor, expand)(e);

This appears to be a frequent question. This is a link to my previous response:
http://www.mapleprimes.com/questions/207267-Coefficients-Of-Differential-Polynomial#comment223370

 

function_coeffs := proc(A, v::set(name))
local S, T;
   S := indets(A, {function});
   S := select(has, S, v);
   T := {Non(map(identical, S))};
   frontend(proc(A, S) local V; [coeffs](collect(A, S, distributed), S, 'V'), [V] end proc, [A, S union v], [T, {}])
end proc;

fec:=(A,f,t)->frontend(function_coeffs,[A,f],[{Non(t)},{}]);

A:=diff(g(z),x)*g(z)^3+diff(g(z),z,z)*g(z)^4+diff(g(z),z,z,z)*g(z)^5+diff(g(z),z)/g(z)^2;
function_coeffs(A,{g});
fec(A,{g},specfunc(anything,diff));

Try this substitution. Does it produce a different outcome?

 

restart;
assume(U,complex,V,complex,x,complex);
S := {b = U*(1+V^2)/V, a = U*(V-1)*(V+1)/V};
A:=diff(y(x),x)=a*cos(y(x))+b;
B:=subs(S,A);
dsolve(B,y(x));

Radical and multivariable algebraic statements are opportune to cause obstruction, so perhaps you should prepare your constants.

I have aligned the grid with t and t+x. Perhaps this configuration is to your liking:

 

 

restart;
x:='x':y:=0:z:=0:
f:=unapply(abs(2*(-exp(-t-x-z)+exp(t+x+z))/(exp(-t-x-z)+tanh((1+I)*t+(1/2-1/2*I)*y+z)+exp(t+x+z))),t,x);
g:=(u,v)->(u,v-u);
(f@g)(u,v);
p1:=plot3d([g,f@g](u,v),u=-5..5,v=-10..10,numpoints=20000):
mp:=proc() global p1; plots[display](p1,'args'); end proc:
plots[display](
mp(style=contour,thickness=2,shading=XY,contours=[seq(i/4,i=0..12)]),
mp(style=point,symbol=POINT,color=blue),
mp(style=patchnogrid,shading=XYZ,lightmodel=light3),
scaling=constrained,orientation=[120,45],projection=0.1,axes=boxed,view=[-6..6,-6..6,0..3]);

Considering this is a residue of a rational polynomial with coefficients in Q, at a singular point.

Edited:
used evala@AFactor instead of split
corrected use of roots
replaced evala@residue with evala@coeff@series
added seq to RootOf definition

 

 

C0 := rationalize(expand(2^(1/4)*exp(3/8*I*Pi)));
P := z^2 / (z^4 + 2*z^2 + 2)^2;
Pf := numer(P) / (evala@AFactor)(denom(P),z);
Pfs := select(`@`(evalb, 0 = evalc, evala, Norm, `+`), map2(op, 1, (roots@denom)(Pf)), -C0);

 

QRatpolyResidue := proc(Pf, z, Pfs, C0)
local ANS, R, X, Y, Z, W, Wn, A, k, d, i;
    _EnvExplicit := false;
    A := NULL;
    for R in Pfs do
        #ANS := evala(residue(Pf, z = R));
        ANS := evala(coeff(series(Pf, z = R, 1 + degree(numer(Pf), z) + degree(denom(Pf), z)), z - R, -1));

        #print(R, Residue, ANS);
        X := R - k;
        Y := X;
        W := NULL;
        Wn := NULL;
        while hastype(Y, RootOf) do           
            Z := `evala/toprof`(Y);
            d := frontend(degree, [op(1, Z), _Z], [{Non}(function), {}]);
            W := W, seq((evala@Expand)(Y*Z^i), i = 0 .. d - 1);
            Wn := Wn, Z;
            Y := (evala@Norm)(Y, {Z}, indets(Y, RootOf) minus {Z})

        end do;
        ANS := frontend(factor@simplify, [ANS, [W], [Wn, k]],
            [({Non}@map)(identical, {Wn}), {}]);
        A := A, map(evalc@rationalize, subs(k = C0, ANS))
    end do;
    A
end proc:

 

ANS := {QRatpolyResidue}(Pf, z, Pfs, C0);
ANS2 := {QRatpolyResidue}(Pf, z, Pfs, k), k = C0;

 

returns:

C0 := 2^(1/4)*(-1)^(3/8)
P := z^2/(z^4+2*z^2+2)^2
Pf := z^2/(z+RootOf(RootOf(_Z^4+2*_Z^2+2)^2+_Z^2+2))^2/(RootOf(_Z^4+2*_Z^2+2)+
z)^2/(z-RootOf(RootOf(_Z^4+2*_Z^2+2)^2+_Z^2+2))^2/(z-RootOf(_Z^4+2*_Z^2+2))^2
Pfs := [RootOf(_Z^4+2*_Z^2+2), RootOf(RootOf(_Z^4+2*_Z^2+2)^2+_Z^2+2), -RootOf
(_Z^4+2*_Z^2+2), -RootOf(RootOf(_Z^4+2*_Z^2+2)^2+_Z^2+2)]

ANS := {(1/32-3/32*I)*2^(1/4)*(1/2*(2-2^(1/2))^(1/2)+1/2*I*(2+2^(1/2))^(1/2))}
ANS2 := {-1/32*k*(2+3*k^2)}, k = 2^(1/4)*(-1)^(3/8)

 

 

5 6 7 8 9 10 Page 7 of 10