Christian Wolinski

MaplePrimes Activity


These are answers submitted by Christian Wolinski

Try the code below and consider what it implies:

 

A := -144*z-44+12*sqrt(-12*z^3+96*z^2+24*z-15);;
B := 1728*z^2+2304*z+1024+432*z^3;


rationalize(B/A);

q := rationalize(B/A)*A-B;
evalb(rationalize(q)=0);

 

member(0,map(`@`(radnormal,unapply(A,z)),{solve}(B)));

Is the following at all close to the anticipated solution?Result of solve.

Try this code:

 

OperandsTable := proc()
local F;
    F := proc(A)
        local i, j, B;
            j := args[2 .. -1];
            if nops(A) = 1 then
                B := op(1, 'A');
                if type(B, '{indexed, list, set, `*`, `+`, `^`, function, relation, boolean, `::`, `..`, `.`, uneval}') then
                    j = eval(B, 1), procname([op(0, B)], j, 0), seq(procname([op(i, B)], j, i), i = 1 .. nops(B))
                else j = eval(B, 1)
                end if
            else j = op('A'), seq(procname([op(i, 'A')], j, i), i = 1 .. nops(A))
            end if
        end proc;
    table([F(['args'])])
end proc;

An example:

 

K:=OperandsTable('map((x->x)=SetPartitions,[op](5..6,remove(has,combinat[partition](10),1)))'):
eval(K[],1);
leafsindices:=remove(proc(L,S) hastype(S,[op(L),anything]) end,{indices}(K)$2):
leafs:=map((S,T)->eval(T[op(S)],1),leafsindices,K);
leafs_parameters:=map((S,T)->`if`( op(-1,S)=0 , NULL, eval(T[op(S)],1)),leafsindices,K);
leafs_operand0:=map((S,T)->`if`( op(-1,S)=0 , eval(T[op(S)],1), NULL),leafsindices,K);
all_operand0indices:=select(S->evalb(nops(S)>0 and op(-1,S)=0),{indices}(K)):
all_operand0:=map((S,T)->eval(T[op(S)],1),all_operand0indices,K);

Let me know if there is anything amiss.

 

Two versions of same but with small distinctions:

 

F := proc(N::nonnegint, lo::nonnegint, hi::nonnegint) local q, A, i; A := 'irem(q, 2, 'q')'; irem(N, 2^lo, 'q'), [seq(eval(A), i = lo .. hi)], q end proc;

or this:

 

F  := proc(N::nonnegint, range::(nonnegint .. nonnegint))
local q, A, i;
    A := unapply('irem(q, 2, 'q'), i'); irem(N, 2^lhs(range), 'q'), map(A, [`$`(range)]), q
end proc;


So F(8,0..7)[2]; gives [0, 0, 0, 1, 0, 0, 0, 0]

and F(11+5*256+7*256*256,8..15); gives 11, [1, 0, 1, 0, 0, 0, 0, 0], 7

Lookup ?member. This function is intended to compare expressions. In your example you are looking for matrices. The difference here is a matrx is a storage and identified by a reference and not its contents. On the other hand type listlist is an expression.

This code will match matrices only if the expressions of the elements are a match. This maybe sufficient for matrices of constants. Otherwise lookup ?iszero, ?Normalizer and test the difference.

fl:=a->convert(a,listlist):Jfl:=map(fl,J):
for i to 1 do for j to 2 do a := J[i].J[j]; member(fl(a), Jfl, 'k'); print(i, j, k, a, whattype(a)) end do end do;

 

I do not know this is easier, but it is more transparent.

A := (Cq = Cao*k1*t/(1+k1*t)/(1+k2*t));
X := {A}, {Cq}(t), {Cq};
Aextremas := `@`(S -> collect(S, RootOf, distributed, factor), evala, proc () _EnvExplicit := false;
[solve](args) end proc)({A, D(Cq) = 0} union implicitdiff(X, t) union implicitdiff(X, t, t), {t} union map2(`@@`, D, {`$`(0 .. 2)})(Cq));
map(allvalues, Aextremas);

 

Plainly:


A:=[2,4,6,8,10,12];
m:=proc(x,L) local i; if member(x,L,'i') then i else NULL end if end proc;
m(4,A);
m(3,A);

 

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

First 17 18 19 20 21 Page 19 of 21