Christian Wolinski

MaplePrimes Activity


These are answers submitted by Christian Wolinski

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

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});
about(V,Z);


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 module
end 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.

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}

plot(ln(-(x-12)^(1/2)/x/(x-15)),x = 12 .. 15,scaling = constrained,axes = boxed,thickness = 3)

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)

 

plot([fn,fn2],1..phi,color=[khaki,black],thickness=[4,0],numpoints=100,adaptive=false);

PLOT(CURVES([[1.007, .7267], [1.012, .7438], [1.019, .7630], [1.025, .7823], [1.031, .8015], [1.037, .8192], [1.044, .8376], [1.050, .8565], [1.056, .8753], [1.063, .8947], [1.068, .9116], [1.075, .9307], [1.081, .9497], [1.088, .9680], [1.093, .9845], [1.100, 1.004], [1.106, 1.020], [1.112, 1.040], [1.118, 1.056], [1.125, 1.075], [1.131, 1.092], [1.137, 1.110], [1.143, 1.126], [1.150, 1.143], [1.156, 1.161], [1.162, 1.177], [1.168, 1.193], [1.175, 1.210], [1.181, 1.227], [1.187, 1.242], [1.194, 1.259], [1.200, 1.274], [1.206, 1.290], [1.212, 1.305], [1.219, 1.320], [1.225, 1.334], [1.231, 1.348], [1.237, 1.362], [1.244, 1.377], [1.250, 1.390], [1.256, 1.403], [1.262, 1.416], [1.268, 1.428], [1.275, 1.441], [1.281, 1.452], [1.287, 1.463], [1.293, 1.474], [1.300, 1.485], [1.306, 1.495], [1.312, 1.505], [1.318, 1.514], [1.325, 1.523], [1.331, 1.530], [1.337, 1.538], [1.343, 1.545], [1.350, 1.552], [1.356, 1.558], [1.362, 1.563], [1.368, 1.568], [1.374, 1.572], [1.381, 1.575], [1.387, 1.578], [1.393, 1.580], [1.400, 1.581], [1.406, 1.581], [1.412, 1.580], [1.418, 1.579], [1.424, 1.576], [1.431, 1.573], [1.437, 1.568], [1.443, 1.563], [1.450, 1.556], [1.456, 1.548], [1.462, 1.539], [1.468, 1.529], [1.475, 1.517], [1.480, 1.504], [1.487, 1.488], [1.493, 1.472], [1.499, 1.455], [1.506, 1.434], [1.512, 1.411], [1.518, 1.388], [1.524, 1.361], [1.530, 1.332], [1.537, 1.298], [1.543, 1.266], [1.549, 1.225], [1.556, 1.183], [1.562, 1.137], [1.568, 1.086], [1.574, 1.029], [1.581, .9601], [1.587, .8885], [1.593, .8074], [1.599, .7052], [1.606, .5787], [1.612, .4266], [undefined, undefined]],COLOUR(RGB,.6235,.6235,.3725),THICKNESS(4)),CURVES([[1., .7071], [1.007, .7267], [1.012, .7438], [1.019, .7630], [1.025, .7823], [1.031, .8015], [1.037, .8192], [1.044, .8376], [1.050, .8565], [1.056, .8753], [1.063, .8947], [1.068, .9116], [1.075, .9307], [1.081, .9497], [1.088, .9680], [1.093, .9845], [1.100, 1.004], [1.106, 1.020], [1.112, 1.040], [1.118, 1.056], [1.125, 1.075], [1.131, 1.092], [1.137, 1.110], [1.143, 1.126], [1.150, 1.143], [1.156, 1.161], [1.162, 1.177], [1.168, 1.193], [1.175, 1.210], [1.181, 1.227], [1.187, 1.242], [1.194, 1.259], [1.200, 1.274], [1.206, 1.290], [1.212, 1.305], [1.219, 1.320], [1.225, 1.334], [1.231, 1.348], [1.237, 1.362], [1.244, 1.377], [1.250, 1.390], [1.256, 1.403], [1.262, 1.416], [1.268, 1.428], [1.275, 1.441], [1.281, 1.452], [1.287, 1.463], [1.293, 1.474], [1.300, 1.485], [1.306, 1.495], [1.312, 1.505], [1.318, 1.514], [1.325, 1.523], [1.331, 1.530], [1.337, 1.538], [1.343, 1.545], [1.350, 1.552], [1.356, 1.558], [1.362, 1.563], [1.368, 1.568], [1.374, 1.572], [1.381, 1.575], [1.387, 1.578], [1.393, 1.580], [1.400, 1.581], [1.406, 1.581], [1.412, 1.580], [1.418, 1.579], [1.424, 1.576], [1.431, 1.573], [1.437, 1.568], [1.443, 1.563], [1.450, 1.556], [1.456, 1.548], [1.462, 1.539], [1.468, 1.529], [1.475, 1.517], [1.480, 1.504], [1.487, 1.488], [1.493, 1.472], [1.499, 1.455], [1.506, 1.434], [1.512, 1.411], [1.518, 1.388], [1.524, 1.361], [1.530, 1.332], [1.537, 1.298], [1.543, 1.266], [1.549, 1.225], [1.556, 1.183], [1.562, 1.137], [1.568, 1.086], [1.574, 1.029], [1.581, .9601], [1.587, .8885], [1.593, .8074], [1.599, .7052], [1.606, .5787], [1.612, .4266], [undefined, undefined]],COLOUR(RGB,0,0,0),THICKNESS(0)),AXESSTYLE(BOX),SCALING(CONSTRAINED))

Region boundaries, contents of the grey line are excluded:

PLOT(CURVES([[0, 0], [0, -1.500]],COLOUR(RGB,.2,.8,.5),THICKNESS(2)),CURVES([[.2500, -.2500], [-.5000, -1.000]],COLOUR(RGB,.2,.8,.5),THICKNESS(2)),CURVES([[0, 0], [1.500, 0]],COLOUR(RGB,.2,.5,.8),THICKNESS(2)),CURVES([[.2500, -.2500], [1.000, .5000]],COLOUR(RGB,.2,.5,.8),THICKNESS(2)),CURVES([[0, 0], [-1.500, 0]],COLOUR(RGB,.8,.2,.5),THICKNESS(2)),CURVES([[-.2500, .2500], [-1.000, -.5000]],COLOUR(RGB,.8,.2,.5),THICKNESS(2)),CURVES([[0, 0], [0, 1.500]],COLOUR(RGB,.5,.2,.8),THICKNESS(2)),CURVES([[-.2500, .2500], [.5000, 1.000]],COLOUR(RGB,.5,.2,.8),THICKNESS(2)),CURVES([[-.7500, -.7500], [-.6519, -.6519], [-.5538, -.5538], [-.4557, -.4557], [-.3577, -.3577], [-.2596, -.2596], [-.1615, -.1615], [-.6339e-1, -.6339e-1], [.3470e-1, .3470e-1], [.1241, .1241], [.2135, .2135], [.3029, .3029], [.3923, .3923], [.4818, .4818], [.5712, .5712], [.6606, .6606], [.7500, .7500]],COLOUR(RGB,.7529,.7529,.7529),THICKNESS(2)),AXESSTYLE(BOX),SCALING(CONSTRAINED))

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.


 

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



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


#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));
SQ:=map((x->x)=`@`(proc(base,exponent,n) base^coeff(exponent,n,0)*radsimp(base^coeff(exponent,n,1))^n end,(a,b)->(op(a),b)),Q,n);
fi;
A2:=subs(SQ,A);
simplify(A=A2);

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

 

Try:

 

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

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;
    [eigenvectors](map(Normalizer, M), radical)
end

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

E:=[[4, 1, {vector([1/2*2^(1/2)*3^(1/2), 1, 1/2*2^(1/2)])}], [2, 1, {vector([0, 1, -2^(1/2)])}], [1, 1, {vector([-1/2*2^(1/2)*3^(1/2), 1, 1/2*2^(1/2)])}]]

 

matrix([[4, 0, 0], [0, 2, 0], [0, 0, 1]])

 

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

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)}

You appear to be solving for F(x,y) defined as y=F(x,y). So we can do the following:

EQ:=y=F(x,y);
sd:=map((f,x)->f=f(x),map2(`@@`,D,[$0..1])(y),x);
dEQ:=subs(sd,{EQ} union implicitdiff({EQ},{y}(x),{y},x));


EQ := y = F(x,y)
sd := [y = y(x), D(y) = D(y)(x)]
dEQ := {y(x) = F(x,y(x)), D(y)(x) = -D[1](F)(x,y(x))/(-1+D[2](F)(x,y(x)))}

So D(y)(x) = -D[1](F)(x,y(x))/(-1+D[2](F)(x,y(x))) contains the derivatives sought.

Using the definition F = min/max

minovermax:=piecewise(x<y,x,x=y,(x+y)/2,y)/piecewise(x<y,y,x=y,(x+y)/2,x):
rf:=map(`@`(unapply,L->(L[1],op(L[2])),[`@`(unapply(minovermax,x,y),op),L->L]),[assume(x0<y0,x1=y1,x2>y2),[x0,y0],[x1,y1],[x2,y2]]):
pf:=piecewise(x<y,rf[1](x,y),x=y,rf[2](x,y),x>y,rf[3](x,y)):
sol:=map2(proc(X,L,x,y) 'solve'({op(L[2],X)=y,op(L[1],X)},{x,y}) end,pf,[[1,2],[3,4],[5,6]],x,y);
sol;


sol := [solve({x < y, x/y = y},{x, y}), solve({1 = y, x = y},{x, y}), solve({y < x, y/x = y},{x, y})]
[{x = y^2, 0 < y, y < 1}, {y = 1, x = 1}, {y = 0, 0 < x}, {y < 1, x = 1}]

Above and to the right the x,y curve for {y=F(x,y), F=min/max}:plot([[y^2,y,y=0..1],[x,0,x=-2..0],[1,y,y=1..3]],color=red)

And a 3d display of y=F(x,y) in [x,y,F(x,y)] coordinates:

Plot1:=plots[display](
map(plot,[[y^2,y,y=0..1],[x,0,x=-2..0],[1,y,y=1..3]],color=grey,thickness=3),
plots[pointplot]([[1,1]],symbol=BOX,color=black),
axes=boxed
):
Plot2:=plots[display](
plottools[transform]((x,y)->[x,y,y])(Plot1),
labels=['x,y,f'],scaling=constrained):
plots[display](Plot2);

 

Since that curve contains your definitions then you should contain your differentiation to it.

Observe your system in detail first.

#Some Maple V code:

solveit := proc() frontend(solve, [args], [{Non(radical)}, {}]) end:

 

aaghulu := {-6-4*y-x-(1+y)*x+sqrt((4*(1+y))*(2+x)*(4+2*y+x)+(-(1+y)*x+2+x)^2), (2*(4+2*y+x))*(1+y)-(1+y)*x+2+x+sqrt((4*(1+y))*(2+x)*(4+2*y+x)+(-(1+y)*x+2+x)^2)-(2+y)*(-(1+y)*x+2+x+sqrt((4*(1+y))*(2+x)*(4+2*y+x)+(-(1+y)*x+2+x)^2))};usys:={6+2*x+4*y+y*x-u};
result:=`@`(factor,simplify)(aaghulu,usys,{x,y,u}) union usys;


tryit:=unapply('result union {(u^2)^(1/2)=someu},someu'):


solveit(tryit(u));
solveit(tryit(u),{sqrt(u^2),y});
solveit(tryit(-u),{sqrt(u^2),y,u});

 

#Results:

aaghulu := {2*(4+2*y+x)*(1+y)-(1+y)*x+2+x+((6+4*y+2*x+y*x)^2)^(1/2)-(2+y)*(-(1+y)*x+2+x+((6+4*y+2*x+y*x)^2)^(1/2)), -6-4*y-x-(1+y)*x+((6+4*y+2*x+y*x)^2)^(1/2)}
usys := {6+4*y+2*x+y*x-u}
result := {-u+(u^2)^(1/2), 6+4*y+2*x+y*x-u, (u-(u^2)^(1/2))*(1+y)}
{u = 6+4*y+2*x+y*x, x = x, (u^2)^(1/2) = 6+4*y+2*x+y*x, y = y}
{(u^2)^(1/2) = u, y = -(6+2*x-u)/(4+x)}
{u = 0, (u^2)^(1/2) = 0, y = -2*(3+x)/(4+x)}

 

For the solution of (u^2)^(1/2) = u if we assume u is real, positive and x,y are real then a map of x,y is:

plots[contourplot](6+4*y+2*x+y*x,x=-4..4,y=-4..4,contours=map(`*`,[$0..100],0.5));

First 18 19 20 21 Page 20 of 21