acer

32622 Reputation

29 Badges

20 years, 44 days
Ontario, Canada

Social Networks and Content at Maplesoft.com

MaplePrimes Activity


These are replies submitted by acer

@rlewis In my 64bit Maple 12.02 on Windows 7 it takes 1 minute for the animate call below to compute. Then, when I use commands to programmatically export to a .gif it takes 20 sec before a 0 KB file appears and then another 40 sec before the full 2.4 MB file appears.

I used plotsetup to change the plot output device to gif. That way I didn't have to use any right-click menus to export.

A few things to note about Maple 12: the plots:-display command does not applying directional lighting or surface glossiness by default (ie. opposite of Maple 2015). So I specify those as options below.

I find that the solidcircle symbol of a 3D point plot looks clunky and rough at large symbolsize. So I use plottools:-sphere below instead. Adjust its grid option to make it more or less smooth.

restart;
with(plots): with(plottools):
f1:=cos(t)/4: f2:=sin(t)/5: f3:=sin(2*t+1)/6:
pts:=[[0,0,f1],[1+f2,1,1],[-1,0,f3]]:
ptsL:=[pts[],pts[1]]:
c:=[blue,red,green]:
p1:=seq(sphere(eval(ptsL[i],t=0),0.07,color=c[i],
               grid=[30,30],style=patchnogrid),
        i=1..3):
p2:=pointplot3d(eval(ptsL,t=0),connect,thickness=3,color=black):
display(p1,p2,scaling=constrained,lightmodel=Light4,glossiness=1.0);
p:=tt->display(seq(sphere(eval(ptsL[i],t=tt), 0.07,
                          color=c[i], grid=[30,30],
                          style=patchnogrid, lightmodel=Light4),
                   i=1..3),
               pointplot3d(eval(ptsL,t=tt),
                           connect, thickness=3, color=black),
               scaling=constrained,lightmodel=Light4,glossiness=0.0):
A:=animate(p,[t],t=0..50,frames=100):
fn:=cat(kernelopts(homedir),"/rl01.gif"):
plotsetup(gif,plotoutput=fn);
A; # This should now create the .gif file, eventually.

Running the above in 64bit Maple 12.02 on Windows 7 gave me this .gif, eventually.

 

@rlewis Using Preben's code for Maple 12, and running it in Maple 12.02, I right-clicked and chose "Export" as the bottom choice in the popped-up context-menu. I selected the GIF item from the submenu of that "Export" item. I gave it a file location, etc. It takes a few moments for Maple to finish writing out the .gif file and close the write operation.

Here's what I got when it finished writing out the file:

@Carl Love I don't want to confuse Robert, but FYI it is possible in Maple 2015 to write code which embeds a PlotComponent which contains the plot-sequence-animation and which plays it automatically (ie. fully programmatically).

Robert, Carl's suggestions 1) or 2) are very much the usual way, and are what you need to do in Maple 12.

Also, Robert, right-click context-menu export of the visible plot (animation) should allow you to produce an animated .gif file, if you want.

@rlewis Apart from converting to tangents your bullet points are what I did in my Answer. I used expand to deal with terms like cos(t1+t). Then I used freeze and subs to replace the sin and cos terms with names. Then I built extra a set of the additional equations based on that same trig identity. And then I solved with RootFinding:-Isolate (which I let return float results but which internally does exact solving for the system of polynomials with exact rational coefficients -- its default method=RS computes via a Groebner basis ). And then I used the solutions from that stage to recover roots in terms of the original names (and I noted that I could have just used inverse trig, but wanted it coded more generally).

 

@Carl Love The output from anames could be compared, from before and after.

Hmmm.  By Maple 17.02 `realroot` has become an appliable module which doesn't export `zero_one`.

restart:

kernelopts(version);

          Maple 16.02, X86 64 WINDOWS, Nov 18 2012, Build ID 788210

showstat(zero_one);
Error, (in showstat) procedure name expected

readlib(realroot);

                 proc(poly, widthgoal)  ...  end proc;

showstat(zero_one);

zero_one := proc(A, x, n, widthgoal)
local Astar, var, L, Aprime, Lprime, Aprime2, Lprime2, y;
   1   Astar := expand(subs(y = x+1,expand(y^n*subs(x = 1/y,A))));
   2   var := polyvariations(Astar,x,n);
   3   if var = 0 then
   4     return []
       elif var = 1 then
   5     if 1 <= widthgoal then
   6       return [[0, 1]]
         else
   7       return midpoint(A,x,n,widthgoal)
         end if
       end if;
   8   Aprime := subs(x = 1/2*x,A);
   9   if subs(x = 1,Aprime) = 0 then
  10     L := [[1/2, 1/2]];
  11     divide(A,2*x-1,'Aprime');
  12     Aprime := subs(x = 1/2*x,Aprime)
       else
  13     L := []
       end if;
  14   Aprime := expand(2^n*Aprime);
  15   Lprime := zero_one(Aprime,x,n,2*widthgoal);
  16   L := [op(L), op(map((x, y) -> map(y,x),Lprime,z -> 1/2*z))];
  17   Aprime2 := expand(subs(x = x+1,Aprime));
  18   Lprime2 := zero_one(Aprime2,x,n,2*widthgoal);
  19   L := [op(L), op(map((x, y) -> map(y,x),Lprime2,z -> 1/2*z+1/2))]
end proc

And then there are `polyvariations` and `midpoint` and a few other erstwhile locals of module `realroot`to consider as well.

Was `zero_one` ever documented? If not, why use it without making a code comment about what it does?

Your question is not clearly phrased.

Are you looking for a sequence of some (or all) of the permutations of the fixed number k diagonal entries being 1? For example, for fixed k=7 you want several or all of the possible permutations of the 7 nonzero values along the disagonal?

Or are you looking for a sequence, for k=1..9 say, where the k entries of value 1 are in the first (say, or last) k rows? 

acer

How many pieces are allowed?

Do you have a mechanism for evaluating f(x) at arbitary x, or do you only know f(x) at a fixed, given set of x points?

Are you looking to minimize the error between f(x) and the approximation, between known endpoints and a and b?

More details of your goal would likely help get you to an acceptable answer.

acer

@Markiyan Hirnyk Yes, I have seen all the previous discussions in this forum on this topic, both for 2D and 3D. The plot you show, (produced by Kitonum) has some weaknesses of its own. For example, if the plot is rotated manually then the colorbar and the surface obscure each other. Also, it would need additional generalization to support custom shading schemes.

My approach above is much more like Carl's suggestion in that thread you cited (and which had been mentioned other places too, even earlier than that). The key difference is that in Maple 2015.1 the Tabulate command offers better control over the placement and sizing of the two entries in a GUI Table, and in control over the exterior and interior borders of such a Table.

What is zero_one ?

acer

@Mac Dude

type(f(a*b), patfunc(`+`, anything));
                                     false

type(f(a+b), patfunc(`+`, anything));
                                     true

type(Sum(a+b), patfunc(`+`, anything));
                                     true

type(Sum(a), patfunc(`+`, anything));  
                                     false

It's been pointed out several times before that the SumTools package might be given an Expand export (and other useful bits too, akin to what IntegrationTools has).

Also, while I am not advocating its use, it could be pointed out that loading the deprecated student package can make some such expansions succeed. For example, it expands here in the Sum case (but not sum, if I recall).

The question of validity can also crop up...

 

@Markiyan Hirnyk It works fine for me in each of: 32bit Maple 17.02, 32bit Maple 18.02, 32bit Maple 2015.1, all of them running on Windows 7 Pro, on an i7-920.

I could mention, in case anyone else but me find this topic interesting, that of course the roots of the unfrozen trig terms (ie, the certified roots of the polynomial system as returned by RootFinding:-Isolate) can simply be obtained using arctrig calls (and fill-in by adding/subtracting multiples of Pi, and then sieving out those solutions not "in range"). Calling arctrig commands is obviously faster still than calling fsolve or my `findroots` above. The reason I used `allroots` or fsolve was that in general this kind of problem can have more involved substitutions and I'm interested in discovering how difficult it is to program for that in general.

@spm71 A Matrix has its indices start from 1.

An Array can have its indices start from whatever integers you want, and the default is to start from 0. Note that an Array itself will not prettyprint display (if that matters to you...). So you could do, say,

Array(0..5,0..5,(i,j)->i+j);

or

Array(0..4,1..5,(i,j)->i+j);

or what have you.

Note also that for Matrix M the operation M^(-1) computes a Matrix inverse. But for an Array A the operation A^(-1) will do elementwise (scalar) multiplicative inversion.

This sounds like a good time to start reading the manuals and Help. (But you may find it difficiult to find good material on Matrix; ie, you won't find that here, or here, or here. I suggest go here and here.)

Several years ago I posted an answer to another question, where I wanted something faster than Student:-Calculus1:-Roots for finding multiple roots of a univariate nonpolynomial expression over a finite range. The quick one-off that I posted I called `findroots`. (Carl Love posted a very similar thing in yet another thread here just last year.) Here is one version of what I wrote. It may not be the latest and most robust I've implemented, but it is the first version I found.

findroots:=proc(expr,a,b,{guard::posint:=5,maxtries::posint:=50})
local F,x,sols,i,res,start,t;
   x:=indets(expr,name) minus {constants};
   if nops(x)>1 then error "too many indeterminates"; end if;
   F:=subs(__F=unapply(expr,x[1]),__G=guard,proc(t)
      Digits:=Digits+__G;
      __F(t);
   end proc);
   sols,i,start:=table([]),0,a;
   to maxtries do
      i:=i+1;
      res:=RootFinding:-NextZero(F,start,
                                 'maxdistance'=b-start);
      if type(res,numeric) then
         sols[i]:=fnormal(res);
         if sols[i]=sols[i-1] then
            start:=sols[i]+1.0*10^(-Digits);
            i:=i-1;
         else
            start:=sols[i];
         end if;
      else
         break;
      end if;
   end do;
   op({entries(sols,'nolist')});
end proc:

Using that for the 2nd stage (of reclaiming roots in terms of t,t2,t2,t3, from the certified roots of the polynomial system as obtained in the 1st stage using RootFinding:-Isolate) the computation to find 16 roots of the original problem in this thread goes down from about 30 seconds to about 1.2 seconds on my 5 year-old i7 machine. And that's over 200 times faster than what DirectSearch:-SolveEquation might take my machine. Yout mileage may vary.

f1 := -8100+(-30+70*cos(t1)-40*cos(t2))^2
      +(-70*sin(t1)+40*sin(t2))^2:
f2 := (-20-80*cos(t3))^2+(-15+70*cos(t1)+10*cos(t1+t))^2
      +(-70*sin(t1)-10*sin(t1+t)+80*sin(t3))^2-5625:
f3 := (-20-80*cos(t3))^2+(15+40*cos(t2)+10*cos(t1+t))^2
      +(-40*sin(t2)-10*sin(t1+t)+80*sin(t3))^2-5625:
f4 := 10*cos(t1+t)*(30-70*cos(t1)+40*cos(t2))
      -10*sin(t1+t)*(70*sin(t1)-40*sin(t2)):
origsys := {f1,f2,f3,f4}:
st,str := time(),time[real]():
sys := map(expand,origsys):
T := [indets(sys,function)[]]:
Tsub := [seq(x=freeze(x),x=T)]:
extra := {seq(sin(r)^2+cos(r)^2-1,r=[t,t1,t2,t3])}:
Digits := 20:
raw := thaw(RootFinding:-Isolate(eval(sys union extra,Tsub),eval(T,Tsub))):
gen := proc(cand)
  local c, v;
  c[t]:=select(has,cand,t); c[t1]:=select(has,cand,t1);
  c[t2]:=select(has,cand,t2); c[t3]:=select(has,cand,t3);
  [seq(seq(seq(seq([e,f,g,h],e=c[t3]),f=c[t2]),g=c[t1]),h=c[t])];
end proc:
Digits := 15:
sols := {seq(seq(
      `if`(evalf(max(map(abs,eval(origsys,eq))))<10^(-5),
           eq, NULL),
      eq=gen(
map(eq->indets(eq,name)[]
                     =~findroots((lhs-rhs)(eq),
                                 0,evalf(2*Pi))[],raw[i]))
                ),i=1..nops(raw))}:
sols := evalf[15](sols):
time()-st,time[real]()-str;
                                1.170, 1.167
nops(sols);
                                     16
Digits := 50:
max(seq(max(abs~(evalf(eval([f1,f2,f3,f4],s)))),s=sols)): evalf[5](%);
Digits := 10:
                                         -11
                                5.7233 10   
First 334 335 336 337 338 339 340 Last Page 336 of 596