## 1415 Reputation

18 years, 335 days

## Similar to this...

posting:
http://www.mapleprimes.com/questions/207267-Coefficients-Of-Differential-Polynomial#comment223370

Try with:

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;

eq := (-Omega^2*a*A[2]-Omega^2*m*B[1]+Omega*A[1]*c[1]+B[1]*k[1])*cos(Omega*t)+(Omega^2*a*B[2]-Omega^2*m*A[1]-Omega*B[1]*c[1]+A[1]*k[1])*sin(Omega*t) = 0;

function_coeffs(lhs(eq),{t});

gives:

[-Omega^2*a*A[2]-Omega^2*m*B[1]+Omega*A[1]*c[1]+B[1]*k[1], Omega^2*a*B[2]-Omega^2*m*A[1]-Omega*B[1]*c[1]+A[1]*k[1]], [cos(Omega*t), sin(Omega*t)]

## Final word....

I think this is safe to use:

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]);

## Some code....

F1 := proc(S, F) local x, f; f := unapply('hastype'(x, F(map(identical, S))), x); (remove, select)(f, S) end proc;
A := F1(indets(eq, anyfunc(dependent(t))), anyfunc);
subs(seq(A[2][i] = cat(K, i), i = 1 .. nops(A[2])), eq);

## Some code....

restart;
A:=a,positive,k,positive,Omega,positive,m,positive,Z,positive,-1+V,positive;interface(showassumed=0),assume(A);
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)));

P := Z^2*Omega^2*a^2-k*m, 1+4*Z^2-V^2;
`@`(factor,simplify)(u,[P],[k,Z,V]); #m works too
`@`(expand,solve)({P},{Z^2,V^2});

## If the first one worked then......

`this should work too:createModule3 := proc(A::Matrix(square))    local dim;    dim := RowDimension(A);    module()        export det;        det := (proc(dim) (x::Matrix(1..dim,1..dim)) -> Determinant(x) end proc)(dim);    end moduleend proc:`
`createModule3(Matrix(2)):-det(IdentityMatrix(2));Does the above work?Arguments to procedures are themselves not variables and in your createModule2 you use dim as variable and not parameter.`

## Solve the ranges first....

restart;
A:=interface(showassumed=0),assume(x,real),factor(ln(sqrt(x-12)/(-x^(2)+15*x)));((expr,var)->solve({`@`(evalc,Re)(expr)>=0,`@`(evalc,Im)(expr)=0},var))(op(1,A),{x});
plot(A,x=12..15,scaling=constrained,axes=boxed,thickness=3);

#Gives
# A := ln(-(x-12)^(1/2)/x/(x-15))
# {x < 15, 12 <= x}

## Objective....

With small expressions it is hard to observe facilities at work.

interface(version);
mf:=unapply('unapply(F(n),n),F,n'):
phi:=(1+sqrt(5))/2:

#   Maple Worksheet Interface, Release 4, IBM INTEL NT, Apr 16 1996

fn:=unapply(1/2*sqrt(-(u-1)*(u+1)*(u^2-u-1))*u*(4*u-3)/sqrt(u*(u-1)),u):
fn2:=assume(u1>1,u1<phi),mf(`@`(factor,combine,simplify,fn),u1):
fn2(u);

Gives:

#1/2*(4*u-3)*(-(u+1)*(u^2-u-1)*u)^(1/2)

## Transform....

Region boundaries, contents of the grey line are excluded:

A0:=log[2*abs(x-a)](abs(x+a)+abs(x-a)) < 1;
A2 := signum((U1 - U2) * (2 * U1 - 1)) = 1;

It can be shown A0 and A2,U2=abs(x+a), U1=abs(x-a) are equivalent.

## Lagrange. (2)...

You may find this useful:

#interface(version);
#Maple Worksheet Interface, Release 4, IBM INTEL NT, Apr 16 1996

LocalExtrema := proc(obj, expre)
local Solutions, Lagrange, Restraint, Other, Equations, Variables, Lambdas, NewNames, n, i, E, V, lambda;
description `Looks for local extrema of obj, subject of restraint of expre, using Lagrange multiplier method. Returns [Solutions], [obj, Lagrange Function], [Restraint, Lagrange Equations, Other], [Variables, Lambdas, New Names].`;
if type(expre, {list, set}) then E := ([op]@{op})(expre) else E := [expre] fi;
Restraint := `@`({op}, map)(op, {remove(type, E, {relation, logical}), map(lhs - rhs, select(type, E, equation))});
n := nops(Restraint);
Other := `@`({op}, remove)(member, E, select(type, E, {equation, Non({relation, logical})}));
Lagrange := obj + add(lambda[i]*Restraint[i], i = 1 .. n);
Variables := select(type, {args[3 .. -1]}, name);
Lambdas := {seq(lambda[i], i = 1 .. n)};
Equations := map2(diff = 0, Lagrange, Variables);
Solutions := traperror(solve(Equations union Restraint union Other, Lambdas union Variables));
if lasterror = Solutions then lasterror
else
NewNames := indets({Solutions}, name) minus indets({constants, Restraint, Other, Variables, Lambdas, Equations}, name);
[op]({Solutions}), [obj, Lagrange], [Restraint, Equations, Other], [Variables, Lambdas, NewNames]
fi
end:

_EnvExplicit:=true;
A:=LocalExtrema(x^3+y^3+z^3,{x^2+y^2+z^2-1,x>0},x,y,z):
P:=map(subs,A[1],[[x,y,z],(x^3+y^3+z^3)]);
map(print,[A]):

## Practice....

References for your question are too numerous.

Some code:

#interface(version);
# Maple Worksheet Interface, Release 4, IBM INTEL NT, Apr 16 1996

Collatz := proc(x) local m, n; option remember; m := iquo(x, 2, 'n'); if n = 0 then m else 6*m + 4 fi end;
CollatzSeq := proc(x, q)
local y, t;
option remember;
y := x; t := x; while 1 < t do t := Collatz(t); y := y, t od; if q then procname(x, false) := t; y else procname(x, true) := y; t fi
end;

L:=[\$1..60];
map(CollatzSeq, L, false);
type(map(CollatzSeq, L, false), list(1));
#map([CollatzSeq], L, true);
`@`(sort, [op], map)(CollatzSeq, {op}(L), true);

## If all else fails then......

#interface(version);
#   Maple Worksheet Interface, Release 4, IBM INTEL NT, Apr 16 1996

assume(n, positive);
A:=3^(-(1/2)*n)*2^((1/6)*n)-2^((2/3)*n)*6^(-(1/2)*n):
simplify(A);

#if all else fails:
Q:=select(`@`(evalb,proc(base,exponent) is(base,positive)=true and is(exponent,real)=true end,op),indets(A,anything^anything));
if is(n,real) then
Q:=select(type,Q,anything^linear(n));
fi;
A2:=subs(SQ,A);
simplify(A=A2);

## Compose....

Try with:

F:=piecewise(x>=0 and x <= 1, x^2,x > 1 and x<=2, (2-x)^2);
f:=unapply(F,x);
P:=2*frac(x/2);
p:=(expand@unapply)(P,x);
plot(f,0..2,scaling=constrained);
plot(p,0..8,scaling=constrained);
plot(f@p,0..8,scaling=constrained);
Q:=unapply('q*(frac@((x->x)/q)),q');
p:=Q(2);
plot(f@p,0..8,scaling=constrained,color=blue);
plot([f@Q(2),f@Q(4)],0 .. 8,color = [khaki, black],thickness = [3, 0],numpoints = 101,axes=boxed,scaling=constrained);

## Typo....

Try:

piecewise(x>=0 and x <= 1, x^2,x > 1 and x<=2, (2-x)^2);

## Not a bug....

You alone are meant to guarantee the applicability of the facility you are using. For linear algebra package, elements of the matrix should have a linear basis as arbitrary transformations required to obtain one will not be attempted. In your sample, the transformation sqrt(6)=sqrt(2)*sqrt(3) is not attempted and so the procedure is blind to existing 0s and it does not find the nullspace.

restart; with(linalg):
M:=matrix([[5/2, sqrt(3/2), sqrt(3/4)],
[sqrt(3/2), 7/3, sqrt(1/18)],
[sqrt(3/4), sqrt(1/18), 13/6]]):

eiv := proc(M)
Normalizer := proc(x)
local f, y;
option `Shake things around.`;
f := x -> normal(radnormal(x, rationalized)); y := radsimp(x, ratdenom); normal(f(x - y) + y)
end;
Testzero := proc(x) option `Shaken.`; evalb(Normalizer(x) = 0) end;
end

E:=eiv(M);
P:=`@`(eval,augment,op,map2)(op@map,normalize,map2(op,3,E)):

E:=[[4, 1, {}], [2, 1, {}], [1, 1, {}]]

Normalizer, Testzero are enviroment procedures (look up ?_Env). All modifications terminate with the scope.

## Recovery....

You could recover a system by eliminating the RootOfs. The cheap way to do this is to use eliminate.

#interface(version);
#   Maple Worksheet Interface, Release 4, IBM INTEL NT, Apr 16 1996

recover := proc(S, T0, V0)
local Rs, n, Rs1, r, P, E, T, V;
option `This can fail in ways too many...`;
Rs := indets(S, RootOf);
Rs := remove(proc(x, S) has(op(1, x), S minus {x}) end, Rs, Rs);
n := nops(Rs);
if nargs < 2 then T := {} else T := T0 fi;
if nargs < 3 then V := [] else V := V0 fi;
if 0 < n then
Rs1 := op(1, Rs);
P := ({evala}@Norm)(r - Rs1);
T := T union P;
V := [op(V), Rs1 = r];
E := eliminate(subs(op(-1, V), S) union P, r);
if 1 < n then recover(E[2], T, V) else E[2], T, V fi
else S, T, V
fi
end;

Eliminate may return multiple results so you may want to fork it there.

_EnvExplicit:=false:
A:=evala({a = s/RootOf(_Z^2-s^2+s), b = -RootOf(_Z^2-s^2+s)/s, c = RootOf(_Z^2-s^2+s)});
rA:=recover(A);
rAs:=solve(rA[1],{a,b,c});
A2:=solve(rA[1],{a,b,s});
rA2:=recover(A2);
rA2s:=solve(rA2[1],{a,b,c});

A := {b = -RootOf(_Z^2-s^2+s)/s, c = RootOf(_Z^2-s^2+s), a = RootOf(_Z^2-s^2+s)/(s-1)}
rA := {c-a*s+a, s^2-s-a^2*s^2+2*a^2*s-a^2, b*s+a*s-a}, {-s^2+s+r^2}, [RootOf(_Z^2-s^2+s) = r]
rAs := {b = -RootOf((s-1)*_Z^2-s)*(s-1)/s, a = RootOf((s-1)*_Z^2-s), c = RootOf((s-1)*_Z^2-s)*(s-1)}
A2 := {a = RootOf(-c-_Z+_Z^2*c), s = c*RootOf(-c-_Z+_Z^2*c), b = -(c*RootOf(-c-_Z+_Z^2*c)-1)/c}
rA2 := {b*c+a*c-1, -c-a+a^2*c, -s+a*c}, {(-c-r+r^2*c)/c}, [RootOf(-c-_Z+_Z^2*c) = r]
rA2s := {b = -RootOf(_Z^2-s^2+s)/s, c = RootOf(_Z^2-s^2+s), a = RootOf(_Z^2-s^2+s)/(s-1)}

 First 17 18 19 20 Page 19 of 20
﻿