acer

32333 Reputation

29 Badges

19 years, 323 days
Ontario, Canada

Social Networks and Content at Maplesoft.com

MaplePrimes Activity


These are replies submitted by acer

@shahri On what grounds should that single solution be preferred over the others?

If you cannot specify that precisely then your request does not make good sense.

@shahri Your reply is nonsense because the system depends also on the name x, but you don't include that name in either the variables or the parameters.

The main problem is that you haven't explained what solve_pde does.

It's exceedingly awkward to recover the input from you're pasted output.

Please attach a worksheet that contains the input explictly, or paste in the lprint of the system.

@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

First 190 191 192 193 194 195 196 Last Page 192 of 591