%------------------------------------------------------------% %---Cox & DeBoor formula-------------------------------------% %------------------------------------------------------------% DEF myDeBoor (knots::IsSeqOf:IsReal) = IF:< C:EQ:2 ~ LEN, basicCase, recursiveCase >:knots WHERE ui0 = S1:knots, ui1 = S2:knots, ui3 = (LAST ~ leftKnots):knots, ui4 = LAST:knots, u = S1, rightKnots = TAIL, leftKnots = RTAIL, basicCase = K:(IF:< AND ~ [GE:ui0 ~ S1, LT:ui1 ~ S1], K:1, K:0 >), recursiveCase = + ~ [ K:((u - K:ui0) MyDiv ) RAISE:* (myDeBoor ~ leftKnots), K:((K:ui4 - u) MyDiv ) RAISE:* (myDeBoor ~ rightKnots) ], MyDiv (a::IsFun; b::IsSeq) = IF:< EQ ~ [s1,s2], StrangeValues, K:(a/c) >:b WHERE StrangeValues = filter ~ a, % precondition a/0 % filter = % if a = 0 then 1 else 0 % IF:, testOnZero = (LT:precision) ~ (ABS ~ - ~ [ID,K:0]), precision = 1E-12, c = (K ~ -):b END END; DEF mydomain = Intervals:6:64; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<3,4>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<4,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<3,4,5>]:mydomain >; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<4,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<5,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<4,5,5>]:mydomain >; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<4,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<5,5.5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<4,5,5.5>]:mydomain >; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<2,3,4>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<3,4,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<2,3,4,5>]:mydomain >; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<3,4,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<4,5,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<3,4,5,5>]:mydomain >; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<3,4,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<4,5,5.5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<3,4,5,5.5>]:mydomain >; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<4,5,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<5,5,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<4,5,5,5>]:mydomain >; DEF OUT= STRUCT:< MAP:[s1,DeBoor:<1,2,3,4>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<2,3,4,5>]:mydomain, T:2:-1.25, MAP:[s1,DeBoor:<1,2,3,4,5>]:mydomain >; %------------------------------------------------------------% %---Non uniform B-spline basis-------------------------------% %------------------------------------------------------------% DEF myBsplineBasis (order::IsInt) (knots::IsSeqOf:IsReal) = (AA:myDeBoor ~ subsets:(order+1)): knots WHERE subsets (h::IsIntPos)(seq::IsSeq) = (CONS ~ AA:(AS:SEL ~ FROMTO ~ [ID - K:h + K:1,ID])):(h..LEN:seq):seq END; % mult % DEF mydomain = Intervals:5:64; DEF out = STRUCT:<(STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain, T:2:1, STRUCT:<(STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain>>; % uniform % DEF mydomain = Intervals:10:128; DEF out1 = (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): ):mydomain ; DEF out2 = (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): ):mydomain ; DEF out3 = (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): ):mydomain ; DEF mydomain = t:1:3:(Intervals:1:32); DEF out4 = (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): ):mydomain ; DEF mydomain = t:1:4:(Intervals:1:32); DEF out5 = (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): ):mydomain ; DEF out=STRUCT:; DEF mydomain = Intervals:5:64; DEF out = (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain ; DEF out = (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain ; %bezier% DEF mydomain = Intervals:1:64; DEF out = STRUCT:< (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain, T:1:1, (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain, T:1:1, (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain, T:1:1, (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain, T:1:1, (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain, T:1:1, (STRUCT ~ (CONS ~ AA:(MAP ~ CONS) ~ DISTL): >):mydomain >; %------------------------------------------------------% %----Non uniform B-spline------------------------------% %------------------------------------------------------% DEF myBspline (dom::Ispol)(degree::Isint)(knots::IsSeq)(points::IsSeq) = STRUCT:maps WHERE order = degree + 1, basis = myBsplineBasis: order: knots, segmentmaps = (AA:(INSL:APPLY ~ AL) ~ DISTL): < Blend, (AA:TRANS ~ subsets:order ~ TRANS):< basis, points >>, domain = AS:SEL:(order..(LEN:points+1)): knots, nonempty = AS:SEL~CAT ~ AA:(IF:< EQ~S1, K:<>, [S2] >) ~ TRANS ~ [ID,INTSTO~LEN], nondegenerate = nonempty: subdomains, subdomains = subsets:2:domain, poldoms = AA:(STRUCT~[T:1~S1, S:1~(S2 - S1), K:dom]):subdomains, maps = (AA:(INSL:APPLY)~ nondegenerate ~TRANS): < #:(LEN:domain - 1):MAP, segmentmaps, poldoms >, subsets (h::IsIntPos)(seq::IsSeq) = (CONS ~ AA:(AS:SEL ~ FROMTO ~ [ID - K:h + K:1,ID])):(h..LEN:seq):seq END; DEF myNUBspline = myBspline:(intervals:1:splineSampling); DEF myNUBsplineKnots = myBspline: Knotzero WHERE Knotzero = MK:<0> END; %------------------------------------------------------------% %----Display Non uniform B-spline----------------------------% %------------------------------------------------------------% DEF myDisplayNUBspline (degree::Isnat; knots::IsSeq ; points::IsSeq ) = (STRUCT ~ [ IF:< K:(GT:0:degree), NUBspline:degree:knots, polymarker:3 >, polymarker:2 ~ S1 ~ UKPOL ~ NUBsplineKnots:degree:knots , polyline, polymarker:1 ]): points; DEF points = <<0.1,0>,<2,0>,<6,1.5>,<6,4>,<2,5.5>,<2,6>,<3.5,6.5>>; DEF out = myDisplayNUBspline:<3, <0,0,0,0,1,2,3,4,4,4,4>, points >; DEF out = myDisplayNUBspline:<2, <0,0,0,1,2,3,4,5,5,5>,points >; DEF MarkerSize = 0.15; DEF points2 = <<0,0>,<-1,2>,<1,4>,<2,3>,<1,1>,<1,2>,<2.5,1>>; DEF out = STRUCT:< myDisplayNUBspline:< 0,<0,1,2,3,4,5,6,7>, points2 >, T:1:4, myDisplayNUBspline:< 1,<0,0,1,2,3,4,5,6,6>, points2 >, T:1:4, myDisplayNUBspline:< 2,<0,0,0,1,2,3,4,5,5,5>, points2 >, T:1:4, myDisplayNUBspline:< 3,<0,0,0,0,1,2,3,4,4,4,4>, points2 > >; DEF out = STRUCT:< DisplayNUBspline:< 2,<0,0,0,1,2,3,4,5,5,5>, points2 >, T:1:4, DisplayNUBspline:< 2,<0,0,0,1,1,2,3,4,4,4>, points2 >, T:1:4, DisplayNUBspline:< 2,<0,0,0,1,1,1,2,3,3,3>, points2 >, T:1:4 >;