Carl Love

Carl Love

28100 Reputation

25 Badges

13 years, 104 days
Himself
Wayland, Massachusetts, United States
My name was formerly Carl Devore.

MaplePrimes Activity


These are replies submitted by Carl Love

For what it's worth, continuation doesn't help with this problem. I was able to successfully apply continuation (I multiplied the right side of the first boundary condition by the continuation parameter) only to get the much-more-difficult-to-deal-with error Newton iteration is not converging.

I need to know the modulus, i.e., the degree-8 irreducible polynomial, that you used to create GF(2^8).

Here's Kitonum's procedure with my improvements.

restart:

ContoursWithLabels:= proc(
     Expr::algebraic,
     Range1::(name= range(realcons)), Range2::(name= range(realcons)),
     {contours::{posint, {set,list}(realcons)}:= 8},
     {ImplicitplotOptions::{list,set}({name, name= anything}):= NULL},
     {GraphicOptions::{list,set}({name, name= anything}):= NULL},
     {TextOptions::{list,set}({name, name= anything}):= NULL},
     {Coloring::{list,set}({name, name= anything}):= NULL}
)
local
     r1, r2, f, L1, h, S1, P, r, M, C, T, p, p1, m, n, i,
     x:= lhs(Range1), y:= lhs(Range2)
;
     f:= unapply(Expr, (x,y));
     if contours::posint then
          r1:= rand(convert(rhs(Range1), float));
          r2:= rand(convert(rhs(Range2), float));
          L1:= select(type, (f@op)~({seq([r1,r2](), i= 1..205)}), realcons);
          h:= (L1[-6]-L1[1])/contours;
          S1:= [seq(L1[1]+h/2+h*(n-1), n= 1..contours)]
     else #contours::{set,list}(realcons)
          S1:= [contours[]]
     end if;
     userinfo(1, ContoursWithLabels, print('Contours' = evalf[2](S1)), `\n`);
     r:= k-> rand(20..k-20);
     for C in S1 do
          P:= plots:-implicitplot(
               Expr = C, Range1, Range2,
               gridrefine= 3, ImplicitplotOptions[]
          );
          for p in [plottools:-getdata(P)] do
               p1:= convert(p[3], listlist);
               n:= nops(p1);
               if n < 500 then
                    m:= `if`(40 < n, r(n)(), round(n/2));
                    M[`if`(40 < n, [p1[1..m-11], p1[m+11..n]], [p1])[]]:= NULL;
                    T[[p1[m][], evalf[2](C)]]:= NULL
               else
                    h:= trunc(n/2);
                    m:= r(h)();
                    M[p1[1..m-11], p1[m+11..m+h-11], p1[m+h+11..n]]:= NULL;
                    T[[p1[m][], evalf[2](C)], [p1[m+h][], evalf[2](C)]]:= NULL
               end if
          end do
     end do;
     plots:-display(
          [`if`(
               Coloring = NULL,
               NULL,
               plots:-densityplot(Expr, Range1, Range2, Coloring[])
          ),
          plot([indices(M, 'nolist')], color= black, GraphicOptions[]),
          plots:-textplot([indices(T, 'nolist')], TextOptions[])
         ], 'axes'= 'box', 'gridlines'= false, _rest
     )
end proc:

 

Example:

PP:=0.3800179925e-3*exp(-0.6065722618e-3*(x-29.51704536)^2+(0.6650093594e-3*(x-29.51704536))*(a-12.94061928)-0.1106850312e-2*(a-12.94061928)^2);

0.3800179925e-3*exp(-0.6065722618e-3*(x-29.51704536)^2+0.6650093594e-3*(x-29.51704536)*(a-12.94061928)-0.1106850312e-2*(a-12.94061928)^2)

infolevel[ContoursWithLabels]:= 1:

ContoursWithLabels(
     PP, x= -20..20, a= -20..20, contours= {seq(1e-4..4e-4, 5e-5)},
     Coloring= [colorstyle= HUE, colorscheme= ["Cyan", "Red"], style= surface],
     TextOptions= [font= [HELVETICA,BOLD,7], color= blue],
     ImplicitplotOptions= [gridrefine= 4],
     GraphicOptions= [thickness= 0],
     title= "         My contour plot\n",
     labelfont= [TIMES,BOLDITALIC,16], axesfont= [HELVETICA,8],
     size= [600,600]
);

ContoursWithLabels:

Contours = [0.1e-3, 0.15e-3, 0.20e-3, 0.25e-3, 0.30e-3, 0.35e-3, 0.40e-3]


 


Download ContoursWithLabels.mw

@Kitonum Okay, I made it an Answer, and I'll make it a Comment to your post.

I did just what I said: changed x to x(t) and y to y(t). Then you just press ENTER and you should get the plot.

Don't repeat your Questions. It's very annoying to the moderators.

You got an Answer in about 35 minutes. I think that that's a pretty good response rate.

@WernerP There's no need for implicitplot3d or high values of numpoints. Your code can be simplified to

A:= plot3d(5, theta= -Pi..Pi, phi= arccos(4/5)..arccos(3/5), coords= spherical):
B:= plot3d(5, theta= -Pi..Pi, phi= 0..Pi/2, coords= spherical, transparency= .6):
C1:= plot3d([3, theta, z], theta= -Pi..Pi, z= 0..4, coords= cylindrical):
C2:= plot3d([4, theta, z], theta= -Pi..Pi, z= 0..3, coords= cylindrical):
plots:-display(
     {A, B, C1, C2}, scaling= constrained, labels= [X,Y,Z],
     axes= normal, style= patchnogrid, color= yellow
);

@epostma Thanks! Unfortunately, I think that it'll require that kernel work because according to the Maple Programming Guide, section 9.6 "Overloading Built-in Routines," select, etc., aren't on that short list of overloadables. This is surprising because I'd expect to be able to use select on any container object.

To get the plot in the lower hemisphere also, as well as the plot of the sphere itself, you can use

f:= (r,phi)-> sqrt(25-r^2):
P1:= plot3d(
     [[r*cos(phi), r*sin(phi), f(r,phi)], [r*cos(phi), r*sin(phi), -f(r,phi)]],
     r= 3..4, phi= 0..2*Pi, labels= ['x','y','z'],
     color= black, style= patchnogrid, glossiness= 0
):
P2:= plot3d(5, phi= -Pi/2..Pi/2, theta= 0..2*Pi, coords= spherical):
plots:-display([P2,P1], axes= box, scaling= constrained);

@farazhedayati Unfortunately Kitonum's procedure relies on the variables in the expression being x and y. Your variables are x and a. So, call it like this:

ContoursWithLabels(subs(a= y, PP), -3..3, -3..3);

Of course, you may want to change the ranges.

I'll post a correction to the procedure in a little while, if someone else doesn't beat me to it.

 

@a_simsim Get rid of the line return z. The fsolve itself should be the return value. The fsolve doesn't assign the value of z; it just returns a numeric value for z.

@acer To appreciate the difference in timing, you'd need to do a bunch of short messages. I didn't do it, but it's obvious that there'd be some savings. Every little bit helps.

@acer Sure it can be done that way:

BySubs:= module()
local
     b, k,
     All:= seq(Bits:-Split(k, bits= 8), k= 0..254, 2),
     Subs:= {seq(b= [b[1..2][], 1 -~ b[3..7][], b[8]], b= All)},
     ModuleApply:= block-> subs(Subs, block)
;
     All:= 'All'  #garbage collection
end module:

@Carl Love I was motivated by Joe's idea that there were a very limited number of possible eight-bit lists. If they all have leading zeros, as yours do, then there's 128. So we can use the subs command directly, making every possible substitution. This is significantly faster (than even the LinearAlgebra:-Modular method) for long messages:

BySubs:= proc(block)
local k, b, All:= [seq(Bits:-Split(k, bits= 8), k= 0..254, 2)];
     subs({seq(b= [b[1..2][], 1 -~ b[3..7][], b[8]], b= All)}, block)
end proc;

This processes a million-byte message in 60 milliseconds.

@Kitonum Your shorter code can be shortened further to

block1:= [seq(subsop(seq(j= 1-B[j], j= 3..7), B), B= block)];

which removes one level of indexing.

First 420 421 422 423 424 425 426 Last Page 422 of 709