<Text-field style="Heading 1" layout="Heading 1">Set up Procedures</Text-field> A procedure that returns an approximation of a curve with special Euclidean curvature k using h points. CurveApprox := proc(k,h,a,b) description "input curvature of a curve - k; number of partitions in the approximation - h; and starting / ending points - a, b; outputs (h+1)x2 array giving x and y components of original curve"; local i, d, Kt, C; d := (b-a)/h; Kt := Array(1..h+1); C := Array(1..h+1,1..2); Kt := 0; C[1,1] := 0; C[1,2] := 0; for i from 2 to h+1 do; Kt[i] := Kt[i-1] + d/2 * (evalf(eval(k,s=d*(i-2)+a)) + evalf(eval(k,s=d*(i-1)+a))); C[i,1] := C[i-1,1] + d/2 * (evalf(cos(Kt[i-1])) + evalf(cos(Kt[i]))); C[i,2] := C[i-1,2] + d/2 * (evalf(sin(Kt[i-1])) + evalf(sin(Kt[i]))); end do; return C; end proc: The below procedure will give the curvature and derivative with respect to arclength given a parameterization of the curve with respect to t. curvature := proc(x,y,t) description "input x and y parameterized by t to return curvature parameterized by t"; local k, kp; k := (diff(x,t)*diff(y,t,t)-diff(y,t)*diff(x,t,t))/((diff(x,t)^2+diff(y,t)^2)^(3/2)); kp := diff(k,t)/((diff(x,t)^2+diff(y,t)^2)^(1/2)); return k, kp; end proc:
<Text-field style="Heading 1" layout="Heading 1">Curvature and Signature of Original Curve</Text-field> As a guide the entries shown in blue are used in the example "Curves with different order of smoothness" found at http://egeig.com/research/ncndcis/maple-diffSmoothness.These should be changed to suit the problem. pts := 1500: Curvature is either given: k := 1/2*(sin(s)-cos(3*s))-1/5: kp := diff(k,s): Or obtained from a parameterization of the curve (comment out what is not used) Regardless if t is the arclength parameter, it will be necessary to use s as the parameter below. #x := _: #y := _: #k, kp := curvature(x,y,t): #k := eval(k,t=s): #kp := eval(kp,t=s): The we plot the curve obtained below where q is the index of symmetry of the curve, and ell is the minimal period of the curvature. We also plot its Euclidean signature. q := 5: ell := 2*Pi: C := CurveApprox(k,pts,0,q*ell): plots[display](Array([plot(C[1..-1,1],C[1..-1,2]),plot(k,s=0..ell,labels=[s,kappa])])); plot([k,diff(k,s),s=0..ell]);
<Text-field style="Heading 1" layout="Heading 1">Find Points of Signature Intersection</Text-field> Numerically approximate pre-images of self-intersection points of the signature under the signature map using the curvature function and signature as a guide for the starting points for fsolve. For an example, see the "Curves with different order of smoothness" example at http://egeig.com/research/ncndcis/maple-diffSmoothness.The indicies, and number of fsolves used will need to be changed. kt := eval(k,s=t): kpt := eval(kp,s=t): s16 := fsolve({k=kt,kp=kpt},{s=0.2,t=4.9}): s25 := fsolve({k=kt,kp=kpt},{s=1.7,t=3.3}): s38 := fsolve({k=kt,kp=kpt},{s=2.0,t=5.6}): s47 := fsolve({k=kt,kp=kpt},{s=2.5,t=4.8}): # add or remove extra fsolves needed, current indices are based on order the preimages appear in. The above returns pairs of points, so we will separate them. s1, s2, s3, s4 := rhs(s16), rhs(s25), rhs(s38), rhs(s47): s5, s6, s7, s8 := rhs(s25), rhs(s16), rhs(s47), rhs(s38):
<Text-field style="Heading 1" layout="Heading 1">Construct New Curvature</Text-field> Now we can illustrate which parts of the curvature and curve correspond to subsets of the signature curve via color.Our intervals associated with each edge and color can be read directly below. sig1 := plot([k,kp,s=s1..s2],color="Red",thickness=3): sig2 := plot([k,kp,s=s2..s3],color="Orange",thickness=3): sig3 := plot([k,kp,s=s3..s4],color="Yellow",thickness=3): sig4 := plot([k,kp,s=s4..s5],color="Lime",thickness=3): sig5 := plot([k,kp,s=s5..s6],color="Green",thickness=3): sig6 := plot([k,kp,s=s6..s7],color="Cyan",thickness=3): sig7 := plot([k,kp,s=s7..s8],color="Blue",thickness=3): sig8 := plot([k,kp,s=s8..ell+s1],color="Purple",thickness=3): #add or remove extra intervals plots[display](sig1,sig2,sig3,sig4,sig5,sig6,sig7,sig8); #add or remove extra intervals Give a letter to each edge of the signature graph, and then to each letter associate a color, the end points of it's associated interval, and how many points of our earlier designated amount we should use to approximate it . Here we will use the integer closest to (length of interval * pts)/(q*ell) to approximate the number of points. These numbers may need to be altered slightly so that the total adds up properly.You will probably want to make sure the colors assigned below match the colors given to the signature curve above. eCol := table([a="Green",b="Purple",c="Cyan",d="Yellow",e="Blue",f="Orange",g="Lime",h="Red"]): eInt := table([a=[s5,s6],b=[s8,s1+2*Pi],c=[s6,s7],d=[s3,s4],e=[s7,s8],f=[s2,s3],g=[s4,s5],h=[s1,s2]]): ePts := table([a=round((s6-s5)*pts/(q*ell)),b=round((s1+2*Pi-s8)*pts/(q*ell)),c=round((s7-s6)*pts/(q*ell)),d=round((s4-s3)*pts/(q*ell)),e=round((s8-s7)*pts/(q*ell)),f=round((s3-s2)*pts/(q*ell)),g=round((s5-s4)*pts/(q*ell)),h=round((s2-s1)*pts/(q*ell))]): The procedure below takes a list that gives the desired path on the signature graph, the number of times that path is repeated, and a curvature function that gives the Euclidean signature used to obtain the signature graph. The output will be the new curvature function, an array that approximates the new curve, and colored plots of both. New_Curve := proc(L,m,k) description "input a list of letters making up a word of minimal period, m: the number of times the minimal word appears, and a curvature function for a curve with the signature, outputs the curvature, and a plot of both the curve and curvature"; local pts, C, C_pts, kw_period, kw, kw_plot, Cw, Cw_plot, i; pts := 0; for i from 1 to nops(L) do: pts := pts + ePts[L[i]]*m; end do: C := [s<=0,0]; for i from 1 to nops(L) do: C := [op(C),s<=(eInt[L[i]]-eInt[L[i]]+rhs(C[2*i-1])),eval(k,s=s+eInt[L[i]]-rhs(C[2*i-1]))]; end do: C_pts := ; for i from 1 to nops(L)*m do: C_pts := [op(C_pts), C_pts[i]+ePts[L[(i-1) mod nops(L) + 1]]]; end do: kw_period := piecewise(op(C[3..-1])); kw := eval(kw_period,s=s-rhs(C[2*nops(L)+1])*floor(s/rhs(C[2*nops(L)+1]))); kw_plot := seq(plot(kw,s=rhs(C[2*i-1])..rhs(C[2*i+1]),color=eCol[L[i]]),i=1..nops(L)); Cw := CurveApprox(kw,pts,0,m*rhs(C[2*nops(L)+1])); Cw_plot := seq(plot(Cw(C_pts[i]..C_pts[i+1],1),Cw(C_pts[i]..C_pts[i+1],2),color=eCol[L[(i-1) mod nops(L)+1]]),i=1..m*nops(L)); return kw, Cw, [kw_plot], [Cw_plot]; end proc:
<Text-field style="Heading 1" layout="Heading 1">New Curves</Text-field> Using the signature quiver, find paths and the corresponding CLUklbXJvd0c2Iy9JK21vZHVsZW5hbWVHNiJJLFR5cGVzZXR0aW5nR0koX3N5c2xpYkdGJzYkLUklbXN1cEdGJDYlLUkjbWlHRiQ2I1EhRictRiM2JS1JI21uR0YkNiRRIjNGJy8lLG1hdGh2YXJpYW50R1Enbm9ybWFsRicvJSdpdGFsaWNHUSV0cnVlRicvRjlRJ2l0YWxpY0YnLyUxc3VwZXJzY3JpcHRzaGlmdEdRIjBGJ0Y4 curves below.Input the minimal path as a list, the number of times the minimal path is repeated, and the original curvature. C1 := New_Curve([b,h,f,d,g,a,c,e],5,k): plots[display](Array([plots[display](C1),plots[display](C1)])); C2 := New_Curve([b,h,a,c,e,d,g,f],5,k): plots[display](Array([plots[display](C2),plots[display](C2)])); C3 := New_Curve([b,h,a,c,g,f,d,e],5,k): plots[display](Array([plots[display](C3),plots[display](C3)])); C4 := New_Curve([b,c,e,d,g,a,h,f],5,k): plots[display](Array([plots[display](C4),plots[display](C4)])); C5 := New_Curve([b,c,g,a,h,f,d,e],5,k): plots[display](Array([plots[display](C5),plots[display](C5)]));
JSFH