Carl Love

Carl Love

28055 Reputation

25 Badges

12 years, 357 days
Himself
Wayland, Massachusetts, United States
My name was formerly Carl Devore.

MaplePrimes Activity


These are answers submitted by Carl Love

The procedure below handles, with the greatest possible generality, all cases of multivariate functional iteration. It uses a combination of unapply and eval, and can be used as a replacement for eval or `@@`. It is often far more efficient than `@@` because it uses a repeated squaring algorithm. As far as I can determine, this is the only usage of a repeated squaring algorithm for functional iteration.

Multivariate Functional Iteration

Author: Carl Love, 2016-Sep-05

restart:

 

These first two procedures simply exist to use remember tables to avoid repetition of suboperations during recursive calls to the main procedure.

unapplyR:= proc(f, v, S, $)
option cache;
     S~@unapply(f, v)
end proc:

 

#Convert from a list({name, name=anything}) to a list(name=anything),
#then extract the left and right sides of the list elements.
ListNameValue:= proc(v::list({name, name= anything}), $)
option cache;
local V:= (x-> `if`(x::'name', x=x, x))~(v);
     (V, (lhs~,rhs~)(V))
end proc:

 

MultivarIterate:= proc(
     f::list,
     v::And(
          list({name, name= anything}),
          #Check that the names are distinct and match f in length.
          satisfies(
               v-> (n-> n=nops(f) and n=nops((x-> `if`(x::name, x, lhs(x)))~({v[]})))
                    (nops(v))
          )
     ),
     {Simp::{identical(NULL), appliable}:= expand},
     {iters::nonnegint:= 2},
     {method::identical(linear, repeatedsquaring):= repeatedsquaring}
)
local q, r, F, Fx, V, R, L, S;
     (V,L,R):= ListNameValue(v);
     S:= `if`(Simp = NULL or Simp = expand and R::'list(numeric)', _-> _, Simp);
     Fx:= S~(eval(f,V));
     if iters = 0 then
          S~(R)
     elif iters = 1 then
          Fx
     elif iters = 2 or method = 'linear' then
          thisproc(f, L=~ Fx, ':-iters'= iters-1, ':-Simp'= S)
     else #Use repeated squaring.
          F:= unapplyR(f, L, S);
          q:= iquo(iters, 2, 'r');         
          thisproc(F(F(L[])[]), `if`(r=1, L=~ Fx, v), ':-iters'= q, ':-Simp'= S)
     end if
end proc:          

The procedure above could be made simpler if iters=1 and iters=2 weren't treated as special cases, but it wouldn't be as efficient.

 

Your example:

f:= [y, y*z - x, -15*x*y - x*z - x]:
v:= [x,y,z]:

The default number of iterations is 2, and the default simplifier is expand.

MultivarIterate(f, v);

[y*z-x, -15*x*y^2*z-x*y*z^2+15*x^2*y+x^2*z-x*y*z+x^2-y, 15*x*y^2+x*y*z-15*y^2*z+16*x*y-y]

MultivarIterate(f, v, Simp= NULL);

[y*z-x, (y*z-x)*(-15*x*y-x*z-x)-y, -15*y*(y*z-x)-y*(-15*x*y-x*z-x)-y]

MultivarIterate(f, v, Simp= NULL, iters= 3);

[(y*z-x)*(-15*x*y-x*z-x)-y, ((y*z-x)*(-15*x*y-x*z-x)-y)*(-15*y*(y*z-x)-y*(-15*x*y-x*z-x)-y)-y*z+x, -15*(y*z-x)*((y*z-x)*(-15*x*y-x*z-x)-y)-(y*z-x)*(-15*y*(y*z-x)-y*(-15*x*y-x*z-x)-y)-y*z+x]

A:= MultivarIterate(f, v, iters= 3);

[-15*x*y^2*z-x*y*z^2+15*x^2*y+x^2*z-x*y*z+x^2-y, -225*x^2*y^4*z-30*x^2*y^3*z^2-x^2*y^2*z^3+225*x*y^4*z^2+15*x*y^3*z^3+225*x^3*y^3+30*x^3*y^2*z+x^3*y*z^2-480*x^2*y^3*z-32*x^2*y^2*z^2+15*x*y^3*z^2+255*x^3*y^2+17*x^3*y*z-31*x^2*y^2*z+15*x*y^3*z+x*y^2*z^2+16*x^3*y-15*x^2*y^2-x^2*y*z-15*x*y^3+15*y^3*z-x^2*y-16*x*y^2+y^2-y*z+x, 225*x*y^3*z^2+15*x*y^2*z^3-450*x^2*y^2*z-30*x^2*y*z^2-15*x*y^3*z+14*x*y^2*z^2+15*y^3*z^2+225*x^3*y+15*x^3*z+15*x^2*y^2-29*x^2*y*z-31*x*y^2*z+15*x^3+16*x^2*y+16*y^2*z-16*x*y-y*z+x]

v0:= [1.3, 2.5, -0.7]:

eval(A, v=~ v0);

[147.3770, 34596.1163250, 7461.459000]

The procedure can perform numeric evaluation of the iterated function. This is often more efficient than symbolic iteration followed by numeric evaluation.

MultivarIterate(f, v=~ v0, iters= 3);

[147.3770, 34596.1163250, 7461.459000]

MultivarIterate(f, v=~ v0, iters= 8);

[0.203944206379806e57, 0.161058256445710e105, -0.804233613250701e88]

The procedure Forget isn't a necessary part of this computation. It's only purpose is to make the timings accurate.

Forget:= ()-> forget~([ListNameValue, unapplyR]):

Forget():

A1:= CodeTools:-Usage(MultivarIterate(f, v, iters= 8)):

memory used=1.50GiB, alloc change=1.38GiB, cpu time=2.37m, real time=46.19s, gc time=58.70s

Often it's the simplification that takes the vast majority of the time.

Forget():

A2:= CodeTools:-Usage(MultivarIterate(f, v, iters= 8, Simp= NULL)):

memory used=52.60KiB, alloc change=0 bytes, cpu time=0ns, real time=1000.00us, gc time=0ns

evalb(A1 = expand~(A2));

true

Forget():

A3:= CodeTools:-Usage(MultivarIterate(f, v, iters= 8, method= linear)):

memory used=119.34KiB, alloc change=0 bytes, cpu time=0ns, real time=1000.00us, gc time=0ns

evalb(A1 = A3);

true

map(eval, [A1,A2], v=~ v0);

[[0.203944206379810e57, 0.161058256445714e105, -0.804233613250713e88], [0.203944206379808e57, 0.161058256445713e105, -0.804233613250717e88]]

Note that the simplification or expansion of the symbolics causes slight changes in the last few digits of the numeric evaluations. I suspect that unexpanded forms are more accurate.

 

The evaluation point can be symbolic and/or partial.

MultivarIterate(f, [x= (p+q), y, z= 0], iters= 4, Simp= NULL);

[((-p-q)*(-15*(p+q)*y-p-q)-y)*(-15*y*(-p-q)-y*(-15*(p+q)*y-p-q)-y)+p+q, (((-p-q)*(-15*(p+q)*y-p-q)-y)*(-15*y*(-p-q)-y*(-15*(p+q)*y-p-q)-y)+p+q)*(-15*(-p-q)*((-p-q)*(-15*(p+q)*y-p-q)-y)-(-p-q)*(-15*y*(-p-q)-y*(-15*(p+q)*y-p-q)-y)+p+q)-(-p-q)*(-15*(p+q)*y-p-q)+y, -15*((-p-q)*(-15*(p+q)*y-p-q)-y)*(((-p-q)*(-15*(p+q)*y-p-q)-y)*(-15*y*(-p-q)-y*(-15*(p+q)*y-p-q)-y)+p+q)-((-p-q)*(-15*(p+q)*y-p-q)-y)*(-15*(-p-q)*((-p-q)*(-15*(p+q)*y-p-q)-y)-(-p-q)*(-15*y*(-p-q)-y*(-15*(p+q)*y-p-q)-y)+p+q)-(-p-q)*(-15*(p+q)*y-p-q)+y]

This example shows how the procedure can be used to evaluate a recurrence relation of higher-than-first order.

MultivarIterate([y, x+y], [x=0, y=1], iters= 99);

[218922995834555169026, 354224848179261915075]

combinat:-fibonacci(99);

218922995834555169026

Now I'll show that MultivarIterate using its default repeatedsquaring algorithm is much more efficient than `@@`, (which I suspect uses something akin to the linear algorithm).

CodeTools:-Usage((((x,y)-> (y,x+y))@@999999)(0,1)):

memory used=40.65GiB, alloc change=0 bytes, cpu time=97.89s, real time=58.99s, gc time=63.06s

Forget():

CodeTools:-Usage(MultivarIterate([y, x+y], [x=0, y=1], iters= 999999)):

memory used=3.58MiB, alloc change=0 bytes, cpu time=31.00ms, real time=31.00ms, gc time=0ns

 

 

Download MultivarIterate.mw

The function IsSubspace that you want isn't predefined in Maple, but it can be built as a one-liner from LinearAlgebra:-IntersectionBasis like this:

IsSubspace:= (U::set(Vector), V::set(Vector))->
     andmap(u-> LinearAlgebra:-IntersectionBasis([u, V]) <> {}, U)
:

And it's used like this:

IsSubspace({<0,1,0>, <0,0,1>}, {<1,0,0>, <0,1,0>, <0,0,1>});

     true

An approach that would be more computationally efficient would be based on examining the row-echelon form of the matrix formed by the columns of V on the left augmented by the columns of U on the right. I don't feel like coding that right now, but I suspect that it could be done also as a one-liner using LinearAlgebra:-LinearSolve. I'll do it tomorrow, if someone else doesn't do it first.

The output of both procedures is now 0, 0, 1, 1. That's because assign is now built-in, and thus it can alter an environment variable. In earlier Maple, assign was written in Maple, so it any change that it made to an environment variable would revert as soon as assign exited.

If you want to see any output in a simple form, use lprint.

int(1/(x-a)/(x-b), x= -infinity..infinity);
lprint(%);

piecewise(And(a = RootOf(Im(_Z)), b = RootOf(Im(_Z))), undefined, Im(a) = 0, undefined, Im(b) = 0, undefined, I*Pi*(signum(0, Im(a), 1)-signum(0, Im(b), 1))/(a-b))

I suspect that the symbol that you were having trouble undetstanding is the script I that Maple uses to prettyprint Im.

Perhaps you're looking for a more-automatic way, such as a method that tells you that (-1+d1) and (-2+d1) are the best subexpressions to substitute for.


restart:

y:=
     -8*C*d1^2*(-2+d1)*(-1+d1)^3*r*L*R^3 + (d1^4*(-2+d1)^2*L^2 -
     4*C*(-2+d1)*(4*d1^3-13*d1^2+16*d1-8)*(-1+d1)^2*r^2*L+4*C^2*(-2+d1)^2*
     (-1+d1)^4*r^4)*R^2+(2*d1^4*(-2+d1)^2*r*L^2-2*C*(-2+d1)*
     (5*d1^3-24*d1^2+32*d1-16)*(-1+d1)^2*r^3*L+4*C^2*(-2+d1)^2*
     (-1+d1)^4*r^5)*R+d1^4*(-2+d1)^2*r^2*L^2-2*C*(-2+d1)*
     (d1^3-6*d1^2+8*d1-4)*(-1+d1)^2*r^4*L+C^2*(-2+d1)^2*(-1+d1)^4*r^6
:

Find the most frequently occuring subexpressions of type `+`. There's no need to limit this to type `+`, but I wanted an easy way to exclude trivial subexpressions like constants and names.

AllE:= [indets(y, `+`)[]]:

All:= [indets~(AllE, `+`)[]]:

MCS:= sort(AllE, key= (e-> -nops(select(x-> member(e,x), All))))[..-2];

[-2+d1, -1+d1, 4*d1^3-13*d1^2+16*d1-8, 5*d1^3-24*d1^2+32*d1-16, d1^4*(-2+d1)^2*L^2-4*C*(-2+d1)*(4*d1^3-13*d1^2+16*d1-8)*(-1+d1)^2*r^2*L+4*C^2*(-2+d1)^2*(-1+d1)^4*r^4, 2*d1^4*(-2+d1)^2*r*L^2-2*C*(-2+d1)*(5*d1^3-24*d1^2+32*d1-16)*(-1+d1)^2*r^3*L+4*C^2*(-2+d1)^2*(-1+d1)^4*r^5, d1^3-6*d1^2+8*d1-4]

We see from the list MCS that the two most commonly occuring subexpressions are those that you expected. We substitute names A and B for those.

Y:= eval(y, MCS[1..2]=~ [A,B]);

-8*C*d1^2*A*B^3*r*L*R^3+(d1^4*A^2*L^2-4*C*A*(4*d1^3-13*d1^2+16*d1-8)*B^2*r^2*L+4*C^2*A^2*B^4*r^4)*R^2+(2*d1^4*A^2*r*L^2-2*C*A*(5*d1^3-24*d1^2+32*d1-16)*B^2*r^3*L+4*C^2*A^2*B^4*r^5)*R+d1^4*A^2*r^2*L^2-2*C*A*(d1^3-6*d1^2+8*d1-4)*B^2*r^4*L+C^2*A^2*B^4*r^6

Attempt some further compactification.

collect(Y, [A,B]);

((4*C^2*R^2*r^4+4*C^2*R*r^5+C^2*r^6)*B^4+d1^4*L^2*R^2+2*d1^4*r*L^2*R+d1^4*r^2*L^2)*A^2+(-8*C*d1^2*B^3*r*L*R^3+(-4*C*(4*d1^3-13*d1^2+16*d1-8)*r^2*L*R^2-2*C*(5*d1^3-24*d1^2+32*d1-16)*r^3*L*R-2*C*(d1^3-6*d1^2+8*d1-4)*r^4*L)*B^2)*A

Another alternative.

collect(Y, [B,A]);

(4*C^2*R^2*r^4+4*C^2*R*r^5+C^2*r^6)*A^2*B^4-8*C*d1^2*A*B^3*r*L*R^3+(-4*C*(4*d1^3-13*d1^2+16*d1-8)*r^2*L*R^2-2*C*(5*d1^3-24*d1^2+32*d1-16)*r^3*L*R-2*C*(d1^3-6*d1^2+8*d1-4)*r^4*L)*A*B^2+(L^2*R^2*d1^4+2*L^2*R*d1^4*r+L^2*d1^4*r^2)*A^2

 

Download Most-common_subexpressions.mw

The model is linear in the parameters a and b, which is all that's needed for it to be a linear fit problem. The implicit nature of the model can be handled by subtracting one side from the other and using 0 as the dependent variable values.

restart:

NMP:= <0.530, 0.555, 0.572, 0.592>:
ETOH:= <0.136, 0.153, 0.163, 0.170>:

Model:= ln(etoh/(1-etoh-nmp)) = a*ln(nmp/(1-etoh-nmp)) + b:

S:= Statistics:-Fit(
     (lhs-rhs)(Model), <ETOH|NMP|0~(NMP)>, [etoh,nmp],
     summarize, output= parametervalues
):

Summary:
----------------
Model: -1.2558617*ln(nmp/(1.-1.*etoh-1.*nmp))+1.4660801+ln(etoh/(1.-1.*etoh-1.*nmp))
----------------
Coefficients:
    Estimate  Std. Error  t-value  P(>|t|)
a    1.2559    0.0580      21.6682   0.0021
b   -1.4661    0.0415     -35.3513   0.0008
----------------
R-squared: 0.9958, Adjusted R-squared: 0.9936

eval(Model, S);

ln(etoh/(1-etoh-nmp)) = HFloat(1.255861653096077)*ln(nmp/(1-etoh-nmp))-HFloat(1.466080124258709)

 

Download Implicit_linear_fit.mw

It looks like you have a very good fit. The p-values are very impressive, especially considering that there's only four data and two degrees of freedom.

I guess that it bothers you to need to select the variable with respect to which to eliminate. Your first inclination is f__F; Kitonum's is L. It turns out that there are an amazing five choices of variable that lead to the same simplest possible final form. The following line of code finds all possible injective substitutions (there are seven!) and tries them all:

map2(simplify@eval, nb, op~(select(s-> nops(s)=1, map2(solve, hh, `[]`~([indets(hh)[]])))));

[(gamma*upsilon-delta__1122^k*tau)*rho, (gamma*upsilon-delta__1122^k*tau)*rho, (gamma*upsilon-delta__1122^(L*lambda*upsilon*tau*v*(sigma-1)/(L*lambda*tau*upsilon*v+f__F*rho*sigma*tau^2-f__F*rho*sigma*upsilon^2))*tau)*rho, (gamma*upsilon-delta__1122^k*tau)*rho, -(k-sigma+1)*lambda*L*(gamma*upsilon-delta__1122^k*tau)*upsilon*tau*v/(f__F*sigma*(tau^2-upsilon^2)*k), (gamma*upsilon-delta__1122^k*tau)*rho, (gamma*upsilon-delta__1122^k*tau)*rho]

When you look at it with 2-D ouput, it's obvious that there are five in the simplest form. If you just want the simplest form selected automatically, do

sort(%, key= length)[1];

(gamma*upsilon-delta__1122^k*tau)*rho

 

First, some case corrections: Ln should be ln, pi should be Pi, and S should be s. Second, it's poor style (though not an error) to use .5 as an exponent; I changed these to sqrt. Using exponent (1/2) would also be okay.

The plot can be done by substituting z^(1/3) for R/R[0] and then using plots:-implicitplot.

eq:=
     ln(2*s*t+2*s*sqrt(t/Pi)*z^(1/3)+z^(2/3)) =
     2*s/sqrt(2*Pi*s-s^2)*(arctan((s+z^(1/3)*sqrt(Pi/t))/sqrt(2*Pi*s-s^2)) - Pi/2);

plots:-implicitplot(
     map2(eval, eq, s=~ [.01, .005, .003]), t= .01..99, z= 0..2, gridrefine= 3,
     color= [red, green, blue], labels= [t, typeset([R/R__0]^3)],
     legend= (s=~ [.01, .005, .003])
);

R:= solve(Fx, x);
a:= `+`(R)/2;
b:= (R[1]-a)^2;

I find it easiest to put the information into a Matrix and then put the Matrix into a spreadsheet. Here's an example:

restart:
R:= RandomTools:-Generate(float(range= -2..2), makeproc):
f:= randpoly([p,x,y]);

M:= Matrix([
     seq(
          [S[1], S[2][1], eval([x,y], S[2][2])[]],
          S= [seq(
               [
                     p,
                     Optimization:-Maximize(
                          f, x= -2..2, y= -2..2,
                          initialpoint= ([x,y]=~ ['R()' $ 2])
                     )
               ],
               p= 0..1, 0.1
          )]
     )
]);

Spread:-CreateSpreadsheet(MySpreadsheet);
Spread:-SetMatrix(MySpreadsheet, M, 3, 3); #(3,3) is starting (row,column) in spread sheet.

Code edited to randomize the initial point.

Good Question. Do the legended and unlegended plots in separate plot commands and paste the results together with plots:-display, like this:

plots:-display(
     plot(
          [cos(x)^2, 1-(1/2)*x],
          x = -Pi .. Pi,
          legend = [typeset("Curve: ", cos(x)^2), typeset("Curve: ", 1-(1/2)*x)]
     ),
     plot(x^2, x= -Pi..Pi)
);

You're misinterpretting the placement of the horizontal axis. Maple doesn't always place it at y = 0. In this case, it placed it at the minimum y-value, 1.2. Look at the numbers on the vertical axis to confirm this. If you want to see the axes with their normal placement, use

plot({3.8+2.6*sin(50*Pi*t), 5}, t= 0..0.05, axes= normal, view= [0..0.05, -1..7]);

You can also "probe" values on the graph with the mouse. Right-click on the graph, select Manipulator, then Point Probe. Right-click again, select Probe Info, then Nearest Point on Line. Now you can trace your mouse along the curve and see the values.

There's an undocumented command inner for dot products that won't use the conjugate:

inner(vector([x,y,z]), vector([a,b,c]));

Use plottools:-sphere to plot an actual small sphere at each point.

You must be using Maple's garbage 2-D input mode. You original code probably contained the statement

ans(ind):= [op([1], f1max), roll];

If you had been using Maple's 1-D input, this statement only has one possible interpretation (in context): You are assigning an Array element. With garbage 2-D input, Maple tells you that the statement can be interpretted as either a remember table assignment or a function definition and asks you to choose which. (Note that the correct interpretation isn't even one of the choices; however, remember table assignment is effectively the same as Array assignment for the purpose of this question.) Two weeks ago, you selected "remember table assignment"; today you selected "function definition".

If you use 1-D input (aka Maple Input), you'll avoid this problem, and you won't have to answer a stupid question every time you run your code. 2-D input is garbage: No reasonable language asks the end user to provide an interpretation for the code every time a program is run.

 

First 212 213 214 215 216 217 218 Last Page 214 of 395