Christian Wolinski

MaplePrimes Activity


These are answers submitted by Christian Wolinski

 

A := p(x) = 1/3 *x^ 3 - 6/10 *x^ 2 - 187/100* x + 1;
As := map(unapply, A, x);
(proc(f::function, r::range)
local g, x, x0, y0, S, V;
    _EnvExplicit := true;
    S := map(allvalues, [solve]({g(x) = f(x0), g(x) = y0, D(f)(x0) = 0}, {x0, g(x), y0}));
    S := select(type, S, set(anything = realcons));
    V := map((S, x0, y0, g) -> subs(S, [[x0, y0], g]), S, x0, y0, g(x));
    V := map2(map2, op, [1, 2], V);
    traperror(print(plots[display](
        plots[pointplot](V[1], color = red, symbol = box),
        plot(V[2], x = r, color = black),
        plot(f, r, color = black, thickness = 3, adaptive = true, args[3 .. -1]))));
    V, f
end proc)(rhs(As), -3 .. 3, view = [-3 .. 3, -5 .. 5], axes = boxed, scaling = constrained);

 gives:

INTERFACE_PLOT(POINTS([2.093, -2.486],[-.8933, 1.954],COLOUR(RGB,1.000,0,0),SYMBOL(BOX)),CURVES([[-3., -2.486], [-2.869, -2.486], [-2.755, -2.486], [-2.627, -2.486], [-2.499, -2.486], [-2.370, -2.486], [-2.252, -2.486], [-2.128, -2.486], [-2.001, -2.486], [-1.874, -2.486], [-1.744, -2.486], [-1.629, -2.486], [-1.499, -2.486], [-1.369, -2.486], [-1.244, -2.486], [-1.131, -2.486], [-.9953, -2.486], [-.8808, -2.486], [-.7475, -2.486], [-.6296, -2.486], [-.5002, -2.486], [-.3770, -2.486], [-.2484, -2.486], [-.1303, -2.486], [0, -2.486], [.1293, -2.486], [.2445, -2.486], [.3688, -2.486], [.4973, -2.486], [.6230, -2.486], [.7447, -2.486], [.8797, -2.486], [1.001, -2.486], [1.131, -2.486], [1.248, -2.486], [1.376, -2.486], [1.497, -2.486], [1.623, -2.486], [1.747, -2.486], [1.876, -2.486], [2.000, -2.486], [2.128, -2.486], [2.254, -2.486], [2.370, -2.486], [2.503, -2.486], [2.622, -2.486], [2.748, -2.486], [2.870, -2.486], [3., -2.486]],COLOUR(RGB,0,0,0)),CURVES([[-3., 1.954], [-2.869, 1.954], [-2.755, 1.954], [-2.627, 1.954], [-2.499, 1.954], [-2.370, 1.954], [-2.252, 1.954], [-2.128, 1.954], [-2.001, 1.954], [-1.874, 1.954], [-1.744, 1.954], [-1.629, 1.954], [-1.499, 1.954], [-1.369, 1.954], [-1.244, 1.954], [-1.131, 1.954], [-.9953, 1.954], [-.8808, 1.954], [-.7475, 1.954], [-.6296, 1.954], [-.5002, 1.954], [-.3770, 1.954], [-.2484, 1.954], [-.1303, 1.954], [0, 1.954], [.1293, 1.954], [.2445, 1.954], [.3688, 1.954], [.4973, 1.954], [.6230, 1.954], [.7447, 1.954], [.8797, 1.954], [1.001, 1.954], [1.131, 1.954], [1.248, 1.954], [1.376, 1.954], [1.497, 1.954], [1.623, 1.954], [1.747, 1.954], [1.876, 1.954], [2.000, 1.954], [2.128, 1.954], [2.254, 1.954], [2.370, 1.954], [2.503, 1.954], [2.622, 1.954], [2.748, 1.954], [2.870, 1.954], [3., 1.954]],COLOUR(RGB,0,0,0)),CURVES([[-3., -7.790], [-2.935, -7.104], [-2.869, -6.448], [-2.812, -5.901], [-2.755, -5.376], [-2.691, -4.812], [-2.627, -4.275], [-2.563, -3.761], [-2.499, -3.273], [-2.435, -2.813], [-2.370, -2.378], [-2.252, -1.636], [-2.128, -.9523], [-2.001, -.3321], [-1.874, .2023], [-1.744, .6689], [-1.629, 1.014], [-1.499, 1.331], [-1.369, 1.579], [-1.244, 1.756], [-1.131, 1.866], [-.9953, 1.938], [-.8808, 1.954], [-.7475, 1.923], [-.6296, 1.856], [-.5002, 1.744], [-.3770, 1.602], [-.2484, 1.422], [-.1303, 1.233], [0, 1.006], [.1293, .7489], [.2445, .5118], [.3688, .2454], [.4973, -.3741e-1], [.6230, -.3174], [.7447, -.5876], [.8797, -.8824], [1.001, -1.139], [1.131, -1.399], [1.248, -1.620], [1.376, -1.841], [1.497, -2.026], [1.623, -2.191], [1.747, -2.321], [1.876, -2.419], [2.000, -2.473], [2.128, -2.484], [2.254, -2.446], [2.370, -2.365], [2.503, -2.213], [2.622, -2.020], [2.748, -1.752], [2.870, -1.430], [3., -1.010]],COLOUR(RGB,0,0,0),THICKNESS(3)),SCALING(CONSTRAINED),AXESSTYLE(BOX),AXESLABELS(x,``),VIEW(-3. .. 3.,-5. .. 5.))

.

AFAIK thre is no way to sort those. Maple will display sum terms according to "in-memory address" ordering and you can not change that. You can always try this:

 

ind:=(n->`if`(type(n,indexed),op(1,n),-infinity));
L:=sort([op](a[3]+a[2]+a[1]),(a,b)->evalb(ind(a)<=ind(b)));

add(i,i=L);

 

Look up ?extrema

Simply put you are trying to compute this:

 

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,2,B),`@`({op},map2)(op,3,B);
minimize(S)..maximize(S);;

@Honigmelone 

 

asimplify := proc(Expr, Terms::{list, set}, EliminationTerms::{list, set}, Assumptions::{function, procedure}, Execution::{function, procedure})
local X, Zs, Ze, ZS, Ot, Oe, i, T1, Z;
    Ot := [op](Terms);
    Oe := [op](EliminationTerms);
    T1 := {Non}(map(identical, {op}(Oe)));
    Zs := [seq(cat(Z, i), i = 1 .. nops(Ot))];
    Zs := `@`(assume, op, zip)(Assumptions, Zs, Ot), eval(Zs);
    ZS := zip((a, b) -> a = b, Zs, Ot);
    Ze := Ot - Zs;
    X := frontend(Execution@simplify, [Expr, Ze, map(op, [Oe, Zs])], [T1, {}]);
    X := subs(ZS, X)
end proc;

asimplify(f_minus,[a(t)-b],[a(t)],(n,x)->(n,real),x->simplify(convert(x,signum)));


Please test the above code. Let me know the cases that dont work.


 

restart:
f:=abs(a)*abs(1,a);

assume(a,real),simplify(convert(f,signum));

Try the above.

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

Lookup ?frontend. It is intended precisely for your task.

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

 

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

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



First 18 19 20 21 22 Page 20 of 22