acer

32485 Reputation

29 Badges

20 years, 7 days
Ontario, Canada

Social Networks and Content at Maplesoft.com

MaplePrimes Activity


These are replies submitted by acer

@mmcdara Suppose that we'd been able to give you a magic command which you could apply to the a[i] so that its aliased value were attained, even when `i` were programmatically replaced.

That mightn't be much better than redirection through, say, a table lookup. Eg, T[a[i]] or Value[a[i]] if you wanted it understandable to a general reader. And you could easily construct that table, instead of calling `alias`.

@Carl Love I believe that the plotting command automatically scales the hue data to the 0..1 range.

ColoredTubeplot_ac.mw

@Rouben Rostamian  I dug around the vault and tried to adjust the following to your example.

You may wish to check that my normalization of the data (to get range 0..1 for color components) is ok.

You could also utilize the Torsion. And you could use both Curvature and Torsion, in HSV or RGB components, as you wish.

I was originally working with various knots, and my old code did not automatically normalize.

restart:

with(LinearAlgebra):

 

SC:=proc( T::list, trng::name=range(realcons),
          {numpoints::posint:=3, colorfunc::procedure:=NULL} )

  local M, C, t, a, b, i;

  t := lhs(trng);

  a,b := op(evalf(rhs(trng)));

  M := [seq(eval(T,t=a+i*(b-a)/(numpoints-1)),i=0..numpoints-1)];

  if colorfunc=NULL then

    C := NULL;

  else

    #C := ':-COLOUR'(':-RGB',
    #                Array([seq(colorfunc(a+(i-1)*(b-a)/(numpoints-1)),
    #                           i=1..numpoints)],
    #                      ':-datatype'='float[8]',':-order'=':-C_order'));

    C := :-COLOUR(':-RGB',
                  hfarray([seq(colorfunc(a+(i-1)*(b-a)/(numpoints-1)),
                               i=1..numpoints)]));

  end if;

  :-PLOT3D(:-CURVES(M,C),':-THICKNESS'(5));

end proc:

 

C := <cos(t), 2*sin(t), t^2/20>;
C1, C2 := diff(C,t), diff(C,t,t);

Vector(3, {(1) = cos(t), (2) = 2*sin(t), (3) = (1/20)*t^2})

Vector[column](%id = 18446884189768133798), Vector[column](%id = 18446884189768133918)

Kappa:=simplify(VectorCalculus:-Curvature(C,t));
kappa := Norm(CrossProduct(C1,C2),2) / Norm(C1,2)^3;
plot([kappa,Kappa],t=0..2*Pi,style=[line,point],
     adaptive=false,numpoints=50,size=[600,200]);
(kmin,kmax):=[min,max](op([1,1],%)[..,2])[];

100*((6*sin(t)*cos(t)*t+(-3*t^2+3)*cos(t)^2+4*t^2+401)/(300*cos(t)^2+t^2+100)^2)^(1/2)/(300*cos(t)^2+t^2+100)^(1/2)

100*(4*abs(cos(t)+sin(t)*t)^2+abs(-sin(t)+cos(t)*t)^2+400*abs(sin(t)^2+cos(t)^2)^2)^(1/2)/(100*abs(sin(t))^2+400*abs(cos(t))^2+abs(t)^2)^(3/2)

HFloat(0.22857562522275804), HFloat(1.9482867151552743)

cur:=unapply(kappa,t):

#tor:=unapply(simplify(VectorCalculus:-Torsion(C,t)),t):
#plot(tor,0..2*Pi,size=[600,200]);

cfunc:=proc(tt)

        local L;

        L := [ (evalf[30](cur(tt))-kmin)/(kmax-kmin), 1, 1 ];

        ColorTools:-Color("RGB",ColorTools:-Color("HSV",L))[];

      end proc:

#plot([y->cfunc(y)[1],y->cfunc(y)[2],y->cfunc(y)[3]],0..2*Pi,
#     color=[red,green,blue],numpoints=150,adaptive=false,
#     size=[600,200]);

SC( convert(C,list), t= 0..2*Pi, numpoints=100, colorfunc=cfunc );

 

Download spacecurve_curvature.mw

You might also look at Carl's idea of using a coloring function (expression) directly within tubeplot. That makes some aspects very simple. For example,

restart:

with(plots):

C := <cos(t), 2*sin(t), t^2/20>:

tubeplot(convert(C,list), t=0..2*Pi, radius= .03, numpoints=500,
         color= COLOR(HUE, simplify(VectorCalculus:-Curvature(C,t))),
         style= surface, lightmodel=none);

 

Download tubeplot_curvature_hue.mw

[edited] By using the approach of constructing the replacement COLOR plot substructure (in the code above, for the spacecurve), there is full control over the colorspace components, including normalization of the hue values. So, if you do not like full wrapping in HSV back to red at the upper end of the Hue component, you can scale the Hue. Here I use the Hue value 0.833 (Magenta) as a cap. Capping the Hue at 0.75 also looks good.

spacecurve_curvature_hue_adjusted.mw

Similarly, the hue-shaded tubeplot can also be adjusted:

tubeplot_curvature_adjusted_hue.mw

I notice that some of these plots (eg. the tubeplot) look more vivid when re-executed than they do when the worksheet is closed and re-opened. In my 64bit Linux Maple 2019.2 at least.

Someone converted this old Question to a Post, today. Please don't do that.

I have reverted it to a Question.

@dingtianlidi 

I use Kitonum's parametrization of the space-curve here, and apply the single procedure (x,y,z)->x*y*z to get the effect of an xyzcoloring colorscheme.

A single procedure with an xyzcoloring colorscheme uses the (normalized) scalar results for hue.

restart:

with(plots):

with(Student:-LinearAlgebra):

A := RotationMatrix(t, <1,1,1>):
Curve := convert(A.<5,0,0>,list);

[(10/3)*cos(t)+5/3, -(5/3)*cos(t)+(5/3)*3^(1/2)*sin(t)+5/3, -(5/3)*cos(t)-(5/3)*3^(1/2)*sin(t)+5/3]

P := spacecurve(Curve,t=0..2*Pi,thickness=5,colorscheme=[red,blue],axes=normal):

huefunc := (x,y,z)->x*y*z;

proc (x, y, z) options operator, arrow; x*y*z end proc

M := op([1,1],P):
m := (rhs-lhs+1)(op([2,1],M)):
dat := [seq(huefunc(M[i,1],M[i,2],M[i,3]),i=1..m)]:
(mindat,maxdat) := [min,max](dat)[]:
newC := Array(map[evalhf](d->(d-mindat)/(maxdat-mindat),dat),datatype=float[8]):

newP := subsindets(P,specfunc(anything,:-COLOR),u->COLOR(HUE,newC)):

newP;

 

Download spacecurve_xyzcolorscheme_hue.mw

Of course, this kind of approach can be robustified and put into a re-usable procedure.

One possible robustification might be to utilize fnormal suitably during the (subtraction in the) normalization of the scalar result values. For example, the coloring function x+y+z would otherwise merely produce roundoff noise for the given example's space-curve (given the particular plane of the data points).

Note: I wrote this to work with the particular result from spacecurve, and not intersectplot. A general approach could work for intersectplot, but the code above would have to be modified. I don't have the time for that right now, sorry...

@dingtianlidi Sorry I was not clear.

I meant that the COLOR substricture could be manuaĺly constructed from the curves x.y.z data. I'll try to find time to show you what I mean, but I've got some pressing thing to do right this moment.

You should contact Maplesoft Technical Support.   You can email them at 

   support@maplesoft.com

Please don't start additional and separate threads here, about this severe lack of function. It's more helpful to keep this all together.

@Carl Love What might be tricky is the deployment of any quaternion package so that it is bundled with the Mobius application that the OP is authoring. The key thing might be to make it directly available to any end-user of the "app".

I was thinking that the Tech Support staff of DigitalEd might know best how to do that part (in the most graceful way appropriate to MapleTA or a Mobius App).

The MapleTA and Mobius products are now produced and sold by DigitalEd, and no longer by Maplesoft.

This site is run by Maplesoft. I doubt that many Mobius users or DigitalEd staff monitor it.

You may be better off trying their tech support,

    http://digitaled.com/support

Another way to get a similar plot (but perhaps not so flexible, as not directly using the parameter), is as follows.

restart;

with(plots):

Cl := x->max(-1,min(1, x)): f := (x,y)->Re(sqrt(x+I*y)):
M := 15: R := 5: local O := 0.1:

F := [Cl((j+O)/R*cos(2*Pi*t)), Cl((j+O)/R*sin(2*Pi*t)),
      signum(k)*(abs(k) - 1.5)/140
      + signum(k)*f(Cl((j+O)/R*cos(2*Pi*t)),Cl((j+O)/R*sin(2*Pi*t)))]:

Pcurves:=display(seq(seq(spacecurve(F, t=0..1, thickness=3,
                           colorscheme=["linear",
                                        [red,ColorTools:-Color("RGB",[1,0,0.001])],
                                         colorspace="HSV"]),
                         k=[-2,-1,1,2]),j=1..R+3)):
Pcurves;

optsurf := grid=[70,70], style=surface, transparency=0.1, color=u:
ee := evalc(Re(sqrt(x+I*y))):
ff := simplify(eval(ee,[x=v*cos(u),y=v*sin(u)])) assuming real:
Psurf:=display(seq(plot3d([v*cos(u), v*sin(u), k*ff],
                          u=0..2*Pi, v=0..4, optsurf),
                   k=[-1,1]),
               view=[-1..1,-1..1,-1..1]):

display(Psurf,Pcurves);

 

Download spacecurve_colorbyparam2.mw

Note: The backend MapleNet server of this site cannot properly render such colored curves when displaying inline here. (Might be an hfarray vs Array thing...) So I've pasted in the .png exports of the plots.

@Stretto I happened to find this old piece of code. (I was coloring spacecurves by torsion and curvature, as functions of the parameter...). Perhaps its results are a little closer to what you're after. You might adust, of course.

restart;

with(plots):

Cl := x->max(-1,min(1, x)): f := (x,y)->Re(sqrt(x+I*y)):
M := 15: R := 5: local O := 0.1:

cfunc:=proc(tt,j)
  local L:=[j/(R+3),j/(R+3)*sin(2*Pi*tt)^2,tt];# print(L);

  ColorTools:-Color("RGB",L)[];

end proc:

SC:=proc(T::list, j, trng::name=range(realcons),
         {numpoints::posint:=3, colorfunc::procedure:=NULL})
  local M,C,t,a,b,i;
  t:=lhs(trng);
  (a,b):=op(evalf(rhs(trng)));
  M:=[seq(eval(T,t=a+i*(b-a)/(numpoints-1)),i=0..numpoints-1)];
  if colorfunc=NULL then C:=NULL;
  else
    C:=':-COLOUR'(':-RGB',Array([seq(colorfunc(a+(i-1)*(b-a)/(numpoints-1),j),
                                     i=1..numpoints)],
                                ':-datatype'='float[8]',':-order'=':-C_order'));
  end if;
  :-PLOT3D(:-CURVES(M,C),':-THICKNESS'(3));
end proc:

display(
  seq(seq(SC([Cl((j+O)/R*cos(2*Pi*t)), Cl((j+O)/R*sin(2*Pi*t)),
              sign(k)*(abs(k) - 1.5)/140
              + sign(k)*f(Cl((j+O)/R*cos(2*Pi*t)),Cl((j+O)/R*sin(2*Pi*t)))],
             j, t=0..1, numpoints=150, colorfunc=cfunc),
          k=[-2,-1,1,2]), j=1..R+3));

cfunc2:=proc(tt,j)
  local L:=[tt,1,1];# print(L);

  ColorTools:-Color("RGB",ColorTools:-Color("HSV",L))[];

end proc:

Pcurves:=plots:-display(
  seq(seq(SC([Cl((j+O)/R*cos(2*Pi*t)), Cl((j+O)/R*sin(2*Pi*t)),
              sign(k)*(abs(k) - 1.5)/140
              + sign(k)*f(Cl((j+O)/R*cos(2*Pi*t)),Cl((j+O)/R*sin(2*Pi*t)))],
             j, t=0..1, numpoints=150, colorfunc=cfunc2),
          k=[-2,-1,1,2]), j=1..R+3)):
Pcurves;

optsurf := grid=[70,70], style=surface, transparency=0.1, color=u:
ee := evalc(Re(sqrt(x+I*y))):
ff := simplify(eval(ee,[x=v*cos(u),y=v*sin(u)])) assuming real:
Psurf:=display(seq(plot3d([v*cos(u), v*sin(u), k*ff],
                          u=0..2*Pi, v=0..4, optsurf),
                   k=[-1,1]),
               view=[-1..1,-1..1,-1..1]):

display(Psurf,Pcurves);

 

Download spacecurve_colorbyparam.mw

@Axel Vogt 

restart;
kernelopts(version);

      Maple 2018.2, X86 64 LINUX, Nov 16 2018, Build ID 1362973

g:=exp(r*cos(theta))/Pi+exp(r*cos(theta))*cos(theta)/Pi:
Int(g, theta = 0 .. Pi):
value(IntegrationTools:-Expand(%)) assuming r>0;

         BesselI(0, r) + BesselI(1, r)

# Or,

int(g, theta = 0 .. Pi):

IntegrationTools:-Expand(%) assuming r>0;

         BesselI(0, r) + BesselI(1, r)

The two separate integrals are obtained by method=lookup, but that is not being successfully used against the sum.

Could you not utilize the assuming mechanism for the key simplifications?

Show us what youve been able to do so far with this homework question.

@zphaze I'll look into this, as well as another kind of evalf-related bug in it that I know of.

Perhaps you're also the fellow who asked about saving the module to an archive. There are a few subtleties (including ModuleLoad material), but nothing not easily resolved.

If you give me a couple of days (it's Sunday night...) I'll look into these bug/issues which I expect are easily resolved, as well as show/verify both the module saving as well as cloud-package creation. I've been meaning to do all that for some time now.

I will post in this thread, when progress is made.

First 193 194 195 196 197 198 199 Last Page 195 of 594