function tspackgui(x,y,z) % tspackgui: Tension Spline Package for interactive curve design % % R. J. Renka: renka@cs.unt.edu % 02/09/2008, 03/19/2008 % % This package allows an interactive user to create, modify, % and display curves constructed by TSPACK. Options include % both univariate functions and parametric planar curves or % space curves, either interpolatory or approximating. % Derivatives (or derivative vectors) may be user-specified % or computed automatically for C^1 or C^2 continuity. % Tension factors may be user-selected or chosen automatically % to satisfy either shape constraints (local monotonicity % and convexity) or user-specified bounds. % % An interpolatory parametric space curve, for example, is % defined as C(t) = (H1(t),H2(t),H3(t)) where the components % are tension splines that interpolate the components of % discrete control points (x,y,z) and knot derivative % values (xp,yp,zp) at knots (parameter values) t computed % as cumulative arc lengths. The curve may be self- % intersecting, but adjacent control points must be distinct. % % USAGE: % % The initial set of control points is assumed to define % an interpolant with two continuous derivatives. If the % first and last control points coincide, the curve is % assumed to be closed, and periodic end conditions are used. % % tspackgui(x,y,z) starts with control points (x,y,z) % defining a parametric space curve. % tspackgui(x,y) starts with control points (x,y,0) % defining the graph of a function if x is strictly % increasing, or a parametric planar curve otherwise. % tspackgui(x) starts with control points (i,x,0), for % i = 1:length(x), defining the graph of a function. % tspackgui with no arguments starts with five points on % a circle defining a closed planar curve: the first % and last points coincide. % Development platform: % % The code was developed in MATLAB Version 7.2.0.283 (R2006) % under Linux, and has been tested on MATLAB Version 7.0 % under Microsoft Windows and Version 7.5 under OS X. % Code Organization: % % Excluding MATLAB functions, all source code is contained % in this file. There are four sets of functions, stored in % the same order as the following brief function descriptions. % The order is alphabetic within each category except that % some of the Callback functions are ordered in the same way % as their corresponding menu entries. The first two categories % are nested functions which can access TSPACKGUI's workspace. % These are also subfunctions and are not visible outside this % file. % % A) TSPACKGUI Nested Functions % % cancelop: Cancel current operation. % createlo: Create line objects. % deletecp: Delete a control point. % dragcp: Initiate a control point drag operation. % insertcp: Insert a control point. % snaptogrid: Move a point to the nearest grid vertex. % tscurve: Create a tension spline curve. % tseval: Update curve segment line objects. % ulpush: Add an entry to the undo list. % % B) TSPACKGUI Callbacks (Nested Functions) % % AlterBoundsFcn (Operations menu): Alter bounds. % AlterDerivFcn (Operations menu): Alter derivative. % AlterSigmaFcn (Operations menu): Alter tension factor. % AlterWeightFcn (Operations menu): Alter smoothing weight. % AppendCpFcn (Operations menu): Append control point. % ButtonDnFcn: Mouse button press in figure 1. % ButtonUpFcn: Mouse button release. % CpButtonDnFcn: Mouse button press on a control point. % CpolyButtonDnFcn: Mouse button press on the control polygon. % CsButtonDnFcn: Mouse button press on a curve segment. % CTndof1: Function graph. % CTndof2: Parametric planar curve. % CTndof3: Parametric space curve. % CTc2Deriv: C^2 derivatives. % CTc1Deriv: C^1 automatic derivatives. % CTuserDeriv: C^1 user-specified derivatives. % CTshape: Shape-preserving tension. % CTbounds: Bounds-constrained tension. % CTuserTension: User-specified tension factors. % CTclosed: Closed curve. % CTautoEnd: Automatic end conditions. % CTuserEnd: User-specified end conditions. % CTinterp: Interpolatory curve. % CTsmooth: Approximating (smoothing or B-spline) curve. % DeleteCpFcn (Operations menu): Delete control point. % DOarrows: Display derivatives (tangents). % DOaxes: Display axes. % DObox: Display box. % DOcpts: Display control points. % DOgrid: Display grid. % DOlimits: Freeze axis limits. % DOplot1; Plot first derivative or curvature. % DOplot2; Plot second derivative or torsion. % DOplotp; Plot curvature (as a porcupine plot). % DOview3: Display 3D view. % F4CheckboxFcn: Checkbox selection in figure 4. % F4EditFcn: Text edit box change in figure 4. % F4PushbuttonFcn: Pushbutton press in figure 4 (Terminate operation). % F4SliderFcn: Slider change in figure 4. % F5CheckboxFcn: Checkbox selection in figure 5. % F5EditFcn: Text edit box change in figure 5. % F5PushbuttonFcn: Pushbutton press in figure 5 (Terminate operation). % F5SliderFcn: Slider change in figure 5. % F6CheckboxFcn: Checkbox selection in figure 6. % F6EditFcn: Text edit box change in figure 6. % F6PushbuttonFcn: Pushbutton press in figure 6 (Terminate operation). % FexitFcn: File menu exit selection. % FopenFcn: File open. % FsaveFcn: File save. % FsaveasFcn: File save with new file name. % HelpFcn: Display help file in the MATLAB browser. % InsertCpFcn (Operations menu): Insert control point. % KeyPressFcn: Key press in a figure window. % MotionFcn: Mouse motion with button down in figure 1 or figure 4. % MoveCpFcn (Operations menu): Move control point. % SnapToGridFcn (Operations menu): Toggle snap to grid option. % UndoFcn: (Operations menu): Undo last operation. % % C) General-purpose Utility Functions % % edialog: Error dialog box (alternative to errordlg). % movevtx: Move vertex (data space) to mouse position (window coords). % resnrm1: Least squares fit of a degree-1 polynomial. % xform: Transform vertices from data space to window coordinates. % % D) TSPACK Functions % % arcl2d: Computes cumulative arc lengths along a planar curve. % arcl3d: Computes cumulative arc lengths along a space curve. % b2tri: SPD block tridiagonal system solver. % b2trip: SPD periodic block tridiagonal system solver. % bsp2h: Convert a tension spline from B-spline to Hermite form. % endslp: Endpoint first derivative estimate. % h2bsp: Convert a tension spline from Hermite to B-spline form. % hpppval: Third derivative of Hermite interpolatory tension spline. % hppval: Second derivative of Hermite interpolatory tension spline. % hpval: First derivative of Hermite interpolatory tension spline. % hval: Evaluation of Hermite interpolatory tension spline. % intrvl: Finds interval containing a point. % sig0: Minimum tension factor for bound on function values. % sig1: Minimum tension factor for bound on first derivative. % sig2: Minimum tension factor for convexity. % sigbi: Minimum tension for bounds-constrained interpolant. % sigbp: Minimum tension for bounds-constrained planar curve. % sigs: Minimum tension for monotonicity and convexity. % sigsp: Minimum tension for shape-preserving parametric curve. % smcrv: C^2 smoothing curve. % snhcsh: Modified hyperbolic function evaluation. % trisolve: Solution to nonsymmetric tridiagonal linear system. % trisolvp: Solution to nonsymmetric almost tridiagonal linear system. % tsintl: Integral of a Hermite interpolatory tension spline. % tspbi: Parameters defining constrained interpolatory tension spline. % tspbp: Parameters defining constrained parametric planar curve. % tspsi: Parameters defining shape-preserving interpolatory tension spline. % tspsp: Parameters defining shape-preserving parametric space curve. % tspss: Parameters defining shape-preserving smoothing curve. % tsval1: Values or derivatives of a tension spline. % tsval2: Values or derivative vectors of planar curve. % tsval3: Values or derivative vectors of space curve. % ypc1: Local derivative estimates. % ypc1p: Local derivative estimates, periodic case. % ypc1t: Local derivative estimates as unit tangent vectors. % ypc2: C^2 global derivative estimates. % ypc2p: C^2 global derivative estimates, periodic case. % ypcoef: Coefficients for ypc2p and smcrv. % GLOBAL variable defining maximum tension factor: global SBIG SBIG = 100.0; % CONSTANTS (shared by all nested functions) % % arrow_color = Arrow color for depicting derivatives % or derivative vectors. % bmax = User-defined value of infinity for bounds % constraint definitions. % cp_color = Control point marker color. % cs_color = Curve segment color. % csf = Curvature scale factor: ratio of porcupine plot % line segment length to curvature. % ms1,ms2 = Marker sizes in points for depicting control % points and knot values. Note that large markers % are easier to select. % ne = Number of vertices in each curve segment. % qmin = Minimum length of a quiver3 object (positive to % avoid divide-by-zero errors). % sl_color = Highlight color denoting a currently selected % control point, curve segment, or arrow. % upmax = Length of ulist and maximum value of ulcnt. arrow_color = [0 0 0]; bmax = inf; cp_color = [0 0.7 0.7]; cs_color = [0 0 .5]; csf = 0.3; ms1 = 8; ms2 = 12; ne = 128; qmin = 1.e-4; sl_color = [1 0 0]; upmax = 20; % Process input arguments n, x, y, z. if nargin == 0 n = 5; x = [0 1 1 0 0]; y = [0 0 1 1 0]; else if ~isvector(x) error('%s\n','Arguments must be vectors.') end n = length(x); end if nargin == 1 y = x(:)'; x = 1:n; end if nargin < 3 z = zeros(1,n); end if n < 2 error('%s\n','Arguments must have length at least 2.') end if length(y) ~= n || length(z) ~= n error('%s\n','Arguments must have the same lengths.') end if ~isnumeric(x) || ~isnumeric(y) || ~isnumeric(z) error('%s\n','Arguments must be numeric.') end % Convert column vectors to row vectors. x = x(:)'; y = y(:)'; z = z(:)'; if all(z == 0) if all(diff(x) > 0) ndof = 1; else ndof = 2; end else ndof = 3; end % Compute a row vector of knots t if ndof > 1. Note that t % is defined as a variable (shared by all nested functions) % even if it is not initialized. ierr = 0; if ndof == 2 [t,ierr] = arcl2d(x,y); elseif ndof == 3 [t,ierr] = arcl3d(x,y,z); end if ierr > 0 error('%s\n','A pair of adjacent control points coincide.') end % VARIABLES (shared by all nested functions and initialized % for the input data set). % % active = Flag set to true iff a smoothing curve is % constructed and the constraint is active (the % curve is not the graph of a linear function). % aln = Array of length n containing knot values of arc % length s(t) if ndof > 1. % asf = Scale factor for arrow lengths. % az,el = Azimuth and elevation defining view: possibly % altered before initiating a drag of a control % point or arrow, and restored upon release of the % mouse button. % bcolor = Figure background color. % bnds = Array dimensioned 5 by n-1 defining bounds % constraints when tension = 'bounds'. If ndof = 2, % only the first two rows are used. % bnds_dflt = default values for a column of bnds: no % constraint, and hence zero tension. % cpstate = Flag with values 0, 1, and 2 specifying display % of no control point markers, unannotated control % point markers, and markers annotated with control % point indices, respectively, in figures 1 to 3 % (but not annotated in figures 2 and 3). Each % selection of Display Control Points increments % cpstate modulo 3. % crv = Array dimensioned 2 by n-1 containing knot curvature % or signed curvature values if ndof > 1: left endpoint % values in row 1, and right endpoint values in row 2 % for each curve segment. The interior knot values are % averaged to define marker locations in figure 2. Note % that curvature may be discontinuous at the knots if % deriv = 'c1' or deriv = 'user'. % deriv = String variable specifying the method for % selecting (first) derivatives at knots: % deriv = 'c2' if derivatives are chosen to produce % a C^2 curve (second derivative continuity). % deriv = 'c1' if derivatives are computed by local % fits using three control points in an % interpolatory curve. % deriv = 'user' if derivatives are user-selected. % drag_cp = Logical variable indicating that a control % point is currently being dragged with the % mouse. % drag_dv = Logical variable indicating that a derivative % is currently being altered by dragging an % arrow tip. % dx,dy,dz = Axis lengths used to compute asf, xsf, and % ysf. Note that dy = 0 makes ysf = Inf, % resulting in zero-length quiver objects and % divide-by-zero warnings; dy is therefore % bounded below by qmin. % endcond = String variable specifying the method for % selecting end conditions: % endcond = 'periodic' in the case of a closed % parametric curve. % endcond = 'auto' if endpoint derivatives are computed % by local fits. % endcond = 'user' if endpoint derivatives are user- % specified. % fname = String containing a file name (including an % absolute or relative path) used by FsaveFcn to % save a data set defining a curve: altered by % FopenFcn and FsaveasFcn. % fp = Figure 1 position [left bottom width height]. % freeze_cp = Logical variable indicating that the set of % control points may not be altered -- a data- % fitting rather than curve-design application. % gridsize = Grid refinement level specified as the number % of subintervals per coarse grid interval, where % the coarse grid is the figure 1 grid computed % automatically by MATLAB and chosen so that tick % marks have short labels (decimal numbers). % Visibility of the grid can be toggled on or off % by a menu selection, and dragged control points % may be automatically moved to the nearest grid % point. The initial value is gridsize = 1, and % the Alt-g key may be used to cycle through the % sequence of values 1, 2, 5, and 10. Tick mark % labels are suppressed if gridsize > 1. Note % that MATLAB can display minor grid lines, but % it neither provides the minor grid tick values % nor does it document the (apparently poor) % algorithm by which they are computed. % harrow = Array of length imax containing derivative % handles. % hax = Array of length 3 containing handles of the axes % contained in figures 1, 2, and 3. % hc = Handle of currently selected control point or curve % segment. % hcheck4 = Handle of check box in figure 4 used to select % uniform tension. % hcheck5 = Handle of check box in figure 5 used to select % uniform weights. % hcheck6 = Handle of check box in figure 6 used to select % uniform bounds. % hcop = Handle of text box in figure 1 displaying the % currently selected operation. % hcp0 = Array of length imax containing control point % handles. % hcp1 = Handle of sequence of knot derivatives or curva- % ture values, depicted by small dots as are control % points, in figure 2. % hcp2 = Handle of sequence of knot second derivatives or % torsion values depicted by small dots in figure 3. % hcpi0 = Array of length imax containing handles of text % strings used to annotate the control points with % their indices. % hcpoly = Handle of control polygon displayed for % non-interpolatory curves. % hcs0 = Array of length n-1 containing handles of curve % segments in figure 1. % hcs1 = Array of length n-1 containing handles of curve % segments in first derivative or curvature plots % (figure 2). % hcs2 = Array of length n-1 containing handles of curve % segments in second derivative or torsion plots % (figure 3). % hcsp = Array of length n-1 containing handles of line % segments depicting curvature (as a porcupine % plot) in figure 1. % hct = Array of length 14 containing Curve Type menu % handles. % hdo = Array of length 10 containing Display Option menu % handles. % hdragcp = Handle of line object used to depict a control % point being dragged when operation = 'move_cp' % or 'insert_cp'. % hdragdv = Handle of line object used to depict an arrow % (representing a derivative) being dragged when % operation = 'alter_dv'. % hedit4 = Handle of text edit box in figure 4. % hedit5 = Handle of text edit box in figure 5. % hedit6 = Array of length 5 containing handles of text % edit boxes in figure 6. Refer to pos6. % hedstr6 = Array of length 5 containing handles of text % strings associated with edit boxes in figure 6. % hf = Array of length 4 containing File menu handles. % hfig1 = Handle of the primary figure window (figure 1). % Actually the first available integer handle is % used. If the same handle was always used, it % would not be possible to run more than one % instance of the code at the same time. % hfig2 = Handle of a figure used to display the first % derivative or curvature if plot1 = true. % hfig3 = Handle of a figure used to display the second % derivative or torsion if plot2 = true. % hfig4 = Handle of the tension selection figure (figure 4). % hfig5 = Handle of the smoothing weight selection figure % (figure 5). % hfig6 = Handle of the bounds selection figure (figure 6). % hmenu = Temporary variable containing a menu handle. % hslider4 = Handle of slider in figure 4. % hslider5 = Handle of slider in figure 5. % hslitxt5 = Handle of slider text label in figure 5. % hsnap = Handle of Snap to Grid operations menu entry. % htxt = Handle of static text box created by Right Click. % htxt6 = Handle of static text box used to display a % tension factor value or error message in figure 6. % icflg = Array of length n-1 containing constraint % violation flags returned by tspbi or sigbi in % the case of a bounds-constrained interpolatory % function. % ierr = Error flag returned by function arcl2d or arcl3d. % imax = Number of control points excluding the last when % it coincides with the first defining a closed % curve. % interpolate = Logical variable indicating an interpola- % ting, as opposed to an approximating, % curve. % L = Arrow length in window coordinates for arrows used % to depict derivatives when ndof = 1. % n = Number of control points. % ndof = Number of degrees of freedom in each control % point, or number of dependent variables: % ndof = 1 for a univariate function. % ndof = 2 for a parametric planar curve. % ndof = 3 for a parametric space curve. % newknots = Logical variable with value true if knots % are to be recomputed (as cumulative arc % length) by tscurve for a parametric curve. % opcnt = Number of (unreversed) changes made to the % current data set since it was saved: % incremented by ulpush, decremented by UndoFcn. % operation = String variable specifying a currently % executing operation that was selected by % the user: % operation = '' if no operation has been selected. % operation = 'alter_bd' if a set of bounds associated % with a control point is to be % altered. % operation = 'alter_dv' if a derivative is to be % altered by dragging the % endpoint of an arrow. % operation = 'alter_sw' if a smoothing weight is to % be altered. % operation = 'alter_tf' if a tension factor is to be % altered. % operation = 'append_cp' if a control point is to be % appended to a user-selected % endpoint. % operation = 'delete_cp' if a control point is to be % deleted. % operation = 'insert_cp' if a control point is to be % inserted on a user-selected % curve segment or control % polygon edge. % operation = 'move_cp' if a control point is to be % moved by dragging it with the % mouse. % plot1 = Logical variable with value true iff the first % derivative (ndof = 1) or curvature (ndof > 1) is % to be displayed (in figure 2). % plot2 = Logical variable with value true iff the second % derivative (ndof = 1) or torsion (ndof = 3) is % to be displayed (in figure 3). % plotp = Logical variable with value true iff a porcupine % plot depicting curvature is to be included (in % figure 1). % pos6 = Array of length 5 containing positions % [left bottom] of the edit boxes in figure 6. % sigf = Tension factor or flag (-1) specifying that % tension factors are nonuniform (vary with the % curve segment). % sigma = Row vector of length n-1 containing tension % factors. % smwf = Smoothing weight or flag (-1) specifying that % smoothing weights are nonuniform (vary with the % data point). % smwts = Array of length n containing weights for % smoothing in Function SMCRV: reciprocals of % the variances in the data values. These are % used only for a smoothing curve (ndof = 1 and % interpolate = false). % snapto = Logical variable with value true iff a dragged % control point is to be automatically moved to % the nearest grid point (in function ButtonUpFcn). % Refer to variable gridsize. % ssiz = Array containing [1 1 width height], where width % and height specify the screen size in pixels. % t = Array of length n containing knot values if ndof > 1. % te = Array of length ne containing uniformly distributed % knots or abscissae for spline evaluation. % tension = String variable specifying the method for % setting tension factors sigma: % tension = 'shape' if tension factors are chosen by % SIGS or SIGSP to preserve shape % properties (local monotonicity % and/or convexity. % tension = 'bounds' if tension factors are chosen by % SIGBx to satisfy bounds constraints. % tension = 'user' if tension factors can be altered by % the user. % trs = Array dimensioned 2 by n-1 containing knot torsion % values if ndof = 3: left endpoint values in row 1, % and right endpoint values in row 2 for each curve % segment. The interior knot values are averaged to % define marker locations in figure 3. % ulcnt = Current number of entries in ulist (number of % undo levels available). % ulist = Undo list stored as an array of structures, and % accessed as a stack. Refer to Function ulpush. % ulist(i).opcode = one-character code specifying % the operation or change of % curve type to be reversed. % ulist(i).index = index of a control point or % curve type. % ulist(i).data = array containing the data required % to reverse the operation. % ulistfull = Logical variable set to true when an entry % (the oldest) had to be removed from ulist in % order to allow a new entry to be added. % uptr = Stack pointer (in the range 0 to upmax) for access % to ulist. % vx,vy,vz = Arrays of length ne containing tension spline % values at the elements of te: computed in % Function tseval, and used to create curve % segment line objects. % vx1,vy1,vz1 = Arrays of length ne containing first % derivative vectors at the elements of te. % vx2,vy2,vz2 = Arrays of length ne containing second % derivative vectors at the elements of te. % vx3,vy3,vz3 = Arrays of length ne containing third % derivative vectors at the elements of te. % vxc,vyc,vzc = Arrays of length ne containing curvature % vectors at the elements of te. % x,y,z = Arrays of length n containing axes (data space) % coordinates of the control points. % xk,yk,zk = Arrays of length n containing axes (data % space) coordinates of the knot function % values. These coincide with control points % in the case of interpolation. % xp,yp,zp = Arrays of length n containing knot derivative % values. % xsf,ysf = Scale factors in the mappings from axes coordi- % nates to window coordinates; used, along with L, % to compute arrow lengths when ndof = 1. active = false; az = 0; bnds_dflt = [bmax; -bmax; bmax; -bmax; 0]; bnds = bnds_dflt*ones(1,n-1); cpstate = 1; el = 0; deriv = 'c2'; drag_cp = false; drag_dv = false; if x(1) == x(n) && y(1) == y(n) && z(1) == z(n) if n < 4 error('%s\n',['Arguments must have length at least 4 ', ... 'for a closed curve']) end endcond = 'periodic'; imax = n-1; else endcond = 'auto'; imax = n; end fname = 'tspgui_data.tsp'; % Default file name freeze_cp = true; gridsize = 1; hc = []; hdragcp = []; hdragdv = []; htxt = []; interpolate = true; newknots = false; opcnt = 0; operation = ''; plot1 = false; plot2 = false; plotp = false; sigf = -1; smwf = -1; smwts = ones(1,n); snapto = false; tension = 'user'; ulist = repmat(struct('opcode',' ', 'index',0, ... 'data',[]), 1, upmax); ulistfull = false; ulcnt = 0; uptr = 0; xk = x; yk = y; zk = z; % Change the root default font size for question dialog boxes. set(0,'DefaultTextFontSize',14) % Create the primary figure and axes. hfig1 = figure; drawnow % This may be required to correctly set properties. ssiz = get(0,'ScreenSize'); set(hfig1, 'CloseRequestFcn',@FexitFcn, ... 'DoubleBuffer','on', ... 'KeyPressFcn',@KeyPressFcn, ... 'MenuBar','none', ... 'Name','TSPACK Curve', 'NumberTitle','off', ... 'Units','pixels', ... 'Position',[100 ssiz(4)/2 ssiz(3)/2 ssiz(4)/2], ... 'Toolbar','figure', ... 'WindowButtonDownFcn',@ButtonDnFcn, ... 'WindowButtonMotionFcn',@MotionFcn, ... 'WindowButtonUpFcn',@ButtonUpFcn) hax(1) = axes; set(hax(1), 'Color',[.8 .8 .8], ... 'FontSize',18, ... 'MinorGridLineStyle','-', ... 'NextPlot','add', ... 'OuterPosition',[0 0.05 1 0.95], ... 'Parent',hfig1) bcolor = get(hfig1,'Color'); hcop = uicontrol('Style','text', 'BackgroundColor',bcolor, ... 'FontSize',18, 'ForegroundColor',[0 0 1], ... 'Units','normalized', ... 'Parent',hfig1, ... 'Position',[0 0 1 0.07], ... 'String',''); xlabel('x') ylabel('y') zlabel('z') title('C^2 curve created by TSPACK') % File Menu hmenu = uimenu('Label','File', ... 'Parent',hfig1); hf(1) = uimenu('Accelerator','o', ... 'Callback',@FopenFcn, ... 'Label','Open', ... 'Parent',hmenu); hf(2) = uimenu('Accelerator','s', ... 'Callback',@FsaveFcn, ... 'Label','Save', ... 'Parent',hmenu); hf(3) = uimenu('Callback',@FsaveasFcn, ... 'Label','Saveas', ... 'Parent',hmenu); hf(4) = uimenu('Callback',@FexitFcn, ... 'Label','Exit', ... 'Parent',hmenu); % Display_options Menu hmenu = uimenu('Label','Display_options', ... 'Parent',hfig1); hdo(1) = uimenu('Accelerator','a', ... 'Callback',@DOarrows, ... 'Label','Display Derivatives', ... 'Parent',hmenu); hdo(2) = uimenu('Accelerator','x', ... 'Callback',@DOaxes, ... 'Label','Display Axes', ... 'Parent',hmenu); set(hdo(2),'Checked','on') hdo(3) = uimenu('Accelerator','b', ... 'Callback',@DObox, ... 'Label','Display Box', ... 'Parent',hmenu); set(hax(1),'Box','off') hdo(4) = uimenu('Accelerator','g', ... 'Callback',@DOgrid, ... 'Label','Display Grid Lines', ... 'Parent',hmenu); hdo(5) = uimenu('Accelerator','c', ... 'Callback',@DOcpts, ... 'Label','Display Control Points', ... 'Parent',hmenu); if cpstate > 0 set(hdo(5),'Checked','on') end hdo(6) = uimenu('Accelerator','l', ... 'Callback',@DOlimits, ... 'Label','Freeze Axis Limits', ... 'Parent',hmenu); hdo(7) = uimenu('Accelerator','3', ... 'Callback',@DOview3, ... 'Label','Standard 3D View', ... 'Parent',hmenu); hdo(8) = uimenu('Accelerator','p', ... 'Callback',@DOplotp, ... 'Label','Display Curvature', ... 'Parent',hmenu); hdo(9) = uimenu('Accelerator','1', ... 'Callback',@DOplot1, ... 'Label','Plot 1st Derivative or Curvature', ... 'Parent',hmenu); hdo(10) = uimenu('Accelerator','2', ... 'Callback',@DOplot2, ... 'Label','Plot 2nd Derivative or Torsion', ... 'Parent',hmenu); % Curve_type Menu hmenu = uimenu('Label','Curve_type', ... 'Parent',hfig1); hct(1) = uimenu('Callback',@CTndof1, ... 'Label','Function Graph', ... 'Parent',hmenu); if ndof == 1 set(hct(1),'Checked','on') end hct(2) = uimenu('Callback',@CTndof2, ... 'Label','Parametric Planar Curve', ... 'Parent',hmenu); if ndof == 2 set(hct(2),'Checked','on') end hct(3) = uimenu('Callback',@CTndof3, ... 'Label','Parametric Space Curve', ... 'Parent',hmenu); if ndof == 3 set(hct(3),'Checked','on') end hct(4) = uimenu('Callback',@CTc2Deriv, ... 'Label','C^2 Derivatives', ... 'Parent',hmenu, 'Separator','on'); if strcmp(deriv,'c2') set(hct(4),'Checked','on') end hct(5) = uimenu('Callback',@CTc1Deriv, ... 'Label','C^1 Automatic Derivatives', ... 'Parent',hmenu); if strcmp(deriv,'c1') set(hct(5),'Checked','on') end hct(6) = uimenu('Callback',@CTuserDeriv, ... 'Label','C^1 User-specified Derivatives', ... 'Parent',hmenu); if strcmp(deriv,'user') set(hct(6),'Checked','on') end hct(7) = uimenu('Callback',@CTshape, ... 'Label','Shape-preserving Tension', ... 'Parent',hmenu, 'Separator','on'); if strcmp(tension,'shape') set(hct(7),'Checked','on') end hct(8) = uimenu('Callback',@CTbounds, ... 'Label','Bounds-constrained Tension', ... 'Parent',hmenu); if strcmp(tension,'bounds') set(hct(8),'Checked','on') end hct(9) = uimenu('Callback',@CTuserTension, ... 'Label','User-specified Tension', ... 'Parent',hmenu); if strcmp(tension,'user') set(hct(9),'Checked','on') end hct(10) = uimenu('Callback',@CTclosed, ... 'Label','Closed Curve', ... 'Parent',hmenu, 'Separator','on'); if strcmp(endcond,'periodic') set(hct(10),'Checked','on') end hct(11) = uimenu('Callback',@CTautoEnd, ... 'Label','Automatic End Conditions', ... 'Parent',hmenu); if strcmp(endcond,'auto') set(hct(11),'Checked','on') end hct(12) = uimenu('Callback',@CTuserEnd, ... 'Label','User-specified End Conditions', ... 'Parent',hmenu); if strcmp(endcond,'user') set(hct(12),'Checked','on') end hct(13) = uimenu('Callback',@CTinterp, ... 'Label','Interpolatory Curve', ... 'Parent',hmenu, 'Separator','on'); if interpolate set(hct(13),'Checked','on') end hct(14) = uimenu('Callback',@CTsmooth, ... 'Label','Approximating/Smoothing Curve', ... 'Parent',hmenu); if ~interpolate set(hct(14),'Checked','on') end % Operations Menu hmenu = uimenu('Label','Operations', ... 'Parent',hfig1); uimenu('Accelerator','e', ... 'Callback',@AppendCpFcn, ... 'Label','Append Control Point', ... 'Parent',hmenu) uimenu('Accelerator','d', ... 'Callback',@MoveCpFcn, ... 'Label','Drag Control Point', ... 'Parent',hmenu) uimenu('Accelerator','i', ... 'Callback',@InsertCpFcn, ... 'Label','Insert Control Point', ... 'Parent',hmenu) uimenu('Accelerator','r', ... 'Callback',@DeleteCpFcn, ... 'Label','Remove Control Point', ... 'Parent',hmenu) uimenu('Accelerator','v', ... 'Callback',@AlterDerivFcn, ... 'Label','Alter Derivative', ... 'Parent',hmenu, 'Separator','on') uimenu('Accelerator','t', ... 'Callback',@AlterSigmaFcn, ... 'Label','Alter Tension Factor', ... 'Parent',hmenu, 'Separator','on') uimenu('Accelerator','w', ... 'Callback',@AlterWeightFcn, ... 'Label','Alter Smoothing Weight', ... 'Parent',hmenu, 'Separator','on') uimenu('Accelerator','n', ... 'Callback',@AlterBoundsFcn, ... 'Label','Alter Bounds', ... 'Parent',hmenu, 'Separator','on') uimenu('Accelerator','u', ... 'Callback',@UndoFcn, ... 'Label','Undo Last Operation', ... 'Parent',hmenu, 'Separator','on') hsnap = uimenu('Callback',@SnapToGridFcn, ... 'Label','Toggle Snap to Grid Option', ... 'Parent',hmenu, 'Separator','on'); if snapto set(hsnap,'Checked','on') end % Help Menu uimenu('Callback',@HelpFcn, ... 'Label','Help', ... 'Parent',hfig1); % Create figures 2 and 3 with axes for plotting derivatives % (if ndof = 1) or curvature and torsion (if ndof = 3). hfig2 = figure('CloseRequestFcn', ... 'disp(''Disallowed attempt to delete hfig2.'')', ... 'DoubleBuffer','on', ... 'KeyPressFcn',@KeyPressFcn, ... 'MenuBar','none', ... 'Name','TSPACK First Derivative or Curvature', ... 'NumberTitle','off', ... 'Units','pixels', ... 'Position',[ssiz(3)/2+110 ssiz(4)/2+30 ... ssiz(3)/2-110 ssiz(4)/2-80], ... 'Toolbar','figure', ... 'Visible','off'); hax(2) = axes; set(hax(2), 'Color',[.8 .8 .8], ... 'FontSize',18, ... 'MinorGridLineStyle','-', ... 'NextPlot','add', ... 'OuterPosition',[0 0.05 1 0.95], ... 'Parent',hfig2) xlabel('x') ylabel('y') zlabel('z') if ndof == 1 title('First Derivative of Tension Spline') elseif ndof == 2 title('Signed Curvature as a Function of Arc Length') else title('Curvature as a Function of Arc Length') end hfig3 = figure('CloseRequestFcn', ... 'disp(''Disallowed attempt to delete hfig3.'')', ... 'DoubleBuffer','on', ... 'KeyPressFcn',@KeyPressFcn, ... 'MenuBar','none', ... 'Name','TSPACK Second Derivative or Torsion', ... 'NumberTitle','off', ... 'Units','pixels', ... 'Position',[ssiz(3)/2+110 60 ssiz(3)/2-110 ssiz(4)/2-80], ... 'Toolbar','figure', ... 'Visible','off'); hax(3) = axes; set(hax(3), 'Color',[.8 .8 .8], ... 'FontSize',18, ... 'MinorGridLineStyle','-', ... 'NextPlot','add', ... 'OuterPosition',[0 0.05 1 0.95], ... 'Parent',hfig3) xlabel('x') ylabel('y') zlabel('z') if ndof == 1 title('Second Derivative of Tension Spline') elseif ndof == 2 title('Curvature as a Function of Arc Length') else title('Torsion as a Function of Arc Length') end % Set the appropriate view type for the axes. if ndof == 3 view(hax(1),3) else view(hax(1),2) end view(hax(2),2) view(hax(3),2) % The following figures are designed to display textual % information and to obtain input from the user. The boxes % (with sizes in pixels) containing text strings (with font % sizes in points) are large enough to allow for up to 150 % dpi (dots per inch) such as resolution 1920 by 1200 on a % 13 by 8 inch screen. The figure sizes are at most 410 by % 395. % Figures 4, 5, and 6 use WindowStyle modal, theoretically % requiring that the user click on the 'Done' pushbutton, % invoking a callback that turns off the figure's visibility, % before it is possible to change anything in figure 1. % This works correctly under Microsoft Windows, but not % under Linux. It is therefore necessary to duplicate the % functionality of the pushbutton callbacks when the current % operation is altered. Note, however, that in this case the % selected control point or curve segment is not restored to % its normal color until another control point or curve segment % is selected. % Create figure 4, initially not visible, for user-selection % of tension factors: right-justified and vertically centered. hfig4 = figure('CloseRequestFcn', ... 'disp(''Disallowed attempt to delete hfig4.'')', ... 'DoubleBuffer','on', ... 'MenuBar','none', ... 'Name','Tension Selection', ... 'NumberTitle','off', ... 'Units','pixels', ... 'Position',[ssiz(3)-420 ssiz(4)/2-100 410 290], ... 'Resize','off', 'Toolbar','none', ... 'Visible','off', ... 'WindowButtonMotionFcn',@MotionFcn, ... 'WindowStyle','modal'); uicontrol('Style','pushbutton', ... 'BackgroundColor',bcolor, ... 'Callback',@F4PushbuttonFcn, ... 'FontSize',14, 'HandleVisibility','callback', ... 'Position',[120 25 170 35], ... 'String','Done'); hcheck4 = uicontrol('Style','checkbox', 'BackgroundColor',bcolor, ... 'Callback',@F4CheckboxFcn, ... 'FontSize',14, 'HandleVisibility','callback', ... 'Position',[20 75 370 25], ... 'String',['Use value for all curve segments ' ... '(uniform tension)']); hslider4 = uicontrol('Style','slider', ... 'BackgroundColor',bcolor, ... 'Callback',@F4SliderFcn, ... 'HandleVisibility','callback', ... 'Min',0, 'Max',SBIG, ... 'Position',[25 125 350 25], ... 'SliderStep',[0.005 0.05], ... 'Value',0); uicontrol('Style','text', 'BackgroundColor',bcolor, ... 'Position',[25 150 15 15], ... 'String','0') uicontrol('Style','text', 'BackgroundColor',bcolor, ... 'Position',[350 150 30 15], ... 'String','100') hedit4 = uicontrol('Style','edit', 'BackgroundColor',bcolor, ... 'Callback',@F4EditFcn, ... 'HandleVisibility','callback', ... 'Position',[180 190 50 25], 'String','0'); uicontrol('Style','text', 'BackgroundColor',bcolor, ... 'FontSize',18, ... 'Position',[105 240 200 30], ... 'String','Tension Factor') drawnow set(hfig4,'HandleVisibility','callback') % Create figure 5, initially not visible, for user-selection % of smoothing weights: right-justified and vertically centered. hfig5 = figure('CloseRequestFcn', ... 'disp(''Disallowed attempt to delete hfig5.'')', ... 'DoubleBuffer','on', ... 'MenuBar','none', ... 'Name','Smoothing Weight Selection', ... 'NumberTitle','off', ... 'Units','pixels', ... 'Position',[ssiz(3)-420 ssiz(4)/2-100 410 290], ... 'Resize','off', 'Toolbar','none', ... 'Visible','off', ... 'WindowStyle','modal'); uicontrol('Style','pushbutton', ... 'BackgroundColor',bcolor, ... 'Callback',@F5PushbuttonFcn, ... 'FontSize',14, 'HandleVisibility','callback', ... 'Position',[120 25 170 35], ... 'String','Done'); hcheck5 = uicontrol('Style','checkbox', 'BackgroundColor',bcolor, ... 'Callback',@F5CheckboxFcn, ... 'FontSize',14, 'HandleVisibility','callback', ... 'Position',[20 75 370 25], ... 'String',['Use value for all data points ' ... '(uniform weights)']); % The values of 'Min' and 'Max' in hslider5 and the value of % 'String' in hslitxt5 and hedit5 are stored by callback % function AlterWeightFcn because these values depend on the % data points (x,y). hslider5 = uicontrol('Style','slider', ... 'BackgroundColor',bcolor, ... 'Callback',@F5SliderFcn, ... 'HandleVisibility','callback', ... 'Position',[25 125 360 25], ... 'SliderStep',[0.005 0.05]); uicontrol('Style','text', 'BackgroundColor',bcolor, ... 'Position',[25 150 15 15], ... 'String','0') hslitxt5 = uicontrol('Style','text', 'BackgroundColor',bcolor, ... 'Position',[330 150 55 15]); hedit5 = uicontrol('Style','edit', 'BackgroundColor',bcolor, ... 'Callback',@F5EditFcn, ... 'HandleVisibility','callback', ... 'Position',[175 190 60 25]); uicontrol('Style','text', 'BackgroundColor',bcolor, ... 'FontSize',18, ... 'Position',[105 240 200 30], ... 'String','Variance 1/w') drawnow set(hfig5,'HandleVisibility','callback') % Create figure 6, initially not visible, for user-selection % of bounds: right-justified and vertically centered. hfig6 = figure('CloseRequestFcn', ... 'disp(''Disallowed attempt to delete hfig6.'')', ... 'DoubleBuffer','on', ... 'MenuBar','none', ... 'Name','Bounds Selection', ... 'NumberTitle','off', ... 'Units','pixels', ... 'Position',[ssiz(3)-420 ssiz(4)/2-100 410 395], ... 'Resize','off', 'Toolbar','none', ... 'Visible','off', ... 'WindowStyle','modal'); uicontrol('Style','pushbutton', ... 'BackgroundColor',bcolor, ... 'Callback',@F6PushbuttonFcn, ... 'FontSize',14, 'HandleVisibility','callback', ... 'Position',[120 25 170 35], ... 'String','Done'); hcheck6 = uicontrol('Style','checkbox', 'BackgroundColor',bcolor, ... 'Callback',@F6CheckboxFcn, ... 'FontSize',14, 'HandleVisibility','callback', ... 'Position',[20 75 370 25], ... 'String','Use values for all curve segments '); htxt6 = uicontrol('Style','text', ... 'BackgroundColor',bcolor, ... 'FontSize',14, ... 'Position',[95 125 220 25]); % The values of 'Position' in hedit6 and hedstr6, along with % the height of figure 6 are stored by callback function % AlterBoundsFcn because these values depend on ndof. pos6 = [260 330; 90 330; 260 265; 90 265; 175 200]; hedit6 = zeros(1,5); hedstr6 = zeros(1,5); for jj = 1:5 hedit6(jj) = uicontrol('Style','edit', 'BackgroundColor',bcolor, ... 'Callback',@F6EditFcn, ... 'HandleVisibility','callback', ... 'Tag',num2str(jj)); hedstr6(jj) = uicontrol('Style','text', ... 'BackgroundColor',bcolor, ... 'FontSize',12); end drawnow set(hfig6,'HandleVisibility','callback') set(hedit6(3:5),'Visible','off'); set(hedstr6(3:5),'Visible','off'); set(hedstr6(1),'String','Max y') set(hedstr6(2),'String','Min y') set(hedstr6(3),'String','Max y ''') set(hedstr6(4),'String','Min y ''') set(hedstr6(5),'String','Sign of y ''''') % Compute an arrow scale factor asf based on the axis lengths. dx = max(x)-min(x); dy = max([max(y)-min(y),qmin]); dz = max([max(z)-min(z),dx,dy]); asf = 0.07*(dx + dy + dz); if ndof == 1 % Compute arrow length L in window coordinates and scale % factors xsf, ysf for computing quiver object (u,v) % values. fp = get(hfig1,'Position'); L = (fp(3)+fp(4))/(6*asf); xsf = fp(3)/dx; ysf = fp(4)/dy; end % Reserve storage and make tscurve outputs global. aln = zeros(1,n); crv = zeros(2,n-1); icflg = zeros(1,n-1); sigma = zeros(1,n-1); trs = zeros(2,n-1); xp = ones(1,n); yp = zeros(1,n); zp = zeros(1,n); % Create line objects. vx = zeros(1,ne); vy = zeros(1,ne); vz = zeros(1,ne); vx1 = zeros(1,ne); vy1 = zeros(1,ne); vz1 = zeros(1,ne); vx2 = zeros(1,ne); vy2 = zeros(1,ne); vz2 = zeros(1,ne); vx3 = zeros(1,ne); vy3 = zeros(1,ne); vz3 = zeros(1,ne); vxc = ones(1,ne); vyc = zeros(1,ne); vzc = zeros(1,ne); harrow = zeros(1,imax); hcp0 = zeros(1,imax); hcp1 = []; hcp2 = []; hcpi0 = zeros(1,imax); hcpoly = []; hcs0 = zeros(1,n-1); hcs1 = zeros(1,n-1); hcs2 = zeros(1,n-1); hcsp = zeros(1,n-1); createlo set(hax,'PlotBoxAspectRatioMode','auto') if ndof > 1 set(hax(1),'DataAspectRatio',[1 1 1]) else set(hax(1),'DataAspectRatioMode','auto') end % Construct the curve. tscurve; return; %*********************************************************** % TSPACKGUI Nested Functions %*********************************************************** function cancelop % Cancel the current operation. % % USAGE: cancelop % % Sets operation and the string value of hcop to empty strings, % sets line object hit tests appropriately, and turns off % visibility of figures 4, 5, and 6. operation = ''; set(hcop,'String', '') set(hcp0,'HitTest','on') set(hcs0,'HitTest','on') set(hcpoly,'HitTest','off') set([hfig4 hfig5 hfig6],'Visible','off') return; end % cancelop function createlo % Create line objects for a new data set. % % USAGE: createlo % % Adds line objects harrow, hcp0, hcpi0, hcpoly, hcs0, and % hcsp to the axes in figure 1, adds hcp1 and hcs1 to % figure 2, and adds hcp2 and hcs2 to figure 3. In figure % 1, each quiver3 object, curve segment, and control point % is an individually selectable line object. for i = 1:imax % Create control point line objects. hcp0(i) = line(x(i),y(i),z(i), ... 'ButtonDownFcn',@CpButtonDnFcn, ... 'HandleVisibility','callback', ... 'HitTest','on', ... 'LineStyle','none','Marker','o', ... 'MarkerEdgeColor',cp_color, ... 'MarkerFaceColor',cp_color, ... 'MarkerSize',ms2, ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'Tag',num2str(i)); % Create quiver objects (arrows) depicting derivatives. % The arrow scale factor asf is applied directly to the % (u,v,w) data. % % Note that quiver3 objects are poorly documented. % MATLAB 7.0 does not allow properties other than the % data, AutoScaleFactor, and line specs to be set in the % quiver3 function. Also, the size of a data property % (x, y, z, u, v, or w) cannot be altered by the set command. % Furthermore, when 'ShowArrowHead' is set to off, altering % the data, while altering the line segment, leaves the % arrowhead behind. Toggling visibility off and on then % makes the arrowhead visible even though 'ShowArrowHead' % remains off. A workaround is to set 'ShowArrowHead' on % while altering the data. An alternative would be to set % 'MaxHeadSize' to a small value (but not so small as to % result in divide-by-zero warnings). harrow(i) = quiver3(xk(i),yk(i),zk(i), ... xp(i),yp(i),zp(i)); set(harrow(i),'AutoScale','off', ... 'Color',arrow_color, ... 'HandleVisibility','callback', ... 'HitTest','off', ... 'MaxHeadSize',0.5, ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'Tag',num2str(i), ... 'Visible','off'); end if strcmp(get(hdo(1),'Checked'),'on') set(harrow(1:imax),'Visible','on') end if ndof > 1 for i = 1:imax set(harrow(i),'UData',asf*xp(i), 'VData',asf*yp(i), ... 'WData',asf*zp(i)) end else % Compute arrow components (u,v) chosen so that v/u = yp(i) % and (xsf*u)^2 + (ysf*v)^2 = L^2, where xsf and ysf are the % scale factors in the mappings from axes coordinates to % window coordinates, and L is arrow length in window coor- % dinates. w = 0; for i = 1:imax u = L/sqrt(xsf^2+(ysf*yp(i))^2); v = yp(i)*u; set(harrow(i),'UData',asf*u, 'VData',asf*v, 'WData',asf*w) end end % Create the curve segment line objects with ne-point % segments (to be replaced by Function tscurve). for i = 1:n-1 vx = linspace(x(i),x(i+1),ne); vy = linspace(y(i),y(i+1),ne); hcs0(i) = line(vx,vy,vz, ... 'ButtonDownFcn',@CsButtonDnFcn, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','on', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'Tag',num2str(i)); hcsp(i) = quiver3(vx,vy,vz,vxc,vyc,vzc); set(hcsp(i),'AutoScale','off', ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'ShowArrowHead','off') hcs1(i) = line(vx,vy,vz, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(2), ... 'SelectionHighlight','off'); hcs2(i) = line(vx,vy,vz, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(3), ... 'SelectionHighlight','off'); end if ~plotp set(hcsp,'Visible','off') end % Create a control polygon to be displayed if and when a % B-spline curve or smoothing curve is selected. hcpoly = line(x,y,z, ... 'ButtonDownFcn',@CpolyButtonDnFcn, ... 'Color',cp_color, ... 'HandleVisibility','callback', ... 'HitTest','off', ... 'LineStyle','--', 'Marker','none', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'Visible','off'); if ~interpolate set(hcpoly,'Visible','on') end % Create figure 2 and figure 3 control point sequences as % single line objects since they are not selectable. The % data will be altered by tseval. hcp1 = line(xp,yp,zp, ... 'HandleVisibility','callback', ... 'HitTest','off', ... 'LineStyle','none','Marker','o', ... 'MarkerEdgeColor',cp_color, ... 'MarkerFaceColor',cp_color, ... 'MarkerSize',ms1, ... 'Parent',hax(2), ... 'SelectionHighlight','off'); hcp2 = line(xp,yp,zp, ... 'HandleVisibility','callback', ... 'HitTest','off', ... 'LineStyle','none','Marker','o', ... 'MarkerEdgeColor',cp_color, ... 'MarkerFaceColor',cp_color, ... 'MarkerSize',ms1, ... 'Parent',hax(3), ... 'SelectionHighlight','off'); % Create the control point annotation strings. The text % commands create arrays of handles. i = 1:imax; indices = cellstr(num2str(i')); hcpi0 = text(x(i),y(i),z(i),indices, ... 'FontSize',14, ... 'HandleVisibility','callback', ... 'HitTest','off', ... 'HorizontalAlignment','left', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'VerticalAlignment','bottom', ... 'Visible','off'); if cpstate == 2 set(hcpi0,'Visible','on') end return; end % createlo function deletecp(i) % Delete a control point. % % USAGE: deletecp(i) % % The control point with index i (1 to n) is deleted. % In the case of a closed curve, a call to this function % with i = 1 deletes both the first and last control points % (which coincide), but a call with i = n deletes only % the last control point and the last curve segment, thus % converting the curve to open. % Shift arrays down. j = i+1:n; % indices of control points x(j-1) = x(j); y(j-1) = y(j); z(j-1) = z(j); smwts(j-1) = smwts(j); xk(j-1) = xk(j); yk(j-1) = yk(j); zk(j-1) = zk(j); xp(j-1) = xp(j); yp(j-1) = yp(j); zp(j-1) = zp(j); if i <= imax delete(hcp0(i)); delete(hcpi0(i)); delete(harrow(i)); end j = i+1:imax; hcp0(j-1) = hcp0(j); hcpi0(j-1) = hcpi0(j); harrow(j-1) = harrow(j); % Adjust tags in hcp0 and harrow. for j = i:imax-1 set(hcp0(j),'Tag',num2str(j)) set(harrow(j),'Tag',num2str(j)) end if (i < n) delete(hcs0(i)) delete(hcs1(i)) delete(hcs2(i)) delete(hcsp(i)) else delete(hcs0(n-1)) delete(hcs1(n-1)) delete(hcs2(n-1)) delete(hcsp(n-1)) end j = i+1:n-1; % indices of curve segments sigma(j-1) = sigma(j); bnds(:,j-1) = bnds(:,j); crv(:,j-1) = crv(:,j); trs(:,j-1) = trs(:,j); hcs0(j-1) = hcs0(j); hcs1(j-1) = hcs1(j); hcs2(j-1) = hcs2(j); hcsp(j-1) = hcsp(j); % Adjust tags in hcs0. for j = i:n-2 set(hcs0(j),'Tag',num2str(j)) end % Reduce array lengths. x(n) = []; y(n) = []; z(n) = []; smwts(n) = []; aln(n) = []; t(n) = []; xk(n) = []; yk(n) = []; zk(n) = []; xp(n) = []; yp(n) = []; zp(n) = []; sigma(n-1) = []; bnds(:,n-1) = []; crv(:,n-1) = []; trs(:,n-1) = []; hcs0(n-1) = []; hcs1(n-1) = []; hcs2(n-1) = []; hcsp(n-1) = []; if i <= imax hcp0(imax) = []; hcpi0(imax) = []; harrow(imax) = []; imax = imax - 1; end % Update n. n = n - 1; if i == 1 && strcmp(endcond,'periodic') x(n) = x(1); y(n) = y(1); z(n) = z(1); smwts(n) = smwts(1); xk(n) = x(1); yk(n) = y(1); zk(n) = z(1); xp(n) = xp(1); yp(n) = yp(1); zp(n) = zp(1); end if ~interpolate set(hcpoly,'XData',x, 'YData',y, 'ZData',z) end return; end % deletecp %*********************************************************** function dragcp % Initiate a control point drag operation. % % USAGE: dragcp; % % Create a dotted line (initially not visible) connecting % the control point with handle hc to its (one or two) % neighbors. The WindowButtonMotion and WindowButtonUp % callbacks will update the line object and curve segments. set(hc,'MarkerEdgeColor',sl_color) set(hc,'MarkerFaceColor',sl_color) drag_cp = true; [az el] = view; if ndof < 3 && el ~= 90 el = 90; view(az,el); % Set el to 90 degrees for planar curve end i = str2double(get(hc,'Tag')); xd(2) = x(i); yd(2) = y(i); zd(2) = z(i); i1 = i-1; if i1 < 1 && strcmp(endcond,'periodic') i1 = n-1; end if i1 > 0 xd(1) = get(hcp0(i1),'XData'); yd(1) = get(hcp0(i1),'YData'); zd(1) = get(hcp0(i1),'ZData'); else xd(1) = x(i); yd(1) = y(i); zd(1) = z(i); end i2 = i+1; if i2 > imax && strcmp(endcond,'periodic') i2 = 1; end if i2 <= imax xd(3) = get(hcp0(i2),'XData'); yd(3) = get(hcp0(i2),'YData'); zd(3) = get(hcp0(i2),'ZData'); else xd(3) = x(i); yd(3) = y(i); zd(3) = z(i); end % The line object consists of three points: the control % point and its neighbors, with the control point duplicated % if it is an endpoint of an open curve. hdragcp = line(xd,yd,zd,'Color',sl_color, ... 'LineStyle',':','Marker','o', ... 'MarkerSize',ms2,'Tag',num2str(i), ... 'Visible','off'); return end % dragcp %*********************************************************** function insertcp(i,p) % Insert a control point on a curve segment or polygon edge. % % USAGE: insertcp(i,p) % % A new control point with axes coordinates p and index i % (1 to n+1) is inserted (2 <= i <= n) or appended (i = 1 or % i = n+1). For a closed curve i is in the range 1 to n. % Increase array lengths and shift arrays up. j = i:n; % indices of control points x(j+1) = x(j); y(j+1) = y(j); z(j+1) = z(j); aln(j+1) = aln(j); smwts(j+1) = smwts(j); t(j+1) = t(j); xk(j+1) = xk(j); yk(j+1) = yk(j); zk(j+1) = zk(j); xp(j+1) = xp(j); yp(j+1) = yp(j); zp(j+1) = zp(j); j = i:imax; hcp0(j+1) = hcp0(j); hcpi0(j+1) = hcpi0(j); harrow(j+1) = harrow(j); % Adjust tags in hcp0 and harrow. for j = i+1:imax+1 set(hcp0(j),'Tag',num2str(j)) set(harrow(j),'Tag',num2str(j)) end if i <= n jmin = max(i-1,1); j = jmin:n-1; % indices of curve segments sigma(j+1) = sigma(j); bnds(:,j+1) = bnds(:,j); crv(:,j+1) = crv(:,j); trs(:,j+1) = trs(:,j); hcs0(j+1) = hcs0(j); hcs1(j+1) = hcs1(j); hcs2(j+1) = hcs2(j); hcsp(j+1) = hcsp(j); for j = jmin+2:n set(hcs0(j),'Tag',num2str(j)) end elseif i == n+1 sigma(n) = sigma(n-1); bnds(:,n) = bnds(:,n-1); crv(:,n) = crv(:,n-1); trs(:,n) = trs(:,n-1); end % Increment n, imax. n = n + 1; imax = imax + 1; % Insert p as the new control point i. x(i) = p(1); y(i) = p(2); z(i) = p(3); xk(i) = x(i); yk(i) = y(i); zk(i) = z(i); % Select reasonable parameter values associated with the new % control point. With the exception of smwts(i) and (xp(i), % yp(i),zp(i)) when derivatives are user-specified, these % values will be recomputed by a call to tscurve. if i == 1 xp(i) = xk(i+1)-xk(i); yp(i) = yk(i+1)-yk(i); zp(i) = zk(i+1)-zk(i); sf = 1/sqrt(xp(i)^2 + yp(i)^2 + zp(i)^2); xp(i) = sf*xp(i); yp(i) = sf*yp(i); zp(i) = sf*zp(i); if strcmp(endcond,'periodic') x(n) = x(1); y(n) = y(1); z(n) = z(1); smwts(n) = smwts(1); xk(n) = x(1); yk(n) = y(1); zk(n) = z(1); xp(n) = xp(1); yp(n) = yp(1); zp(n) = zp(1); end vx = get(hcs0(i),'XData'); vy = get(hcs0(i),'YData'); vz = get(hcs0(i),'ZData'); elseif i < n % 1 < i < n smwts(i) = (smwts(i-1)+smwts(i+1))/2; t(i) = (t(i-1)+t(i+1))/2; xp(i) = xk(i+1)-xk(i-1); yp(i) = yk(i+1)-yk(i-1); zp(i) = zk(i+1)-zk(i-1); sf = 1/sqrt(xp(i)^2 + yp(i)^2 + zp(i)^2); xp(i) = sf*xp(i); yp(i) = sf*yp(i); zp(i) = sf*zp(i); vx = get(hcs0(i-1),'XData'); vy = get(hcs0(i-1),'YData'); vz = get(hcs0(i-1),'ZData'); else aln(i) = aln(i-1); % i = n smwts(i) = smwts(i-1); t(i) = t(i-1); xp(i) = xk(i)-xk(i-1); yp(i) = yk(i)-yk(i-1); zp(i) = zk(i)-zk(i-1); sf = 1/sqrt(xp(i)^2 + yp(i)^2 + zp(i)^2); xp(i) = sf*xp(i); yp(i) = sf*yp(i); zp(i) = sf*zp(i); vx = get(hcs0(n-2),'XData'); vy = get(hcs0(n-2),'YData'); vz = get(hcs0(n-2),'ZData'); end hcp0(i) = line(x(i),y(i),z(i), ... 'ButtonDownFcn',@CpButtonDnFcn, ... 'HandleVisibility','callback', ... 'HitTest','on', ... 'LineStyle','none','Marker','o', ... 'MarkerEdgeColor',cp_color, ... 'MarkerFaceColor',cp_color, ... 'MarkerSize',ms2, ... 'SelectionHighlight','off', ... 'Tag',num2str(i)); if strcmp(operation,'alter_tf') || ... strcmp(operation,'insert_cp') || strcmp(operation,'alter_bd') set(hcp0(i),'HitTest','off') end u = xp(i); v = yp(i); w = zp(i); if ndof == 1 u = L/sqrt(xsf^2+(ysf*yp(i))^2); v = yp(i)*u; end harrow(i) = quiver3(xk(i),yk(i),zk(i),asf*u,asf*v,asf*w); set(harrow(i),'AutoScale','off', ... 'Color',arrow_color, ... 'HandleVisibility','callback', ... 'HitTest','off', ... 'MaxHeadSize',0.5, ... 'SelectionHighlight','off', ... 'Tag',num2str(i), ... 'Visible','off'); if strcmp(get(hdo(1),'Checked'),'on') set(harrow(i),'Visible','on') end % Create new annotation text objects. hcpi0(i) = text(x(i),y(i),z(i),num2str(i), ... 'FontSize',14, ... 'HandleVisibility','callback', ... 'HitTest','off', ... 'HorizontalAlignment','left', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'VerticalAlignment','bottom', ... 'Visible','off'); if cpstate == 2 set(hcpi0(i),'Visible','on') end if i == n, i = n-1; end hcs0(i) = line(vx,vy,vz, ... 'Color',cs_color, ... 'ButtonDownFcn',@CsButtonDnFcn, ... 'HandleVisibility', 'callback', ... 'HitTest','on', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'Tag',num2str(i)); hcsp(i) = quiver3(vx,vy,vz,vxc,vyc,vzc); set(hcsp(i),'AutoScale','off', ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'ShowArrowHead','off') if ~plotp set(hcsp(i),'Visible','off') end hcs1(i) = line(vx1,vy1,vz1, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(2), ... 'SelectionHighlight','off'); hcs2(i) = line(vx2,vy2,vz2, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(3), ... 'SelectionHighlight','off'); if strcmp(operation,'alter_dv') || strcmp(operation,'alter_sw') || ... strcmp(operation,'delete_cp') || ... (strcmp(operation,'insert_cp') && ~interpolate) || ... strcmp(operation,'move_cp') set(hcs0(i),'HitTest','off') end if ~interpolate set(hcpoly,'XData',x, 'YData',y, 'ZData',z) end return; end % insertcp %*********************************************************** function q = snaptogrid(q) % Move a point to the nearest grid vertex. % % USAGE: q = snaptogrid(q); % % The point q (3-vector) is moved to the nearest point of % the grid defined by the figure 1 axes properties XTick, % YTick, ZTick. % % The grid is assumed to be uniform, and it is implicitly % extended beyond the range of the data to allow for q % outside of the grid (as might occur if a point is dragged % with the axis limits frozen). % Loop on components. for j = 1:3 if j == 1 tk = get(hax(1),'XTick'); elseif j == 2 tk = get(hax(1),'YTick'); else tk = get(hax(1),'ZTick'); end dt = tk(2)-tk(1); % dt = mesh width q(j) = tk(1) + dt*round((q(j)-tk(1))/dt); end return; end % snaptogrid %*********************************************************** function tscurve % Create and display a tension spline curve % % This is a nested function that provides an interface % between TSPACKGUI (and its callbacks) and the tension % spline package TSPACK. % TSPACKGUI variables used: % % active = Flag set to true iff a smoothing curve is % constructed and the constraint is active (the % curve is not the graph of a linear function). % bmax = User-defined value of infinity for bounds % constraint definitions. % bnds = Array dimensioned 5 by n-1 defining bounds % constraints when tension = 'bounds'. If ndof = 2, % only the first two rows are used. % deriv = String variable specifying the method for % selecting (first) derivatives at knots: % deriv = 'c2' if derivatives are chosen to produce % a C^2 curve (second derivative continuity). % deriv = 'c1' if derivatives are computed by local % fits using three control points in an % interpolatory curve. % deriv = 'user' if derivatives are user-selected. % endcond = string variable specifying the method for % selecting end conditions: % endcond = 'periodic' in the case of a closed % parametric curve. % endcond = 'auto' if endpoint derivatives are computed % by local fits. % endcond = 'user' if endpoint derivatives are user- % specified. % harrow = Array of length imax containing derivative % (arrow) handles. % imax = Number of control points excluding the last when % it coincides with the first defining a closed % curve. % interpolate = Logical variable indicating an interpola- % ting, as opposed to an approximating, % curve. % n = Number of control points. % ndof = Number of degrees of freedom in each control % point, or number of dependent variables (1, 2, % or 3). % ne = number of vertices in each curve segment. % newknots = Logical variable with value true if knots % are to be recomputed (as cumulative arc % length) for a parametric curve. % sigf = Tension factor or flag (negative value) specifying % that tension factors are nonuniform (vary with % the curve segment). % sigma = Tension factors if user-specified (tension = % 'user'). % smwts = Array of length n containing weights for % smoothing in Function SMCRV: reciprocals of % the variances in the data values. % t = Knot values in the case of a parametric curve. % tension = String variable specifying the method for % setting tension factors sigma: % tension = 'shape' if tension factors are chosen by % SIGS or SIGSP to preserve shape % properties (local monotonicity % and/or convexity. % tension = 'bounds' if tension factors are chosen by % SIGBx to satisfy bounds constraints. % tension = 'user' if tension factors can be altered by % the user. % x,y,z = Arrays of length n containing axes (data space) % coordinates of the control points. % xk,yk,zk = Arrays of length n containing axes (data % space) coordinates of the knot function % values in the case of interpolation. % xp,yp,zp = Knot derivative values if user-specified % (deriv = 'user'). % % TSPACKGUI Output parameters: % % icflg = Array of length n-1 containing constraint % violation flags in the case of a bounds- % constrained interpolatory function. % sigma = Tension factors if not user-specified. % t = Altered knot values in the case of a parametric % curve if newknots = true. % xk,yk,zk = Knot function values in the case of smoothing. % xp,yp,zp = Knot derivative values if not user-specified. % % Additional parameters: % % bv1,bvn = End condition values (endpoint derivatives) % used only if deriv = 'c2' and endcond = 'user'. % dsmax = Maximum relative change in a component of sigma % at the last iteration. % dyp = Maximum relative change in a derivative component % at the last iteration. % dyk = Maximum relative change in a component of yk % at the last iteration in TSPSS. % iendc = End condition indicator, used only for a C^2 % open curve (deriv = 'c2' and endcond ~= 'periodic'). % ier = Iteration count or error flag. % ncd = Number of continuous derivatives. % nit = Number of iterations in TSPSS. % per = Logical variable indicating a closed parametric % curve with periodic end conditions. % sm = Smoothing parameter for SMCRV when interpolate = 0. % smtol = Smoothing tolerance for SMCRV. % stol = Tolerance for calls to SIGS or SIGSP. active = false; iendc = 3; if strcmp(deriv,'c2') && (strcmp(endcond,'user') || ~interpolate) iendc = 1; if ndof == 1 bv1 = yp(1); bvn = yp(n); else bv1 = [xp(1) yp(1) zp(1)]; bvn = [xp(n) yp(n) zp(n)]; end end ncd = 1; if strcmp(deriv,'c2'), ncd = 2; end per = strcmp(endcond,'periodic'); sm = n; smtol = 2/n; if n == 2, smtol = 0.5; end stol = 0; if ndof > 1 && newknots % Compute knots for a parametric curve. if ndof == 2 [t,ier] = arcl2d(x,y); else [t,ier] = arcl3d(x,y,z); end newknots = false; if interpolate && ier > 0 error('%s\n','A pair of adjacent control points coincide.') end end ier = 0; if strcmp(tension,'shape') % shape-preserving fit if interpolate if ndof == 1 if (iendc == 1 || iendc == 2) [yp,sigma,ier,dyp,dsmax] = tspsi(x,y,ncd,iendc, ... per,sigf,bv1,bvn); else if strcmp(deriv,'user') sigma(:) = 0; [sigma,dsmax] = sigs(x,y,yp,stol,sigma); else [yp,sigma,ier,dyp,dsmax] = tspsi(x,y,ncd, ... iendc,per,sigf); end end else if (iendc == 1 || iendc == 2) if ndof == 2 [xp,yp,zp,sigma,ier,dyp,dsmax] = tspsp(ndof, ... t,x,y,z,ncd,iendc,per,sigf,bv1(1), ... bvn(1),bv1(2),bvn(2)); else [xp,yp,zp,sigma,ier,dyp,dsmax] = tspsp(ndof, ... t,x,y,z,ncd,iendc,per,sigf,bv1(1), ... bvn(1),bv1(2),bvn(2),bv1(3),bvn(3)); end else if strcmp(deriv,'user') sigma(:) = 0; [sigma,dsmax,ier] = sigsp(ndof,t,x,y,z,xp,yp,zp,stol,sigma); if (ier >= 0), ier = 1; end else [xp,yp,zp,sigma,ier,dyp,dsmax] = tspsp(ndof, ... t,x,y,z,ncd,iendc,per,sigf); end end end else if ndof == 1 active = true; [sigma,yk,yp,nit,ier,dyk,dsmax] = tspss(x,y, ... per,sigf,smwts,sm,smtol); if ier > 0 active = false; ier = 0; end else % Invalid parameters: C^2 shape-preserving parametric % B-spline curves are not supported. error('%s\n%s\n','C^2 shape-preserving parametric B-spline', ... 'curves are not supported.') end end elseif strcmp(tension,'bounds') % Bounds-constrained interpolation if ndof == 1 if (iendc == 1 || iendc == 2) [yp,sigma,icflg,ier,dyp,dsmax] = tspbi(x,y,ncd, ... iendc,per,bnds,bmax,bv1,bvn); else if strcmp(deriv,'user') sigma(:) = 0; [sigma,icflg,dsmax,ier] = sigbi(x,y,yp,stol, ... bnds,bmax,sigma); else [yp,sigma,icflg,ier,dyp,dsmax] = tspbi(x,y,ncd, ... iendc,per,bnds,bmax); end end else % Parametric interpolatory planar curve if (iendc == 1 || iendc == 2) [xp,yp,sigma,ier,dyp,dsmax] = tspbp(t,x,y,ncd, ... iendc,per,bnds(2,:),bnds(1,:),bmax, ... bv1(1),bvn(1),bv1(2),bvn(2)); else if strcmp(deriv,'user') sigma(:) = 0; [sigma,dsmax,ier] = sigbp(x,y,xp,yp,stol, ... bnds(2,:),bnds(1,:),bmax,sigma); else [xp,yp,sigma,ier,dyp,dsmax] = tspbp(t,x,y,ncd, ... iendc,per,bnds(2,:),bnds(1,:),bmax); end end end elseif ~strcmp(deriv,'user') % User-specified tension: compute derivative vectors. if ndof == 1 if ncd == 1 [yp,ier] = ypc1(x,y); % C^1 interpolatory function elseif interpolate % C^2 interpolatory function if (iendc == 1 || iendc == 2) [yp,ier] = ypc2(x,y,sigma,iendc,iendc,bv1,bvn); else [yp,ier] = ypc2(x,y,sigma,iendc,iendc); end else % C^2 smoothing function active = true; [yk,yp,ier] = smcrv(x,y,sigma,per,smwts, ... sm,smtol); if ier > 0 active = false; ier = 0; end end else if ncd == 1 % C^1 parametric interpolant if ndof == 2 [xp,yp,ier] = ypc1t(x,y); else [xp,yp,zp,ier] = ypc1t(x,y,z); end elseif interpolate if per % C^2 closed parametric curve [xp,ier] = ypc2p(t,x,sigma); yp = ypc2p(t,y,sigma); if ndof == 3, zp = ypc2p(t,z,sigma); end else % C^2 open parametric curve if (iendc == 1 || iendc == 2) [xp,ier] = ypc2(t,x,sigma,iendc,iendc,bv1(1),bvn(1)); yp = ypc2(t,y,sigma,iendc,iendc,bv1(2),bvn(2)); if ndof == 3 zp = ypc2(t,z,sigma,iendc,iendc,bv1(3),bvn(3)); end else [xp,ier] = ypc2(t,x,sigma,iendc,iendc); yp = ypc2(t,y,sigma,iendc,iendc); if ndof == 3 zp = ypc2(t,z,sigma,iendc,iendc); end end end else % Uniform B-spline [xk,yk,zk,xp,yp,zp] = bsp2h(ndof,t,x,y,z, ... sigma,per,bv1,bvn); end end if ier > 0 if ndof == 1 error('Abscissae are not strictly increasing.') else error('Invalid knots returned by ARCLxD.') end end end % Force sigma to be a row vector. sigma = sigma(:)'; if ier == -4 && ndof > 1 error('A pair of adjacent control points coincide.') end if ier == -5 error('Invalid bounds constraints.') end if ier < 0 error('Error flag %0.0f returned by function TSPxx.\n', ier) end % fprintf(1,['tspsp output: no. calls to sigs = %0.0f, dyp = %9.3e, ' ... % 'dsmax = %9.3e\n'], ier, dyp, dsmax); % Update the curve segment line objects. tseval(1:n-1); % Update derivative (arrow) data. for i = 1:imax set(harrow(i),'XData',xk(i), 'YData',yk(i), ... 'ZData',zk(i)) end if ~strcmp(deriv,'user') if ndof > 1 for i = 1:imax set(harrow(i),'UData',asf*xp(i), 'VData',asf*yp(i), ... 'WData',asf*zp(i)) end else % Compute arrow components (u,v) chosen so that v/u = yp(i) % and (xsf*u)^2 + (ysf*v)^2 = L^2, where xsf and ysf are the % scale factors in the mappings from axes coordinates to % window coordinates, and L is arrow length in window coor- % dinates: 2*(w+h)/n for window width w and height h. w = 0; for i = 1:imax u = L/sqrt(xsf^2+(ysf*yp(i))^2); v = yp(i)*u; set(harrow(i),'UData',asf*u, 'VData',asf*v, 'WData',asf*w) end end end % Update the annotation text strings for control points. for i = 1:imax set(hcpi0(i),'Position',[x(i) y(i) z(i)], 'String',num2str(i)) end return; end % tscurve %*********************************************************** function tseval(indx) % Update curve segment line objects by evaluating tension splines. % % This is a nested function that provides an interface % between TSPACKGUI (and its callbacks) and the tension % spline package TSPACK. % % INDX is a row vector of indices (1 to n-1) specifying which % curve segments are to be updated. % TSPACKGUI parameters used: % % aln = Array of length n containing knot values of arc % length s(t) if ndof > 1. % crv = Array dimensioned 2 by n-1 containing knot curvature % or signed curvature values if ndof > 1. % hcp1 = Handle of sequence of knot derivatives or curva- % ture values depicted by small dots in figure 2. % hcp2 = Handle of sequence of knot second derivatives or % torsion values depicted by small dots in figure 3. % hcs0 = Array of length n-1 containing handles of curve % segments in figure 1. % hcs1 = Array of length n-1 containing handles of curve % segments in first derivative or curvature plots % (figure 2). % hcs2 = Array of length n-1 containing handles of curve % segments in second derivative or torsion plots % (figure 3). % hcsp = Array of length n-1 containing handles of line % segments depicting curvature (as a porcupine % plot) in figure 1. % ndof = Number of degrees of freedom in each control % point, or number of dependent variables (1, 2, % or 3). % ne = number of vertices in each curve segment. % plot1,plot2,plotp = Logical variables. % sigma = Tension factors. % t = Array of length n containing knot values if ndof > 1. % trs = Array dimensioned 2 by n-1 containing knot torsion % values if ndof = 3. % vx,vy,vz = Arrays of length ne containing tension spline % values at the elements of te. % vx1,vy1,vz1 = Arrays of length ne containing first % derivative vectors at the elements of te. % vx2,vy2,vz2 = Arrays of length ne containing second % derivative vectors at the elements of te. % vx3,vy3,vz3 = Arrays of length ne containing third % derivative vectors at the elements of te. % vxc,vyc,vzc = Arrays of length ne containing curvature % vectors at the elements of te. % xk,yk,zk = Arrays of length n containing axes (data % space) coordinates of the knot function % values. % xp,yp,zp = Knot derivative values. % % % Local parameters: % % crvmin,crvmax = Minimum and maximum allowable curvature % values for porcupine plots. % c,d,k,s1,s2 = Arrays of length ne used to compute and % adjust curvature and torsion. % te = Array of length ne containing evaluation points. crvmin = qmin; if ndof == 1 crvmax = 1.5*mean(diff(xk)); else crvmax = 1.5*mean(diff(t)); end % For each curve segment i in INDX, update aln if needed, % and create vectors of length ne: evaluation points te, % values (vx,vy,vz) of h = (H1,H2,H3) at the evaluation % points, first derivatives h' = (vx1,vy1,vz1), second % derivatives h'' = (vx2,vy2,vz2), and third derivatives % h''' = (vx3,vy3,vz3) at te, curvature vectors % (h'' - h')/^2 = (vxc,vyc,vzc), % curvature |h' X h''|/|h'|^3 = c, and torsion % det(h',h'',h''')/. % % Since h' and h'' values are required for the curvature, % the figure 2 and figure 3 data are stored even when plot1 % or plot2 is false when plotp = true. It is therefore not % necessary to call this function when plot1 or plot2 is % toggled on if plotp = true. aln(1) = 0; for i = indx if ndof == 1 te = linspace(xk(i),xk(i+1),ne); vy = tsval1(xk,yk,yp,sigma,0,te); set(hcs0(i),'XData',te, 'YData',vy) if plot1 || plotp vy1 = tsval1(xk,yk,yp,sigma,1,te); set(hcs1(i),'XData',te, 'YData',vy1) end if plot2 || plotp vy2 = tsval1(xk,yk,yp,sigma,2,te); set(hcs2(i),'XData',te, 'YData',vy2) end if plotp d = (1+vy1.*vy1).^2; vxc = -vy1.*vy2./d; vyc = 1./d; % Restrict curvature magnitudes to [crvmin,crvmax]. s2 = sqrt(vxc.*vxc + vyc.*vyc); k = find(s2 < crvmin); s1 = crvmin./s2(k); vxc(k) = s1.*vxc(k); vyc(k) = s1.*vyc(k); k = find(s2 > crvmax); s1 = crvmax./s2(k); vxc(k) = s1.*vxc(k); vyc(k) = s1.*vyc(k); set(hcsp(i),'ShowArrowHead','on') set(hcsp(i),'XData',te, 'YData',vy, ... 'UData',csf*vxc, 'VData',csf*vyc) set(hcsp(i),'ShowArrowHead','off') end elseif ndof == 2 % Planar curve te = linspace(t(i),t(i+1),ne); [vx,vy] = tsval2(t,xk,yk,xp,yp,sigma,0,te); set(hcs0(i),'XData',vx, 'YData',vy) if plot1 || plot2 || plotp d = arcl2d(vx,vy) + aln(i)*ones(1,ne); % Arc length del = d(ne) - aln(i+1); aln(i+1:n) = aln(i+1:n) + del*ones(1,n-i); % Update aln [vx1,vy1] = tsval2(t,xk,yk,xp,yp,sigma,1,te); [vx2,vy2] = tsval2(t,xk,yk,xp,yp,sigma,2,te); s1 = vx1.*vx1 + vy1.*vy1; % s2 = vx1.*vy2 - vx2.*vy1; % h' X h'' c = s2./(s1.^1.5); % Signed curvature crv(1,i) = c(1); % Update crv crv(2,i) = c(ne-1); if i == n-1, crv(2,i) = c(ne); end set(hcs1(i),'XData',d, 'YData',c) set(hcs2(i),'XData',d, 'YData',c) end if plotp s2 = vx1.*vx2 + vy1.*vy2; d = s1.*s1; vxc = (s1.*vx2 - s2.*vx1)./d; % Curvature vector vyc = (s1.*vy2 - s2.*vy1)./d; % Restrict curvature magnitudes to [crvmin,crvmax]. s2 = sqrt(vxc.*vxc + vyc.*vyc); % Curvature k = find(s2 < crvmin); s1 = crvmin./s2(k); vxc(k) = s1.*vxc(k); vyc(k) = s1.*vyc(k); k = find(s2 > crvmax); s1 = crvmax./s2(k); vxc(k) = s1.*vxc(k); vyc(k) = s1.*vyc(k); set(hcsp(i),'ShowArrowHead','on') set(hcsp(i),'XData',vx, 'YData',vy, ... 'UData',csf*vxc, 'VData',csf*vyc) set(hcsp(i),'ShowArrowHead','off') end else % Space curve te = linspace(t(i),t(i+1),ne); [vx,vy,vz] = tsval3(t,xk,yk,zk,xp,yp,zp,sigma,0,te); set(hcs0(i),'XData',vx, 'YData',vy, 'ZData',vz) if plot1 || plot2 || plotp d = arcl3d(vx,vy,vz) + aln(i)*ones(1,ne); % Arc length del = d(ne) - aln(i+1); aln(i+1:n) = aln(i+1:n) + del*ones(1,n-i); % Update aln [vx1,vy1,vz1] = tsval3(t,xk,yk,zk,xp,yp,zp,sigma,1,te); [vx2,vy2,vz2] = tsval3(t,xk,yk,zk,xp,yp,zp,sigma,2,te); vxc = vy1.*vz2 - vz1.*vy2; % h' X h'' vyc = vz1.*vx2 - vx1.*vz2; vzc = vx1.*vy2 - vy1.*vx2; s2 = vxc.*vxc + vyc.*vyc + vzc.*vzc; % |h' X h''|^2 end if plot1 || plotp s1 = vx1.*vx1 + vy1.*vy1 + vz1.*vz1; % |h'|^2 c = sqrt(s2)./(s1.^1.5); % Curvature crv(1,i) = c(1); % Update crv crv(2,i) = c(ne-1); if i == n-1, crv(2,i) = c(ne); end set(hcs1(i),'XData',d, 'YData',c) end if plot2 || plotp [vx3,vy3,vz3] = tsval3(t,xk,yk,zk,xp,yp,zp,sigma,3,te); s2 = (vxc.*vx3 + vyc.*vy3 + vzc.*vz3)./s2; % Torsion trs(1,i) = s2(1); % Update trs trs(2,i) = s2(ne-1); if i == n-1, trs(2,i) = s2(ne); end set(hcs2(i),'XData',d, 'YData',s2) end if plotp vx3 = vyc.*vz1 - vzc.*vy1; % h' X h'' X h' vy3 = vzc.*vx1 - vxc.*vz1; vz3 = vxc.*vy1 - vyc.*vx1; s1 = s1.*s1; % |h'|^4 vxc = vx3./s1; % Curvature vector vyc = vy3./s1; vzc = vz3./s1; % Restrict curvature magnitudes to [crvmin,crvmax]. s2 = c; % Curvature k = find(s2 < crvmin); s1 = crvmin./s2(k); vxc(k) = s1.*vxc(k); vyc(k) = s1.*vyc(k); vzc(k) = s1.*vzc(k); k = find(s2 > crvmax); s1 = crvmax./s2(k); vxc(k) = s1.*vxc(k); vyc(k) = s1.*vyc(k); vzc(k) = s1.*vzc(k); set(hcsp(i),'ShowArrowHead','on') set(hcsp(i),'XData',vx, 'YData',vy, 'ZData',vz, ... 'UData',csf*vxc, 'VData',csf*vyc, 'WData',csf*vzc) set(hcsp(i),'ShowArrowHead','off') end end end % Store figure 2 and figure 3 control points. if ndof == 1 set(hcp1,'XData',xk(1:imax), 'YData',yp(1:imax), ... 'ZData',zeros(1,imax)) c = tsval1(xk,yk,yp,sigma,2,xk(1:imax)); set(hcp2,'XData',xk(1:imax), 'YData',c, ... 'ZData',zeros(1,imax)) elseif ndof == 2 c = 0.5*([crv(1,:),crv(2,n-1)] + [crv(1,1),crv(2,:)]); set(hcp1,'XData',aln, 'YData',c, 'ZData',zeros(1,n)) set(hcp2,'XData',aln, 'YData',c, 'ZData',zeros(1,n)) else c = 0.5*([crv(1,:),crv(2,n-1)] + [crv(1,1),crv(2,:)]); set(hcp1,'XData',aln, 'YData',c, 'ZData',zeros(1,n)) set(hcp2,'XData',aln, ... 'YData',0.5*([trs(1,:),trs(2,n-1)] + [trs(1,1),trs(2,:)]), ... 'ZData',zeros(1,n)) end return; end % tseval %*********************************************************** function ulpush(opcode,index) % Add an entry to the undo list. % % USAGE: ulpush(opcode,index) % % The one-character code, opcode, specifies the operation or % change of curve type being performed (and to be reversed % if the entry is popped off the stack by Function UndoFcn), % and index is the index of the relevant control point % (opcode = 'a', 'd', 'i', 'm', or 'w'), tension factor % (opcode = 'b' or 's'), or old curve type (opcode = 'c', % 'e', 'n', 't', or 'x'), where the curve type index (1:3) % is position in the Curve Type menu. The following codes % specify operations. % % opcode = 'm': move control point. % opcode = 'i': insert control point. % opcode = 'd': delete control point. % opcode = 'a': alter derivative. % opcode = 's': alter tension factor. % opcode = 'w': alter smoothing weight. % opcode = 'b': alter bounds. % % The following codes specify changes of curve type. % % opcode = 'n/N': ndof = 1,2,3. % opcode = 'c/C': deriv = 'c2', 'c1', 'user'. % opcode = 't': tension = 'shape', 'bounds', 'user'. % opcode = 'e': endcond = 'periodic', 'auto', 'user'. % opcode = 'x/X': interpolate, approximate. % % The uppercase letters indicate that, in addition to the % specified change of curve type, endcond was changed from % 'auto' to 'user' or vice versa. Note that the following % operations are not reversible: % % 1) A curve type change from ndof = 2 to ndof = 1 with % user-specified derivatives that are not unit vectors. % 2) A curve type change from ndof = 3 to ndof = 2 when a % control point or derivative vector has a nonzero z % component. % 3) A curve type change from user-specified derivatives % to deriv = 'c2' or 'c1'. % 4) A curve type change from user-specified tension to % tension = 'shape' or 'bounds' when tension factors % were not all identical before the change. % 5) Altering a tension factor ('s') with uniform tension % specified by sigf >= 0 when tension factors were not % all identical before the change. % TSPACKGUI parameters used: % % opcnt = Number of (unreversed) changes made to the % current data set since it was saved: % incremented by ulpush, decremented by UndoFcn. % ulcnt = Current number of entries in ulist (number of % undo levels available). % ulist = Undo list stored as an array of structures, and % accessed as a stack. % ulist(i).opcode = operation code defined above. % ulist(i).index = index defined above. % ulist(i).data = array containing the data required % to reverse the operation. % upmax = Length of ulist and maximum value of ulcnt. % uptr = Stack pointer (in the range 1 to upmax) for access % to ulist. uptr = uptr + 1; if uptr > upmax, uptr = 1; end i = index; data = []; switch opcode case 'a' data = [xp(i) yp(i) zp(i)]; case 'b' data = bnds(:,i)'; case {'C', 'e', 'N', 'X'} data = [xp(1) yp(1) zp(1) xp(n) yp(n) zp(n)]; case 'd' if i < n data = [x(i) y(i) z(i) xp(i) yp(i) zp(i) sigma(i) smwts(i) ... bnds(:,i)']; else data = [x(i) y(i) z(i) xp(i) yp(i) zp(i) sigma(n-1) smwts(i) ... bnds(:,n-1)']; end case 'm' data = [x(i) y(i) z(i)]; case 's' data = [sigma(i) sigf]; case 't' data = sigf; case 'w' data = [smwts(i) smwf]; end ulist(uptr).opcode = opcode; ulist(uptr).index = index; ulist(uptr).data = data; if ulcnt < upmax ulcnt = ulcnt + 1; else ulistfull = true; end opcnt = opcnt + 1; return; end % ulpush %*********************************************************** % TSPACKGUI Callbacks (Nested Functions) %*********************************************************** function AlterBoundsFcn(hobj,event_data) % Callback for Operations menu selection: alter bounds. if strcmp(tension,'bounds') set([hfig4 hfig5],'Visible','off') operation = 'alter_bd'; set(hcp0,'HitTest','off') set(hcs0,'HitTest','on') set(hcpoly,'HitTest','off') set(hcop,'String', ... 'Current Operation: Alter Bounds') % Store edit box positions in figure 6. delh is a height % adjustment (decrement) of 130 if ndof = 2. delh = 130*(ndof-1); for j = 1:5 set(hedit6(j),'Position',[pos6(j,1) pos6(j,2)-delh 60 25]) set(hedstr6(j),'Position',[pos6(j,1) pos6(j,2)-delh+25 60 15]) end set(hfig6,'Position',[ssiz(3)-420 ssiz(4)/2-100 410 395-delh]) if ndof > 1 set(hedit6(3:5),'Visible','off'); set(hedstr6(3:5),'Visible','off'); set(hedstr6(1),'String','Max d') set(hedstr6(2),'String','Min d') else set(hedit6(3:5),'Visible','on'); set(hedstr6(3:5),'Visible','on'); set(hedstr6(1),'String','Max y') set(hedstr6(2),'String','Min y') end else edialog({'This operation requires bounds-constrained tension.'}, ... 'Invalid Operation'); end return; end % AlterBoundsFcn %*********************************************************** function AlterDerivFcn(hobj,event_data) % Callback for Operations menu selection: alter derivative. if ~strcmp(deriv,'user') && (~strcmp(deriv,'c2') || ... ~strcmp(endcond,'user')) edialog({'This operation requires that curve type', ... 'C^1 User-specified Derivatives be selected.'}, ... 'Invalid Operation'); else set([hfig4 hfig5 hfig6],'Visible','off') operation = 'alter_dv'; set(hcp0,'HitTest','on') set(hcs0,'HitTest','off') set(hcpoly,'HitTest','off') if strcmp(deriv,'user') set(hcop,'String', ... 'Current Operation: Alter Derivative Vectors') else set(hcop,'String', ... 'Current Operation: Alter Endpoint Derivative Vectors') end if cpstate == 0 DOcpts(hdo(5),event_data) end set(hcp0,'Visible','on') if ~interpolate, set(hcpoly,'Visible','on'), end end return; end % AlterDerivFcn %*********************************************************** function AlterSigmaFcn(hobj,event_data) % Callback for Operations menu selection: alter tension factor. if strcmp(tension,'user') set([hfig5 hfig6],'Visible','off') operation = 'alter_tf'; set(hcp0,'HitTest','off') set(hcs0,'HitTest','on') set(hcpoly,'HitTest','off') set(hcop,'String', ... 'Current Operation: Alter Tension Factors') elseif strcmp(tension,'bounds') edialog({'Tension factors cannot be altered', ... 'in a bounds-constrained curve.'}, ... 'Invalid Operation'); else edialog({'Tension factors cannot be altered', ... 'in a shape-preserving curve.'}, ... 'Invalid Operation'); end return; end % AlterSigmaFcn %*********************************************************** function AlterWeightFcn(hobj,event_data) % Callback for Operations menu selection: alter smoothing weight. if ndof == 1 && ~interpolate set([hfig4 hfig6],'Visible','off') operation = 'alter_sw'; set(hcp0,'HitTest','on') set(hcs0,'HitTest','off') set(hcpoly,'HitTest','off') set(hcop,'String', ... 'Current Operation: Alter Smoothing Weights') % Compute maximum variance vmax such that if the average weight % is n/vmax then the constraint is not active. vmax = resnrm1(x,y); vmin = 1.e-5*vmax; set(hslider5,'Min',vmin,'Max',vmax) set(hslitxt5,'String',num2str(vmax)) % Adjust weights if necessary for the altered range. for i = 1:n if smwts(i) > 1/vmin, smwts(i) = 1/vmin; end if smwts(i) < 1/vmax, smwts(i) = 1/vmax; end end else edialog({'This operation can only be applied', ... 'to a smoothing curve (function).'}, ... 'Invalid Operation'); end return; end % AlterWeightFcn %*********************************************************** function AppendCpFcn(hobj,event_data) % Callback for Operations menu selection: append control point. set([hfig4 hfig5 hfig6],'Visible','off') if strcmp(endcond,'periodic') edialog({'A control point cannot be appended', ... 'to a closed curve.'}, 'Invalid Selection'); return; end if freeze_cp a = questdlg('Alter the set of control points?', ... 'Alter Control Points','Yes','No','Yes'); if ~strcmp(a,'Yes') cancelop % Cancel current operation return; end freeze_cp = false; end operation = 'append_cp'; set(hcp0,'HitTest','on') set(hcs0,'HitTest','off') set(hcpoly,'HitTest','off') set(hcop,'String', ... 'Current Operation: Append Control Points') if cpstate == 0 DOcpts(hdo(5),event_data) end set(hcp0,'Visible','on') if ~interpolate, set(hcpoly,'Visible','on'), end if snapto && strcmp(get(hdo(6),'Checked'),'off') DOlimits(hdo(6),event_data) % Freeze axis limits end return; end % AppendCpFcn %*********************************************************** function ButtonDnFcn(hobj,event_data) % Callback for mouse button press in figure window. % Erase the text box, if any, created by a right mouse click % on a control point or curve segment. if ishandle(htxt) delete(htxt); end return; end % ButtonDnFcn %*********************************************************** function ButtonUpFcn(hobj,event_data) % Callback for mouse button release. if drag_cp % Button release following a control point drag: update % x, y, z, the curve segments, and the line objects with % the new position. drag_cp = false; set(hc,'MarkerEdgeColor',cp_color) set(hc,'MarkerFaceColor',cp_color) view(az,el) % Restore view if changed when drag was initiated xd = get(hdragcp,'XData'); yd = get(hdragcp,'YData'); zd = get(hdragcp,'ZData'); i = str2double(get(hdragcp,'Tag')); delete(hdragcp) if snapto p = snaptogrid([xd(2) yd(2) zd(2)]); if ndof == 1 yd(2) = p(2); else xd(2) = p(1); yd(2) = p(2); zd(2) = p(3); end end % Compute the distance d in window coordinates from the new % control point (xd(2),yd(2),zd(2)) to each of its two % neighbors (xd(1),yd(1),zd(1)) and (xd(3),yd(3),zd(3)). % If d < dtol then move the control point away from its % neighbor in the case of an interpolatory or smoothing % curve, or create a duplicate control point in the case of % a B-spline curve. dtol = 4; dely = get(hax(1),'YLim'); fp = get(hfig1,'Position'); dely = 2*dtol*(dely(2)-dely(1))/fp(4); p = [xd(2) yd(2) zd(2)]; w = xform(p); if i > 1 || strcmp(endcond,'periodic') if abs(zd(2)-zd(1)) > 1.e-4 d = 2*dtol; else pn = [xd(1) yd(1) zd(1)]; wn = xform(pn); d = sqrt((w(1)-wn(1))^2 + (w(2)-wn(2))^2); end if d < dtol if ndof == 1 || interpolate yd(2) = yd(2) + dely; else xd(2) = xd(1); yd(2) = yd(1); zd(2) = zd(1); end end end if i < n || strcmp(endcond,'periodic') if abs(zd(2)-zd(3)) > 1.e-4 d = 2*dtol; else pn = [xd(3) yd(3) zd(3)]; wn = xform(pn); d = sqrt((w(1)-wn(1))^2 + (w(2)-wn(2))^2); end if d < dtol if ndof == 1 || interpolate yd(2) = yd(2) + dely; else xd(2) = xd(3); yd(2) = yd(3); zd(2) = zd(3); end end end x(i) = xd(2); y(i) = yd(2); if ndof == 3, z(i) = zd(2); end if interpolate xk(i) = x(i); yk(i) = y(i); zk(i) = z(i); end per = strcmp(endcond,'periodic'); if i == 1 && per x(n) = x(1); y(n) = y(1); z(n) = z(1); if interpolate xk(n) = x(n); yk(n) = y(n); zk(n) = z(n); end end set(hcp0(i),'XData',x(i), 'YData',y(i), 'ZData',z(i)) if ~interpolate set(hcpoly,'XData',x, 'YData',y, 'ZData',z) end % Update the curve, and the knots if parametric, for the moved % or inserted control point. if ndof > 1, newknots = true; end tscurve; elseif drag_dv % Button release following a derivative arrow tip drag: % update xp, yp, zp, the curve segments, and the line % objects with the new derivative. set(hc,'MarkerEdgeColor',cp_color) set(hc,'MarkerFaceColor',cp_color) view(az,el) % Restore view if changed when drag was initiated xd = get(hdragdv,'UData'); yd = get(hdragdv,'VData'); zd = get(hdragdv,'WData'); i = str2double(get(hdragdv,'Tag')); delete(hdragdv) if ndof == 1 if xd <= 0, return; end xp(i) = 1; yp(i) = yd/xd; else xp(i) = xd/asf; yp(i) = yd/asf; if ndof == 3, zp(i) = zd/asf; end end if i == 1 && strcmp(endcond,'periodic') xp(n) = xp(1); yp(n) = yp(1); zp(n) = zp(1); end if ndof > 1 set(harrow(i),'UData',xd, 'VData',yd, 'WData',zd) else % Compute arrow components (u,v) chosen so that v/u = yp(i) % and (xsf*u)^2 + (ysf*v)^2 = L^2, where xsf and ysf are the % scale factors in the mappings from axes coordinates to % window coordinates, and L is arrow length in window coor- % dinates: 2*(w+h)/n for window width w and height h. u = L/sqrt(xsf^2+(ysf*yp(i))^2); v = yp(i)*u; set(harrow(i),'UData',asf*u, 'VData',asf*v) end tscurve; end if drag_dv % Set the figure CurrentPoint to the window coordinates wp % associated with the control point p, and move the mouse % position (screen PointerLocation) sp to the same point. % sp = wp + fp - 1, where fp = figure position (lower left % corner). drag_dv = false; p(1) = xk(i); p(2) = yk(i); p(3) = zk(i); wp = ceil(xform(p)); fp = get(hfig1,'Position'); fp(3:4) = []; sp = wp + fp - 1; set(0,'PointerLocation',sp) % This has no effect on the Mac. set(hfig1,'CurrentPoint',wp) end return; end % ButtonUpFcn %*********************************************************** function CpButtonDnFcn(hobj,event_data) % Callback for mouse button press on a control point. % Set s to the selection (mouse click) type: s = get(hfig1,'SelectionType'); if strcmp(s,'normal') % Left button click: % % Change the currently selected curve object to hobj: if ishandle(hc) if strcmp(get(hc,'Marker'),'none') set(hc,'Color',cs_color) else set(hc,'MarkerEdgeColor',cp_color) set(hc,'MarkerFaceColor',cp_color) end end hc = hobj; i = str2double(get(hc,'Tag')); switch operation case 'alter_dv' % Unless deriv = 'user', this operation is only allowed % for the endpoint derivative vectors (B-spline curve). if strcmp(deriv,'user') || i == 1 || i == n % Alter derivative: create an arrow (initially not visible) % connecting the knot function value to the mouse position. % The WindowButtonMotion and WindowButtonUp callbacks will % update the arrow and, eventually, the derivative. The % arrow length is scaled by asf. ulpush('a',i) drag_dv = true; [az el] = view; if ndof < 3 && el ~= 90 el = 90; view(az,el); % Set el to 90 degrees for planar curve end if ~strcmp(get(hdo(1),'Checked'),'on') set(hdo(1),'Checked','on') set(harrow(1:imax),'Visible','on') end u = get(harrow(i),'UData'); v = get(harrow(i),'VData'); w = get(harrow(i),'WData'); hdragdv = quiver3(xk(i),yk(i),zk(i),u,v,w,0); set(hdragdv,'Color',sl_color, ... 'MaxHeadSize',0.5, ... 'Tag',num2str(i), 'Visible','off'); % Set the figure CurrentPoint to the window coordinates wp % associated with the arrow tip p, and move the mouse % position (screen PointerLocation) sp to the same point. % sp = wp + fp - 1, where fp = figure position (lower left % corner). p(1) = xk(i) + u; p(2) = yk(i) + v; p(3) = zk(i) + w; wp = ceil(xform(p)); fp = get(hfig1,'Position'); fp(3:4) = []; sp = wp + fp - 1; set(0,'PointerLocation',sp) % This has no effect on the Mac. set(hfig1,'CurrentPoint',wp) end case 'alter_sw' % Alter the smoothing weight associated with control point i. set(hc,'MarkerEdgeColor',sl_color) set(hc,'MarkerFaceColor',sl_color) ulpush('w',i) var = 1/smwts(i); set(hedit5,'String',num2str(var)) set(hslider5,'Value',var) set(hcheck5,'Value',0) set(hfig5,'Visible','on') case 'append_cp' if ~strcmp(endcond,'periodic') && (i == 1 || i == n) % Extend the curve in the direction defined by the first two or % last two points. If running on a Macintosh, the new point is % made close to the endpoint because the mouse position cannot be % altered. sf = 1.0; if ismac, sf = 1.e-4; end if i == 1 q = [x(1)+sf*(x(1)-x(2)) y(1)+sf*(y(1)-y(2)) ... z(1)+sf*(z(1)-z(2))]; else i = n+1; q = [x(n)+sf*(x(n)-x(n-1)) y(n)+sf*(y(n)-y(n-1)) ... z(n)+sf*(z(n)-z(n-1))]; end ulpush('i',i) insertcp(i,q) hc = hcp0(i); % Set the figure CurrentPoint to the window coordinates wp % associated with the extended endpoint q, and move the mouse % position (screen PointerLocation) sp to the same point. % sp = wp + fp - 1, where fp = figure position (lower left % corner). wp = ceil(xform(q)); fp = get(hfig1,'Position'); fp(3:4) = []; sp = wp + fp - 1; set(0,'PointerLocation',sp) % This has no effect on the Mac. set(hfig1,'CurrentPoint',wp) % Initiate a drag. dragcp; end case 'delete_cp' % Delete control point i, and update the curve. ulpush('d',i) deletecp(i) if ndof > 1, newknots = true; end tscurve; if n <= 2 || (n <= 4 && strcmp(endcond,'periodic')) cancelop % Cancel delete_cp operation. end case 'move_cp' % Allow the user to drag the control point: create a dotted % line (initially not visible) connecting the point to its % (one or two) neighbors. The WindowButtonMotion and % WindowButtonUp callbacks will update the line object and % curve segments. ulpush('m',i) dragcp; end elseif strcmp(s,'alt') % Right button click: % Display a text box. cpt = get(hax(1),'CurrentPoint'); i = str2double(get(hobj,'Tag')); htxt = text(cpt(1,1),cpt(1,2),cpt(1,3),'', ... 'EdgeColor','black', ... 'FontSize',14, ... 'HitTest','off', 'Visible','on'); if interpolate set(htxt,'String',{['Control point ' get(hobj,'Tag')], ... ['x = ',num2str(x(i)),', xp = ',num2str(xp(i))], ... ['y = ',num2str(y(i)),', yp = ',num2str(yp(i))], ... ['z = ',num2str(z(i)),', zp = ',num2str(zp(i))]}) else set(htxt,'String',{['Control point ' get(hobj,'Tag')], ... ['x = ',num2str(x(i))], ... ['y = ',num2str(y(i))], ... ['z = ',num2str(z(i))]}) end end return; end % CpButtonDnFcn %*********************************************************** function CpolyButtonDnFcn(hobj,event_data) % Callback for mouse button press on the control polygon. % Set s to the selection type: s = get(hfig1,'SelectionType'); if strcmp(s,'normal') % Left button click: % % Change the currently selected curve object to []. if ishandle(hc) if strcmp(get(hc,'Marker'),'none') set(hc,'Color',cs_color) else set(hc,'MarkerEdgeColor',cp_color) set(hc,'MarkerFaceColor',cp_color) end end hc = []; switch operation case 'insert_cp' % Insert a new control point at the point p on the control % polygon that maps to the mouse position mp. Each pair of % adjacent control points p1,p2 is mapped to a line segment % in window coordinates, and the distance d from mp to the % line segment is computed. mp = get(hfig1,'CurrentPoint'); p2 = [x(1) y(1) z(1)]; w2 = ceil(xform(p2)); s = -1; for i = 2:n p1 = p2; w1 = w2; p2 = [x(i) y(i) z(i)]; w2 = ceil(xform(p2)); ds = (w2(1)-w1(1))^2 + (w2(2)-w1(2))^2; % Squared length if ds == 0, continue, end d = abs((w2(1)-w1(1))*(mp(2)-w1(2)) - ... (w2(2)-w1(2))*(mp(1)-w1(1)))/sqrt(ds); % Distance if d > 3.0, continue, end s = ((w2(1)-w1(1))*(mp(1)-w1(1)) + ... (w2(2)-w1(2))*(mp(2)-w1(2)))/ds; % Local coordinate if s >= 0 && s <= 1, break, end end if s < 0 || s > 1 fprintf(1,'Control point insertion failed.\n'); else p = (1-s)*p1 + s*p2; ulpush('i',i) insertcp(i,p) hc = hcp0(i); % Initiate a drag. dragcp; end end end return; end % CpolyButtonDnFcn %*********************************************************** function CsButtonDnFcn(hobj,event_data) % Callback for mouse button press on a curve segment. % Set s to the selection type: s = get(hfig1,'SelectionType'); if strcmp(s,'normal') % Left button click: % % Change the currently selected curve object to hobj. if ishandle(hc) if strcmp(get(hc,'Marker'),'none') set(hc,'Color',cs_color) else set(hc,'MarkerEdgeColor',cp_color) set(hc,'MarkerFaceColor',cp_color) end end hc = hobj; switch operation case 'alter_bd' % Alter the bounds associated with the curve segment. set(hc,'Color',sl_color) i = str2double(get(hc,'Tag')); ulpush('b',i) bnd = bnds(:,i); for j = 1:5 set(hedit6(j),'String',num2str(bnd(j))) end set(hcheck6,'Value',0) set(htxt6,'String',['Tension factor: ',num2str(sigma(i))], ... 'ForegroundColor','black') set(hfig6,'Visible','on') case 'alter_tf' % Alter the tension factor associated with the curve segment. set(hc,'Color',sl_color) i = str2double(get(hc,'Tag')); ulpush('s',i) sig = sigma(i); set(hedit4,'String',num2str(round(100*sig)/100)) set(hslider4,'Value',sig) set(hcheck4,'Value',0) set(hfig4,'Visible','on') case 'insert_cp' % Insert a new control point at the mouse position (which % lies on the selected curve segment). i = str2double(get(hc,'Tag')) + 1; % Convert the ne points on curve segment hcs0(i-1) to window % coordinates wp (ne by 2), and find the nearest point p to % the mouse position mp. vx = get(hcs0(i-1),'XData'); vy = get(hcs0(i-1),'YData'); vz = get(hcs0(i-1),'ZData'); wp = ceil(xform([vx' vy' vz'])); mp = get(hfig1,'CurrentPoint'); wp = [wp(:,1)-mp(1) wp(:,2)-mp(2)]'; [m,j] = min(max(abs(wp))); p(1) = vx(j(1)); p(2) = vy(j(1)); p(3) = vz(j(1)); ulpush('i',i) insertcp(i,p) hc = hcp0(i); % Initiate a drag. dragcp; end elseif strcmp(s,'alt') % Right button click: % Display a text box. cpt = get(hax(1),'CurrentPoint'); i = str2double(get(hobj,'Tag')); htxt = text(cpt(1,1),cpt(1,2),cpt(1,3),'', ... 'EdgeColor','black', ... 'FontSize',14, ... 'HitTest','off', ... 'String',{['Curve segment ' get(hobj,'Tag')], ... ['sigma = ' num2str(sigma(i))]}, ... 'Visible','on'); end return; end % CsButtonDnFcn %*********************************************************** function CTndof1(hobj,event_data) % Callback for Curve Type selection 1: function graph. if ndof == 1, return; end if ndof == 3 edialog({'A space curve cannot be', ... 'converted to a function.'}, ... 'Invalid Selection'); return; end if any(diff(x) <= 0) edialog({'This operation requires strictly', ... 'increasing abscissae.'}, ... 'Invalid Selection'); return; end if strcmp(deriv,'user') && any(xp <= 0) edialog({'With user-specified derivatives,', ... 'this operation requires xp > 0.'}, ... 'Invalid Selection'); return; end if strcmp(deriv,'user') a = questdlg(['This change may not be correctly ', ... 'reversed by Undo. Go ahead anyway?'], ... 'Undo Warning','Yes','No','Yes'); if ~strcmp(a,'Yes'), return; end end % Convert parametric planar curve to function. ndof = 1; set(hobj,'Checked','on') set(hct(2),'Checked','off') set(hax(1),'DataAspectRatioMode','auto') set(get(hax(2),'Title'),'String', ... 'First Derivative of Tension Spline') set(get(hax(3),'Title'),'String', ... 'Second Derivative of Tension Spline') % Recompute arrow scale factor for new axis limits. xl = get(hax(1),'XLim'); yl = get(hax(1),'YLim'); zl = get(hax(1),'ZLim'); dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); % Recompute arrow length L and scale factors xsf, ysf. fp = get(hfig1,'Position'); L = (fp(3)+fp(4))/(6*asf); xsf = fp(3)/dx; ysf = fp(4)/dy; if strcmp(deriv,'user') yp = yp./xp; % Convert derivative vectors to scalars xp(:) = 1; % Compute arrow components (u,v) chosen so that v/u = yp(i) % and (xsf*u)^2 + (ysf*v)^2 = L^2. for i = 1:imax u = L/sqrt(xsf^2+(ysf*yp(i))^2); v = yp(i)*u; set(harrow(i),'UData',asf*u, 'VData',asf*v) end end if strcmp(operation,'alter_bd') || ... strcmp(operation,'alter_dv') cancelop % Cancel current operation. end if ~interpolate % Change endcond from 'user' to 'auto'. set(hct(12),'Checked','off') endcond = 'auto'; set(hct(11),'Checked','on') ulpush('N',2) else ulpush('n',2) end tscurve; % Construct the new curve. return; end % CTndof1 %*********************************************************** function CTndof2(hobj,event_data) % Callback for Curve Type selection 2: parametric planar curve. if ndof == 1 && ~interpolate && strcmp(tension,'shape') edialog({'Shape-preserving tension is not ', ... 'an option for B-spline curves.'}, ... 'Invalid Selection') return; end if ndof == 1 && ~interpolate && strcmp(endcond,'auto') edialog({'Automatic End Conditions are not ', ... 'an option for B-spline curves.'}, ... 'Invalid Selection') return; end if ndof == 1 ulpush('n',1) set(hct(1),'Checked','off') if strcmp(operation,'alter_sw') || ... strcmp(operation,'alter_bd') cancelop % Cancel current operation. end if strcmp(deriv,'user') % Convert derivative values yp to unit tangent vectors % (xp,yp) by normalizing (1,yp). (Unit speed corresponds % to arc length parameterization.) xp = 1./sqrt(1+yp.^2); yp = xp.*yp; for i = 1:imax set(harrow(i),'UData',asf*xp(i), 'VData',asf*yp(i)) end end % Change to preserving the aspect ratio of the data, and % recompute the arrow scale factor for new axis limits. set(hax(1),'DataAspectRatio',[1 1 1]) xl = get(hax(1),'XLim'); yl = get(hax(1),'YLim'); zl = get(hax(1),'ZLim'); dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); elseif ndof == 2 return; else zmx = max([abs(z) abs(zp)]); if zmx ~= 0 a = questdlg(['Max{|z|,|zp|} = ', num2str(zmx,3), ... '. Irreversibly zero out z and zp?'], ... 'Undo Warning','Yes','No','Yes'); if ~strcmp(a,'Yes'), return; end opcnt = 0; % Empty the undo list. ulcnt = 0; ulistfull = false; uptr = 0; z(:) = 0; if interpolate zk(:) = 0; end set(hcp0(1:imax),'ZData',0) set(hcs0,'ZData',zeros(1,ne)) set(hcs1,'ZData',zeros(1,ne)) set(hcs2,'ZData',zeros(1,ne)) set(hcsp,'ZData',zeros(1,ne), 'WData',zeros(1,ne)) zp(:) = 0; set(harrow(1:imax),'ZData',0, 'WData',0) set(hcpoly,'ZData',zeros(1,n)) else ulpush('n',3) end set(hct(3),'Checked','off') end ndof = 2; set(hobj,'Checked','on') set(get(hax(2),'Title'),'String', ... 'Signed Curvature as a Function of Arc Length') set(get(hax(3),'Title'),'String', ... 'Signed Curvature as a Function of Arc Length') newknots = true; tscurve; % Construct the new curve. return; end % CTndof2 %*********************************************************** function CTndof3(hobj,event_data) % Callback for Curve Type selection 3: space curve. if ndof == 1 && ~interpolate && strcmp(tension,'shape') edialog({'Shape-preserving tension is not ', ... 'an option for B-spline curves.'}, ... 'Invalid Selection') return; end if ndof == 1 && ~interpolate && strcmp(endcond,'auto') edialog({'Automatic End Conditions are not ', ... 'an option for B-spline curves.'}, ... 'Invalid Selection') return; end if ndof == 1 ulpush('n',1) set(hct(1),'Checked','off') if strcmp(operation,'alter_sw') || ... strcmp(operation,'alter_bd') cancelop % Cancel current operation. end if strcmp(deriv,'user') % Convert derivative values yp to unit tangent vectors % (xp,yp,0) by normalizing (1,yp). (Unit speed corresponds % to arc length parameterization.) xp = 1./sqrt(1+yp.^2); yp = xp.*yp; zp = zeros(1,n); for i = 1:imax set(harrow(i),'UData',asf*xp(i), 'VData',asf*yp(i)) end end % Change to preserving the aspect ratio of the data, and % recompute the arrow scale factor for new axis limits. set(hax(1),'DataAspectRatio',[1 1 1]) xl = get(hax(1),'XLim'); yl = get(hax(1),'YLim'); zl = get(hax(1),'ZLim'); dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); newknots = true; ndof = 3; set(hobj,'Checked','on') tscurve; % Construct the new curve. elseif ndof == 2 ulpush('n',2) set(hct(2),'Checked','off') ndof = 3; set(hobj,'Checked','on') if plot2 tseval(1:n-1) % Compute torsion end end set(get(hax(2),'Title'),'String', ... 'Curvature as a Function of Arc Length') set(get(hax(3),'Title'),'String', ... 'Torsion as a Function of Arc Length') return; end % CTndof3 %*********************************************************** function CTc2Deriv(hobj,event_data) % Callback for Curve Type selection 4: C^2 derivatives. switch deriv case 'c2' return; case 'c1' ulpush('c',2) set(hct(5),'Checked','off') case 'user' a = questdlg(['This change may not be correctly ', ... 'reversed by Undo. Go ahead anyway?'], ... 'Undo Warning','Yes','No','Yes'); if ~strcmp(a,'Yes'), return; end ulpush('c',3) set(hct(6),'Checked','off') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation. end end deriv = 'c2'; title('C^2 curve created by TSPACK') set(hobj,'Checked','on') % Compute the new curve with altered derivatives. tscurve; return; end % CTc2Deriv %*********************************************************** function CTc1Deriv(hobj,event_data) % Callback for Curve Type selection 5: C^1 automatic derivatives. if strcmp(deriv,'c1'), return; end if strcmp(deriv,'c2') && strcmp(endcond,'user') edialog({'User-specified End Conditions are not ', ... 'compatible with C^1 Automatic Derivatives.'}, ... 'Invalid Selection') return; end switch deriv case 'c2' if ~interpolate edialog('C^1 smoothing curves are not an option.', ... 'Invalid Selection') return; else index = 1; set(hct(4),'Checked','off') title('C^1 curve created by TSPACK') end case 'user' a = questdlg(['This change may not be correctly ', ... 'reversed by Undo. Go ahead anyway?'], ... 'Undo Warning','Yes','No','Yes'); if ~strcmp(a,'Yes'), return; end index = 3; set(hct(6),'Checked','off') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation. end end deriv = 'c1'; set(hobj,'Checked','on') if strcmp(endcond,'user') % Change endcond from 'user' to 'auto'. set(hct(12),'Checked','off') endcond = 'auto'; set(hct(11),'Checked','on') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation. end ulpush('C',index) else ulpush('c',index) end % Compute the new curve with altered derivatives. tscurve; return; end % CTc1Deriv %*********************************************************** function CTuserDeriv(hobj,event_data) % Callback for Curve Type selection 6: C^1 user-specified derivatives. if strcmp(deriv,'user'), return; end switch deriv case 'c2' if ~interpolate edialog('C^1 smoothing curves are not an option.', ... 'Invalid Selection') return; else index = 1; set(hct(4),'Checked','off') title('C^1 curve created by TSPACK') end case 'c1' index = 2; set(hct(5),'Checked','off') end deriv = 'user'; set(hct(6),'Checked','on') AlterDerivFcn(hobj,event_data) % Set operation to 'alter_dv' if strcmp(endcond,'auto') % Change endcond from 'auto' to 'user'. set(hct(11),'Checked','off') endcond = 'user'; set(hct(12),'Checked','on') ulpush('C',index) else ulpush('c',index) end return; end % CTuserDeriv %*********************************************************** function CTshape(hobj,event_data) % Callback for Curve Type selection 7: shape-preserving tension. if strcmp(tension,'shape'), return; end if ndof > 1 && ~interpolate edialog({'Shape-preserving tension is not ', ... 'an option for B-spline curves.'}, ... 'Invalid Selection') return; end switch tension case 'bounds' ulpush('t',2) set(hct(8),'Checked','off') if strcmp(operation,'alter_bd') cancelop % Cancel alter_bd operation. end case 'user' if sigf < 0 a = questdlg(['This change may not be correctly ', ... 'reversed by Undo. Go ahead anyway?'], ... 'Undo Warning','Yes','No','Yes'); if ~strcmp(a,'Yes'), return; end end ulpush('t',3) set(hct(9),'Checked','off') if strcmp(operation,'alter_tf') cancelop % Cancel alter_tf operation. end end tension = 'shape'; set(hobj,'Checked','on') sigf = -1; % Variable tension % Construct the shape-preserving curve. tscurve; return; end % CTshape %*********************************************************** function CTbounds(hobj,event_data) % Callback for Curve Type selection 8: bounds-constrained tension. if strcmp(tension,'bounds'), return; end if ndof == 3 || ~interpolate edialog({'Bounds constraints are available only', ... 'for interpolatory planar curves.'}, ... 'Invalid Selection') return; end switch tension case 'shape' ulpush('t',1) set(hct(7),'Checked','off') case 'user' if sigf < 0 a = questdlg(['This change may not be correctly ', ... 'reversed by Undo. Go ahead anyway?'], ... 'Undo Warning','Yes','No','Yes'); if ~strcmp(a,'Yes'), return; end end ulpush('t',3) set(hct(9),'Checked','off') if strcmp(operation,'alter_tf') cancelop % Cancel alter_tf operation. end end tension = 'bounds'; set(hobj,'Checked','on') sigf = -1; % Variable tension % Compute the new curve with bounds constraints. tscurve; return; end % CTbounds %*********************************************************** function CTuserTension(hobj,event_data) % Callback for Curve Type selection 9: user-specified tension. switch tension case 'user' return; case 'shape' ulpush('t',1) set(hct(7),'Checked','off') case 'bounds' ulpush('t',2) set(hct(8),'Checked','off') if strcmp(operation,'alter_bd') cancelop % Cancel alter_bd operation. end end tension = 'user'; set(hobj,'Checked','on') AlterSigmaFcn(hobj,event_data) % Set operation to 'alter_tf' return; end % CTuserTension %*********************************************************** function CTclosed(hobj,event_data) % Callback for Curve Type selection 10: closed curve. if strcmp(endcond,'periodic'), return; end if ndof == 1 edialog(['This option is only available ', ... 'for parametric curves.'], ... 'Invalid Selection'); return; end if n < 3 edialog(['A closed curve requires at least three ',... 'control points.'], 'Invalid Selection'); return end switch endcond case 'auto' ulpush('e',2) set(hct(11),'Checked','off') case 'user' ulpush('e',3) set(hct(12),'Checked','off') end endcond = 'periodic'; if strcmp(operation,'append_cp') cancelop end set(hobj,'Checked','on') if x(1) ~= x(n) || y(1) ~= y(n) || z(1) ~= z(n) % Add a copy of (x(1),y(1),z(1)) as a new control point, and % add a new curve segment. n = n+1; x(n) = x(1); y(n) = y(1); z(n) = z(1); smwts(n) = smwts(1); a = arcl3d([x(n-1) x(n)],[y(n-1) y(n)],[z(n-1) z(n)]); t(n) = t(n-1) + a(2); aln(n) = aln(n-1) + a(2); xk(n) = xk(1); yk(n) = yk(1); zk(n) = zk(1); xp(n) = xp(1); yp(n) = yp(1); zp(n) = zp(1); sigma(n-1) = 0; bnds(:,n-1) = bnds_dflt; crv(:,n-1) = [0;0]; trs(:,n-1) = [0;0]; vx = linspace(xk(n-1),xk(n),ne); vy = linspace(yk(n-1),yk(n),ne); vz = zeros(1,ne); hcs0(n-1) = line(vx,vy,vz, ... 'Color',cs_color, ... 'ButtonDownFcn',@CsButtonDnFcn, ... 'HandleVisibility', 'callback', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'Tag',num2str(n-1)); hcsp(n-1) = quiver3(vx,vy,vz,vxc,vyc,vzc); set(hcsp(n-1),'AutoScale','off', ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'ShowArrowHead','off') if ~plotp set(hcsp(n-1),'Visible','off') end hcs1(n-1) = line(vx1,vy1,vz1, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(2), ... 'SelectionHighlight','off'); hcs2(n-1) = line(vx2,vy2,vz2, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(3), ... 'SelectionHighlight','off'); if ~interpolate set(hcpoly,'XData',x, 'YData',y, 'ZData',z) end end if strcmp(operation,'alter_dv') && (~interpolate || ... strcmp(deriv,'c2')) cancelop % Cancel alter_dv operation. end % Compute the new curve with periodic end conditions. tscurve; return; end % CTclosed %*********************************************************** function CTautoEnd(hobj,event_data) % Callback for Curve Type selection 11: automatic end conditions. if strcmp(endcond,'auto'), return; end if ndof > 1 && ~interpolate edialog(['This option is not allowed with ', ... 'a B-spline curve.'], ... 'Invalid Selection'); return; end if strcmp(deriv,'user') edialog({'Automatic End Conditions are not ', ... 'compatible with User-specified Derivatives.'}, ... 'Invalid Selection') return; end switch endcond case 'periodic' ulpush('e',1) set(hct(10),'Checked','off') % Remove the last control point and curve segment. deletecp(n) case 'user' ulpush('e',3) set(hct(12),'Checked','off') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation. end end endcond = 'auto'; set(hobj,'Checked','on') % Compute the new curve with altered end conditions. tscurve; return; end % CTautoEnd %*********************************************************** function CTuserEnd(hobj,event_data) % Callback for Curve Type selection 12: user-specified end conditions. if strcmp(endcond,'user'), return; end if ndof == 1 && ~interpolate edialog({'User-specified End Conditions are not ', ... 'an option for smoothing curves.'}, ... 'Invalid Selection') return; end if strcmp(deriv,'c1') edialog({'User-specified End Conditions are not ', ... 'compatible with C^1 Automatic Derivatives.'}, ... 'Invalid Selection') return; end switch endcond case 'periodic' ulpush('e',1) set(hct(10),'Checked','off') % Remove the last control point and curve segment. deletecp(n) case 'auto' ulpush('e',2) set(hct(11),'Checked','off') end endcond = 'user'; set(hct(12),'Checked','on') % Compute the new curve with altered end conditions. tscurve; return; end % CTuserEnd %*********************************************************** function CTinterp(hobj,event_data) % Callback for Curve Type selection 13: interpolatory curve. if interpolate, return; end % Test for duplicate control points. j = 1:n-1; if any(x(j) == x(j+1) & y(j) == y(j+1) & z(j) == z(j+1)) edialog({'Duplicate control points are not allowed ', ... 'in an interpolatory curve.'}, ... 'Invalid Selection') return; end ulpush('x',2) set(hct(14),'Checked','off') if strcmp(operation,'alter_sw') cancelop % Cancel alter_sw operation. end interpolate = true; set(hobj,'Checked','on') % Set knot function values to control points. xk = x; yk = y; zk = z; set(hcpoly,'HitTest','off', 'Visible','off') if strcmp(operation,'insert_cp') set(hcs0,'HitTest','on') end % Construct the new curve. tscurve; return; end % CTinterp %*********************************************************** function CTsmooth(hobj,event_data) % Callback for Curve Type selection 14: approximating curve. if ~interpolate, return; end if ~strcmp(deriv,'c2') edialog({'An approximating curve requires ', ... 'C^2 Derivatives.'}, ... 'Invalid Selection') return; end if strcmp(tension,'bounds') edialog({'Bounds-constrained curves are ', ... 'necessarily interpolatory.'}, ... 'Invalid Selection') return; end if ndof > 1 && strcmp(tension,'shape') edialog({'Shape-preserving tension is not ', ... 'an option for B-spline curves.'}, ... 'Invalid Selection') return; end set(hct(13),'Checked','off') interpolate = false; set(hobj,'Checked','on') % Create control polygon line object. set(hcpoly,'XData',x, 'YData',y, 'ZData',z) if strcmp(get(hdo(5),'Checked'),'on') set(hcpoly,'Visible','on') end if strcmp(operation,'insert_cp') set(hcpoly,'HitTest','on') end if ndof > 1 % B-spline curve. if strcmp(endcond,'auto') % Change endcond from 'auto' to 'user'. set(hct(11),'Checked','off') endcond = 'user'; set(hct(12),'Checked','on') ulpush('X',1) else ulpush('x',1) end else % Smoothing curve. if strcmp(endcond,'user') % Change endcond from 'user' to 'auto'. set(hct(12),'Checked','off') endcond = 'auto'; set(hct(11),'Checked','on') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation. end ulpush('X',1) else ulpush('x',1) end end % Construct the new curve. tscurve; return; end % CTsmooth %*********************************************************** function DeleteCpFcn(hobj,event_data) % Callback for Operations menu selection: delete control point. if n <= 2 edialog({'A curve must have at least two ', ... 'control points.'}, ... 'Invalid Operation') return; end if strcmp(endcond,'periodic') && n <= 4 edialog({'A closed curve requires at least four ', ... 'control points.'}, ... 'Invalid Operation') return; end set([hfig4 hfig5 hfig6],'Visible','off') if freeze_cp a = questdlg('Alter the set of control points?', ... 'Alter Control Points','Yes','No','Yes'); if ~strcmp(a,'Yes') cancelop % Cancel operation. return; end freeze_cp = false; end operation = 'delete_cp'; set(hcp0,'HitTest','on') set(hcs0,'HitTest','off') set(hcpoly,'HitTest','off') set(hcop,'String', ... 'Current Operation: Remove Control Points') if cpstate == 0 DOcpts(hdo(5),event_data) end set(hcp0,'Visible','on') if ~interpolate, set(hcpoly,'Visible','on'), end return; end % DeleteCpFcn %*********************************************************** function DOarrows(hobj,event_data) % Callback for Display Option selection: display derivatives. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') set(harrow(1:imax),'Visible','off') else set(hobj,'Checked','on') set(harrow(1:imax),'Visible','on') end return; end % DOarrows %*********************************************************** function DOaxes(hobj,event_data) % Callback for Display Option selection: display axes. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') set(hax,'Visible','off') else set(hobj,'Checked','on') set(hax,'Visible','on') end return; end % DOaxes %*********************************************************** function DObox(hobj,event_data) % Callback for Display Option selection: display box. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') set(hax,'Box','off') else set(hobj,'Checked','on') set(hax,'Box','on') end return; end % DObox %*********************************************************** function DOcpts(hobj,event_data) % Callback for Display Option selection: display control points. cpstate = rem(cpstate+1,3); % Increment cpstate mod 3. if cpstate > 0 set(hobj,'Checked','on') set(hcp0,'Visible','on') set(hcp1,'Visible','on') set(hcp2,'Visible','on') if ~interpolate, set(hcpoly,'Visible','on'), end else set(hobj,'Checked','off') set(hcp0,'Visible','off') set(hcp1,'Visible','off') set(hcp2,'Visible','off') set(hcpoly,'Visible','off') if ~(strcmp(operation,'alter_bd') || ... strcmp(operation,'alter_tf') || ... strcmp(operation,'')) cancelop % Cancel current operation. end end if cpstate == 2 set(hcpi0,'Visible','on') else set(hcpi0,'Visible','off') end return; end % DOcpts %*********************************************************** function DOgrid(hobj,event_data) % Callback for Display Option selection: display grid. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') grid(hax(1),'off') grid(hax(2),'off') grid(hax(3),'off') else set(hobj,'Checked','on') grid(hax(1),'on') grid(hax(2),'on') grid(hax(3),'on') end return; end % DOgrid %*********************************************************** function DOlimits(hobj,event_data) % Callback for Display Option selection: freeze axis limits (toggle). if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') % Recompute axis limits for all axes and tick marks for the % figure 1 axis based on the range of data values. set(hax,'XLimMode','auto','YLimMode','auto', ... 'ZLimMode','auto') set(hax(1),'XTickMode','auto','YTickMode','auto', ... 'ZTickMode','auto') % Recompute arrow scale factor for new axis limits. xl = get(hax(1),'XLim'); yl = get(hax(1),'YLim'); zl = get(hax(1),'ZLim'); dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); else set(hobj,'Checked','on') % Loop on components, resetting figure 1 tick marks in each % axis direction. for j = 1:3 if j == 1 tk = get(hax(1),'XTick'); elseif j == 2 tk = get(hax(1),'YTick'); else tk = get(hax(1),'ZTick'); end dt =(tk(2)-tk(1))/gridsize; nt = (length(tk)-1)*gridsize; tknew = tk(1) + dt*(0:nt-1); if j == 1 set(hax(1),'XTick',tknew) elseif j == 2 set(hax(1),'YTick',tknew) else set(hax(1),'ZTick',tknew) end end % Expand the axis limits by 2% in order to allow selection % of points on the boundary of the data's bounding box % (which is also the clip window). The axis limit modes % are automatically set to manual. for j = 1:3 xl = get(hax(j),'XLim'); yl = get(hax(j),'YLim'); zl = get(hax(j),'ZLim'); dl = .01*(xl(2)-xl(1)); xl = [xl(1)-dl xl(2)+dl]; dl = .01*(yl(2)-yl(1)); yl = [yl(1)-dl yl(2)+dl]; dl = .01*(zl(2)-zl(1)); zl = [zl(1)-dl zl(2)+dl]; set(hax(j),'XLim',xl) set(hax(j),'YLim',yl) set(hax(j),'ZLim',zl) end end return; end % DOlimits %*********************************************************** function DOplot1(hobj,event_data) % Callback for Display Option selection: plot 1st derivative or curvature. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') plot1 = false; set(hfig2,'Visible','off') else set(hobj,'Checked','on') plot1 = true; set(hfig2,'Visible','on') if ~plotp % Data already computed if plotp = true. if strcmp(get(hdo(6),'Checked'),'on') DOlimits(hdo(6),event_data) % Unfreeze axis limits. end tseval(1:n-1); end end return; end % DOplot1 %*********************************************************** function DOplot2(hobj,event_data) % Callback for Display Option selection: plot 2nd derivative or torsion. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') plot2 = false; set(hfig3,'Visible','off') else set(hobj,'Checked','on') plot2 = true; set(hfig3,'Visible','on') if ~plotp % Data already computed if plotp = true. if strcmp(get(hdo(6),'Checked'),'on') DOlimits(hdo(6),event_data) % Unfreeze axis limits. end tseval(1:n-1); end end return; end % DOplot2 %*********************************************************** function DOplotp(hobj,event_data) % Callback for Display Option selection: display porcupine plot. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') plotp = false; set(hcsp,'Visible','off') else set(hobj,'Checked','on') plotp = true; set(hcsp,'Visible','on') tseval(1:n-1); end return; end % DOplotp %*********************************************************** function DOview3(hobj,event_data) % Callback for Display Option selection: display 3D view. % Erase the text box, if any, created by a right mouse click % on a control point or curve segment. if ishandle(htxt) delete(htxt); end % Toggle between standard 2D and 3D views. if strcmp(get(hobj,'Checked'),'on') set(hobj,'Checked','off') view(hax(1),2) else set(hobj,'Checked','on') view(hax(1),3) if strcmp(get(hdo(3),'Checked'),'on') set(hax(1),'Box','on') else set(hax(1),'Box','off') end end return; end % DOview3 %*********************************************************** function F4CheckboxFcn(hobj,event_data) % Callback for Tension Factor Selection: checkbox toggle. if ~get(hobj,'Value'), return; end sig = get(hslider4,'Value'); sigf = sig; sigma(1:n-1) = sig; %% Replace the following line with 'tseval(1:n-1);' if it's too slow. tscurve; return; end % F4CheckboxFcn %*********************************************************** function F4EditFcn(hobj,event_data) % Callback for Tension Factor Selection: text edit box change. sig = str2double(get(hobj,'String')); if sig >= 0 && sig <= SBIG set(hslider4,'Value',sig) if get(hcheck4,'Value') sigf = sig; i = 1:n-1; else sigf = -1; i = str2double(get(hc,'Tag')); end sigma(i) = sig; %% Replace the following line with 'tseval(i);' if it's too slow. tscurve; else sig = get(hslider4,'Value'); set(hobj,'String',num2str(sig)) end return; end % F4EditFcn %*********************************************************** function F4PushbuttonFcn(hobj,event_data) % Callback for Tension Factor Selection pushbutton press. % Make figure 4 invisible. This is necessary on Windows % systems to return the mouse focus to figure 1. The user % may not be done altering tension factors, and the current % operation is therefore not canceled. set(hc,'Color',cs_color) set(hfig4,'Visible','off') if ~strcmp(deriv,'user') tscurve; end return; end % F4PushbuttonFcn %*********************************************************** function F4SliderFcn(hobj,event_data) % Callback for Tension Factor Selection slider change. sig = get(hobj,'Value'); sig = round(10*sig)/10; set(hedit4,'String',num2str(sig)) if get(hcheck4,'Value') sigf = sig; i = 1:n-1; else sigf = -1; i = str2double(get(hc,'Tag')); end sigma(i) = sig; %% Replace the following line with 'tseval(i);' if it's too slow. tscurve; return; end % F4SliderFcn %*********************************************************** function F5CheckboxFcn(hobj,event_data) % Callback for Smoothing Weight Selection: checkbox toggle. if ~get(hobj,'Value'), return; end var = get(hslider5,'Value'); smwf = 1/var; smwts(1:n) = 1/var; tscurve; return; end % F5CheckboxFcn %*********************************************************** function F5EditFcn(hobj,event_data) % Callback for Smoothing Weight Selection: text edit box change. var = str2double(get(hobj,'String')); if var >= get(hslider5,'Min') && var <= get(hslider5,'Max') set(hslider5,'Value',var) if get(hcheck5,'Value') smwf = 1/var; i = 1:n; else smwf = -1; i = str2double(get(hc,'Tag')); end smwts(i) = 1/var; tscurve; else var = get(hslider5,'Value'); set(hobj,'String',num2str(var)) end return; end % F5EditFcn %*********************************************************** function F5PushbuttonFcn(hobj,event_data) % Callback for Smoothing Weight Selection pushbutton press. % Make figure 5 invisible. Refer to the header comments in % F4PushbuttonFcn. set(hc,'MarkerEdgeColor',cp_color) set(hc,'MarkerFaceColor',cp_color) set(hfig5,'Visible','off') return; end % F5PushbuttonFcn %*********************************************************** function F5SliderFcn(hobj,event_data) % Callback for Smoothing Weight Selection slider change. var = get(hobj,'Value'); set(hedit5,'String',num2str(var)) if get(hcheck5,'Value') smwf = 1/var; i = 1:n; else smwf = -1; i = str2double(get(hc,'Tag')); end smwts(i) = 1/var; tscurve; return; end % F5SliderFcn %*********************************************************** function F6CheckboxFcn(hobj,event_data) % Callback for Bounds Selection: checkbox toggle. if ~get(hobj,'Value'), return; end for j = 1:5 bnds(j,1:n-1) = str2double(get(hedit6(j),'String')); end tscurve; % Display altered tension factor. i = str2double(get(hc,'Tag')); set(htxt6,'String',['Tension factor: ',num2str(sigma(i))], ... 'ForegroundColor','black') return; end % F6CheckboxFcn %*********************************************************** function F6EditFcn(hobj,event_data) % Callback for Bounds Selection: text edit box change. i = str2double(get(hc,'Tag')); j = str2double(get(hobj,'Tag')); b = str2double(get(hobj,'String')); if isnan(b) set(hobj,'String',num2str(bnds(j,i))); return; end if j == 5 if b < 0, b = -1; end if b > 0, b = 1; end end if ndof > 1 && j == 1 && b <= 0 b = bmax; end if ndof > 1 && j == 2 && b >= 0 b = -bmax; end set(hobj,'String',num2str(b)); if get(hcheck6,'Value') ii = 1:n-1; else ii = i; end bnds(j,ii) = b; tscurve; % Test for invalid bound, and display error message or % altered tension factor. if ndof == 1 && icflg(i) > 0 set(htxt6,'String','Invalid bound','ForegroundColor','red') else set(htxt6,'String',['Tension factor: ',num2str(sigma(i))], ... 'ForegroundColor','black') end return; end % F6EditFcn %*********************************************************** function F6PushbuttonFcn(hobj,event_data) % Callback for Bounds Selection pushbutton press. % Make figure 6 invisible. Refer to the header comments in % F4PushbuttonFcn. set(hc,'Color',cs_color) set(hfig6,'Visible','off') return; end % F6PushbuttonFcn %*********************************************************** function FexitFcn(hobj,event_data) % Callback for File menu selection: Exit. if opcnt > 0 a = questdlg(['Changes have not been saved. ', ... 'Proceed anyway?'], ... 'Unsaved Data Warning','Yes','No','No'); if ~strcmp(a,'Yes'), return; end end delete(hfig1); delete(hfig2); delete(hfig3); delete(hfig4); delete(hfig5); delete(hfig6); return; end % FexitFcn %*********************************************************** function FopenFcn(hobj,event_data) % Callback for File menu selection: Open. if opcnt > 0 a = questdlg(['Changes have not been saved. ', ... 'Proceed anyway?'], ... 'Unsaved Data Warning','Yes','No','No'); if ~strcmp(a,'Yes'), return; end end [filename,path] = uigetfile({'*.tsp'}, ['Open tension ', ... 'spline data file *.tsp']); if isequal(filename,0) || isequal(path,0) return; end fn = fullfile(path,filename); [fid,msg] = fopen(fn, 'rt'); if fid == -1 fprintf(1,msg); return; end % Save parameter values n, ndof, deriv, tension, endcond, and % interpolate, and read new values, testing each for validity. n0 = n; ndof0 = ndof; deriv0 = deriv; tension0 = tension; endcond0 = endcond; interpolate0 = interpolate; line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end [n,cnt,msg] = sscanf(line,'%f',1); if ~strcmp(msg,'') fprintf(1,msg); return; end if n < 2 fprintf(1,'Invalid data: n = %f.\n', n); n = n0; return; end line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end [ndof,cnt,msg] = sscanf(line,'%f',1); if ~strcmp(msg,'') fprintf(1,msg); n = n0; ndof = ndof0; return; end if ndof < 1 || ndof > 3 fprintf(1,'Invalid data: ndof = %f.\n', ndof); n = n0; ndof = ndof0; return; end line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end [deriv,cnt,msg] = sscanf(line,'%s',1); if ~strcmp(msg,'') fprintf(1,msg); n = n0; ndof = ndof0; deriv = deriv0; return; end if ~(strcmp(deriv,'c2') || strcmp(deriv,'c1') || ... strcmp(deriv,'user')) fprintf(1,'Invalid data: deriv = %s.\n', deriv); n = n0; ndof = ndof0; deriv = deriv0; return; end line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end [tension,cnt,msg] = sscanf(line,'%s',1); if ~strcmp(msg,'') fprintf(1,msg); n = n0; ndof = ndof0; deriv = deriv0; tension = tension0; return; end if ~(strcmp(tension,'shape') || strcmp(tension,'bounds') || ... strcmp(tension,'user')) fprintf(1,'Invalid data: tension = %s.\n', tension); n = n0; ndof = ndof0; deriv = deriv0; tension = tension0; return; end line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end [endcond,cnt,msg] = sscanf(line,'%s',1); if ~strcmp(msg,'') fprintf(1,msg); n = n0; ndof = ndof0; deriv = deriv0; tension = tension0; endcond = endcond0; return; end if ~(strcmp(endcond,'periodic') || strcmp(endcond,'auto') || ... strcmp(endcond,'user')) fprintf(1,'Invalid data: endcond = %s.\n', endcond); n = n0; ndof = ndof0; deriv = deriv0; tension = tension0; endcond = endcond0; return; end line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end [interpolate,cnt,msg] = sscanf(line,'%f',1); if ~strcmp(msg,'') fprintf(1,msg); n = n0; ndof = ndof0; deriv = deriv0; tension = tension0; endcond = endcond0; interpolate = interpolate0; return; end if interpolate < 0 || interpolate > 1 fprintf(1,'Invalid data: interpolate = %f.\n', interpolate); n = n0; ndof = ndof0; deriv = deriv0; tension = tension0; endcond = endcond0; interpolate = interpolate0; return; end % Test parameters for consistency. per = strcmp(endcond,'periodic'); if (per && n < 4) || (per && ndof == 1) || ... (~interpolate && ~strcmp(deriv,'c2')) || ... (strcmp(tension,'bounds') && (ndof == 3 || ~interpolate)) fprintf(1,'Invalid data: inconsistent parameters.\n'); n = n0; ndof = ndof0; deriv = deriv0; tension = tension0; endcond = endcond0; interpolate = interpolate0; return; end % Erase the text box, if any, created by a right mouse click % on a control point or curve segment. if ishandle(htxt) delete(htxt); end % Reallocate arrays and read knots and control point % coordinates t,x,y,z. aln = zeros(1,n); crv = zeros(2,n-1); icflg = zeros(1,n-1); trs = zeros(2,n-1); t = zeros(1,n); x = zeros(1,n); y = zeros(1,n); z = zeros(1,n); if ndof == 1 for i = 1:n line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end a = sscanf(line,'%e %e',2); x(i) = a(1); y(i) = a(2); end elseif ndof == 2 for i = 1:n line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end a = sscanf(line,'%e %e %e',3); t(i) = a(1); x(i) = a(2); y(i) = a(3); end else for i = 1:n line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end a = sscanf(line,'%e %e %e %e',4); t(i) = a(1); x(i) = a(2); y(i) = a(3); z(i) = a(4); end end if per && ~(x(1) == x(n) && y(1) == y(n) && z(1) == z(n)) error('%s\n%s\n','Invalid data: endcond = ''periodic'' but the', ... 'first and last control points don''t coincide.') end % Allocate arrays and read knot derivatives unless the % data set is a B-spline curve. xp = ones(1,n); yp = zeros(1,n); zp = zeros(1,n); if ndof == 1 || interpolate if ndof == 1 for i = 1:n line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end yp(i) = sscanf(line,'%e',1); end elseif ndof == 2 for i = 1:n line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end a = sscanf(line,'%e %e',2); xp(i) = a(1); yp(i) = a(2); end else for i = 1:n line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end a = sscanf(line,'%e %e %e',3); xp(i) = a(1); yp(i) = a(2); zp(i) = a(3); end end if per && ~(xp(1) == xp(n) && yp(1) == yp(n) && zp(1) == zp(n)) error('%s\n%s\n','Invalid data: endcond = ''periodic'' but the', ... 'first and last derivatives don''t coincide.') end end % Read tension factors. sigma = zeros(1,n-1); for i = 1:n-1 line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end sigma(i) = sscanf(line,'%e',1); end if any(sigma < 0) error('%s\n','Invalid data: negative tension factor.') end smwts = ones(1,n); if ndof == 1 && ~interpolate % Read smoothing weights. for i = 1:n line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end smwts(i) = sscanf(line,'%e',1); end if any(smwts <= 0) error('%s\n','Invalid data: nonpositive smoothing weight.') end end bnds = bnds_dflt*ones(1,n-1); if strcmp(tension,'bounds') % Read bounds. if ndof == 1 for i = 1:n-1 line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end a = sscanf(line,'%e %e %e %e %e',5); bnds(1,i) = a(1); bnds(2,i) = a(2); bnds(3,i) = a(3); bnds(4,i) = a(4); bnds(5,i) = a(5); end if any(any(isnan(bnds))) error('%s\n','Invalid data: nonnumeric bound.') end else for i = 1:n-1 line(1) = '#'; % Read comment lines while line(1) == '#' line = fgetl(fid); end a = sscanf(line,'%e %e',2); bnds(1,i) = a(1); bnds(2,i) = a(2); end if any(isnan(bnds(1,:))) || any(isnan(bnds(2,:))) error('%s\n',['Invalid data: nonnumeric upper bound or ', ... 'lower bound.']) end if any(bnds(1,:) <= 0) || any(bnds(2,:) >= 0) error('%s\n',['Invalid data: nonpositive upper bound or ', ... 'nonnegative lower bound.']) end end end % Store additional variables that depend on the control points. freeze_cp = true; hc = []; if per imax = n-1; else imax = n; end opcnt = 0; sigf = -1; ulistfull = false; ulcnt = 0; uptr = 0; xk = x; yk = y; zk = z; % Compute an arrow scale factor asf based on the axis lengths. dx = max(x)-min(x); dy = max([max(y)-min(y),qmin]); dz = max([max(z)-min(z),dx,dy]); asf = 0.07*(dx + dy + dz); if ndof == 1 % Compute arrow length L in window coordinates and scale % factors xsf, ysf for computing quiver object (u,v) % values. fp = get(hfig1,'Position'); L = (fp(3)+fp(4))/(6*asf); xsf = fp(3)/dx; ysf = fp(4)/dy; end % Delete old line objects and create new ones. delete(harrow) delete(hcp0) delete(hcp1) delete(hcp2) delete(hcpi0) delete(hcpoly) delete(hcs0) delete(hcs1) delete(hcs2) delete(hcsp) harrow = zeros(1,imax); hcp0 = zeros(1,imax); hcpi0 = zeros(1,imax); hcs0 = zeros(1,n-1); hcs1 = zeros(1,n-1); hcs2 = zeros(1,n-1); hcsp = zeros(1,n-1); createlo % Update titles, view, DataAspectRatioMode, PlotBoxAspectRatio, % operation, and Curve_type menu checkmarks. if strcmp(deriv,'c2') title('C^2 curve created by TSPACK') else title('C^1 curve created by TSPACK') end if ndof == 3 view(hax(1),3) else view(hax(1),2) end view(hax(2),2) view(hax(3),2) set(hax,'PlotBoxAspectRatioMode','auto') % Restore default if ndof > 1 set(hax(1),'DataAspectRatio',[1 1 1]) else set(hax(1),'DataAspectRatioMode','auto') end cancelop % Cancel current operation. if strcmp(get(hdo(6),'Checked'),'on') DOlimits(hdo(6),event_data) end switch ndof case 1 set(get(hax(2),'Title'),'String', ... 'First Derivative of Tension Spline') set(get(hax(3),'Title'),'String', ... 'Second Derivative of Tension Spline') set(hct(1),'Checked','on') set(hct(2:3),'Checked','off') case 2 set(get(hax(2),'Title'),'String', ... 'Signed Curvature as a Function of Arc Length') set(get(hax(3),'Title'),'String', ... 'Signed Curvature as a Function of Arc Length') set(hct(2),'Checked','on') set(hct([1,3]),'Checked','off') case 3 set(get(hax(2),'Title'),'String', ... 'Curvature as a Function of Arc Length') set(get(hax(3),'Title'),'String', ... 'Torsion as a Function of Arc Length') set(hct(3),'Checked','on') set(hct(1:2),'Checked','off') end switch deriv case 'c2' set(hct(4),'Checked','on') set(hct(5:6),'Checked','off') case 'c1' set(hct(5),'Checked','on') set(hct([4,6]),'Checked','off') case 'user' set(hct(6),'Checked','on') set(hct(4:5),'Checked','off') end switch tension case 'shape' set(hct(7),'Checked','on') set(hct(8:9),'Checked','off') case 'bounds' set(hct(8),'Checked','on') set(hct([7,9]),'Checked','off') case 'user' set(hct(9),'Checked','on') set(hct(7:8),'Checked','off') end switch endcond case 'periodic' set(hct(10),'Checked','on') set(hct(11:12),'Checked','off') case 'auto' set(hct(11),'Checked','on') set(hct([10,12]),'Checked','off') case 'user' set(hct(12),'Checked','on') set(hct(10:11),'Checked','off') end if interpolate set(hct(13),'Checked','on') set(hct(14),'Checked','off') else set(hct(14),'Checked','on') set(hct(13),'Checked','off') end % Construct the curve. tscurve; fname = fn; % Update fname and close the file. fclose(fid); return; end % FopenFcn %*********************************************************** function FsaveFcn(hobj,event_data) % Callback for File menu selection: Save. [fid,msg] = fopen(fname, 'wt'); if fid == -1 fprintf(1,msg); return; end % Write header comments and parameters n, ndof, deriv, % tension, endcond, and interpolate. datstr = date; fprintf(fid,['# Tension spline curve data set created by ', ... 'tspackgui on ', datstr, '\n', ... '%6u # n = Number of knots and control points\n', ... '%6u # ndof = Number of dependent variables\n', ... '%-8s # deriv = Derivative flag (c2/c1/user)\n', ... '%-8s # tension = Tension factor flag (shape/bounds/user)\n', ... '%-8s # endcond = End condition flag (periodic/auto/usr)\n', ... '%6u # interpolate = Interpolation flag (1/0)\n'], ... n, ndof, deriv, tension, endcond, interpolate); % Write control points x,y,z. fprintf(fid,'# Knots and control point coordinates\n'); if ndof == 1 for i = 1:n fprintf(fid,'% 24.16e % 24.16e\n', x(i), y(i)); end elseif ndof == 2 for i = 1:n fprintf(fid,'% 24.16e % 24.16e % 24.16e\n', t(i), x(i), y(i)); end else for i = 1:n fprintf(fid,'% 24.16e % 24.16e % 24.16e % 24.16e\n', ... t(i), x(i), y(i), z(i)); end end if ndof == 1 || interpolate % Write knot derivatives. fprintf(fid,'# Knot derivatives\n'); if ndof == 1 for i = 1:n fprintf(fid,'% 24.16e\n', yp(i)); end elseif ndof == 2 for i = 1:n fprintf(fid,'% 24.16e % 24.16e\n', xp(i), yp(i)); end else for i = 1:n fprintf(fid,'% 24.16e % 24.16e % 24.16e\n', xp(i), yp(i), zp(i)); end end end % Write tension factors. fprintf(fid,'# Tension factors\n'); for i = 1:n-1 fprintf(fid,'% 24.16e\n', sigma(i)); end if ndof == 1 && ~interpolate % Write smoothing weights. fprintf(fid,'# Smoothing weights\n'); for i = 1:n fprintf(fid,'% 24.16e\n', smwts(i)); end end if strcmp(tension,'bounds') % Write bounds. fprintf(fid,'# Bounds\n'); if ndof == 1 for i = 1:n-1 fprintf(fid,'% 24.16e % 24.16e % 24.16e %24.16e % 24.16e\n', ... bnds(1,i), bnds(2,i), bnds(3,i), bnds(4,i), bnds(5,i)); end else for i = 1:n-1 fprintf(fid,'% 24.16e % 24.16e\n', bnds(1,i), bnds(2,i)); end end end % Close the file and reset the change count. fclose(fid); opcnt = 0; return; end % FsaveFcn %*********************************************************** function FsaveasFcn(hobj,event_data) % Callback for File menu selection: Saveas. [filename,path] = uiputfile({'*.tsp'}, 'Save current curve as'); if isequal(filename,0) || isequal(path,0) return; end fname = fullfile(path,filename); FsaveFcn(hobj,event_data) return; end % FsaveasFcn %*********************************************************** function HelpFcn(hobj,event_data) % Callback for Help menu selection. web(['file:///' which('tspgui_doc.html')]); return; end % HelpFcn %*********************************************************** function InsertCpFcn(hobj,event_data) % Callback for Operations menu selection: insert control point. set([hfig4 hfig5 hfig6],'Visible','off') if freeze_cp a = questdlg('Alter the set of control points?', ... 'Alter Control Points','Yes','No','Yes'); if ~strcmp(a,'Yes') cancelop % Cancel current operation return; end freeze_cp = false; end operation = 'insert_cp'; set(hcp0,'HitTest','off') if ~interpolate set(hcpoly,'HitTest','on') set(hcs0,'HitTest','off') else set(hcpoly,'HitTest','off') set(hcs0,'HitTest','on') end set(hcop,'String', ... 'Current Operation: Insert Control Points') if cpstate == 0 DOcpts(hdo(5),event_data) end set(hcp0,'Visible','on') if ~interpolate, set(hcpoly,'Visible','on'), end if snapto && strcmp(get(hdo(6),'Checked'),'off') DOlimits(hdo(6),event_data) % Freeze axis limits end return; end % InsertCpFcn %*********************************************************** function KeyPressFcn(hobj,event_data) % Callback for key press in figure window. % Get the ASCII value key. key = double(event_data.Character); % Shift, Alt, and Ctrl keys, when held down, generate % callbacks at the keyboard repeat rate, and these keys % by themselves are stored as ''. if isempty(key), return; end modifier = event_data.Modifier; if length(modifier) > 0 && ((~ismac && strcmp(modifier{1},'control')) ... || (ismac && strcmp(modifier{1},'command'))) axes(hax(1)); % Return control to figure 1 for menu hotkeys. return; end switch key case 27 % Escape keypress: terminate current operation, and % recompute grid if axes are frozen. cancelop if strcmp(get(hdo(6),'Checked'),'on') DOlimits(hdo(6),event_data) DOlimits(hdo(6),event_data) end case 28 % Left Arrow keypress: rotate camera clockwise (as viewed % from positive z). [az el] = view; if length(modifier) > 0 && strcmp(modifier{1},'shift') az = az - 10; else az = az - 1; end if (az < -360), az = az + 360; end view(az,el) case 29 % Right Arrow keypress: rotate camera ccw. [az el] = view; if length(modifier) > 0 && strcmp(modifier{1},'shift') az = az + 10; else az = az + 1; end if (az > 360), az = az - 360; end view(az,el) case 30 % Up Arrow keypress: increase elevation. % % In order to avoid a discontinuity in the transition when % elevation is incremented or decremented past +/-90 degrees, % elevation is taken to be in the range 0 to 360 degrees, % and the azimuth is increased by 180 degrees (corresponding % to a rotation about the view vector). Note that the % the inequalities (strict .vs. nonstrict) in the test for % the transition must be carefully chosen. Note also that % Function view automatically sets the up vector to [0 0 1] % unless elevation = +/-90, in which case the up vector is set % to [0 1 0]. % % There is some kind of glitch at elevation 180 which is % avoided by simply not using that value. [az el_old] = view; if el_old < 0, el_old = el_old + 360; end if length(modifier) > 0 && strcmp(modifier{1},'shift') el_new = el_old + 10; else el_new = el_old + 1; end if (el_new >= 360), el_new = el_new - 360; end if (el_old <= 90 && el_new > 90) || ... (el_old < 270 && el_new >= 270) az = az + 180; if (az >= 360), az = az - 360; end end if el_new == 180, el_new = 181; end view(az,el_new) case 31 % Down Arrow keypress: decrease elevation. [az el_old] = view; if el_old < 0, el_old = el_old + 360; end if length(modifier) > 0 && strcmp(modifier{1},'shift') el_new = el_old - 10; else el_new = el_old - 1; end if (el_new < 0), el_new = el_new + 360; end if (el_old > 90 && el_new <= 90) || ... (el_old >= 270 && el_new < 270) az = az + 180; if (az >= 360), az = az - 360; end end if el_new == 180, el_new = 179; end view(az,el_new) case double('d') if length(modifier) > 0 && strcmp(modifier{1},'alt') % Alt-d key: Enter debug mode by transferring control to % the keyboard with access to the tspackgui % workspace. keyboard end case 206 if length(modifier) > 0 && strcmp(modifier{2},'alt') % Alt-D key on the Macintosh: Enter debug mode. keyboard end case {double('g'), 169} % Alt-g = 169 on the Macintosh if length(modifier) > 0 && strcmp(modifier{1},'alt') % Alt-g key: Cycle through gridsize values (1,2,5,10). if gridsize == 1 gridsize = 2; elseif gridsize == 2 gridsize = 5; elseif gridsize == 5 gridsize = 10; else gridsize = 1; end end if gridsize <= 1 set(hax(1),'XTickLabelMode','auto') set(hax(1),'YTickLabelMode','auto') set(hax(1),'ZTickLabelMode','auto') else set(hax(1),'XTickLabel','') % Supress tick marks. set(hax(1),'YTickLabel','') set(hax(1),'ZTickLabel','') end if strcmp(get(hdo(6),'Checked'),'on') DOlimits(hdo(6),event_data) end DOlimits(hdo(6),event_data) case double('h') % h key: Pan left slow. % Move the camera target (center of axis limits) 4% of the % axis extent (view volume diagonal length) horizontally in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.04*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction e1 = cross(e2,v); % e1 = horizontal direction xl = xl - dl*e1(1); % Translate by -dl*e1 yl = yl - dl*e1(2); zl = zl - dl*e1(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('H') % H key: Pan left fast. % Move the camera target (center of axis limits) 10% of the % axis extent (view volume diagonal length) horizontally in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.10*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction e1 = cross(e2,v); % e1 = horizontal direction xl = xl - dl*e1(1); % Translate by -dl*e1 yl = yl - dl*e1(2); zl = zl - dl*e1(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('j') % j key: Pan down slow. % Move the camera target (center of axis limits) 4% of the % axis extent (view volume diagonal length) vertically in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.04*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction xl = xl - dl*e2(1); % Translate by -dl*e2 yl = yl - dl*e2(2); zl = zl - dl*e2(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('J') % J key: Pan down fast. % Move the camera target (center of axis limits) 10% of the % axis extent (view volume diagonal length) vertically in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.10*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction xl = xl - dl*e2(1); % Translate by -dl*e2 yl = yl - dl*e2(2); zl = zl - dl*e2(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('k') % k key: Pan up slow. % Move the camera target (center of axis limits) 4% of the % axis extent (view volume diagonal length) vertically in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.04*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction xl = xl + dl*e2(1); % Translate by dl*e2 yl = yl + dl*e2(2); zl = zl + dl*e2(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('K') % K key: Pan up fast. % Move the camera target (center of axis limits) 10% of the % axis extent (view volume diagonal length) vertically in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.10*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction xl = xl + dl*e2(1); % Translate by dl*e2 yl = yl + dl*e2(2); zl = zl + dl*e2(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('l') % l key: Pan right slow. % Move the camera target (center of axis limits) 4% of the % axis extent (view volume diagonal length) horizontally in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.04*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction e1 = cross(e2,v); % e1 = horizontal direction xl = xl + dl*e1(1); % Translate by dl*e1 yl = yl + dl*e1(2); zl = zl + dl*e1(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('L') % L key: Pan right fast. % Move the camera target (center of axis limits) 10% of the % axis extent (view volume diagonal length) horizontally in % the projection plane (plane whose normal is the view vector). ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dx = xl(2)-xl(1); dy = yl(2)-yl(1); dz = zl(2)-zl(1); dl = 0.10*norm([dx dy dz]); % dl = move distance v = get(ha,'CameraPosition') - ... get(ha,'CameraTarget'); v = v./norm(v); % v = View vector u = get(ha,'CameraUpVector'); % u = Up vector e2 = u - dot(u,v)*v; % Orthogonal projection e2 = e2./norm(e2); % e2 = vertical direction e1 = cross(e2,v); % e1 = horizontal direction xl = xl + dl*e1(1); % Translate by dl*e1 yl = yl + dl*e1(2); zl = zl + dl*e1(3); set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) case double('z') % z key: Zoom in. % Contract the axis limits by 10%. The axis limit modes % are automatically set to manual. ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dl = .05*(xl(2)-xl(1)); xl = [xl(1)+dl xl(2)-dl]; dl = .05*(yl(2)-yl(1)); yl = [yl(1)+dl yl(2)-dl]; dl = .05*(zl(2)-zl(1)); zl = [zl(1)+dl zl(2)-dl]; set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) if ha == hax(1) % Recompute arrow scale factor for new axis limits. dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); end case double('Z') % Z key: Zoom out. % Expand the axis limits by 10%. The axis limit modes % are automatically set to manual. ha = gca; xl = get(ha,'XLim'); yl = get(ha,'YLim'); zl = get(ha,'ZLim'); dl = .05*(xl(2)-xl(1)); xl = [xl(1)-dl xl(2)+dl]; dl = .05*(yl(2)-yl(1)); yl = [yl(1)-dl yl(2)+dl]; dl = .05*(zl(2)-zl(1)); zl = [zl(1)-dl zl(2)+dl]; set(ha,'XLim',xl) set(ha,'YLim',yl) set(ha,'ZLim',zl) if ha == hax(1) % Recompute arrow scale factor for new axis limits. dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); end end return; end % KeyPressFcn %*********************************************************** function MotionFcn(hobj,event_data) % Callback for mouse motion with a button pressed in figure 1 or figure 4. if drag_cp % Drag a control point (line object with handle hdragcp % created by CpButtonDnFcn): convert the mouse position to % axes coordinates and update the second (and possibly the % first or third) point of the line object. mp = get(hfig1,'CurrentPoint'); xd = get(hdragcp,'XData'); yd = get(hdragcp,'YData'); zd = get(hdragcp,'ZData'); p(1) = xd(2); p(2) = yd(2); p(3) = zd(2); p = movevtx(p,mp); if ndof == 1 p(1) = xd(2); end if xd(1) == xd(2) && yd(1) == yd(2) && zd(1) == zd(2) xd(1) = p(1); yd(1) = p(2); zd(1) = p(3); end if xd(3) == xd(2) && yd(3) == yd(2) && zd(3) == zd(2) xd(3) = p(1); yd(3) = p(2); zd(3) = p(3); end xd(2) = p(1); yd(2) = p(2); zd(2) = p(3); set(hdragcp,'XData',xd, 'YData',yd, 'ZData',zd, ... 'Visible','on') elseif drag_dv % Drag arrow tip p (defined by quiver3 object with handle % hdragdv created by CpButtonDnFcn): convert the mouse % position to axes coordinates and update the arrow data. cp(1) = get(hdragdv,'XData'); cp(2) = get(hdragdv,'YData'); cp(3) = get(hdragdv,'ZData'); v(1) = get(hdragdv,'UData'); v(2) = get(hdragdv,'VData'); v(3) = get(hdragdv,'WData'); p = cp + v; mp = get(hfig1,'CurrentPoint'); p = movevtx(p,mp); p = (p'-cp); set(hdragdv,'UData',p(1), 'VData',p(2), ... 'WData',p(3), 'Visible','on') elseif hslider4 == get(hfig4,'CurrentObject') % Mouse motion in the figure 4 slider trough: update tension. sig = get(hslider4,'Value'); sig = round(10*sig)/10; set(hedit4,'String',num2str(sig)) if get(hcheck4,'Value') sigf = sig; i = 1:n-1; else sigf = -1; i = str2double(get(hc,'Tag')); end sigma(i) = sig; tseval(i); end return; end % MotionFcn %*********************************************************** function MoveCpFcn(hobj,event_data) % Callback for Operations menu selection: move control point. set([hfig4 hfig5 hfig6],'Visible','off') if freeze_cp a = questdlg('Alter the set of control points?', ... 'Alter Control Points','Yes','No','Yes'); if ~strcmp(a,'Yes') cancelop % Cancel current operation return; end freeze_cp = false; end operation = 'move_cp'; set(hcp0,'HitTest','on') set(hcs0,'HitTest','off') set(hcpoly,'HitTest','off') set(hcop,'String','Current Operation: Drag Control Points') if cpstate == 0 DOcpts(hdo(5),event_data) end set(hcp0,'Visible','on') if ~interpolate, set(hcpoly,'Visible','on'), end if snapto && strcmp(get(hdo(6),'Checked'),'off') DOlimits(hdo(6),event_data) % Freeze axis limits end return; end % MoveCpFcn %*********************************************************** function SnapToGridFcn(hobj,event_data) % Callback for Operations menu selection: toggle snap to grid option. if snapto snapto = false; set(hobj,'Checked','off') else snapto = true; set(hobj,'Checked','on') if strcmp(get(hdo(6),'Checked'),'off') DOlimits(hdo(6),event_data) % Freeze axis limits. end end return; end % SnapToGridFcn %*********************************************************** function UndoFcn(hobj,event_data) % Callback for Undo Last Operation menu selection. % % Refer to Function ulpush for a description of the stack % data structure. if ulcnt == 0 edialog('The previous operation cannot be undone', ... 'Empty Stack') return; end op = ulist(uptr).opcode; i = ulist(uptr).index; data = ulist(uptr).data; ulcnt = ulcnt - 1; uptr = uptr - 1; if uptr < 1 uptr = upmax; end opcnt = opcnt - 1; switch op case 'a' % Restore saved derivative. xp(i) = data(1); yp(i) = data(2); zp(i) = data(3); if i == 1 && strcmp(endcond,'periodic') xp(n) = xp(1); yp(n) = yp(1); zp(n) = zp(1); end if ndof > 1 set(harrow(i),'UData',asf*xp(i), 'VData',asf*yp(i), ... 'WData',asf*zp(i)) else % Compute arrow components (u,v) chosen so that v/u = yp(i) % and (xsf*u)^2 + (ysf*v)^2 = L^2, where xsf and ysf are the % scale factors in the mappings from axes coordinates to % window coordinates, and L is arrow length in window coor- % dinates. u = L/sqrt(xsf^2+(ysf*yp(i))^2); v = yp(i)*u; set(harrow(i),'UData',asf*u, 'VData',asf*v) end case 'b' % Restore bounds. bnds(:,i) = data'; case {'c', 'C'} % Curve Type change: (deriv = c2,c1,user). if i == 1 % Restore C^2 derivatives switch deriv case 'c1' set(hct(5),'Checked','off') case 'user' set(hct(6),'Checked','off') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation end end deriv = 'c2'; title('C^2 curve created by TSPACK') set(hct(4),'Checked','on') if strcmp(op,'C') set(hct(12),'Checked','off') % Restore endcond = 'auto' endcond = 'auto'; set(hct(11),'Checked','on') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation end end elseif i == 2 % Restore C^1 derivatives switch deriv case 'c2' set(hct(4),'Checked','off') title('C^1 curve created by TSPACK') case 'user' set(hct(6),'Checked','off') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation end end deriv = 'c1'; set(hct(5),'Checked','on') if strcmp(op,'C') set(hct(12),'Checked','off') % Restore endcond = 'auto' endcond = 'auto'; set(hct(11),'Checked','on') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation end end else % Restore user derivatives switch deriv case 'c2' set(hct(4),'Checked','off') title('C^1 curve created by TSPACK') case 'c1' set(hct(5),'Checked','off') end deriv = 'user'; set(hct(6),'Checked','on') AlterDerivFcn(hobj,event_data) % Set operation to 'alter_dv' if strcmp(op,'C') set(hct(11),'Checked','off') % Restore user end conditions endcond = 'user'; set(hct(12),'Checked','on') xp(1) = data(1); yp(1) = data(2); zp(1) = data(3); xp(n) = data(4); yp(n) = data(5); zp(n) = data(6); if ndof > 1 set(harrow(1),'UData',asf*xp(1), 'VData',asf*yp(1), ... 'WData',asf*zp(1)) set(harrow(n),'UData',asf*xp(n), 'VData',asf*yp(n), ... 'WData',asf*zp(n)) else u = L/sqrt(xsf^2+(ysf*yp(1))^2); v = yp(1)*u; set(harrow(1),'UData',asf*u, 'VData',asf*v) u = L/sqrt(xsf^2+(ysf*yp(n))^2); v = yp(n)*u; set(harrow(n),'UData',asf*u, 'VData',asf*v) end end end case 'd' % Re-insert the deleted control point. cp = [data(1) data(2) data(3)]; insertcp(i,cp) xp(i) = data(4); yp(i) = data(5); zp(i) = data(6); if i == 1 && strcmp(endcond,'periodic') xp(n) = xp(1); yp(n) = yp(1); zp(n) = zp(1); end if i < n sigma(i) = data(7); else sigma(n-1) = data(7); end smwts(i) = data(8); case 'e' % Curve Type change: (endcond = periodic,auto,user). if i == 1 % Restore closed curve switch endcond case 'auto' set(hct(11),'Checked','off') case 'user' set(hct(12),'Checked','off') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation end end endcond = 'periodic'; if strcmp(operation,'append_cp') cancelop end set(hct(10),'Checked','on') if x(1) ~= x(n) || y(1) ~= y(n) || z(1) ~= z(n) % Add a copy of (x(1),y(1),z(1)) as a new control point, and % add a new curve segment. n = n+1; x(n) = x(1); y(n) = y(1); z(n) = z(1); smwts(n) = smwts(1); a = arcl3d([x(n-1) x(n)],[y(n-1) y(n)],[z(n-1) z(n)]); t(n) = t(n-1) + a(2); aln(n) = aln(n-1) + a(2); xk(n) = xk(1); yk(n) = yk(1); zk(n) = zk(1); xp(n) = xp(1); yp(n) = yp(1); zp(n) = zp(1); sigma(n-1) = 0; bnds(:,n-1) = bnds_dflt; crv(:,n-1) = [0;0]; trs(:,n-1) = [0;0]; vx = linspace(xk(n-1),xk(n),ne); vy = linspace(yk(n-1),yk(n),ne); vz = zeros(1,ne); hcs0(n-1) = line(vx,vy,vz, ... 'Color',cs_color, ... 'ButtonDownFcn',@CsButtonDnFcn, ... 'HandleVisibility', 'callback', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'Tag',num2str(n-1)); hcsp(n-1) = quiver3(vx,vy,vz,vxc,vyc,vzc); set(hcsp(n-1),'AutoScale','off', ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'Parent',hax(1), ... 'SelectionHighlight','off', ... 'ShowArrowHead','off') if ~plotp set(hcsp(n-1),'Visible','off') end hcs1(n-1) = line(vx1,vy1,vz1, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(2), ... 'SelectionHighlight','off'); hcs2(n-1) = line(vx2,vy2,vz2, ... 'Color',cs_color, ... 'HandleVisibility', 'callback', ... 'HitTest','off', ... 'LineStyle','-', 'Marker','none', ... 'Parent',hax(3), ... 'SelectionHighlight','off'); if ~interpolate set(hcpoly,'XData',x, 'YData',y, 'ZData',z) end end if strcmp(operation,'alter_dv') && (~interpolate || ... strcmp(deriv,'c2')) cancelop % Cancel alter_dv operation end elseif i == 2 % Restore auto end conditions switch endcond case 'periodic' set(hct(10),'Checked','off') % Remove the last control point and curve segment. deletecp(n) case 'user' set(hct(12),'Checked','off') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation end end endcond = 'auto'; set(hct(11),'Checked','on') else % Restore user end conditions switch endcond case 'periodic' set(hct(10),'Checked','off') % Remove the last control point and curve segment. deletecp(n) case 'auto' set(hct(11),'Checked','off') end endcond = 'user'; set(hct(12),'Checked','on') xp(1) = data(1); yp(1) = data(2); zp(1) = data(3); xp(n) = data(4); yp(n) = data(5); zp(n) = data(6); if ndof > 1 set(harrow(1),'UData',asf*xp(1), 'VData',asf*yp(1), ... 'WData',asf*zp(1)) set(harrow(n),'UData',asf*xp(n), 'VData',asf*yp(n), ... 'WData',asf*zp(n)) else u = L/sqrt(xsf^2+(ysf*yp(1))^2); v = yp(1)*u; set(harrow(1),'UData',asf*u, 'VData',asf*v) u = L/sqrt(xsf^2+(ysf*yp(n))^2); v = yp(n)*u; set(harrow(n),'UData',asf*u, 'VData',asf*v) end end case 'i' % Delete the inserted control point. deletecp(i) case 'm' % Restore the moved control point. x(i) = data(1); y(i) = data(2); z(i) = data(3); if interpolate xk(i) = x(i); yk(i) = y(i); zk(i) = z(i); end if i == 1 && strcmp(endcond,'periodic') x(n) = x(1); y(n) = y(1); z(n) = z(1); if interpolate xk(n) = x(n); yk(n) = y(n); zk(n) = z(n); end end set(hcp0(i),'XData',x(i), 'YData',y(i), 'ZData',z(i)) if ~interpolate set(hcpoly,'XData',x, 'YData',y, 'ZData',z) end case {'n', 'N'} % Curve Type change: (ndof = 1,2,3). if i == 1 % Restore function ndof = 1; set(hct(1),'Checked','on') set(hct(2:3),'Checked','off') set(hax(1),'DataAspectRatioMode','auto') set(get(hax(2),'Title'),'String', ... 'First Derivative of Tension Spline') set(get(hax(3),'Title'),'String', ... 'Second Derivative of Tension Spline') if strcmp(operation,'alter_bd') cancelop % Cancel alter_bd operation end % Recompute arrow scale factor for new axis limits. xl = get(hax(1),'XLim'); yl = get(hax(1),'YLim'); zl = get(hax(1),'ZLim'); dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); % Recompute arrow length L and scale factors xsf, ysf. fp = get(hfig1,'Position'); L = (fp(3)+fp(4))/(6*asf); xsf = fp(3)/dx; ysf = fp(4)/dy; if strcmp(deriv,'user') yp = yp./xp; % Convert derivative vectors to scalars xp(:) = 1; % Compute arrow components (u,v) chosen so that v/u = yp(i) % and (xsf*u)^2 + (ysf*v)^2 = L^2. for ii = 1:imax u = L/sqrt(xsf^2+(ysf*yp(ii))^2); v = yp(ii)*u; set(harrow(ii),'UData',asf*u, 'VData',asf*v) end end elseif i == 2 % Restore planar curve if ndof == 1 set(hct(1),'Checked','off') if strcmp(operation,'alter_sw') || ... strcmp(operation,'alter_bd') cancelop % Cancel operation end if strcmp(deriv,'user') % Convert derivative values yp to unit tangent vectors % (xp,yp) by normalizing (1,yp). (Unit speed corresponds % to arc length parameterization.) xp = 1./sqrt(1+yp.^2); yp = xp.*yp; for ii = 1:imax set(harrow(ii),'UData',asf*xp(ii), 'VData',asf*yp(ii)) end end % Change to preserving the aspect ratio of the data, and % recompute the arrow scale factor for new axis limits. set(hax(1),'DataAspectRatio',[1 1 1]) xl = get(hax(1),'XLim'); yl = get(hax(1),'YLim'); zl = get(hax(1),'ZLim'); dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); if ~interpolate && strcmp(op,'N') % Redundant test set(hct(11),'Checked','off') % Restore user end conditions endcond = 'user'; set(hct(12),'Checked','on') xp(1) = data(1); yp(1) = data(2); zp(1) = data(3); xp(n) = data(4); yp(n) = data(5); zp(n) = data(6); if ndof > 1 set(harrow(1),'UData',asf*xp(1), 'VData',asf*yp(1), ... 'WData',asf*zp(1)) set(harrow(n),'UData',asf*xp(n), 'VData',asf*yp(n), ... 'WData',asf*zp(n)) else u = L/sqrt(xsf^2+(ysf*yp(1))^2); v = yp(1)*u; set(harrow(1),'UData',asf*u, 'VData',asf*v) u = L/sqrt(xsf^2+(ysf*yp(n))^2); v = yp(n)*u; set(harrow(n),'UData',asf*u, 'VData',asf*v) end end else z(:) = 0; if interpolate zk(:) = 0; end set(hcp0(1:imax),'ZData',0) set(hcs0,'ZData',zeros(1,ne)) set(hcs1,'ZData',zeros(1,ne)) set(hcs2,'ZData',zeros(1,ne)) set(hcsp,'ZData',zeros(1,ne), 'WData',zeros(1,ne)) zp(:) = 0; set(harrow(1:imax),'ZData',0, 'WData',0) set(hcpoly,'ZData',zeros(1,n)) set(hct(3),'Checked','off') end ndof = 2; set(hct(2),'Checked','on') set(get(hax(2),'Title'),'String', ... 'Signed Curvature as a Function of Arc Length') set(get(hax(3),'Title'),'String', ... 'Signed Curvature as a Function of Arc Length') else % Restore space curve if ndof == 1 set(hct(1),'Checked','off') if strcmp(operation,'alter_sw') || ... strcmp(operation,'alter_bd') cancelop % Cancel operation end if strcmp(deriv,'user') % Convert derivative values yp to unit tangent vectors % (xp,yp,0) by normalizing (1,yp). (Unit speed corresponds % to arc length parameterization.) xp = 1./sqrt(1+yp.^2); yp = xp.*yp; zp = zeros(1,n); for ii = 1:imax set(harrow(ii),'UData',asf*xp(ii), 'VData',asf*yp(ii)) end end % Change to preserving the aspect ratio of the data, and % recompute the arrow scale factor for new axis limits. set(hax(1),'DataAspectRatio',[1 1 1]) xl = get(hax(1),'XLim'); yl = get(hax(1),'YLim'); zl = get(hax(1),'ZLim'); dx = xl(2)-xl(1); dy = max([yl(2)-yl(1),qmin]); dz = zl(2)-zl(1); asf = 0.07*(dx + dy + dz); ndof = 3; set(hct(3),'Checked','on') elseif ndof == 2 set(hct(2),'Checked','off') ndof = 3; set(hct(3),'Checked','on') end set(get(hax(2),'Title'),'String', ... 'Curvature as a Function of Arc Length') set(get(hax(3),'Title'),'String', ... 'Torsion as a Function of Arc Length') end case 's' % Restore sigf and tension factor(s). sigf = data(2); if sigf < 0 sigma(i) = data(1); else sigma(1:n-1) = sigf; end case 't' % Curve Type change: (tension = shape,bounds,user). if i == 1 % Restore shape-preservation switch tension case 'bounds' set(hct(8),'Checked','off') if strcmp(operation,'alter_bd') cancelop % Cancel alter_bd operation end case 'user' set(hct(9),'Checked','off') if strcmp(operation,'alter_tf') cancelop % Cancel alter_tf operation end end tension = 'shape'; set(hct(7),'Checked','on') sigf = -1; % Variable tension elseif i == 2 % Restore bounds-preservation switch tension case 'shape' set(hct(7),'Checked','off') case 'user' set(hct(9),'Checked','off') if strcmp(operation,'alter_tf') cancelop % Cancel alter_tf operation end end tension = 'bounds'; set(hct(8),'Checked','on') sigf = -1; % Variable tension else % Restore user tension sigf = data; if sigf >= 0 sigma(1:n-1) = sigf; end switch tension case 'shape' set(hct(7),'Checked','off') case 'bounds' set(hct(8),'Checked','off') if strcmp(operation,'alter_bd') cancelop % Cancel alter_bd operation end end tension = 'user'; set(hct(9),'Checked','on') AlterSigmaFcn(hobj,event_data) % Set operation to 'alter_tf' end case 'w' % Restore smwf and smoothing weights. smwf = data(2); if smwf < 0 smwts(i) = data(1); else smwts(1:n) = smwf; end case {'x', 'X'} % Curve Type change: (interpolate,approximate). if i == 1 % Restore interpolant set(hct(14),'Checked','off') if strcmp(operation,'alter_sw') cancelop % Cancel alter_sw operation end interpolate = true; set(hct(13),'Checked','on') if ndof > 1 if strcmp(op,'X') set(hct(12),'Checked','off') % Restore endcond = 'auto' endcond = 'auto'; set(hct(11),'Checked','on') if strcmp(operation,'alter_dv') cancelop % Cancel alter_dv operation end end elseif strcmp(op,'X') set(hct(11),'Checked','off') % Restore user end conditions endcond = 'user'; set(hct(12),'Checked','on') xp(1) = data(1); yp(1) = data(2); zp(1) = data(3); xp(n) = data(4); yp(n) = data(5); zp(n) = data(6); if ndof > 1 set(harrow(1),'UData',asf*xp(1), 'VData',asf*yp(1), ... 'WData',asf*zp(1)) set(harrow(n),'UData',asf*xp(n), 'VData',asf*yp(n), ... 'WData',asf*zp(n)) else u = L/sqrt(xsf^2+(ysf*yp(1))^2); v = yp(1)*u; set(harrow(1),'UData',asf*u, 'VData',asf*v) u = L/sqrt(xsf^2+(ysf*yp(n))^2); v = yp(n)*u; set(harrow(n),'UData',asf*u, 'VData',asf*v) end end % Set knot function values to control points. xk = x; yk = y; zk = z; set(hcpoly,'HitTest','off', 'Visible','off') if strcmp(operation,'insert_cp') set(hcs0,'HitTest','on') end else % Restore approximating curve set(hct(13),'Checked','off') interpolate = false; set(hct(14),'Checked','on') set(hcpoly,'XData',x, 'YData',y, 'ZData',z) if strcmp(get(hdo(5),'Checked'),'on') set(hcpoly,'Visible','on') end if strcmp(operation,'insert_cp') set(hcpoly,'HitTest','on') end end end % Compute the new curve. if ndof > 1, newknots = true; end tscurve; return; end % UndoFcn end % tspackgui %*********************************************************** % TSPACKGUI Utility Functions. %*********************************************************** function edialog(ErrorString,DlgTitle) % Error dialog box (alternative to errordlg) % % USAGE: edialog(ErrorString,DlgTitle); % % The MATLAB function errordlg uses the factory default % value for text font size. This function calls errordlg % and then increases the font size to 14. It also sets % the interpreter to tex. h = errordlg(ErrorString,DlgTitle); ht = findobj(h,'Type','text'); set(ht,'Interpreter','tex') if ismac, return; end % Text would be truncated on Mac. set(ht,'FontSize',14) % Increase the figure window width by 30%. fpos = get(h,'Position'); fpos(3) = 1.3*fpos(3); set(h,'Position',fpos) return; end % edialog %*********************************************************** function vout = movevtx(v,p) % Move vertex (data space) to mouse position (window coordinates). % % USAGE: vout = movevtx(v,p); % % Given a vertex v (in axes coordinates) and a mouse position % p (the CurrentPoint property of the current figure in % absolute device coordinates with origin at lower left), % this function returns a new vertex location vout (as a % column vector) whose window coordinates coincide with p % and whose depth (distance from the camera) is that of v. % This allows an interactive user to move a vertex in a % plane whose normal is the view axis. % % The vertex is assumed to be in the current axes. % Refer to function xform for a description of the MATLAB % vertex pipeline. % % Since the perspective projection transformation is not % invertible, the projection type is changed to orthographic % if necessary. hax = gca; proj = get(hax,'Projection'); if strcmp(proj,'perspective') set(hax,'Projection','orthographic') end % Compute the translation vector defining operator T1 % (first transformation) and the product xf of the % additional transformations. xl = get(hax,'XLim'); yl = get(hax,'YLim'); zl = get(hax,'ZLim'); % Sometimes, when stretch-to-fill mode is in effect, T2(3,3) = % 1/(zl(2)-zl(1)) is equal to 5.0e15, causing xf to be nearly % singular. xf = get(hax,'x_RenderTransform'); if abs(xf(3,3)) > 5.0e15 xf(3,3) = xf(3,3)/5.0e15; end % Apply the translation operator: vt = T1*v. vt = zeros(3,1); vt(1) = v(1) - xl(1); vt(2) = v(2) - yl(1); vt(3) = v(3) - zl(1); % Compute the depth associated with v: 3rd component of xf*vt. depth = xf(3,1)*vt(1) + xf(3,2)*vt(2) + ... xf(3,3)*vt(3) + xf(3,4); % Convert the mouse position to device coordinates relative % to the upper left corner of the current figure window, % solve xf*vt = b for b = [p(1);p(2);depth;1], and remove % the fourth component (which should be 1). b = get(gcf,'Position'); b = [p(1); b(4)+0.5-p(2); depth; 1]; vt = xf\b; vt(4) = []; % Compute vout = T1^(-1)*vt. vout = vt + [xl(1); yl(1); zl(1)]; % Restore the perspective projection type if necessary. set(hax,'Projection',proj) return; end % movevtx %*********************************************************** function [rn,c1,c2] = resnrm1(x,y) % Least squares fit of a degree-1 polynomial to data points. % % USAGE: [rn,c1,c2] = resnrm1(x,y); % % This function computes a least squares fit of a polynomial % p of degree 1 to a set of n data points (x,y) for n >= 2, % returning the squared residual norm rn = (y-p(x))'*(y-p(x)) % and the coefficients of p(x) = c1*x + c2. % Compute the matrix A and right hand side b defining the % normal equations. a11 = dot(x,x); a12 = sum(x); a22 = length(x); b1 = dot(x,y); b2 = sum(y); % Solve the linear system A*c = b, and compute rn = sum(r.*r) % for r = y-p(x). c2 = (a11*b2-a12*b1)/(a11*a22-a12*a12); c1 = (b1-a12*c2)/a11; r = y - (c1*x+c2); rn = dot(r,r); return; end % resnrm1 %*********************************************************** function [p,depth] = xform(v) % Transform vertices from data space to window coordinates. % % USAGE: [p,depth] = xform(v); % % Given an N by 3 array V containing a set of vertices (axes % coordinates), this function returns an N by 2 array P % containing the corresponding window coordinates, and, % optionally, the column vector of depths. The window % coordinate space is [0,w] X [0,h] for a figure window with % width w and height h in pixels with (0,0) at the lower % left corner. If the vertices are points selected by the % mouse (CurrentPoint property of the axes), the window % coordinates will be pixel centers of the form i-0.5 for an % integer i in the range 1 to w or 1 to h. % % Note that the transformation uses properties of the % current axes and the current figure, and the Units % property of the figure is assumed to be pixels (the % default). % The MATLAB vertex pipeline (sequence of transformations % applied to all vertices) is defined below. All trans- % formations are order-4 matrices representing affine % transformations for column vectors of homogeneous % coordinates (x,y,z,w). Some of the transformations are % undocumented read-only axes properties. These undocumented % properties can be uncovered by setting the root property % 'HideUndocumented' (itself an undocumented property) to % 'off'. % % 0) T0: Modeling transformations defined by hgtransform % objects. If the elements of V are points of such % an object, they must be transformed before % calling this function. % % 1) T1: Translation by -xl(1), -yl(1), -zl(1), where % xl, yl, and zl are the axes limit properties % (xlim, ylim, and zlim). % % 2) T2: Normalization operator. The x, y, and z components % are scaled by 1/(xl(2)-xl(1)), 1/(yl(2)-yl(1)), % and 1/(zl(2)-zl(1)), respectively. T2*T1 thus % maps the axis-aligned bounding box associated with % the data to the unit cube [0,1]^3 (the normalized % plot cube). The first components of the axis % limits are stored as the undocumented axes property % x_RenderOffset (a 3 by 1 array). There is a simi- % larly undocumented 3 by 1 array named x_RenderScale % which appears to always be [1 1 1]. % % 3) T3: View transformation returned by Function VIEW and % stored as the undocumented axes properties xform % and x_ViewTransform. This operator translates and % rotates so that the viewing direction (defined by % the camera position and target) is aligned with % the z axis. % % 4) T4: Projection operator stored as the undocumented % property x_ProjectionTransform. This operator % applies a uniform scaling to x and y, leaving z % unaltered. Since the depth z must be retained % for hidden surface removal, no projection is % actually applied. In the case of a perspective % projection, T4 also sets w to z, and T4 is not % invertible. A perspective division operation % (scaling by 1/w) follows the application of T4. % % 5) T5: Viewport mapping stored as the undocumented % property x_ViewportTransform. This operator maps % a rectangle in the projection plane to a % rectangular viewport in the figure window, and % scales the z component. % % There are two additional undocumented 4 by 4 matrices: % % x_NormRenderTransform = T5*T4*T3, % and % x_RenderTransform = T5*T4*T3*T2, % % In the case of perspective projection, neither matrix is % invertible. hax = gca; xl = get(hax,'XLim'); yl = get(hax,'YLim'); zl = get(hax,'ZLim'); % Sometimes, when stretch-to-fill mode is in effect, T2(3,3) = % 1/(zl(2)-zl(1)) is equal to 5.0e15, causing xf to be nearly % singular. xf = get(hax,'x_RenderTransform'); if abs(xf(3,3)) > 5.0e15 xf(3,3) = xf(3,3)/5.0e15; end % Apply the translation operator: vt = T1*v. vt = zeros(size(v)); vt(:,1) = v(:,1) - xl(1); vt(:,2) = v(:,2) - yl(1); vt(:,3) = v(:,3) - zl(1); % Apply xf to the rows of vt (converted to homogeneous % coordinates) to get (p(:,1);p(:,2);depth(:);w(:)). % Perspective projection results in w ~= 1, requiring % normalization. w = xf(4,1)*vt(:,1) + xf(4,2)*vt(:,2) + xf(4,3)*vt(:,3) + xf(4,4); p(:,1) = (xf(1,1)*vt(:,1) + xf(1,2)*vt(:,2) + ... xf(1,3)*vt(:,3) + xf(1,4))./w; p(:,2) = (xf(2,1)*vt(:,1) + xf(2,2)*vt(:,2) + ... xf(2,3)*vt(:,3) + xf(2,4))./w; % The window coordinate system of the transformed vertices % has origin at the upper left. The y-components must be % subtracted from the window height. fp = get(gcf,'Position'); p(:,2) = fp(4) - p(:,2); if nargout == 2 depth = (xf(3,1)*vt(:,1) + xf(3,2)*vt(:,2) + ... xf(3,3)*vt(:,3) + xf(3,4))./w; end return; end % xform %*********************************************************** % TSPACK Functions %*********************************************************** function [t,ier] = arcl2d(x,y) % arcl2d: Computes cumulative arc lengths along a planar curve % % USAGE: [t,ier] = arcl2d(x,y); % % Given an ordered sequence of N points (X,Y) defining a % polygonal curve in the plane, this function computes the % sequence T of cumulative arc lengths along the curve: % T(1) = 0 and, for 2 <= K <= N, T(K) is the sum of % Euclidean distances between (X(I-1),Y(I-1)) and (X(I),Y(I)) % for I = 2 to K. A closed curve corresponds to X(1) = % X(N) and Y(1) = Y(N), and more generally, duplicate points % are permitted but must not be adjacent. Thus, T contains % a strictly increasing sequence of values which may be used % as parameters for fitting a smooth curve to the sequence % of points. % % On input: % % X,Y = Vectors of length N containing the coordinates % of the points. % % On output: % % T = Vector of size(X) containing cumulative arc % lengths defined above. % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = I if X(I) = X(I+1) and Y(I) = Y(I+1) for % some I in the range 1 to N-1. % % Modules required by ARCL2D: None % %*********************************************************** % Set ds to the vector of arc lengths, and compute t. ds = sqrt(diff(x).^2 + diff(y).^2); m = size(x); if (m(1) == 1) t = [0 cumsum(ds)]; else t = [0; cumsum(ds)]; end if (nargout > 1) % Test for a zero arc length. if (all(ds)) ier = 0; else ier = find(~ds,1); % ier = index of first zero end end return; end % arcl2d function [t,ier] = arcl3d(x,y,z) % arcl3d: Computes cumulative arc lengths along a space curve % % USAGE: [t,ier] = arcl3d(x,y,z); % % Given an ordered sequence of N points (X,Y,Z) defining a % polygonal curve in 3-space, this function computes the % sequence T of cumulative arc lengths along the curve: % T(1) = 0 and, for 2 <= K <= N, T(K) is the sum of % Euclidean distances between (X(I-1),Y(I-1),Z(I-1)) and % (X(I),Y(I),Z(I)) for I = 2 to K. A closed curve corre- % sponds to X(1) = X(N), Y(1) = Y(N), and Z(1) = Z(N). More % generally, duplicate points are permitted but must not be % adjacent. Thus, T contains a strictly increasing sequence % of values which may be used as parameters for fitting a % smooth curve to the sequence of points. % % On input: % % X,Y,Z = Vectors of length N containing the coordi- % nates of the points. % % On output: % % T = Vector of size(X) containing cumulative arc % lengths defined above. % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = I if X(I) = X(I+1), Y(I) = Y(I+1), and % Z(I) = Z(I+1) for some I in the range % 1 to N-1. % % Modules required by ARCL3D: None % %*********************************************************** % Set ds to the vector of arc lengths, and compute t. ds = sqrt(diff(x).^2 + diff(y).^2 + diff(z).^2); m = size(x); if (m(1) == 1) t = [0 cumsum(ds)]; else t = [0; cumsum(ds)]; end if (nargout > 1) % Test for a zero arc length. if (all(ds)) ier = 0; else ier = find(~ds,1); % ier = index of first zero end end return; end % arcl3d function [ys,yp] = b2tri(x,y,w,p,d,sd) % b2tri: SPD block tridiagonal system solver % % USAGE: [ys,yp] = b2tri(x,y,w,p,d,sd); % % This function solves the order 2N symmetric positive- % definite block tridiagonal linear system associated with % minimizing the quadratic functional Q(YS,YP) described in % Function SMCRV. % % On input: % % X,Y,W = Vectors of length N containing abscissae, % data values, and positive weights, respect- % ively. The abscissae must be strictly in- % creasing. % % P = Positive smoothing parameter defining Q. % % D,SD = Vectors of length N-1 containing positive ma- % trix entries. Letting DX and SIG denote the % width and tension factor associated with the % interval (X(I),X(I+1)), D(I) = SIG*(SIG* % COSHM(SIG) - SINHM(SIG))/(DX*E) and SD(I) = % SIG*SINHM(SIG)/(DX*E) where E = SIG*SINH(SIG) % - 2*COSHM(SIG). % % Note that no test is made for a nonpositive value of % X(I+1)-X(I), W(I), D(I), or SD(I). % % On output: % % YS,YP = Vectors of size(X) containing solution com- % ponents: function and derivative values, % respectively, at the abscissae. % % Modules required by B2TRI: None % %*********************************************************** m = size(x); n = length(x); nm1 = n - 1; % Initialize output arrays. ys = zeros(m); yp = zeros(m); % Work space: t11 = zeros(nm1,1); t12 = zeros(nm1,1); t21 = zeros(nm1,1); t22 = zeros(nm1,1); % The forward elimination step consists of scaling a row by % the inverse of its diagonal block and eliminating the % subdiagonal block. The superdiagonal is stored in T and % the right hand side in YS,YP. For J = 11, 12, and 22, % SJI and SJIM1 denote the elements in position J of the % superdiagonal block in rows I and I-1, respectively. % Similarly, DJI denotes an element in the diagonal block % of row I. % Initialize for I = 2. dx = x(2) - x(1); dim1 = d(1); s22im1 = sd(1); s12im1 = (dim1 + s22im1)/dx; s11im1 = -2.0*s12im1/dx; r1 = p*w(1); d11i = r1 - s11im1; d12i = s12im1; d22i = dim1; den = d11i*d22i - d12i*d12i; t11(1) = (d22i*s11im1 + d12i*s12im1)/den; t12(1) = (d22i*s12im1 - d12i*s22im1)/den; t21(1) = -(d12i*s11im1 + d11i*s12im1)/den; t22(1) = (d11i*s22im1 - d12i*s12im1)/den; r1 = r1*y(1)/den; ys(1) = d22i*r1; yp(1) = -d12i*r1; % I = 2 to N-1: for i = 2:nm1 im1 = i - 1; dx = x(i+1) - x(i); di = d(i); s22i = sd(i); s12i = (di + s22i)/dx; s11i = -2.0*s12i/dx; r1 = p*w(i); d11i = r1 - s11im1 - s11i - (s11im1*t11(im1) - ... s12im1*t21(im1)); d12i = s12i - s12im1 - (s11im1*t12(im1) - s12im1*t22(im1)); d22i = dim1 + di - (s12im1*t12(im1)+s22im1*t22(im1)); den = d11i*d22i - d12i*d12i; t11(i) = (d22i*s11i + d12i*s12i)/den; t12(i) = (d22i*s12i - d12i*s22i)/den; t21(i) = -(d12i*s11i + d11i*s12i)/den; t22(i) = (d11i*s22i - d12i*s12i)/den; r1 = r1*y(i) - s11im1*ys(im1) + s12im1*yp(im1); r2 = -s12im1*ys(im1) - s22im1*yp(im1); ys(i) = (d22i*r1 - d12i*r2)/den; yp(i) = (d11i*r2 - d12i*r1)/den; dim1 = di; s22im1 = s22i; s12im1 = s12i; s11im1 = s11i; end % I = N: r1 = p*w(n); d11i = r1 - s11im1 - (s11im1*t11(nm1)-s12im1*t21(nm1)); d12i = -s12im1 - (s11im1*t12(nm1) - s12im1*t22(nm1)); d22i = dim1 - (s12im1*t12(nm1) + s22im1*t22(nm1)); den = d11i*d22i - d12i*d12i; r1 = r1*y(n) - s11im1*ys(nm1) + s12im1*yp(nm1); r2 = -s12im1*ys(nm1) - s22im1*yp(nm1); ys(n) = (d22i*r1 - d12i*r2)/den; yp(n) = (d11i*r2 - d12i*r1)/den; % Back solve the system. for i = nm1:-1:1 ys(i) = ys(i) - (t11(i)*ys(i+1) + t12(i)*yp(i+1)); yp(i) = yp(i) - (t21(i)*ys(i+1) + t22(i)*yp(i+1)); end return; end % b2tri function [ys,yp] = b2trip(x,y,w,p,d,sd) % b2trip: SPD periodic block tridiagonal system solver % % USAGE: [ys,yp] = b2trip(x,y,w,p,d,sd); % % This function solves the order 2(N-1) symmetric posi- % tive-definite linear system associated with minimizing the % quadratic functional Q(YS,YP) (described in Function % SMCRV) with periodic end conditions. The matrix is block % tridiagonal except for nonzero blocks in the upper right % and lower left corners. % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae. N >= 3. % % Y,W = Vectors of length N-1 containing data values % and positive weights, respectively, associated % with the first N-1 abscissae. % % P = Positive smoothing parameter defining Q. % % D,SD = Vectors of length N-1 containing positive ma- % trix elements. Letting DX and SIG denote the % width and tension factor associated with the % interval (X(I),X(I+1)), D(I) = SIG*(SIG* % COSHM(SIG) - SINHM(SIG))/(DX*E) and SD(I) = % SIG*SINHM(SIG)/(DX*E) where E = SIG*SINH(SIG) % - 2*COSHM(SIG). % % Note that no test is made for a nonpositive value of % X(I+1)-X(I), W(I), D(I), or SD(I). % % On output: % % YS,YP = Vectors of size(X) containing solution com- % ponents: function and derivative values, % respectively, at the abscissae. YS(N) = % YS(1) and YP(N) = YP(1). % % Modules required by B2TRIP: None % %*********************************************************** m = size(x); n = length(x); nm1 = n - 1; nm2 = n - 2; nm3 = n - 3; % Initialize output arrays. ys = zeros(m); yp = zeros(m); % Work space: t11 = zeros(nm2,1); t12 = zeros(nm2,1); t21 = zeros(nm2,1); t22 = zeros(nm2,1); u11 = zeros(nm2,1); u12 = zeros(nm2,1); u21 = zeros(nm2,1); u22 = zeros(nm2,1); % The forward elimination step consists of scaling a row by % the inverse of its diagonal block and eliminating the % subdiagonal block for the first N-2 rows. The super- % diagonal is stored in T, the negative of the last column % in U, and the right hand side in YS,YP. For J = 11, 12, % and 22, SJI and SJIM1 denote the elements in position J % of the superdiagonal block in rows I and I-1, respect- % ively. Similarly, DJI denotes an element in the diago- % nal block of row I. % I = 1: dx = x(n) - x(nm1); dnm1 = d(nm1); s22nm1 = sd(nm1); s12nm1 = -(dnm1 + s22nm1)/dx; s11nm1 = 2.0*s12nm1/dx; dx = x(2) - x(1); di = d(1); s22i = sd(1); s12i = (di + s22i)/dx; s11i = -2.0*s12i/dx; r1 = p*w(1); d11i = r1 - s11nm1 - s11i; d12i = s12i + s12nm1; d22i = dnm1 + di; den = d11i*d22i - d12i*d12i; t11(1) = (d22i*s11i + d12i*s12i)/den; t12(1) = (d22i*s12i - d12i*s22i)/den; t21(1) = -(d12i*s11i + d11i*s12i)/den; t22(1) = (d11i*s22i - d12i*s12i)/den; u11(1) = -(d22i*s11nm1 + d12i*s12nm1)/den; u12(1) = (d12i*s22nm1 - d22i*s12nm1)/den; u21(1) = (d12i*s11nm1 + d11i*s12nm1)/den; u22(1) = (d12i*s12nm1 - d11i*s22nm1)/den; r1 = r1*y(1)/den; ys(1) = d22i*r1; yp(1) = -d12i*r1; % I = 2 to N-2: for i = 2:nm2 im1 = i - 1; dim1 = di; s22im1 = s22i; s12im1 = s12i; s11im1 = s11i; dx = x(i+1) - x(i); di = d(i); s22i = sd(i); s12i = (di + s22i)/dx; s11i = -2.0*s12i/dx; r1 = p*w(i); d11i = r1 - s11im1 - s11i - (s11im1*t11(im1) - ... s12im1*t21(im1)); d12i = s12i - s12im1 - (s11im1*t12(im1) - s12im1*t22(im1)); d22i = dim1 + di - (s12im1*t12(im1)+s22im1*t22(im1)); den = d11i*d22i - d12i*d12i; t11(i) = (d22i*s11i + d12i*s12i)/den; t12(i) = (d22i*s12i - d12i*s22i)/den; t21(i) = -(d12i*s11i + d11i*s12i)/den; t22(i) = (d11i*s22i - d12i*s12i)/den; su11 = s11im1*u11(im1) - s12im1*u21(im1); su12 = s11im1*u12(im1) - s12im1*u22(im1); su21 = s12im1*u11(im1) + s22im1*u21(im1); su22 = s12im1*u12(im1) + s22im1*u22(im1); u11(i) = (d12i*su21 - d22i*su11)/den; u12(i) = (d12i*su22 - d22i*su12)/den; u21(i) = (d12i*su11 - d11i*su21)/den; u22(i) = (d12i*su12 - d11i*su22)/den; r1 = r1*y(i) - s11im1*ys(im1) + s12im1*yp(im1); r2 = -s12im1*ys(im1) - s22im1*yp(im1); ys(i) = (d22i*r1 - d12i*r2)/den; yp(i) = (d11i*r2 - d12i*r1)/den; end % The backward elimination step zeros the first N-3 blocks % of the superdiagonal. For I = N-2,N-3 to 1, T(I) and % (YS(I),YP(I)) are overwritten with the negative of the % last column and the new right hand side, respectively. t11(nm2) = u11(nm2) - t11(nm2); t12(nm2) = u12(nm2) - t12(nm2); t21(nm2) = u21(nm2) - t21(nm2); t22(nm2) = u22(nm2) - t22(nm2); for i = nm3:-1:1 ip1 = i + 1; ys(i) = ys(i) - t11(i)*ys(ip1) - t12(i)*yp(ip1); yp(i) = yp(i) - t21(i)*ys(ip1) - t22(i)*yp(ip1); t11(i) = u11(i) - t11(i)*t11(ip1) - t12(i)*t21(ip1); t12(i) = u12(i) - t11(i)*t12(ip1) - t12(i)*t22(ip1); t21(i) = u21(i) - t21(i)*t11(ip1) - t22(i)*t21(ip1); t22(i) = u22(i) - t21(i)*t12(ip1) - t22(i)*t22(ip1); end % Solve the last equation for YS(N-1),YP(N-1). SJI = SJNM2 % and DJI = DJNM1. r1 = p*w(nm1); d11i = r1 - s11i - s11nm1 + s11nm1*t11(1) - ... s12nm1*t21(1) + s11i*t11(nm2) - s12i*t21(nm2); d12i = -s12nm1 - s12i + s11nm1*t12(1) - s12nm1*t22(1) + ... s11i*t12(nm2) - s12i*t22(nm2); d22i = di + dnm1 + s12nm1*t12(1) + s22nm1*t22(1) + ... s12i*t12(nm2) + s22i*t22(nm2); den = d11i*d22i - d12i*d12i; r1 = r1*y(nm1) - s11nm1*ys(1) + s12nm1*yp(1) - ... s11i*ys(nm2) + s12i*yp(nm2); r2 = -s12nm1*ys(1) - s22nm1*yp(1) - s12i*ys(nm2) - s22i*yp(nm2); ysnm1 = (d22i*r1 - d12i*r2)/den; ypnm1 = (d11i*r2 - d12i*r1)/den; ys(nm1) = ysnm1; yp(nm1) = ypnm1; % Back substitute for the remainder of the solution % components. for i = 1:nm2 ys(i) = ys(i) + t11(i)*ysnm1 + t12(i)*ypnm1; yp(i) = yp(i) + t21(i)*ysnm1 + t22(i)*ypnm1; end % YS(N) = YS(1) and YP(N) = YP(1). ys(n) = ys(1); yp(n) = yp(1); return; end % b2trip function [xk,yk,zk,xp,yp,zp,ier] = bsp2h(nd,t,x,y,z, ... sigma,per,bv1,bvn) % bsp2h: Convert a tension spline from B-spline to Hermite form % % USAGE: [xk,yk,zk,xp,yp,zp,ier] = bsp2h(nd,t,x,y,z, ... % sigma,per,bv1,bvn); % % Given a sequence of knots, control points, and tension % factors defining a parametric tension spline curve in % B-spline form, this function converts the curve to Hermite % form, returning knot function values and derivative % vectors. The B-spline form is % % C(t) = Sum {B_{j-2}(t)*p_j}, % % where the sum is over j = 0 to N+1, p_j is a control point % in two or three dimensions, and B_j is a C^2 tension % B-spline basis function with support on the open interval % (t_j,t_{j+4}), triple zeros at the endpoints; i.e., B_j is % a generalization of the cubic B-spline. The outputs are % associated with knots t_i, i = 1 to N. % % In the case of a closed curve with p_1 = p_N and periodic % end conditions we have p_0 = p_{N-1} and p_{N+1} = p_2. % In the non-periodic case the first and last control points % are defined by endpoint derivative vectors C'(t_1) = bv1 % and C'(t_N) = bvn, and we use quadruple knots at the end- % points, resulting in endpoint interpolation: % % C(t_1) = p_0 = p_1 - bv1*(t_2-t_1)/3 and % C(t_N) = p_{N+1} = p_N + bvn*(t_N-t_{N-1})/3. % % Note that, with the exception of the endpoints, duplicating % control points reduces geometric continuity, while duplica- % ting knots reduces parametric continuity. Thus, with no % duplicated knots, if two adjacent control points coincide, % continuity of curvature is lost at the control point, and % three coincident control points in sequence results in a % discontinuous tangent direction (a corner). On the other % hand, if knots are computed as cumulative chord length, % then a pair of duplicate control points implies duplicate % knots and a C^1/G^0 corner with a pair of duplicate knot % function values each with a zero derivative vector. The % derivative vectors are perturbed away from zero in this % case to avoid warning messages when depicting them with % arrows (quiver3 objects). % % Refer to Function H2BSP for a means of computing a % sequence of control points for which the corresponding % B-spline curve interpolates a specified sequence of % knot function values. % % The tension splines may be evaluated by Function % TSVAL2 (or TSVAL3) or Functions HVAL (values), HPVAL % (first derivatives), HPPVAL (second derivatives), % HPPPVAL (third derivatives), and TSINTL (integrals). % % On input: % % ND = Number of dimensions: % ND = 2 if a planar curve is to be converted. % ND = 3 if a space curve is to be converted. % % T = Vector of length N containing a non-decreasing % sequence of knots. These might be computed as % cumulative polygonal chord length in the control % polygon: Functions ARCL2D and ARCL3D. N >= 2 % and N >= 4 if PER = TRUE. % % X,Y,Z = Vectors of length N containing the Cartesian % coordinates of an ordered sequence of control % points p(i), i = 1 to N. Z is an unused % dummy parameter if ND = 2. In the case of a % closed curve (PER = TRUE), the first and % last points should coincide. % % SIGMA = Vector of length N-1 containing tension % factors. SIGMA(i) is associated with inter- % val (T(i),T(i+1)) for i = 1 to N-1. If % SIGMA(i) = 0, C(t) is cubic, and as SIGMA % increases, C(t) approaches linear on the % interval. % % PER = Logical variable with value TRUE if and only % C(t) is to be a periodic function with period % T(N)-T(1) corresponding to a closed curve. It % is assumed without a test that the first and % last control points coincide in this case. On % output, XK(1) = XK(N), YK(1) = YK(N), XP(1) = % XP(N), YP(1) = YP(N), and, if ND = 3, then % ZK(1) = ZK(N) and ZP(1) = ZP(N). % % BV1,BVN = Endpoint derivative vectors with ND % components if PER = FALSE, or unused % dummy parameters otherwise. % % On output: % % XK,YK,ZK = Row vectors of length N containing the % knot function values C(t_i) for t_i = % T(i), i = 1 to N. (ZK = 0 if ND = 2.) % % XP,YP,ZP = Row vectors of length N containing the % knot derivative vectors C'(t_i) for % t_i = T(i), i = 1 to N. (ZP = 0 if % ND = 2.) % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = 1 if ND or N is outside its valid range. % IER = 2 if T is not non-decreasing. % % Module required by BSP2H: SNHCSH % %*********************************************************** n = length(t); xk = zeros(1,n); yk = xk; zk = xk; xp = xk; yp = xk; zp = xk; % Test for errors, and compute knot interval lengths dt % associated with interpolatory end conditions. if nd < 2 || nd > 3 || n < 2 || (n < 4 && per) ier = 1; return; end t = t(:)'; dt = [0 diff(t) 0 0]; if any(dt < 0) ier = 2; return; end ier = 0; % Store tension factors sig in 1-1 correspondence with the % n+2 knot intervals, again assuming nonperiodic end % conditions. sig = [sigma(1) sigma(:)' sigma(n-1) sigma(n-1)]; if per % Alter the endpoint values of dt and sig for periodic % end conditions. dt(1) = dt(n); dt(n+1) = dt(2); dt(n+2) = dt(3); sig(1) = sig(n); sig(n+1) = sig(2); sig(n+2) = sig(3); end % Store control points as the columns of an nd by n+1 % array p. The last column is used only if per = true. if nd == 2 p = [x(:)' x(2); y(:)' y(2)]; else p = [x(:)' x(2); y(:)' y(2); z(:)' z(2)]; end % Store sdt = sig.*dt and compute functions % % q = coshm(sdt)/(sig.*sinh(sdt)), % c = sinhm(sdt)/(sig.^2.*sinh(sdt)), % % on the n+2 intervals. sdt = sig.*dt; q = zeros(1,n+2); c = q; % Components with sig = 0 or dt = 0: k = find(sdt < 1.e-9); q(k) = 0.5*dt(k); c(k) = dt(k).^2/6; % Components with 0 < sdt < 0.5: k = find(sdt >= 1.e-9 & sdt <= 0.5); [sinhm,coshm] = snhcsh(sdt(k)); sinh = sinhm + sdt(k); q(k) = coshm./(sig(k).*sinh); c(k) = sinhm./(sig(k).*sig(k).*sinh); % Components with sdt > 0.5: scale sinhm, coshm, and sinh % by 2*exp(-sdt) to avoid overflow. k = find(sdt > 0.5); ems = exp(-sdt(k)); sinh = 1.0 - ems.*ems; sinhm = sinh - 2.0*sdt(k).*ems; coshm = (1.0-ems).^2; q(k) = coshm./(sig(k).*sinh); c(k) = sinhm./(sig(k).*sig(k).*sinh); % Compute s2(i) = q(i)+q(i+1) and d(i) = (c(i)-c(i+1))/s2(i) % for i = 1:n+1 with d(i) = 0 if s2(i) = 0, and compute % s3(i) = d(i)-d(i+1)+dt(i+1) for i = 1:n. i = 1:n+1; ip1 = i+1; s2 = q(i)+q(ip1); d = zeros(1,n+1); k = find(s2); d(k) = (c(k)-c(k+1))./s2(k); i = 1:n; ip1 = i+1; s3 = d(i)-d(ip1)+dt(ip1); % Compute the coefficients d(i) of p(i) and e(i) of p(i+2) % in the expression for the knot function values at t(i) % for i = 1:n-1. The coefficient of p(i+1) is 1-d(i)-e(i). i = 1:n-1; ip1 = i+1; ip2 = i+2; d = zeros(1,n-1); e = d; k = find(s2(ip1)); d(k) = c(k+2)./(s2(k+1).*s3(k)); e(k) = c(k+1)./(s2(k+1).*s3(k+1)); % Compute the knot function values at t(i), i = 2:n. xk(ip1) = p(1,ip1) - d.*(p(1,ip1)-p(1,i)) + ... e.*(p(1,ip2)-p(1,ip1)); yk(ip1) = p(2,ip1) - d.*(p(2,ip1)-p(2,i)) + ... e.*(p(2,ip2)-p(2,ip1)); if nd == 3 zk(ip1) = p(3,ip1) - d.*(p(3,ip1)-p(3,i)) + ... e.*(p(3,ip2)-p(3,ip1)); end % Compute the derivative vectors at t(i), i = 2:n. d(k) = q(k+2)./(s2(k+1).*s3(k)); e(k) = q(k+1)./(s2(k+1).*s3(k+1)); xp(ip1) = d.*(p(1,ip1)-p(1,i)) + e.*(p(1,ip2)-p(1,ip1)); yp(ip1) = d.*(p(2,ip1)-p(2,i)) + e.*(p(2,ip2)-p(2,ip1)); if nd == 3 zp(ip1) = d.*(p(3,ip1)-p(3,i)) + e.*(p(3,ip2)-p(3,ip1)); end % Compute the endpoint knot values. if per xk(1) = xk(n); yk(1) = yk(n); xp(1) = xp(n); yp(1) = yp(n); if nd == 3 zk(1) = zk(n); zp(1) = zp(n); end else xk(1) = x(1) - bv1(1)*dt(2)/3; yk(1) = y(1) - bv1(2)*dt(2)/3; xp(1) = bv1(1); yp(1) = bv1(2); xk(n) = x(n) + bvn(1)*dt(n)/3; yk(n) = y(n) + bvn(2)*dt(n)/3; xp(n) = bvn(1); yp(n) = bvn(2); if nd == 3 zk(1) = z(1) - bv1(3)*dt(2)/3; zp(1) = bv1(3); zk(n) = z(n) + bvn(3)*dt(n)/3; zp(n) = bvn(3); end end % Perturb xp so that all components are significant relative % to the corresponding components of xk. This is necessary % to avoid divide-by-zero warnings in calls to quiver3. k = find(xp == 0); xp(k) = 4*eps(xk(k)); return; end % bsp2h function yp = endslp(x1,x2,x3,y1,y2,y3,sigma) % endslp: Endpoint first derivative estimate % % USAGE: yp = endslp(x1,x2,x3,y1,y2,y3,sigma); % % Given data values associated with a strictly increasing % or decreasing sequence of three abscissae X1, X2, and X3, % this function returns a derivative estimate at X1 based on % the tension spline H(x) that interpolates the data points % and has third derivative equal to zero at X1. Letting S1 % denote the slope defined by the first two points, the est- % mate is obtained by constraining the derivative of H at X1 % so that it has the same sign as S1 and its magnitude is % at most 3*abs(S1). If SIGMA = 0, H(x) is quadratic and % the derivative estimate is identical to the value computed % by Function YPC1 at the first point (or the last point % if the abscissae are decreasing). % % On input: % % X1,X2,X3 = Abscissae satisfying either X1 < X2 < X3 % or X1 > X2 > X3. % % Y1,Y2,Y3 = Data values associated with the abscis- % sae. H(X1) = Y1, H(X2) = Y2, and H(X3) % = Y3. % % SIGMA = Tension factor associated with H in inter- % val (X1,X2) or (X2,X1). % % On output: % % YP = (Constrained) derivative of H at X1, or zero % if the abscissae are not strictly monotonic. % % Module required by ENDSLP: SNHCSH % %*********************************************************** dx1 = x2 - x1; dxs = x3 - x1; if (dx1*(dxs-dx1) <= 0) yp = 0; return; end sg1 = abs(sigma); if (sg1 < 1.e-9) % SIGMA = 0: H is the quadratic interpolant. t = (dx1/dxs)^2; else sigs = sg1*dxs/dx1; if (sigs <= 0.5) % % 0 < SIG1 < SIGS <= .5: compute approximations to % COSHM1 = COSH(SIG1)-1 and COSHMS = COSH(SIGS)-1. % [dummy,coshm1] = snhcsh(sg1); [dummy,coshms] = snhcsh(sigs); t = coshm1/coshms; else % % SIGS > .5: compute T = COSHM1/COSHMS. % t = exp(sg1-sigs)*((1.0-exp(-sg1))/ ... (1.0-exp(-sigs)))^2; end end % The derivative of H at X1 is % T = ((Y3-Y1)*COSHM1-(Y2-Y1)*COSHMS)/ % (DXS*COSHM1-DX1*COSHMS). % % ENDSLP = T unless T*S1 < 0 or abs(T) > 3*abs(S1). t = ((y3-y1)*t-y2+y1)/(dxs*t-dx1); s1 = (y2-y1)/dx1; if (s1 >= 0) yp = min([max([0.0, t]), 3.0*s1]); else yp = max([min([0.0, t]), 3.0*s1]); end return; end % endslp function [x,y,z,ier] = h2bsp(nd,t,xk,yk,zk,sigma,per,bv1,bvn) % h2bsp: Convert a tension spline from Hermite to B-spline form % % USAGE: [x,y,z,ier] = h2bsp(nd,t,xk,yk,zk,sigma,per,bv1,bvn); % % Given a sequence of knots, knot function values, and % tension factors defining a parametric tension spline curve, % this function computes a sequence of control points for % which the corresponding B-spline curve interpolates the % knot function values. The control points p_j, j = 1:n are % obtained by solving the linear equations % % B_{i-3}(t_i)*p_{i-1} + B_{i-2}(t_i)*p_i + % B_{i-1}(t_i)*p_{i+1} = C(t_i) % % for i = 3:N-1 (periodic end conditions) or i = 3:N-2 % (interpolatory end conditions), along with two end % end conditions, where B_j is a C^2 tension B-spline basis % function with support on the open interval (t_j,t_{j+4}) % and triple zeros at the endpoints, and C(t_i) is the knot % function value. % % In the case of periodic end conditions (a closed curve % with C(t_1) = C(t_N)), p_1 = p_N and the first and last % equations are % % B_0(t_2)*p_2 + B_1(t_2)*p_3 + % B_{-1}(t_2)*p_N = C(t_2), and % % B_{N-1}(t_N)*p_2 + B_{N-3}(t_N)*p_{N-1} + % B_{N-2}(t_N)*p_N = C(t_N). % % This is an order-(N-1) nonsymmetric almost tridiagonal % linear system (with nonzero elements in the lower left % and upper right corners) for each component of the N-1 % control points. % % In the case of interpolatory end conditions, we define % % p_1 = C(t_1) + bv1*(t_2-t_1)/3 and % p_N = C(t_N) - bvn*(t_N-t_{N-1})/3 % % for user-specified endpoint derivative vectors bv1 and % bvn, and the first and last equations are % % B_0(t_2)*p_2 + B_1(t_2)*p_3 = C(t_2) - % B_{-1}(t_2)*p_1, and % % B_{N-4}(t_{N-1})*p_{N-2} + B_{N-3}(t_{N-1})*p_{N-1} = % C(t_{N-1}) - B_{N-2}(t_{N-1})*p_{N+1}. % % This is an order-(N-2) nonsymmetric tridiagonal linear % system for each component of the N-2 unknown control % points. % % Refer to Function BSP2H for a means of converting a % B-spline curve to Hermite form. % % On input: % % ND = Number of dimensions: % ND = 2 if a planar curve is to be converted. % ND = 3 if a space curve is to be converted. % % T = Vector of length N containing a non-decreasing % sequence of knots. These might be computed as % cumulative polygonal chord lengths between the % knot function values: Functions ARCL2D and % ARCL3D. N >= 2 and N >= 4 if PER = TRUE. % % XK,YK,ZK = Vectors of length N containing the % Cartesian coordinates of an ordered % sequence of knot function values C(t_i) % for t_i = T(i), i = 1 to N. ZK is an % unused dummy parameter if ND = 2. In the % case of a closed curve (PER = TRUE), the % first and last points should coincide. % % SIGMA = Vector of length N-1 containing tension % factors. SIGMA(i) is associated with inter- % val (T(i),T(i+1)) for i = 1 to N-1. If % SIGMA(i) = 0, C(t) is cubic, and as SIGMA % increases, C(t) approaches linear on the % interval. % % PER = Logical variable with value TRUE if and only % C(t) is a parametric periodic function with % period T(N)-T(1) corresponding to a closed % curve. It is assumed without a test that the % first and last knot function values coincide % in this case. On output, X(1) = X(N), Y(1) = % Y(N), and if ND = 3, Z(1) = Z(N). % % BV1,BVN = Vectors of length ND containing endpoint % derivative vectors if PER = FALSE, or % unused dummy parameters otherwise. % % On output: % % X,Y,Z = Row vectors of length N containing the % control points p(t_i) for t_i = T(i), % i = 1 to N. (Z = 0 if ND = 2.) % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = 1 if ND or N is outside its valid range. % IER = 2 if T is not non-decreasing. % % Modules required by H2BSP: SNHCSH, TRISOLVE, TRISOLVP % %*********************************************************** n = length(t); x = zeros(1,n); y = x; z = x; % Test for errors, and compute knot interval lengths dt % associated with interpolatory end conditions. if nd < 2 || nd > 3 || n < 2 || (n < 4 && per) ier = 1; return; end t = t(:)'; dt = [0 diff(t) 0 0]; if any(dt < 0) ier = 2; return; end ier = 0; % Store tension factors sig in 1-1 correspondence with the % n+2 knot intervals, again assuming nonperiodic end % conditions. sig = [sigma(1) sigma(:)' sigma(n-1) sigma(n-1)]; % Store knot function values as the rows of an n-1 by nd % or n-2 by nd array d (right hand side vectors). xk = xk(:); yk = yk(:); if nd == 3 zk = zk(:); end if ~per if nd == 2 d = [xk(2:n-1) yk(2:n-1)]; else d = [xk(2:n-1) yk(2:n-1) zk(2:n-1)]; end else if nd == 2 d = [xk(2:n) yk(2:n)]; else d = [xk(2:n) yk(2:n) zk(2:n)]; end % Alter the endpoint values of dt and sig for periodic % end conditions. dt(1) = dt(n); dt(n+1) = dt(2); dt(n+2) = dt(3); sig(1) = sig(n); sig(n+1) = sig(2); sig(n+2) = sig(3); end % Store sdt = sig.*dt and compute functions % % q = coshm(sdt)/(sig.*sinh(sdt)), % c = sinhm(sdt)/(sig.^2.*sinh(sdt)), % % on the n+2 intervals. sdt = sig.*dt; q = zeros(1,n+2); c = q; % Components with sig = 0 or dt = 0: k = find(sdt < 1.e-9); q(k) = 0.5*dt(k); c(k) = dt(k).^2/6; % Components with 0 < sdt < 0.5: k = find(sdt >= 1.e-9 & sdt <= 0.5); [sinhm,coshm] = snhcsh(sdt(k)); sinh = sinhm + sdt(k); q(k) = coshm./(sig(k).*sinh); c(k) = sinhm./(sig(k).*sig(k).*sinh); % Components with sdt > 0.5: scale sinhm, coshm, and sinh % by 2*exp(-sdt) to avoid overflow. k = find(sdt > 0.5); ems = exp(-sdt(k)); sinh = 1.0 - ems.*ems; sinhm = sinh - 2.0*sdt(k).*ems; coshm = (1.0-ems).^2; q(k) = coshm./(sig(k).*sinh); c(k) = sinhm./(sig(k).*sig(k).*sinh); % Compute s2(i) = q(i)+q(i+1) and b(i) = (c(i)-c(i+1))/s2(i) % for i = 1:n+1 with b(i) = 0 if s2(i) = 0, and compute % s3(i) = b(i)-b(i+1)+dt(i+1) for i = 1:n. i = 1:n+1; ip1 = i+1; s2 = q(i)+q(ip1); b = zeros(1,n+1); k = find(s2); b(k) = (c(k)-c(k+1))./s2(k); i = 1:n; ip1 = i+1; s3 = b(i)-b(ip1)+dt(ip1); if n > 2 % Store the matrix diagonals in a, b, and e. % The nonzero corner elements (periodic case) are l and u. a = zeros(n-2,1); e = a; l = 0; u = 0; i = 3:n; k = find(s2(i)); a(k) = c(k+3)./(s2(k+2).*s3(k+1)); i = 2:n-1; k = find(s2(i)); e(k) = c(k+1)./(s2(k+1).*s3(k+1)); if s2(2) u = c(3)/(s2(2)*s3(1)); end i = 2:n-2; b = [1-u-e(1); 1-a(i-1)-e(i)]; end if per % Solve the order-(n-1) system for p_i, i = 2:n, stored in % the n-1 by nd array d, and store the solution in x, y, % and z with p_1 = p_n. if s2(n) l = c(n)/(s2(n)*s3(n)); end b(n-1) = 1-a(n-2)-l; d = trisolvp(a,b,e,d,l,u); x = [d(n-1,1); d(:,1)]'; y = [d(n-1,2); d(:,2)]'; if nd == 3 z = [d(n-1,3); d(:,3)]'; end else if n > 2 % Solve the order-(n-2) system for p(i), i = 2:n-1, stored % in the n-2 by nd array d. d(1,1) = d(1,1) - u*(xk(1) + bv1(1)*dt(2)/3); d(1,2) = d(1,2) - u*(yk(1) + bv1(2)*dt(2)/3); d(n-2,1) = d(n-2,1) - e(n-2)*(xk(n) - bvn(1)*dt(n)/3); d(n-2,2) = d(n-2,2) - e(n-2)*(yk(n) - bvn(2)*dt(n)/3); if nd == 3 d(1,3) = d(1,3) - u*(zk(1) + bv1(3)*dt(2)/3); d(n-2,3) = d(n-2,3) - e(n-2)*(zk(n) - bvn(3)*dt(n)/3); end a(n-2) = []; e(n-2) = []; d = trisolve(a,b,e,d); end % Store the solution d, along with p_1 and p_n, in x, y, and z. x = [xk(1) + bv1(1)*dt(2)/3; d(:,1); xk(n) - bvn(1)*dt(n)/3]'; y = [yk(1) + bv1(2)*dt(2)/3; d(:,2); yk(n) - bvn(2)*dt(n)/3]'; if nd == 3 z = [zk(1) + bv1(3)*dt(2)/3; d(:,3); zk(n) - bvn(3)*dt(n)/3]'; end end return; end % h2bsp function [hppp,ier] = hpppval(t,x,y,yp,sigma) % hpppval: Third derivative of Hermite interpolatory tension spline % % USAGE: [hppp,ier] = hpppval(t,x,y,yp,sigma); % % This function evaluates the third derivative HPPP of a % Hermite interpolatory tension spline H at one or more % points. % % On input: % % T = Point or vector of points at which HPPP is to be % evaluated. Extrapolation is performed if T < % X(1) or T > X(N). % % X = Vector of length N containing the abscissae. % These must be in strictly increasing order: % X(I) < X(I+1) for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values. % H(X(I)) = Y(I) for I = 1 to N. % % YP = Vector of length N containing first deriva- % tives. HP(X(I)) = YP(I) for I = 1 to N, where % HP denotes the derivative of H. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % On output: % % HPPP = Column vector of length(T) containing third % derivative values HPPP(T), or zeros if IER % < 0. % % IER = Optional error indicator: % IER = 0 if no errors were encountered and % X(1) <= T <= X(N) for all components % of T. % IER = 1 if no errors were encountered and % extrapolation was necessary. % IER = -1 if the abscissae are not in strictly % increasing order. (This error will % not necessarily be detected.) % % Module required by HPPPVAL: SNHCSH % %*********************************************************** global SBIG % Convert all input row vectors to column vectors. t = t(:); x = x(:); y = y(:); yp = yp(:); sigma = sigma(:); n = length(x); m = size(t); hppp = zeros(m); % Find the index vector I of the left endpoints of the intervals % containing the elements of T. If T < X(1) or T > X(N), % extrapolation is performed using the leftmost or rightmost % interval. i = ones(m); for j = 2:n-1 i(x(j) <= t) = j; end if (nargout > 1) ier = any(t < x(1)) || any(t > x(n)); end % Compute interval widths DX, local coordinates B1 and B2, % and second differences D1 and D2. ip1 = i + 1; dx = x(ip1) - x(i); if (nargout > 1 && any(dx <= 0)) ier = -1; return; end b1 = (x(ip1) - t)./dx; b2 = 1.0 - b1; s = (y(ip1)-y(i))./dx; d1 = s - yp(i); d2 = yp(ip1) - s; sig = abs(sigma(i)); % For SIG = 0, H is the Hermite cubic interpolant. k = find(sig < 1.e-9); hppp(k) = 6.0*(d2(k)-d1(k))./dx(k).^2; % For 0 < SIG <= .5, use approximations designed to avoid % cancellation error in the hyperbolic functions. k = find(sig >= 1.e-9 & sig <= 0.5); sb2 = sig(k).*b2(k); [sm,cm,cmm] = snhcsh(sig(k)); [sm2,cm2] = snhcsh(sb2); sinh2 = sm2 + sb2; cosh2 = cm2 + 1.0; e = sig(k).*sm - cmm - cmm; hppp(k) = sig(k).*sig(k).*((cm.*cosh2-sm.*sinh2).*(d1(k)+d2(k)) + ... sig(k).*(cm.*sinh2-(sm+sig(k)).*cosh2).*d1(k))./ ... (dx(k).*dx(k).*e); % For SIG > .5, use negative exponentials in order to avoid % overflow. Note that EMS = EXP(-SIG). In the case of % extrapolation (negative B1 or B2), H is approximated by % a linear function if -SIG*B1 or -SIG*B2 is large. k = find(sig > 0.5); sb1 = sig(k).*b1(k); sb2 = sig(k) - sb1; k1 = find(-sb1 > SBIG | -sb2 > SBIG); k2 = k(k1); hppp(k2) = 0; k1 = setdiff((1:length(k)),k1); k = k(k1); e1 = exp(-sb1(k1)); e2 = exp(-sb2(k1)); ems = e1.*e2; tm = 1.0 - ems; e = tm.*(sig(k).*(1.0+ems) - tm - tm); hppp(k) = sig(k).*sig(k).*(sig(k).*((e1.*ems-e2).*d1(k)+(e1-e2.*ems).* ... d2(k))-tm.*(e1-e2).*(d1(k)+d2(k)))./(dx(k).*dx(k).*e); return; end % hpppval function [hpp,ier] = hppval(t,x,y,yp,sigma) % hppval: Second derivative of Hermite interpolatory tension spline % % USAGE: [hpp,ier] = hppval(t,x,y,yp,sigma); % % This function evaluates the second derivative HPP of a % Hermite interpolatory tension spline H at one or more % points. % % On input: % % T = Point or vector of points at which HPP is to be % evaluated. Extrapolation is performed if T < % X(1) or T > X(N). % % X = Vector of length N containing the abscissae. % These must be in strictly increasing order: % X(I) < X(I+1) for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values. % H(X(I)) = Y(I) for I = 1 to N. % % YP = Vector of length N containing first deriva- % tives. HP(X(I)) = YP(I) for I = 1 to N, where % HP denotes the derivative of H. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % On output: % % HPP = Column vector of length(T) containing second % derivative values HPP(T), or zeros if IER < 0. % % IER = Optional error indicator: % IER = 0 if no errors were encountered and % X(1) <= T <= X(N) for all components % of T. % IER = 1 if no errors were encountered and % extrapolation was necessary. % IER = -1 if the abscissae are not in strictly % increasing order. (This error will % not necessarily be detected.) % % Module required by HPPVAL: SNHCSH % %*********************************************************** global SBIG % Convert all input row vectors to column vectors. t = t(:); x = x(:); y = y(:); yp = yp(:); sigma = sigma(:); n = length(x); m = size(t); hpp = zeros(m); % Find the index vector I of the left endpoints of the intervals % containing the elements of T. If T < X(1) or T > X(N), % extrapolation is performed using the leftmost or rightmost % interval. i = ones(m); for j = 2:n-1 i(x(j) <= t) = j; end if (nargout > 1) ier = any(t < x(1)) || any(t > x(n)); end % Compute interval widths DX, local coordinates B1 and B2, % and second differences D1 and D2. ip1 = i + 1; dx = x(ip1) - x(i); if (nargout > 1 && any(dx <= 0)) ier = -1; return; end b1 = (x(ip1) - t)./dx; b2 = 1.0 - b1; s = (y(ip1)-y(i))./dx; d1 = s - yp(i); d2 = yp(ip1) - s; sig = abs(sigma(i)); % For SIG = 0, H is the Hermite cubic interpolant. k = find(sig < 1.e-9); hpp(k) = (d1(k) + d2(k) + 3.0.*(b2(k)-b1(k)).*(d2(k)-d1(k)))./dx(k); % For 0 < SIG <= .5, use approximations designed to avoid % cancellation error in the hyperbolic functions. k = find(sig >= 1.e-9 & sig <= 0.5); sb2 = sig(k).*b2(k); [sm,cm,cmm] = snhcsh(sig(k)); [sm2,cm2] = snhcsh(sb2); sinh2 = sm2 + sb2; cosh2 = cm2 + 1.0; e = sig(k).*sm - cmm - cmm; hpp(k) = sig(k).*((cm.*sinh2-sm.*cosh2).*(d1(k)+d2(k)) + ... sig(k).*(cm.*cosh2-(sm+sig(k)).*sinh2).*d1(k))./ ... (dx(k).*e); % For SIG > .5, use negative exponentials in order to avoid % overflow. Note that EMS = EXP(-SIG). In the case of % extrapolation (negative B1 or B2), H is approximated by % a linear function if -SIG*B1 or -SIG*B2 is large. k = find(sig > 0.5); sb1 = sig(k).*b1(k); sb2 = sig(k) - sb1; k1 = find(-sb1 > SBIG | -sb2 > SBIG); k2 = k(k1); hpp(k2) = 0; k1 = setdiff((1:length(k)),k1); k = k(k1); e1 = exp(-sb1(k1)); e2 = exp(-sb2(k1)); ems = e1.*e2; tm = 1.0 - ems; e = tm.*(sig(k).*(1.0+ems) - tm - tm); hpp(k) = sig(k).*(sig(k).*((e1.*ems+e2).*d1(k)+(e1+e2.*ems).*d2(k))- ... tm.*(e1+e2).*(d1(k)+d2(k)))./(dx(k).*e); return; end % hppval function [hp,ier] = hpval(t,x,y,yp,sigma) % hpval: First derivative of Hermite interpolatory tension spline % % USAGE: [hp,ier] = hpval(t,x,y,yp,sigma); % % This function evaluates the first derivative HP of a % Hermite interpolatory tension spline H at one or more % points % % On input: % % T = Point or vector of points at which HP is to be % evaluated. Extrapolation is performed if T < % X(1) or T > X(N). % % X = Vector of length N containing the abscissae. % These must be in strictly increasing order: % X(I) < X(I+1) for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values. % H(X(I)) = Y(I) for I = 1 to N. % % YP = Vector of length N containing first deriva- % tives. HP(X(I)) = YP(I) for I = 1 to N. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % On output: % % HP = Column vector of length(T) containing deriva- % tive values HP(T), or zeros if IER < 0. % % IER = Optional error indicator: % IER = 0 if no errors were encountered and % X(1) <= T <= X(N) for all components % of T. % IER = 1 if no errors were encountered and % extrapolation was necessary. % IER = -1 if the abscissae are not in strictly % increasing order. (This error will % not necessarily be detected.) % % Module required by HPVAL: SNHCSH % %*********************************************************** global SBIG % Convert all input row vectors to column vectors. t = t(:); x = x(:); y = y(:); yp = yp(:); sigma = sigma(:); n = length(x); m = size(t); hp = zeros(m); % Find the index vector I of the left endpoints of the intervals % containing the elements of T. If T < X(1) or T > X(N), % extrapolation is performed using the leftmost or rightmost % interval. i = ones(m); for j = 2:n-1 i(x(j) <= t) = j; end if (nargout > 1) ier = any(t < x(1)) || any(t > x(n)); end % Compute interval widths DX, local coordinates B1 and B2, % and second differences D1 and D2. ip1 = i + 1; dx = x(ip1) - x(i); if (nargout > 1 && any(dx <= 0)) ier = -1; return; end b1 = (x(ip1) - t)./dx; b2 = 1.0 - b1; s1 = yp(i); s = (y(ip1)-y(i))./dx; d1 = s - s1; d2 = yp(ip1) - s; sig = abs(sigma(i)); % For SIG = 0, H is the Hermite cubic interpolant. k = find(sig < 1.e-9); hp(k) = s1(k) + b2(k).*(d1(k) + d2(k) - 3.0*b1(k).*(d2(k)-d1(k))); % For 0 < SIG <= .5, use approximations designed to avoid % cancellation error in the hyperbolic functions. k = find(sig >= 1.e-9 & sig <= 0.5); sb2 = sig(k).*b2(k); [sm,cm,cmm] = snhcsh(sig(k)); [sm2,cm2] = snhcsh(sb2); sinh2 = sm2 + sb2; e = sig(k).*sm - cmm - cmm; hp(k) = s1(k) + ((cm.*cm2-sm.*sinh2).*(d1(k)+d2(k)) + ... sig(k).*(cm.*sinh2-(sm+sig(k)).*cm2).*d1(k))./e; % For SIG > .5, use negative exponentials in order to avoid % overflow. Note that EMS = EXP(-SIG). In the case of % extrapolation (negative B1 or B2), H is approximated by % a linear function if -SIG*B1 or -SIG*B2 is large. k = find(sig > 0.5); sb1 = sig(k).*b1(k); sb2 = sig(k) - sb1; k1 = find(-sb1 > SBIG | -sb2 > SBIG); k2 = k(k1); hp(k2) = s(k2); k1 = setdiff((1:length(k)),k1); k = k(k1); e1 = exp(-sb1(k1)); e2 = exp(-sb2(k1)); ems = e1.*e2; tm = 1.0 - ems; e = tm.*(sig(k).*(1.0+ems) - tm - tm); hp(k) = s(k) + (tm.*((e2-e1).*(d1(k)+d2(k)) + tm.*(d1(k)-d2(k))) + ... sig(k).*((e1.*ems-e2).*d1(k) + (e1-e2.*ems).*d2(k)))./e; return; end % hpval function [h,ier] = hval(t,x,y,yp,sigma) % hval: Evaluation of Hermite interpolatory tension spline % % USAGE: [h,ier] = hval(t,x,y,yp,sigma); % % This function evaluates a Hermite interpolatory tension % spline H at a set of points T. % % On input: % % T = Point or vector of points at which H is to be % evaluated. Extrapolation is performed if T < % X(1) or T > X(N). % % X = Vector of length N containing the abscissae. % These must be in strictly increasing order: % X(I) < X(I+1) for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values. % H(X(I)) = Y(I) for I = 1 to N. % % YP = Vector of length N containing first deriva- % tives. HP(X(I)) = YP(I) for I = 1 to N, where % HP denotes the derivative of H. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % On output: % % H = Column vector of length(T) containing function % values H(T), or zeros if IER < 0. % % IER = Optional error indicator: % IER = 0 if no errors were encountered and % X(1) <= T <= X(N) for all components % of T. % IER = 1 if no errors were encountered and % extrapolation was necessary. % IER = -1 if the abscissae are not in strictly % increasing order. (This error will % not necessarily be detected.) % % Module required by HVAL: SNHCSH % %*********************************************************** global SBIG % Convert all input row vectors to column vectors. t = t(:); x = x(:); y = y(:); yp = yp(:); sigma = sigma(:); n = length(x); m = size(t); h = zeros(m); % Find the index vector I of the left endpoints of the intervals % containing the elements of T. If T < X(1) or T > X(N), % extrapolation is performed using the leftmost or rightmost % interval. i = ones(m); for j = 2:n-1 i(x(j) <= t) = j; end if (nargout > 1) ier = any(t < x(1)) || any(t > x(n)); end % Compute interval widths DX, local coordinates B1 and B2, % and second differences D1 and D2. ip1 = i + 1; dx = x(ip1) - x(i); if (nargout > 1 && any(dx <= 0)) ier = -1; return; end u = t - x(i); b2 = u./dx; b1 = 1.0 - b2; y1 = y(i); s1 = yp(i); s = (y(ip1)-y1)./dx; d1 = s - s1; d2 = yp(ip1) - s; sig = abs(sigma(i)); % For SIG = 0, H is the Hermite cubic interpolant. k = find(sig < 1.e-9); h(k) = y1(k) + u(k).*(s1(k) + b2(k).*(d1(k) + b1(k).*(d1(k)-d2(k)))); % For 0 < SIG <= .5, use approximations designed to avoid % cancellation error in the hyperbolic functions. k = find(sig >= 1.e-9 & sig <= 0.5); sb2 = sig(k).*b2(k); [sm,cm,cmm] = snhcsh(sig(k)); [sm2,cm2] = snhcsh(sb2); e = sig(k).*sm - cmm - cmm; h(k) = y1(k) + s1(k).*u(k) + ... dx(k).*((cm.*sm2-sm.*cm2).*(d1(k)+d2(k)) + ... sig(k).*(cm.*cm2-(sm+sig(k)).*sm2).*d1(k))./(sig(k).*e); % For SIG > .5, use negative exponentials in order to avoid % overflow. Note that EMS = EXP(-SIG). In the case of % extrapolation (negative B1 or B2), H is approximated by % a linear function if -SIG*B1 or -SIG*B2 is large. k = find(sig > 0.5); sb1 = sig(k).*b1(k); sb2 = sig(k) - sb1; k1 = find(-sb1 > SBIG | -sb2 > SBIG); k2 = k(k1); h(k2) = y1(k2) + s(k2).*u(k2); k1 = setdiff((1:length(k)),k1); k = k(k1); e1 = exp(-sb1(k1)); e2 = exp(-sb2(k1)); ems = e1.*e2; tm = 1.0 - ems; ts = tm.*tm; tp = 1.0 + ems; e = tm.*(sig(k).*tp - tm - tm); h(k) = y1(k) + s(k).*u(k) + ... dx(k).*(tm.*(tp-e1-e2).*(d1(k)+d2(k)) + ... sig(k).*((e2+ems.*(e1-2.0)-b1(k).*ts).*d1(k)+ ... (e1+ems.*(e2-2.0)-b2(k).*ts).*d2(k)))./(sig(k).*e); return; end % hval function i = intrvl(t,x) % intrvl: Finds interval containing a point % % USAGE: i = intrvl(t,x); % % This function returns the index of the left end of an % interval (defined by an increasing sequence X) that % contains the value T. The method consists of first test- % ing the interval returned by a previous call, if any, and % then using a binary search if necessary. % % On input: % % T = Point to be located. % % X = Vector of length N assumed (without a test) to % contain a strictly increasing sequence of % values. N >= 2. % % On output: % % I = Index defined as follows: % % I = 1 if T < X(2) or N <= 2, % I = N-1 if T >= X(N-1), and % X(I) <= T < X(I+1) otherwise. % % Modules required by INTRVL: None % %*********************************************************** persistent il n = length(x); if (isempty(il)), il = 1; end if (il >= 1 && il < n) if (x(il) <= t && t < x(il+1)) i = il; return; end end % Initialize low and high indexes. il = 1; ih = n; % Binary search: while (true) if (ih <= il+1) i = il; return; end k = (il+ih)/2.0; if (t < x(k)) ih = k; else il = k; end end % while end % intrvl function [sig,ier] = sig0(x1,x2,y1,y2,y1p,y2p,ifl,hbnd,tol) % sig0: Minimum tension factor for bound on function values % % USAGE: [sig,ier] = sig0(x1,x2,y1,y2,y1p,y2p,ifl,hbnd,tol); % % Given a pair of abscissae with associated ordinates and % slopes, this function determines the smallest (nonnega- % tive) tension factor SIG such that the Hermite interpo- % latory tension spline H(x), defined by SIG and the data, % is bounded (either above or below) by HBND for all x in % (X1,X2). % % On input: % % X1,X2 = Abscissae. X1 < X2. % % Y1,Y2 = Values of H at X1 and X2. % % Y1P,Y2P = Derivative values of H at X1 and X2. % % IFL = Option indicator: % IFL = -1 if HBND is a lower bound on H. % IFL = 1 if HBND is an upper bound on H. % % HBND = Bound on H. If IFL = -1, HBND <= min(Y1, % Y2). If IFL = 1, HBND >= max(Y1,Y2). % % TOL = Nonnegative tolerance for the zero finder when % nonzero finite tension is necessary and % sufficient to satisfy the constraint. Use % TOL = 0 for full accuracy. % % On output: % % SIG = Minimum tension factor defined above unless % IER < 0, in which case SIG = -1. If IER = % 1, SIG = SBIG, resulting in an approximation % to the linear interpolant of the endpoint % values. % % IER = Error indicator: % IER = 0 if no errors were encountered and the % constraint can be satisfied with fin- % ite tension. % IER = 1 if no errors were encountered but SIG % > SBIG is required to satisfy the % constraint. % IER = -1 if X2 <= X1 or abs(IFL) ~= 1. % IER = -2 if HBND is outside its valid range % on input. % % Module required by SIG0: SNHCSH % %*********************************************************** global SBIG % Set fid = 1 to print diagnostic error messages. fid = -1; % Test for error 1. dx = x2 - x1; if (abs(ifl) ~= 1.0 || dx <= 0) sig = -1.0; ier = -1; return; end % Test for a valid constraint. if ( (ifl < 0 && min([y1,y2]) < hbnd) || ... (ifl > 0 && hbnd < max([y1,y2])) ) sig = -1.0; ier = -2; return; end % Test for infinite tension required. s1 = y1p; s2 = y2p; if ((y1 == hbnd && ifl*s1 > 0) || ... (y2 == hbnd && ifl*s2 < 0)) sig = SBIG; ier = 1; return; end % Test for SIG = 0 sufficient. sig = 0; ier = 0; if (ifl*s1 <= 0 && ifl*s2 >= 0), return; end % Compute coefficients A0 and B0 of the Hermite cubic in- % terpolant H0(x) = Y2 - DX*(S2*R + B0*R^2 + A0*R^3/3) % where R = (X2-x)/DX. s = (y2-y1)/dx; t0 = 3.0*s - s1 - s2; a0 = 3.0*(s-t0); b0 = t0 - s2; d0 = t0*t0 - s1*s2; % H0 has local extrema in (X1,X2) iff S1*S2 < 0 or % (T0*(S1+S2) < 0 and D0 >= 0). if (s1*s2 >= 0 && (t0*(s1+s2) >= 0 || d0 < 0)), return; end if (a0 == 0) % H0 is quadratic and has an extremum at R = -S2/(2*B0). % H0(R) = Y2 + DX*S2^2/(4*B0). Note that A0 = 0 im- % plies 2*B0 = S1-S2, and S1*S2 < 0 implies B0 ~= 0. % Also, the extremum is a min iff HBND is a lower bound. f0 = (hbnd - y2 - dx*s2*s2/(4.0*b0))*ifl; else % A0 ~= 0 and H0 has extrema at R = (-B0 +/- SQRT(D0))/ % A0 = S2/(-B0 -/+ SQRT(D0)), where the negative root % corresponds to a min. The expression for R is chosen % to avoid cancellation error. H0(R) = Y2 + DX*(S2*B0 + % 2*D0*R)/(3*A0). t = -b0 - sign(b0)*sqrt(d0); r = t/a0; if (ifl*b0 > 0), r = s2/t; end f0 = (hbnd - y2 - dx*(s2*b0+2.0*d0*r)/(3.0*a0))*ifl; end % F0 >= 0 iff SIG = 0 is sufficient to satisfy the % constraint. if (f0 >= 0), return; end % Find a zero of F = FSIG0(SIG) = (BND-H(R))*RF where the % derivative of H, HP, vanishes at R. F is generally a % nondecreasing function with F(0) < 0 and F = FMAX for % SIG sufficiently large. % % Store shared variables needed by nested function fsig0. fmax = min([abs(y1-hbnd), abs(y2-hbnd)]); d2 = s2 - s; d1pd2 = s2 - s1; nit = -1; f = fsig0(SBIG); if (fid > 0 && ifl < 0) fprintf(fid,['\n\n SIG0 (lower bound): F(0) = %15.8e, ', ... 'F(SBIG) = %15.8e\n', repmat(' ',1,46), ... 'for SBIG = %15.8e\n'], f0, f, SBIG); elseif (fid > 0 && ifl > 0) fprintf(fid,['\n\n SIG0 (upper bound): F(0) = %15.8e, ', ... 'F(SBIG) = %15.8e\n', repmat(' ',1,46), ... 'for SBIG = %15.8e\n'], f0, f, SBIG); end if f <= 0 sig = SBIG; ier = 1; return; end % [0,SBIG] is a bracketing interval. nit = 0; tol = max(tol,eps); options = optimset('TolX',tol); sig = fzero(@fsig0,[0 SBIG],options); return; function f = fsig0(sig) % Nested function for evaluation of F. if sig == 0 f = f0; return; end ems = exp(-sig); if (sig <= 0.5) % SIG <= .5: use approximations designed to avoid can- % cellation error (associated with small % SIG) in the modified hyperbolic functions. [sinhm,coshm,coshmm] = snhcsh(sig); c1 = sig*coshm*d2 - sinhm*d1pd2; c2 = sig*(sinhm+sig)*d2 - coshm*d1pd2; a = c2 - c1; aa = a/ems; e = sig*sinhm - coshmm - coshmm; else % SIG > .5: scale SINHM and COSHM by 2*EXP(-SIG) in order % to avoid overflow. tm = 1.0 - ems; ssinh = tm*(1.0+ems); ssm = ssinh - 2.0*sig*ems; scm = tm*tm; c1 = sig*scm*d2 - ssm*d1pd2; c2 = sig*ssinh*d2 - scm*d1pd2; aa = 2.0*(sig*tm*d2 + (tm-sig)*d1pd2); a = ems*aa; e = sig*ssinh - scm - scm; end % HP(R) = S2 - (C1*SINH(SIG*R) - C2*COSHM(SIG*R))/E = 0 % for ESR = (-B +/- SQRT(D))/A = C/(-B -/+ SQRT(D)), % where ESR = EXP(SIG*R), A = C2-C1, D = B^2 - A*C, and % B and C are defined below. b = e*s2 - c2; c = c2 + c1; d = b*b - a*c; f = 0; if (aa*c ~= 0 || b ~= 0), f = fmax; end if ((aa*c ~= 0 || b ~= 0) && d >= 0) t1 = sqrt(d); t = -b - sign(b)*t1; rsig = 0; if (ifl*b < 0 && aa ~= 0) if (t/aa > 0), rsig = sig + log(t/aa); end end if ((ifl*b > 0 || aa == 0) && c/t > 0), rsig = log(c/t); end if ((rsig > 0 && rsig < sig) || b == 0) % H(R) = Y2 - DX*(B*SIG*R + C1 + RF*SQRT(D))/(SIG*E). f = (hbnd - y2 + dx*(b*rsig+c1+ifl*t1)/(sig*e))*ifl; end end % Update the number of iterations NIT. nit = nit + 1; if (fid > 0 && nit > 0) fprintf(fid,' %0.0f: SIG = %15.8e, F = %15.8e\n', nit, sig, f); end return; end end % sig0 function [sig,ier] = sig1(x1,x2,y1,y2,y1p,y2p,ifl,hpbnd,tol) % sig1: Minimum tension factor for bound on first derivative % % USAGE: [sig,ier] = sig1(x1,x2,y1,y2,y1p,y2p,ifl,hpbnd,tol); % % Given a pair of abscissae with associated ordinates and % slopes, this function determines the smallest (nonnega- % tive) tension factor SIG such that the derivative HP(x) % of the Hermite interpolatory tension spline H(x), defined % by SIG and the data, is bounded (either above or below) % by HPBND for all x in (X1,X2). % % On input: % % X1,X2 = Abscissae. X1 < X2. % % Y1,Y2 = Values of H at X1 and X2. % % Y1P,Y2P = Values of HP at X1 and X2. % % IFL = Option indicator: % IFL = -1 if HPBND is a lower bound on HP. % IFL = 1 if HPBND is an upper bound on HP. % % HPBND = Bound on HP. If IFL = -1, HPBND <= % min(Y1P,Y2P,S) for S = (Y2-Y1)/(X2-X1). If % IFL = 1, HPBND >= max(Y1P,Y2P,S). % % TOL = Nonnegative tolerance for the zero finder when % nonzero finite tension is necessary and % sufficient to satisfy the constraint. Use % TOL = 0 for full accuracy. % % On output: % % SIG = Minimum tension factor defined above unless % IER < 0, in which case SIG = -1. If IER = % 1, SIG = SBIG, resulting in an approximation % to the linear interpolant of the endpoint % values. % % IER = Error indicator: % IER = 0 if no errors were encountered and the % constraint can be satisfied with fin- % ite tension. % IER = 1 if no errors were encountered but SIG % > SBIG is required to satisfy the % constraint. % IER = -1 if X2 <= X1 or abs(IFL) ~= 1. % IER = -2 if HPBND is outside its valid range % on input. % % Module required by SIG1: SNHCSH % %*********************************************************** global SBIG % Set fid = 1 to print diagnostic error messages. fid = -1; % Test for error 1. dx = x2 - x1; if (abs(ifl) ~= 1.0 || dx <= 0) sig = -1.0; ier = -1; return; end s1 = y1p; s2 = y2p; s = (y2-y1)/dx; % Test for a valid constraint. if ( (ifl < 0 && min([s1,s2,s]) < hpbnd) || ... (ifl > 0 && hpbnd < max([s1,s2,s])) ) sig = -1.0; ier = -2; return; end % Test for infinite tension required. if (s == hpbnd && (s1 ~= s || s2 ~= s)) sig = SBIG; ier = 1; return; end % Test for SIG = 0 sufficient. The Hermite cubic interpo- % land H0 has derivative HP0(x) = S2 + 2*B0*R + A0*R^2, % where R = (X2-x)/DX. sig = 0; ier = 0; t0 = 3.0*s - s1 - s2; b0 = t0 - s2; c0 = t0 - s1; a0 = -b0 - c0; % HP0(R) has an extremum (at R = -B0/A0) in (0,1) iff % B0*C0 > 0 and the third derivative of H0 has the % sign of A0. if (b0*c0 <= 0 || a0*ifl > 0), return; end % A0*RF < 0 and HP0(R) = -D0/A0 at R = -B0/A0. d0 = t0*t0 - s1*s2; f0 = (hpbnd + d0/a0)*ifl; if (f0 >= 0), return; end % Find a zero of F = FSIG1(SIG) = (BND-HP(R))*RF, where HP % has an extremum at R. F has a unique zero, F(0) = F0 % < 0, and F = FMAX = (BND-S)*RF > 0 for SIG sufficiently % large. % % Store shared variables needed by nested function fsig1. fmax = (hpbnd-s)*ifl; d1 = s - s1; d2 = s2 - s; d1pd2 = d1 + d2; nit = -1; f = fsig1(SBIG); if (fid > 0 && ifl < 0) fprintf(fid,['\n\n SIG1 (lower bound): F(0) = %15.8e, ', ... 'F(SBIG) = %15.8e\n', repmat(' ',1,46), ... 'for SBIG = %15.8e\n'], f0, f, SBIG); elseif (fid > 0 && ifl > 0) fprintf(fid,['\n\n SIG1 (upper bound): F(0) = %15.8e, ', ... 'F(SBIG) = %15.8e\n', repmat(' ',1,46), ... 'for SBIG = %15.8e\n'], f0, f, SBIG); end if f <= 0 sig = SBIG; ier = 1; return; end % [0,SBIG] is a bracketing interval. nit = 0; tol = max(tol,eps); options = optimset('TolX',tol); sig = fzero(@fsig1,[0 SBIG],options); return; function f = fsig1(sig) % Nested function for evaluation of F. if sig == 0 f = f0; return; end if (sig <= 0.5) % Use approximations designed to avoid cancellation error % (associated with small SIG) in the modified hyperbolic % functions. [sinhm,coshm,coshmm] = snhcsh(sig); c1 = sig*coshm*d2 - sinhm*d1pd2; c2 = sig*(sinhm+sig)*d2 - coshm*d1pd2; a = c2 - c1; e = sig*sinhm - coshmm - coshmm; else % Scale SINHM and COSHM by 2*EXP(-SIG) in order to avoid % overflow. ems = exp(-sig); ems2 = ems + ems; tm = 1.0 - ems; sinh = tm*(1.0+ems); sinhm = sinh - sig*ems2; coshm = tm*tm; c1 = sig*coshm*d2 - sinhm*d1pd2; c2 = sig*sinh*d2 - coshm*d1pd2; a = ems2*(sig*tm*d2 + (tm-sig)*d1pd2); e = sig*sinh - coshm - coshm; end % The second derivative of H(R) has a zero at EXP(SIG*R) = % SQRT((C2+C1)/A) and R is in (0,1) and well-defined % iff HPP(X1)*HPP(X2) < 0. f = fmax; t1 = a*(c2+c1); if (t1 >= 0) if (c1*(sig*coshm*d1 - sinhm*d1pd2) < 0) % HP(R) = (B+SIGN(A)*SQRT(A*C))/E at the critical value % of R, where A = C2-C1, B = E*S2-C2, and C = C2+C1. % NOTE THAT RF*A < 0. f = (hpbnd - (e*s2-c2 - ifl*sqrt(t1))/e)*ifl; end end % Update the number of iterations NIT. nit = nit + 1; if (fid > 0 && nit > 0) fprintf(fid,' %0.0f: SIG = %15.8e, F = %15.8e\n', nit, sig, f); end return; end end % sig1 function [sig,ier] = sig2(x1,x2,y1,y2,y1p,y2p,ifl,tol) % sig2: Minimum tension factor for convexity % % USAGE: [sig,ier] = sig2(x1,x2,y1,y2,y1p,y2p,ifl,tol); % % Given a pair of abscissae with associated ordinates and % slopes, this function determines the smallest (nonnega- % tive) tension factor SIG such that the Hermite interpo- % latory tension spline H(x) preserves convexity (or con- % cavity) of the data; i.e., % % Y1P <= S <= Y2P implies HPP(x) >= 0 or % Y1P >= S >= Y2P implies HPP(x) <= 0 % % for all x in the open interval (X1,X2), where S = (Y2-Y1)/ % (X2-X1) and HPP denotes the second derivative of H. Note, % however, that infinite tension is required if Y1P = S or % Y2P = S (unless Y1P = Y2P = S). % % On input: % % X1,X2 = Abscissae. X1 < X2. % % Y1,Y2 = Values of H at X1 and X2. % % Y1P,Y2P = Derivative values of H at X1 and X2. % % IFL = Option indicator (sign of HPP): % IFL = -1 if HPP is to be bounded above by 0. % IFL = 1 if HPP is to be bounded below by 0 % (preserve convexity of the data). % % TOL = Tolerance whose magnitude determines how close % SIG is to its optimal value when nonzero % finite tension is necessary and sufficient to % satisfy convexity or concavity. In the case % of convexity, SIG is chosen so that 0 <= % HPPMIN <= abs(TOL), where HPPMIN is the min- % imum value of HPP in the interval. In the % case of concavity, the maximum value of HPP % satisfies -abs(TOL) <= HPPMAX <= 0. Thus, % the constraint is satisfied but possibly with % more tension than necessary. % % On output: % % SIG = Tension factor defined above unless IER < 0, % in which case SIG = -1. If IER = 1, SIG % is set to SBIG, resulting in an approximation % to the linear interpolant of the endpoint % values. Note, however, that SIG may be % larger than SBIG if IER = 0. % % IER = Error indicator: % IER = 0 if no errors were encountered and fin- % ite tension is sufficient to satisfy % the constraint. % IER = 1 if no errors were encountered but in- % finite tension is required to satisfy % the constraint. % IER = -1 if X2 <= X1 or abs(IFL) ~= 1. % IER = -2 if the constraint cannot be satis- % fied: the sign of S-Y1P or Y2P-S % does not agree with IFL. % % Module required by SIG2: SNHCSH % %*********************************************************** global SBIG % Set fid = 1 to print diagnostic error messages. fid = -1; % Test for error 1. dx = x2 - x1; if (abs(ifl) ~= 1.0 || dx <= 0) sig = -1.0; ier = -1; return; end % Compute the slope and second differences, and test for % an invalid constraint. s = (y2-y1)/dx; d1 = s - y1p; d2 = y2p - s; if ((ifl > 0 && min([d1,d2]) < 0) || ... (ifl < 0 && max([d1,d2]) > 0)) sig = -1.0; ier = -2; return; end % Test for infinite tension required. if (d1*d2 == 0 && d1 ~= d2) sig = SBIG; ier = 1; return; end % Test for SIG = 0 sufficient. sig = 0; ier = 0; if (d1*d2 == 0), return; end t = max([d1/d2,d2/d1]); if (t <= 2.0), return; end % Find a zero of F(SIG) = SIG*COSHM(SIG)/SINHM(SIG) - (T+1). % Since the derivative of F vanishes at the origin, a % quadratic approximation is used to obtain an initial % estimate for the Newton method. tp1 = t + 1.0; sig = sqrt(10.0*t-20.0); nit = 0; if fid > 0 fprintf(fid,'\n\n SIG2: F(0) = %15.8e\n', tp1); end % Compute an absolute tolerance FTOL = abs(TOL) and a % relative tolerance RTOL = 1000*MACHEPS. ftol = abs(tol); rtol = 1000.0*eps; % Top of loop. while (true) if (sig <= 0.5) % Evaluate F and its derivative FP. % Use approximations designed to avoid cancellation error % in the hyperbolic functions. [sinhm,coshm] = snhcsh(sig); t1 = coshm/sinhm; fp = t1 + sig*(sig/sinhm - t1*t1 + 1.0); else % Scale SINHM and COSHM by 2*exp(-SIG) in order to avoid % overflow. ems = exp(-sig); ssm = 1.0 - ems*(ems+sig+sig); t1 = (1.0-ems)*(1.0-ems)/ssm; fp = t1 + sig*(2.0*sig*ems/ssm - t1*t1 + 1.0); end f = sig*t1 - tp1; nit = nit + 1; if (fid > 0) fprintf(fid,' %0.0f: SIG = %15.8e, F = %15.8e\n', nit, sig, f); end % Test for convergence. if (fp <= 0), return; end dsig = -f/fp; if (abs(dsig) <= rtol*sig || (f >= 0 && f <= ftol) || ... abs(f) <= rtol), return; end % Update SIG. sig = sig + dsig; end % while end % sig2 function [sigma,icflg,dsmax,ier] = sigbi(x,y,yp,tol,b,bmax,sigma) % sigbi: Minimum tension for constrained interpolant % % USAGE: [sigma,icflg,dsmax,ier] = sigbi(x,y,yp,tol,b,bmax,sigma); % % Given a set of abscissae X with associated data values Y % and derivatives YP, this function determines the small- % est (nonnegative) tension factors SIGMA such that the Her- % mite interpolatory tension spline H(x) satisfies a set of % user-specified constraints. % % SIGBI may be used in conjunction with Function YPC2 % (or YPC2P) in order to produce a C-2 interpolant that % satisfies the constraints. This is achieved by calling % YPC2 with SIGMA initialized to the zero vector, and then % alternating calls to SIGBI with calls to YPC2 until the % change in SIGMA is small (refer to the parameter descrip- % tions for SIGMA, DSMAX and IER), or the maximum relative % change in YP is bounded by a tolerance (a reasonable value % is .01). A similar procedure may be used to produce a C-2 % shape-preserving smoothing curve (Function SMCRV). % % Refer to Function SIGS for a means of selecting mini- % mum tension factors to preserve shape properties of the % data. % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values (or % function values computed by SMCRV) associated % with the abscissae. H(X(I)) = Y(I) for I = % 1 to N. % % YP = Vector of length N containing first derivatives % of H at the abscissae. Refer to Functions % YPC1, YPC1P, YPC2, YPC2P, and SMCRV. % % TOL = Tolerance whose magnitude determines how close % each tension factor is to its optimal value % when nonzero finite tension is necessary and % sufficient to satisfy a constraint. Refer to % functions SIG0, SIG1, and SIG2. TOL should be % set to 0 for optimal tension. % % B = Array dimensioned 5 by N-1 containing bounds or % flags which define the constraints. For I = 1 % to N-1, column I defines the constraints associ- % ated with interval I (X(I),X(I+1)) as follows: % % B(1,I) is an upper bound on H % B(2,I) is a lower bound on H % B(3,I) is an upper bound on HP % B(4,I) is a lower bound on HP % B(5,I) specifies the required sign of HPP % % where HP and HPP denote the first and second % derivatives of H, respectively. A null con- % straint is specified by abs(B(K,I)) >= BMAX % for K < 5, or B(5,I) = 0: B(1,I) >= BMAX, % B(2,I) <= -BMAX, B(3,I) >= BMAX, B(4,I) <= % -BMAX, or B(5,I) = 0. Any positive value of % B(5,I) specifies that H should be convex, a % negative values specifies that H should be con- % cave, and 0 specifies that no restriction be % placed on HPP. Refer to Functions SIG0, SIG1, % and SIG2 for definitions of valid constraints. % % BMAX = User-defined value of infinity which, when % used as an upper bound in B (or when its % negative is used as a lower bound), specifies % that no constraint is to be enforced. % % SIGMA = Vector of length N-1 containing minimum val- % ues of the tension factors. SIGMA(I) is as- % sociated with interval (I,I+1) and SIGMA(I) % >= 0 for I = 1 to N-1. SIGMA should be % set to the zero vector if minimal tension % is desired, and should be unchanged from a % previous call in order to ensure convergence % of the C-2 iterative procedure. % % On output: % % SIGMA = Array containing tension factors for which % H(x) satisfies the constraints defined by B, % with the restriction that SIGMA(I) <= SBIG % for all I (unless the input value is larger). % The factors are as small as possible (within % the tolerance), but not less than their % input values. If infinite tension is re- % quired in interval (X(I),X(I+1)), then % SIGMA(I) = SBIG (and H is an approximation % to the linear interpolant on the interval), % and if no constraint is specified in the % interval, then SIGMA(I) = 0 (unless the % input value is positive), and thus H is % cubic. Invalid constraints are treated as % null constraints. % % ICFLG = Array of size 1 by N-1 containing invalid % constraint flags associated with intervals. % For I = 1 to N-1, ICFLG(I) is a 5-bit value % b5b4b3b2b1, where bK = 1 if and only if % constraint K cannot be satisfied. Thus, all % constraints in interval I are satisfied if % and only if ICFLG(I) = 0 (and IER >= 0). % % DSMAX = Maximum increase in a component of SIGMA % from its input value. The increase is a % relative change if the input value is % positive, and an absolute change otherwise. % % IER = Error indicator and information flag: % IER = I if no errors (other than invalid con- % straints) were encountered and I % components of SIGMA were altered from % their input values for 0 <= I <= % N-1. % IER = -1 if N < 2. SIGMA is not altered, and % ICFLG = 0 in this case. % IER = -I if X(I) <= X(I-1) for some I in the % range 2 to N. SIGMA(J) is not % altered, and ICFLG(J) = 0 for J >= % I-1 in this case. % % Modules required by SIGBI: SIG0, SIG1, SIG2, SNHCSH % %*********************************************************** global SBIG % Initialize change counter IER and maximum change DSMAX, and % test for n < 2. ier = 0; dsmax = 0; n = length(x); icflg = zeros(1,n-1); if (n < 2) ier = -1; return; end % Loop on subintervals. for i = 1:n-1 if (x(i) >= x(i+1)) ier = -(i+1); return; end % Loop on constraints for interval I. SIG is set to the % largest tension factor required to satisfy all five % constraints. ICFK = 2**(K-1) is the increment for % ICFLG(I) when constraint K is invalid. sig = 0; icfk = 0.5; for k = 1:5 icfk = 2*icfk; bnd = b(k,i); if (k < 5 && abs(bnd) >= bmax), continue, end if (k <= 2) ifl = 3 - 2*k; [s,ierr] = sig0(x(i),x(i+1),y(i),y(i+1),yp(i),yp(i+1), ... ifl,bnd,tol); elseif (k <= 4) ifl = 7 - 2*k; [s,ierr] = sig1(x(i),x(i+1),y(i),y(i+1),yp(i),yp(i+1), ... ifl,bnd,tol); else if (bnd == 0), continue, end ifl = -1; if (bnd > 0), ifl = 1; end [s,ierr] = sig2(x(i),x(i+1),y(i),y(i+1),yp(i),yp(i+1), ... ifl,tol); end if (ierr == -2) % An invalid constraint was encountered. Increment ICFLG(I). icflg(i) = icflg(i) + icfk; else % Update SIG. sig = max([sig,s]); end % Bottom of loop on constraints K. end % Bottom of loop on intervals: update SIGMA(I), IER, and % DSMAX if necessary. sig = min([sig,SBIG]); sigin = sigma(i); if (sig > sigin) sigma(i) = sig; ier = ier + 1; dsig = sig-sigin; if (sigin > 0), dsig = dsig/sigin; end dsmax = max([dsmax,dsig]); end end % No errors (other than invalid constraints) encountered. return; end % sigbi function [sigma,dsmax,ier] = sigbp(x,y,xp,yp,tol,bl,bu,bmax,sigma) % sigbp: Minimum tension for constrained planar curve % % USAGE: [sigma,dsmax,ier] = sigbp(x,y,xp,yp,tol,bl,bu,bmax,sigma); % % Given an ordered sequence of points C(I) = (X(I),Y(I)) % with associated derivative vectors CP(I) = (XP(I),YP(I)), % this function determines the smallest (nonnegative) ten- % sion factors SIGMA such that a parametric planar curve % C(t) satisfies a set of user-specified constraints. The % components x(t) and y(t) of C(t) are the Hermite interpo- % latory tension splines defined by the data and tension % factors: C(t(I)) = C(I) and C'(t(I)) = CP(I) for para- % meter values t(1), t(2), ..., t(N). In each subinterval % [t1,t2], the signed perpendicular distance from the % corresponding line segment C1-C2 to the curve C(t) is % given by the vector cross product % % d(t) = (C2-C1)/DC X (C(t)-C1) % % where DC = abs(C2-C1) is the length of the line segment. % The associated tension factor SIGMA is chosen to satisfy % an upper bound on the maximum of d(t) and a lower bound on % the minimum of d(t) over t in [t1,t2]. Thus, the upper % bound is associated with distance to the left of the line % segment as viewed from C1 toward C2. Note that the curve % is assumed to be parameterized by arc length (Function % ARCL2D) so that t2-t1 = DC. If this is not the case, the % required bounds should be scaled by DC/(t2-t1) to obtain % the input parameters BL and BU. % % SIGBP may be used in conjunction with Function YPC2 % (or YPC2P) in order to produce a C-2 interpolant that % satisfies the constraints. This is achieved by calling % YPC2 with SIGMA initialized to the zero vector, and then % alternating calls to SIGBP with calls to YPC2 until the % change in SIGMA is small (refer to the parameter descrip- % tions for SIGMA, DSMAX and IER), or the maximum relative % change in YP is bounded by a tolerance (a reasonable value % is .01). % % On input: % % X,Y = Vectors of length N containing the Cartesian % coordinates of the points C(I), I = 1 to N. % N >= 2. % % XP,YP = Vectors of length N containing the components % of the derivative (velocity) vectors CP(I). % Refer to Functions YPC1, YPC1P, YPC2, % YPC2P, and SMCRV. % % TOL = Nonnegative tolerance for the zero finder when % nonzero finite tension is necessary and % sufficient to satisfy the constraint. Use % TOL = 0 for full accuracy. % % BL,BU = Vectors of length N-1 containing lower and % upper bounds, respectively, which define % the constraints as described above. BL(I) % < 0 and BU(I) > 0 for I = 1 to N-1. A null % straint is specified by BL(I) <= -BMAX or % BU(I) >= BMAX. % % BMAX = User-defined value of infinity which, when % used as an upper bound in BU (or when its % negative is used as a lower bound in BL), % specifies that no constraint is to be en- % forced. % % SIGMA = Vector of length N-1 containing minimum val- % ues of the tension factors. SIGMA(I) is as- % sociated with interval (I,I+1) and SIGMA(I) % >= 0 for I = 1 to N-1. SIGMA should be % set to the zero vector if minimal tension % is desired, and should be unchanged from a % previous call in order to ensure convergence % of the C-2 iterative procedure. % % On output: % % SIGMA = Array containing tension factors for which % d(t) satisfies the constraints defined by % BL and BU, with the restriction that % SIGMA(I) <= SBIG for all I (unless the input % value is larger). The factors are as small % as possible (within the tolerance), but not % less than their input values. If no con- % straint is specified in interval I, then % SIGMA(I) = 0 (unless the input value is % positive), and thus x(t) and y(t) are cubic % polynomials. % % DSMAX = Maximum increase in a component of SIGMA % from its input value. The increase is a % relative change if the input value is % positive, and an absolute change otherwise. % % IER = Error indicator and information flag: % IER = I if no errors were encountered and I % components of SIGMA were altered from % their input values for 0 <= I <= % N-1. % IER = -1 if N < 2. SIGMA is not altered in % this case. % IER = -I if BL(I-1) >= 0 or BU(I-1) <= 0 % for some I in the range 2 to N. % SIGMA(J) is unaltered for J >= I-1 % in this case. % % Module required by SIGBP: SNHCSH % %*********************************************************** global SBIG % Set fid = 1 to print diagnostic error messages. fid = -1; % Initialize change counter IER and maximum change DSMAX, and % test for n < 2. ier = 0; dsmax = 0; n = length(x); if (n < 2) ier = -1; return; end % Compute options for fzero. tol = max(tol,eps); options = optimset('TolX',tol); % Loop on subintervals. for i = 1:n-1 ip1 = i + 1; blo = bl(i); bhi = bu(i); sigin = sigma(i); if (fid > 0) fprintf(fid,['\n\n SIGBP: Interval %0.0f, BL = %10.3e, ', ... 'BU = %10.3e, SIGIN = %15.8e\n'], i, blo, bhi, sigin); end if (blo >= 0 || bhi <= 0) ier = -(ip1); return; end if (sigin >= SBIG), continue, end % Initialize SIG to 0 and test for a null constraint. sig = 0; if (blo <= -bmax && bhi >= bmax) % Update SIGMA(I), IER, and DSMAX if necessary, and continue % to the next subinterval. if (sig > sigin) sigma(i) = sig; ier = ier + 1; dsig = sig-sigin; if (sigin > 0), dsig = dsig/sigin; end dsmax = max([dsmax,dsig]); end continue end % Test for SIG = 0 sufficient. % % The signed orthogonal distance is d(b) = b*(1-b)* % (b*V1 - (1-b)*V2), where b = (t2-t)/(t2-t1), % V1 = (C2-C1) X CP(1), and V2 = (C2-C1) X CP(2). dx = x(ip1) - x(i); dy = y(ip1) - y(i); v1 = dx*yp(i) - dy*xp(i); v2 = dx*yp(ip1) - dy*xp(ip1); % Set DP and DM to the maximum and minimum values of d(b) % for b in [0,1]. Note that DP >= 0 and DM <= 0. s = v1 + v2; if (s == 0) % The derivative d'(b) is zero at the midpoint b = .5. if (v1 >= 0) dp = v1/4.0; dm = 0; else dp = 0; dm = v1/4.0; end else % Set RP/RM to the roots of the quadratic equation d'(b) = % (B0 +/- SQRT(D0))/(3*S) = V2/(B0 -/+ SQRT(D0)) = 0, % where B0 = V1 + 2*V2 and D0 = V1^2 + V1*V2 + V2^2. % The expression is chosen to avoid cancellation error. b0 = s + v2; d0 = s*s - v1*v2; t = b0 + sign(b0)*sqrt(d0); if (b0 >= 0) rp = t/(3.0*s); rm = v2/t; else rp = v2/t; rm = t/(3.0*s); end if (v1 <= 0 && v2 >= 0) % The maximum is DP = 0 at the endpoints. dp = 0; else dp = rp*(1.0-rp)*(rp*s - v2); end if (v1 >= 0 && v2 <= 0) % The minimum is DM = 0 at the endpoints. dm = 0; else dm = rm*(1.0-rm)*(rm*s - v2); end end % SIG = 0 is sufficient to satisfy the constraints iff % DP <= BHI and DM >= BLO iff F0 >= 0. f0 = min([bhi-dp, dm-blo]); if (f0 >= 0) % Update SIGMA(I), IER, and DSMAX if necessary, and continue % to the next subinterval. if (sig > sigin) sigma(i) = sig; ier = ier + 1; dsig = sig-sigin; if (sigin > 0), dsig = dsig/sigin; end dsmax = max([dsmax,dsig]); end continue end % Find a zero of F(SIG) = min(BHI-DP,DM-BLO), where DP and % DM are the maximum and minimum values of d(b). F is an % increasing function, F(0) = F0 < 0, and F = FMAX = % min(BHI,-BLO) for SIG sufficiently large. Note that F % has a discontinuity in its first derivative if the % curves BHI-DP and DM-BLO (as functions of SIG) inter- % sect, and the rate of convergence of the zero finder is % reduced to linear if such an intersection occurs near % the zero of F. % % Store shared variables needed by nested function fsigbp. fmax = min([bhi,-blo]); v2m1 = v2 - v1; nit = -1; f = fsigbp(SBIG); if (fid > 0) fprintf(fid,[' F(0) = %15.8e, F(SBIG) = %15.8e, ', ... 'FMAX = %15.8e\n\n'], f0, f, fmax); end if f <= 0 sig = SBIG; else % [0,SBIG] is a bracketing interval. nit = 0; sig = fzero(@fsigbp,[0,SBIG],options); end % Bottom of loop on intervals: update SIGMA(I), IER, and % DSMAX if necessary. if (sig > sigin) sigma(i) = sig; ier = ier + 1; dsig = sig-sigin; if (sigin > 0), dsig = dsig/sigin; end dsmax = max([dsmax,dsig]); end end % No errors encountered. return; function f = fsigbp(sig) % Nested function for evaluation of F. if sig == 0 f = f0; return; end ems = exp(-sig); if (sig <= 0.5) % SIG <= .5: use approximations designed to avoid can- % cellation error (associated with small % SIG) in the modified hyperbolic functions. [sinhm,coshm,coshmm] = snhcsh(sig); sinh = sinhm + sig; a1 = sig*coshm*v2 - sinhm*v2m1; a2 = sig*sinh*v2 - coshm*v2m1; a = a2 - a1; aa = a/ems; e = sig*sinhm - coshmm - coshmm; else % SIG > .5: scale SINHM and COSHM by 2*EXP(-SIG) in order % to avoid overflow. tm = 1.0 - ems; sinh = tm*(1.0+ems); sinhm = sinh - 2.0*sig*ems; coshm = tm*tm; a1 = sig*coshm*v2 - sinhm*v2m1; a2 = sig*sinh*v2 - coshm*v2m1; aa = 2.0*(sig*tm*v2 + (tm-sig)*v2m1); a = ems*aa; e = sig*sinh - coshm - coshm; end if (s == 0) % The derivative d'(b) is zero at the midpoint b = .5. eb = sig*coshm - sinhm - sinhm; if (v1 >= 0) dp = e*v1/(sig*(sqrt(eb*eb-e*e)+eb)); dm = 0; else dp = 0; dm = e*v1/(sig*(sqrt(eb*eb-e*e)+eb)); end f = min([bhi-dp, dm-blo]); else % d'(b)*DC = V2 - (A1*sinh(SIG*b) - A2*coshm(SIG*b))/E = 0 % for ESB = (-B +/- sqrt(D))/A = C/(-B -/+ sqrt(D)), % where ESB = exp(SIG*b), A = A2-A1, D = B^2 - A*C, and % B and C are defined below. b = -coshm*s; c = a2 + a1; d = b*b - a*c; if (d < 0) f = fmax; else t1 = sqrt(d); t = -b - sign(b)*t1; rsp = 0; if (b < 0 && aa ~= 0) if (t/aa > 0), rsp = sig + log(t/aa); end end if ((b > 0 || aa == 0) && c/t > 0), rsp = log(c/t); end if ((rsp <= 0 || rsp >= sig) && b ~= 0) % The maximum is DP = 0 at the endpoints. dp = 0; else dp = -(b*rsp+a1+t1)/(sig*e); end rsm = 0; if (b > 0 && aa ~= 0) if (t/aa > 0), rsm = sig + log(t/aa); end end if ((b < 0 || aa == 0) && c/t > 0), rsm = log(c/t); end if ((rsm <= 0 || rsm >= sig) && b ~= 0) % The minimum is DM = 0 at the endpoints. dm = 0; else dm = -(b*rsm+a1-t1)/(sig*e); end f = min([bhi-dp, dm-blo]); end end % Update the number of iterations NIT. nit = nit + 1; if (fid > 0 && nit > 0) fprintf(fid,' %0.0f: SIG = %15.8e, F = %15.8e\n', nit, sig, f); end return; end end % sigbp function [sigma,dsmax,ier] = sigs(x,y,yp,tol,sigma) % sigs: Minimum tension for monotonicity and convexity % % USAGE: [sigma,dsmax,ier] = sigs(x,y,yp,tol,sigma); % % Given a set of abscissae X with associated data values Y % and derivatives YP, this function determines the small- % est (nonnegative) tension factors SIGMA such that the Her- % mite interpolatory tension spline H(x) preserves local % shape properties of the data. In an interval (X1,X2) with % data values Y1,Y2 and derivatives YP1,YP2, the properties % of the data are % % Monotonicity: S, YP1, and YP2 are nonnegative or % nonpositive, % and % Convexity: YP1 <= S <= YP2 or YP1 >= S % >= YP2, % % where S = (Y2-Y1)/(X2-X1). The corresponding properties % of H are constant sign of the first and second deriva- % tives, respectively. Note that, unless YP1 = S = YP2, in- % finite tension is required (and H is linear on the inter- % val) if S = 0 in the case of monotonicity, or if YP1 = S % or YP2 = S in the case of convexity. % % SIGS may be used in conjunction with Function YPC2 % (or YPC2P) in order to produce a C-2 interpolant that % preserves the shape properties of the data. This is % achieved by calling YPC2 with SIGMA initialized to the % zero vector, and then alternating calls to SIGS with % calls to YPC2 until the change in SIGMA is small (refer to % the parameter descriptions for SIGMA, DSMAX and IER), or % the maximum relative change in YP is bounded by a toler- % ance (a reasonable value is .01). A similar procedure may % be used to produce a C-2 shape-preserving smoothing curve % (Function SMCRV). % % Refer to Function SIGBI for a means of selecting mini- % mum tension factors to satisfy more general constraints. % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values (or % function values computed by SMCRV) associated % with the abscissae. H(X(I)) = Y(I) for I = % 1 to N. % % YP = Vector of length N containing first derivatives % of H at the abscissae. Refer to Functions % YPC1, YPC1P, YPC2, YPC2P, and SMCRV. % % TOL = Nonnegative tolerance for the zero finder when % nonzero finite tension is necessary and % sufficient to satisfy the constraint. Use % TOL = 0 for full accuracy. % % SIGMA = Vector of length N-1 containing minimum val- % ues of the tension factors. SIGMA(I) is as- % sociated with interval (I,I+1) and SIGMA(I) % >= 0 for I = 1 to N-1. SIGMA should be % set to the zero vector if minimal tension % is desired, and should be unchanged from a % previous call in order to ensure convergence % of the C-2 iterative procedure. % % On output: % % SIGMA = Array containing tension factors for which % H(x) preserves the properties of the data, % with the restriction that SIGMA(I) <= SBIG % for all I (unless the input value is larger). % The factors are as small as possible (within % the tolerance), but not less than their % input values. If infinite tension is re- % quired in interval (X(I),X(I+1)), then % SIGMA(I) = SBIG (and H is an approximation % to the linear interpolant on the interval), % and if neither property is satisfied by the % data, then SIGMA(I) = 0 (unless the input % value is positive), and thus H is cubic in % the interval. % % DSMAX = Maximum increase in a component of SIGMA % from its input value. The increase is a % relative change if the input value is % nonzero, and an absolute change otherwise. % % IER = Error indicator and information flag: % IER = I if no errors were encountered and I % components of SIGMA were altered from % their input values for 0 <= I <= % N-1. % IER = -1 if N < 2. SIGMA is not altered in % this case. % IER = -I if X(I) <= X(I-1) for some I in the % range 2 to N. SIGMA(J-1) is unal- % tered for J = I to N in this case. % % Module required by SIGS: SNHCSH % %*********************************************************** global SBIG % Set fid = 1 to print diagnostic error messages. fid = -1; % Initialize change counter IER and maximum change DSMAX, and % test for n < 2. ier = 0; dsmax = 0; n = length(x); if (n < 2) ier = -1; return; end % Compute an absolute tolerance FTOL = abs(TOL) and a % relative tolerance RTOL = 1000*MACHEPS for the % convexity computation, and compute options for fzero % (used for the monotonicity computation). ftol = abs(tol); rtol = 1000.0*eps; options = optimset('TolX',max(tol,eps)); % Loop on subintervals. for i = 1:n-1 if (fid > 0) fprintf(fid,'\n\n SIGS: Interval %0.0f\n', i); end ip1 = i + 1; dx = x(ip1) - x(i); if (dx <= 0) ier = -ip1; return; end sigin = sigma(i); if (sigin >= SBIG), continue, end % Compute first and second differences. s1 = yp(i); s2 = yp(ip1); s = (y(ip1)-y(i))/dx; d1 = s - s1; d2 = s2 - s; d1d2 = d1*d2; while (true) % Test for infinite tension required to satisfy either % property. sig = SBIG; if ((d1d2 == 0 && s1 ~= s2) || ... (s == 0 && s1*s2 > 0)), break, end % Test for SIGMA = 0 sufficient. The data satisfies convex- % ity iff D1D2 >= 0, and D1D2 = 0 implies S1 = S = S2. sig = 0; if (d1d2 >= 0) if (d1d2 == 0), break, end t = max([d1/d2,d2/d1]); if (t <= 2.0), break, end tp1 = t + 1.0; % Convexity: Find a zero of F(SIG) = SIG*COSHM(SIG)/ % SINHM(SIG) - TP1. % % F(0) = 2-T < 0, F(TP1) >= 0, the derivative of F % vanishes at SIG = 0, and the second derivative of F is % .2 at SIG = 0. A quadratic approximation is used to % obtain a starting point for the Newton method. sig = sqrt(10.0*t-20.0); nit = 0; % Top of loop: while (true) if (sig <= 0.5) [sinhm,coshm] = snhcsh(sig); t1 = coshm/sinhm; fp = t1 + sig*(sig/sinhm - t1*t1 + 1.0); else % Scale SINHM and COSHM by 2*EXP(-SIG) in order to avoid % overflow with large SIG. ems = exp(-sig); ssm = 1.0 - ems*(ems+sig+sig); t1 = (1.0-ems)*(1.0-ems)/ssm; fp = t1 + sig*(2.0*sig*ems/ssm - t1*t1 + 1.0); end f = sig*t1 - tp1; if (fid > 0) fprintf(fid,[' CONVEXITY: SIG = %15.8e, F(SIG) = ', ... '%15.8e\n',repmat(' ',1,35),'FP(SIG) = %15.8e\n'], ... sig, f, fp); end nit = nit + 1; % Test for convergence. if (fp <= 0), break, end dsig = -f/fp; if (abs(dsig) <= rtol*sig || (f >= 0 && f <= ftol) || ... abs(f) <= rtol), break, end % Update SIG. sig = sig + dsig; end break end % Convexity cannot be satisfied. Monotonicity can be satis- % fied iff S1*S >= 0 and S2*S >= 0 since S ~= 0. if (s1*s < 0 || s2*s < 0), break, end t0 = 3.0*s - s1 - s2; d0 = t0*t0 - s1*s2; % SIGMA = 0 is sufficient for monotonicity iff S*T0 >= 0 % or D0 <= 0. if (d0 <= 0 || s*t0 >= 0), break, end % Monotonicity: find a zero of F(SIG) = SIGN(S)*HP(R), % where HPP(R) = 0 and HP, HPP denote derivatives of H. % F has a unique zero, F(0) = F0 < 0, and F approaches % abs(S) as SIG increases. % % Store shared variables needed by nested function fsigs. sgn = sign(s); f0 = sgn*d0/(2*t0-s1-s2); sig = SBIG; fmax = sgn*(sig*s-s1-s2)/(sig-2.0); if (fmax <= 0), break, end d1pd2 = d1 + d2; nit = -1; f = fsigs(SBIG); if (fid > 0) fprintf(fid,['\n MONOTONICITY: F(0) = %15.8e, ', ... 'F(SBIG) = %15.8e\n'], f0, f); end if (f <= 0), break, end % [0,SBIG] is a bracketing interval. nit = 0; sig = fzero(@fsigs,[0,SBIG],options); break; end % while % Update SIGMA(I), IER, and DSMAX if necessary. sig = min([sig, SBIG]); if (sig > sigin) sigma(i) = sig; ier = ier + 1; dsig = sig-sigin; if (sigin > 0), dsig = dsig/sigin; end dsmax = max([dsmax,dsig]); end end % for % No errors encountered. return; function f = fsigs(sig) % Nested function for evaluation of F. if sig == 0 f = f0; return; end if (sig <= 0.5) % Use approximations to the hyperbolic functions designed % to avoid cancellation error with small SIG. [sinhm,coshm,coshmm] = snhcsh(sig); c1 = sig*coshm*d2 - sinhm*d1pd2; c2 = sig*(sinhm+sig)*d2 - coshm*d1pd2; a = c2 - c1; e = sig*sinhm - coshmm - coshmm; f = (sgn*(e*s2-c2) + sqrt(a*(c2+c1)))/e; else % Scale SINHM and COSHM by 2*EXP(-SIG) in order to avoid % overflow with large SIG. ems = exp(-sig); ems2 = ems + ems; tm = 1.0 - ems; ssinh = tm*(1.0+ems); ssm = ssinh - sig*ems2; scm = tm*tm; c1 = sig*scm*d2 - ssm*d1pd2; c2 = sig*ssinh*d2 - scm*d1pd2; % R is in (0,1) and well-defined iff HPP(X1)*HPP(X2) < 0. f = fmax; if (c1*(sig*scm*d1 - ssm*d1pd2) < 0) a = ems2*(sig*tm*d2 + (tm-sig)*d1pd2); if (a*(c2+c1) >= 0) e = sig*ssinh - scm - scm; f = (sgn*(e*s2-c2) + sqrt(a*(c2+c1)))/e; end end end % Update number of iterations NIT. nit = nit + 1; if (fid > 0 && nit > 0) fprintf(fid,[repmat(' ',1,11),'%0.0f: SIG = %15.8e', ... ', F = %15.8e\n'], nit, sig, f); end return; end end % sigs function [sigma,dsmax,ier] = sigsp(nd,t,x,y,z,xp,yp,zp,tol,sigma) % sigsp: Minimum tension for convexity in a parametric curve % % USAGE: [sigma,dsmax,ier] = sigsp(nd,t,x,y,z,xp,yp,zp,tol,sigma); % % Given an ordered sequence of points C(I) = (X(I),Y(I)) % or C(I) = (X(I),Y(I),Z(I)) with associated derivative % vectors CP(I) = (XP(I),YP(I)) or CP(I) = (XP(I),YP(I), % ZP(I)) and knots t(I), this function determines the small- % est (nonnegative) tension factors SIGMA such that the % Hermite interpolatory tension spline curve c(t) preserves % local convexity of the data. % % For knot subinterval [t1,t2], denote the endpoint values % and derivative vectors by c1,c2 and d1,d2, respectively, % and let d = (c2-c1)/h for h = t2-t1. Also, define % e1 = d1 X d and e2 = d X d2. (In the case of a planar % curve, the cross products are z-components and e1,e2 are % scalars.) The data is locally convex if > 0. In % this case the tension factor is made sufficiently large % that the curve segment (when projected onto the plane with % normal e1 or e2) has no inflection point. The curvature % vector is proportional to k(t) = c'(t) X c''(t), and the % requirement for convexity is > 0 and % > 0 for all t in [t1,t2]. It can be shown that a sufficient % condition is positivity at the two endpoints, and this is % equivalent to g(sigma) > 0 for the strictly increasing % function % % g(sigma) = sigma*coshm(sigma)/sinhm(sigma) - m, % % where m = max{/|e1|^2, /, % /, /|e2|^2, 0}. In the % case of a space curve, even with > 0, it is % possible that and could be nega- % tive, resulting in m = 0 and g(sigma) > 0 for sigma = 0. % (g(0) = 3-m). % % Note that the data defines a sign for discrete torsion % on each interval: = = det(d1,d,d2). The % interpolatory tension spline automatically preserves this % property for all values of sigma. % % SIGSP may be used in conjunction with Function YPC2 % (or YPC2P) in order to produce a C-2 interpolant that % preserves the shape properties of the data. This is % achieved by calling YPC2 with SIGMA initialized to the % zero vector, and then alternating calls to SIGSP with % calls to YPC2 until the change in SIGMA is small (refer to % the parameter descriptions for SIGMA, DSMAX and IER), or % the maximum relative change in YP is bounded by a toler- % ance (a reasonable value is .01). % % Refer to Function SIGBP for a means of selecting mini- % mum tension factors to satisfy bounds constraints. % % On input: % % ND = Number of dimensions: % ND = 2 if the points lie in a plane. % ND = 3 if the points are in 3-space. % % T = Vector of length N containing a strictly in- % creasing sequence of knots (discrete parameter % values). Refer to Function ARCL2D or ARCL3D. % N >= 2. % % X,Y,Z = Vectors of length N containing the Cartesian % coordinates of an ordered sequence of data % points C(I), I = 1 to N. The curve is con- % strained to pass through these points: % c(t(I)) = C(I). Z is an unused dummy par- % ameter if ND = 2. % % XP,YP,ZP = Vectors of length N containing the compo- % nents of first derivative vectors CP(I) % for I = 1 to N. Refer to Functions % YPC1T, YPC2, and YPC2P. % % TOL = Nonnegative tolerance for the zero finder when % nonzero finite tension is necessary and % sufficient to satisfy the constraint. Use % TOL = 0 for full accuracy. % % SIGMA = Vector of length N-1 containing minimum % values of the tension factors. SIGMA(I) is % associated with interval (t(I),t(I+1)) and % SIGMA(I) >= 0 for I = 1 to N-1. SIGMA % should be set to the zero vector if minimal % tension is desired, and should be unchanged % from a previous call in order to ensure con- % vergence of the C-2 iterative procedure. % % On output: % % SIGMA = Array containing tension factors for which % Hermite interpolatory tension spline c % preserves local convexity of the data, % with the restriction that SIGMA(I) <= SBIG % for all I (unless the input value is larger). % The factors are as small as possible (within % the tolerance), but not less than their % input values. In interval [t(I),t(I+1)], if % the data is not locally convex (or the end- % point values are not distinct, or either % endpoint derivative vector is zero), then % SIGMA(I) = 0 (unless the input value is pos- % itive), and thus c is cubic in the interval. % % DSMAX = Maximum increase in a component of SIGMA % from its input value. The increase is a % relative change if the input value is % nonzero, and an absolute change otherwise. % % IER = Error indicator and information flag: % IER = I if no errors were encountered and I % components of SIGMA were altered from % their input values for 0 <= I <= % N-1. % IER = -1 if ND or N is outside its valid % range. SIGMA is not altered in % this case. % IER = -I if t(I) <= t(I-1) for some I in the % range 2 to N. SIGMA(J-1) is unal- % tered for J = I to N in this case. % % Module required by SIGSP: SNHCSH % %*********************************************************** global SBIG % Set fid = 1 to print diagnostic error messages. fid = -1; % Initialize change counter IER and maximum change DSMAX, and % test for ND invalid or N < 2. ier = 0; dsmax = 0; n = length(t); if (nd < 2 || nd > 3 || n < 2) ier = -1; return; end % Compute an absolute tolerance FTOL = abs(TOL) and a % relative tolerance RTOL = 1000*MACHEPS. ftol = abs(tol); rtol = 1000.0*eps; % Loop on subintervals. for i = 1:n-1 if (fid > 0) fprintf(fid,'\n\n SIGSP: Interval %0.0f\n', i); end ip1 = i + 1; dt = t(ip1) - t(i); if (dt <= 0) ier = -ip1; return; end sigin = sigma(i); if (sigin >= SBIG), continue, end % Compute parameters for interval [t(i),t(ip1)]. if (nd == 2) d = [x(ip1)-x(i) y(ip1)-y(i)]./dt; d1 = [xp(i) yp(i)]; d2 = [xp(ip1) yp(ip1)]; e1 = d1(1)*d(2) - d1(2)*d(1); e2 = d(1)*d2(2) - d(2)*d2(1); d1cd2 = d1(1)*d2(2) - d1(2)*d2(1); else d = [x(ip1)-x(i) y(ip1)-y(i) z(ip1)-z(i)]./dt; d1 = [xp(i) yp(i) zp(i)]; d2 = [xp(ip1) yp(ip1) zp(ip1)]; e1 = cross(d1,d); e2 = cross(d,d2); d1cd2 = cross(d1,d2); end e1e2 = dot(e1,e2); e1e1 = dot(e1,e1); e2e2 = dot(e2,e2); dde1 = dot(d1cd2,e1); dde2 = dot(d1cd2,e2); while (true) % Test for SIGMA = 0 sufficient. sig = 0; if (e1e2 <= 0), break, end m = max([dde1/e1e1,dde2/e1e2,dde1/e1e2,dde2/e2e2,0]); if (3.0 - m >= 0), break, end % Convexity: Find a zero of F(SIG) = SIG*COSHM(SIG)/ % SINHM(SIG) - m. % % F(0) = 3-m < 0, F(m) >= 0, the derivative of F % vanishes at SIG = 0, and the second derivative of F is % .2 at SIG = 0. A quadratic approximation is used to % obtain a starting point for the Newton method. sig = sqrt(10.0*m-30.0); nit = 0; % Top of loop: while (true) if (sig <= 0.5) [sinhm,coshm] = snhcsh(sig); t1 = coshm/sinhm; fp = t1 + sig*(sig/sinhm - t1*t1 + 1.0); else % Scale SINHM and COSHM by 2*EXP(-SIG) in order to avoid % overflow with large SIG. ems = exp(-sig); ssm = 1.0 - ems*(ems+sig+sig); t1 = (1.0-ems)*(1.0-ems)/ssm; fp = t1 + sig*(2.0*sig*ems/ssm - t1*t1 + 1.0); end f = sig*t1 - m; if (fid > 0) fprintf(fid,[' SIG = %15.8e, F(SIG) = ', ... '%15.8e\n',repmat(' ',1,35),'FP(SIG) = %15.8e\n'], ... sig, f, fp); end nit = nit + 1; % Test for convergence. if (fp <= 0), break, end dsig = -f/fp; if (abs(dsig) <= rtol*sig || (f >= 0 && f <= ftol) || ... abs(f) <= rtol), break, end % Update SIG. sig = sig + dsig; end break end % while % Update SIGMA(I), IER, and DSMAX if necessary. sig = min([sig, SBIG]); if (sig > sigin) sigma(i) = sig; ier = ier + 1; dsig = sig-sigin; if (sigin > 0), dsig = dsig/sigin; end dsmax = max([dsmax,dsig]); end end % for % No errors encountered. return; end % sigsp function [ys,yp,ier] = smcrv(x,y,sigma,period,w,sm,smtol) % smcrv: C^2 smoothing curve % % USAGE: [ys,yp,ier] = smcrv(x,y,sigma,period,w,sm,smtol); % % Given a sequence of abscissae X with associated data % values Y and tension factors SIGMA, this function deter- % mines a set of function values YS and first derivatives YP % associated with a Hermite interpolatory tension spline % H that smoothes the data. H has two continuous deriva- % tives at every point, and satisfies either natural or % periodic end conditions. The values and derivatives are % chosen to minimize a quadratic functional Q1(YS,YP) % subject to the constraint Q2(YS) <= SM for Q2(YS) = % (Y-YS)^T*W*(Y-YS), where ^T denotes transpose, and W is % a diagonal matrix of positive weights. % % Functions HVAL, HPVAL, HPPVAL, HPPVAL, and TSINTL may be % called to compute values, derivatives, and integrals of H. % The function values YS must be used as data values in those % functions. % % The smoothing procedure is an extension of the method % for cubic spline smoothing due to C. Reinsch: Numer. % Math., 10 (1967) and 16 (1971). Q1 is defined as the sum % of integrals over the intervals (X(I),X(I+1)) of HPP^2 + % (SIGMA(I)/DX)^2*(HP-S)^2, where DX = X(I+1)-X(I), HP and % HPP denote first and second derivatives of H, and S = % (YS(I+1)-YS(I))/DX. Introducing a smoothing parameter P, % and assuming the constraint is active, the problem is % equivalent to minimizing Q(P,YS,YP) = Q1(YS,YP) + % P*(Q2(YS)-SM). The procedure consists of finding a zero % of G(P) = 1/SQRT(Q2) - 1/SQRT(SM), where YS and YP satisfy % the order 2N symmetric positive-definite linear system % obtained by setting the gradient of Q (treated as a func- % tion of YS and YP) to zero. % % Note that the interpolation problem corresponding to % YS = Y, SM = 0, and P infinite is solved by Function % YPC2 or YPC2P. % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2 if PERIOD = FALSE, % and N >= 3 if PERIOD = TRUE. % % Y = Vector of length N containing data values assoc- % iated with the abscissae. If PERIOD = TRUE, it % is assumed that Y(N) = Y(1). % % SIGMA = Vector of length N-1 containing tension % factors. SIGMA(I) is associated with inter- % val (X(I),X(I+1)) for I = 1 to N-1. If % SIGMA(I) = 0, H is cubic, and as SIGMA in- % creases, H approaches linear in the inter- % val. % % PERIOD = Periodic end condition flag: % PERIOD = 0 if H is to satisfy natural end % conditions: zero second der- % ivatives at X(1) and X(N). % PERIOD = 1 if H is to satisfy periodic % end conditions: the values % and first two derivatives at % X(1) agree with those at X(N), % and a period thus has length % X(N)-X(1). % % W = Vector of length N containing positive weights % associated with the data values. The recommend- % ed value of W(I) is 1/DY^2, where DY is the % standard deviation associated with Y(I). If % nothing is known about the errors in Y, a con- % stant (estimated value) should be used for DY. % If PERIOD = TRUE, it is assumed that W(N) = % W(1). % % SM = Positive parameter specifying an upper bound on % Q2(YS). H(x) is linear (and Q2 is minimized) % if SM is sufficiently large that the constraint % is not active. It is recommended that SM sat- % isfy N-SQRT(2N) <= SM <= N+SQRT(2N) and % SM = N is reasonable if W(I) = 1/DY^2. % % SMTOL = Parameter in the range (0,1) specifying the % relative error allowed in satisfying the % constraint: the constraint is assumed to % be satisfied if SM*(1-SMTOL) <= Q2 <= % SM*(1+SMTOL). A reasonable value for SMTOL % is SQRT(2/N) for N > 2. % % On output: % % YS = Vector of size(X) containing values of H at the % abscissae unless IER < 0. YS(N) = YS(1) if % PERIOD = TRUE. % % YP = Vector of size(X) containing first derivative % values of H at the abscissae unless IER < 0. % YP(N) = YP(1) if PERIOD = TRUE. % % IER = Error indicator: % IER = 0 if no errors were encountered and the % constraint is active: Q2(YS) is ap- % proximately equal to SM. % IER = 1 if no errors were encountered but the % constraint is not active: YS and YP % are the values and derivatives of the % linear function (constant function if % PERIOD = TRUE) that minimizes Q2, and % Q1 = 0. % IER = -1 if N, W, SM, or SMTOL is outside its % valid range. YS and YP are zeros % in this case. % IER = -I if X(I) <= X(I-1) for some I in the % range 2 to N. YS and YP are zeros % in this case. % % Modules required by SMCRV: B2TRI or B2TRIP, SNHCSH, % YPCOEF % %*********************************************************** % Set fid = 1 to print diagnostic error messages. fid = -1; % Test for errors, and compute the components of the system % (normal equations) for the weighted least squares linear % fit. m = size(x); n = length(x); if (n < 2 || (n < 3 && period) || sm <= 0 || ... smtol <= 0 || smtol >= 1.0 || any(w <= 0)) ys = zeros(m); yp = zeros(m); ier = -1; return; end if (any(x(2:n) <= x(1:n-1))) ys = zeros(m); yp = zeros(m); ier = -(find(x(2:n) <= x(1:n-1), 1) + 1); return; end if (~period) t = w.*x; c11 = sum(t.*x); % Sum(w(i)*x(i)^2) c12 = sum(t); % Sum(w(i)*x(i)) r1 = sum(t.*y); % Sum(w(i)*x(i)*y(i)) end c22 = sum(w); % Sum(w(i)) r2 = sum(w.*y); % Sum(w(i)*y(i)) % Solve the system for (HP,H0), where HP is the derivative % (constant) and H0 = H(0). if (period) h0 = r2/c22; hp = 0; else h0 = (c11*r2-c12*r1)/(c11*c22-c12*c12); hp = (r1 - c12*h0)/c11; end % Store function values and derivatives, and accumulate % Q2 = (Y-YS)^T*W*(Y-YS). ys = hp*x + h0; yp = hp*ones(m); t = y-ys; q2 = dot(t, w.*t); % Test for the constraint satisfied by the linear fit. if q2 <= sm*(1.0 + smtol); % The constraint is satisfied by a linear function. if (fid > 0) fprintf(fid,['\n\n\n SMCRV: The constraint is not ', ... 'active, and the fit is linear.\n\n']); end ier = 1; return; end % Compute the matrix components for the linear system. ier = 0; dx = x(2:n)-x(1:n-1); sig = abs(sigma); if size(sig) ~= size(dx) sig = sig'; end [d,sd] = ypcoef(sig,dx); % Compute G0 = G(0), and print a heading. s = 1.0/sqrt(sm); g0 = 1.0/sqrt(q2) - s; if (fid > 0) fprintf(fid,['\n\n\n SMCRV: SM = %10.4e, SMTOL = %14.8e, ', ... 'G(0) = %15.8e\n\n\n'], sm, smtol, g0); end % G(P) is strictly increasing and concave, and G(0) < 0. % % Initialize parameters for the zero finder. iter = 0; tol = min([(1.0-1.0/sqrt(1.0+smtol))*s, (-1.0+1.0/sqrt(1.0-smtol))*s]); options = optimset('TolX',tol); % Find a bracketing interval g = 0; p = sm; while g <= 0 p = 10.0*p; g = fsmcrv(p); end p = fzero(@fsmcrv,[0,p],options); if (fid > 0) fprintf(fid,'\n P = %15.8e\n', p); end return; function g = fsmcrv(p) % Nested function for evaluation of g. if p == 0 g = g0; return; end if (~period) [ys,yp] = b2tri(x,y,w,p,d,sd); else [ys,yp] = b2trip(x,y,w,p,d,sd); end t = y-ys; q2 = dot(t, w.*t); g = 1.0/sqrt(q2) - s; iter = iter + 1; if (fid > 0) fprintf(fid,'\n %0.0f: P = %15.8e, G = %15.8e\n', ... iter, p, g); end return; end end % smcrv function [sinhm,coshm,coshmm] = snhcsh(x) % snhcsh: Modified hyperbolic function evaluation % % USAGE: [sinhm,coshm,coshmm] = snhcsh(x); % % This function evaluates the modified hyperbolic % functions sinh(x)-x, cosh(x)-1, and cosh(x)-1-x/2 with % machine precision accuracy (relative error bounded by % 3.4E-20 for a floating point number system with % sufficient precision). % % On input: % % X = Point or vector of points at which the functions % are to be evaluated. % % On output: % % SINHM = sinh(X) - X. % % COSHM = cosh(X) - 1. % % COSHMM = cosh(X) - 1 - X*X/2. % % Modules required by SNHCSH: None % %*********************************************************** % Coefficients defining rational approximations for small x. p1 = -3.51754964808151394800e5; p2 = -1.15614435765005216044e4; p3 = -1.63725857525983828727e2; p4 = -7.89474443963537015605e-1; q1 = -2.11052978884890840399e6; q2 = 3.61578279834431989373e4; q3 = -2.77711081420602794433e2; q4 = 1.0; ax = abs(x); xs = ax.*ax; m = size(x); sinhm = zeros(m); coshm = zeros(m); coshmm = zeros(m); % Approximations for small X: k = find(ax <= 0.5); xc = x(k).*xs(k); p = ((p4*xs(k)+p3).*xs(k)+p2).*xs(k)+p1; q = ((q4*xs(k)+q3).*xs(k)+q2).*xs(k)+q1; sinhm(k) = xc.*(p./q); xsd4 = 0.25*xs(k); xsd2 = xsd4 + xsd4; p = ((p4*xsd4+p3).*xsd4+p2).*xsd4+p1; q = ((q4*xsd4+q3).*xsd4+q2).*xsd4+q1; f = xsd4.*(p./q); coshmm(k) = xsd2.*f.*(f+2.0); coshm(k) = coshmm(k) + xsd2; % Approximations for large X: k = find(ax > 0.5); expx = exp(ax(k)); sinhm(k) = -(((1.0./expx+ax(k))+ax(k))-expx)/2.0; k1 = find(x < 0); k1 = intersect(k,k1); sinhm(k1) = -sinhm(k1); coshm(k) = ((1.0./expx-2.0)+expx)/2.0; coshmm(k) = coshm(k) - xs(k)/2.0; return; end % snhcsh function x = trisolve(a,b,c,d) % trisolve: Solution to nonsymmetric tridiagonal linear system % % USAGE: x = trisolve(a,b,c,d); % % This function computes the solution to the equations % % b(1)*x(1) + c(1)*x(2) = d(1) % a(i-1)*x(i-1) + b(i)*x(i) + c(i)*x(i+1) = d(i), i = 2:n-1 % a(n-1)*x(n-1) + b(n)*x(n) = d(n) % % No pivoting is used. % % On input: % % A,B,C = Vectors with lengths n-1, n, and n-1, % respectively, containing the subdiagonal, % diagonal, and superdiagonal of the matrix. % % D = Array dimensioned n by k containing one or more % right hand side vectors. % % On output: % % X = Array of size [n k] containing the solution % vectors. % % Modules required by TRISOLVE: None % %*********************************************************** n = length(b); x = d; for i = 1:n-1 % Forward elimination mu = -a(i)/b(i); b(i+1) = b(i+1) + mu*c(i); x(i+1,:) = x(i+1,:) + mu*x(i,:); end x(n,:) = x(n,:)/b(n); % Back substitution for i = n-1:-1:1 x(i,:) = (x(i,:)-c(i)*x(i+1,:))/b(i); end return; end % trisolve function x = trisolvp(a,b,c,d,l,u) % trisolvp: Solution to nonsymmetric almost tridiagonal linear system % % USAGE: x = trisolvp(a,b,c,d,l,u); % % This function computes the solution to the equations % % b(1)*x(1) + c(1)*x(2) + u*x(n) = d(1) % a(i-1)*x(i-1) + b(i)*x(i) + c(i)*x(i+1) = d(i), i = 2:n-1 % l*x(1) + a(n-1)*x(n-1) + b(n)*x(n) = d(n) % % The matrix is tridiagonal with nonzeros in the upper % right and lower left corners. This arises from periodic % end conditions. No pivoting is used. % % On input: % % A,B,C = Vectors with lengths n-1, n, and n-1, % respectively, containing the subdiagonal, % diagonal, and superdiagonal of the matrix. % % D = Array dimensioned n by k containing one or more % right hand side vectors. % % L,U = Lower left and upper right corner elements of % the matrix. % % On output: % % X = Array of size [n k] containing the solution % vectors. % % Modules required by TRISOLVP: None % %*********************************************************** n = length(b); u = [u; zeros(n-2,1)]; % Extend length(u) to allow fill-in. x = d; for i = 1:n-2 % Forward elimination mu = -a(i)/b(i); b(i+1) = b(i+1) + mu*c(i); u(i+1) = mu*u(i); x(i+1,:) = x(i+1,:) + mu*x(i,:); mu = -l/b(i); l = mu*c(i); b(n) = b(n) + mu*u(i); x(n,:) = x(n,:) + mu*x(i,:); end u(n-1) = u(n-1) + c(n-1); l = l + a(n-1); mu = -l/b(n-1); b(n) = b(n) + mu*u(n-1); x(n,:) = (x(n,:) + mu*x(n-1,:))/b(n); % Back substitution x(n-1,:) = (x(n-1,:)-u(n-1)*x(n,:))/b(n-1); for i = n-2:-1:1 x(i,:) = (x(i,:)-c(i)*x(i+1,:)-u(i)*x(n,:))/b(i); end return; end % trisolvp function [hi,ier] = tsintl(a,b,x,y,yp,sigma) % tsintl: Integral of a Hermite interpolatory tension spline % % USAGE: [hi,ier] = tsintl(a,b,x,y,yp,sigma); % % This function computes the integral from A to B of a % Hermite interpolatory tension spline H. % % On input: % % A,B = Lower and upper limits of integration, respec- % tively. Note that -TSINTL(B,A,...) = % TSINTL(A,B,...). % % X = Vector of length N containing the abscissae. % These must be in strictly increasing order: % X(I) < X(I+1) for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values. % H(X(I)) = Y(I) for I = 1 to N. % % YP = Vector of length N containing first deriva- % tives. HP(X(I)) = YP(I) for I = 1 to N, where % HP denotes the derivative of H. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % On output: % % HI = Integral of H from A to B, or zero if IER < 0. % % IER = Optional error indicator: % IER = 0 if no errors were encountered and % X(1) <= T <= X(N) for T = A and % T = B, or A = B. % IER = 1 if no errors were encountered but % extrapolation was necessary: A or B % is not in the interval (X(1),X(N)). % IER = -1 if the abscissae are not in strictly % increasing order. Only those in or % adjacent to an interval of integra- % tion are tested. % % Modules required by TSINTL: INTRVL, SNHCSH % %*********************************************************** global SBIG n = length(x); % Accumulate the integral from XL to XU in SUM. xl = min([a,b]); xu = max([a,b]); sum = 0; % Find left-end indices of intervals containing XL and XU. % If XL < X(1) or XU > X(N), extrapolation is performed % using the leftmost or rightmost interval. il = intrvl(xl,x); iu = intrvl(xu,x); if (nargout > 1) ier = (xl < x(1) || xu > x(n)); end if (xl == xu) hi = 0; return; end ilp1 = il + 1; % Compute the integral from XL to X(IL+1). dx = x(ilp1) - x(il); if (dx <= 0) hi = 0; ier = -1; return; end u = x(ilp1) - xl; b1 = u/dx; y2 = y(ilp1); s = (y2-y(il))/dx; s2 = yp(ilp1); d1 = s - yp(il); d2 = s2 - s; sig = abs(sigma(il)); if (sig < 1.e-9) % SIG = 0. sum = sum + u*(y2 - u*(6.0*s2 - b1*(4.0*d2 + ... (3.0*b1-4.0)*(d1-d2)))/12.0); elseif (sig <= 0.5) % 0 < SIG <= .5. sb1 = sig*b1; [sm,cm,cmm] = snhcsh(sig); [sm1,cm1,cmm1] = snhcsh(sb1); e = sig*sm - cmm - cmm; sum = sum + u*(y2 - s2*u/2.0) + ((cm*cmm1-sm*sm1)* ... (d1+d2) + sig*(cm*sm1-(sm+sig)*cmm1)*d2)/ ... ((sig/dx)^2*e); else % SIG > .5. sb1 = sig*b1; sb2 = sig - sb1; if (-sb1 > SBIG || -sb2 > SBIG) sum = sum + u*(y2 - s*u/2.0); else e1 = exp(-sb1); e2 = exp(-sb2); ems = e1*e2; tm = 1.0 - ems; tp = 1.0 + ems; t = sb1*sb1/2.0 + 1.0; e = tm*(sig*tp - tm - tm); sum = sum + u*(y2 - s2*u/2.0)+(sig*tm*(tp*t-e1-e2- ... tm*sb1)*d2 - (tm*(tm*t-e1+e2-tp*sb1) + ... sig*(e1*ems-e2+2.0*sb1*ems))*(d1+d2))/ ... ((sig/dx)^2*e); end end % Add in the integral from X(IL+1) to X(J) for J = % Max(IL+1,IU). for i = ilp1:max([il,iu-1]) ip1 = i + 1; dx = x(ip1) - x(i); if (dx <= 0) hi = 0; ier = -1; return; end sig = abs(sigma(i)); if (sig < 1.e-9) % SIG = 0. sum = sum + dx*((y(i)+y(ip1))/2.0 - ... dx*(yp(ip1)-yp(i))/12.0); elseif (sig <= .50) % 0 < SIG <= .5. [sm,cm,cmm] = snhcsh(sig); e = sig*sm - cmm - cmm; sum = sum + dx*(y(i)+y(ip1) - dx*e*(yp(ip1)-yp(i))/ ... (sig*sig*cm))/2.0; else % SIG > .5. ems = exp(-sig); sum = sum + dx*(y(i)+y(ip1) - dx*(sig*(1.0+ems)/ ... (1.0-ems)-2.0)*(yp(ip1)-yp(i))/ ... (sig*sig))/2.0; end end % Add in the integral from X(IU) to XU if IU > IL. if (il < iu) iup1 = iu + 1; dx = x(iup1) - x(iu); if (dx <= 0) hi = 0; ier = -1; return; end u = xu - x(iu); if (u == 0) if (a > b), sum = -sum; end hi = sum; return; end b2 = u/dx; y1 = y(iu); s = (y(iup1)-y1)/dx; s1 = yp(iu); d1 = s - s1; d2 = yp(iup1) - s; sig = abs(sigma(iu)); if (sig < 1.e-9) % SIG = 0. sum = sum + u*(y1 + u*(6.0*s1 + b2*(4.0*d1 + ... (4.0-3.0*b2)*(d1-d2)))/12.0); elseif (sig <= 0.5) % 0 < SIG <= .5. sb2 = sig*b2; [sm,cm,cmm] = snhcsh(sig); [sm2,cm2,cmm2] = snhcsh(sb2); e = sig*sm - cmm - cmm; sum = sum + u*(y1 + s1*u/2.0) + ((cm*cmm2-sm*sm2)* ... (d1+d2) + sig*(cm*sm2-(sm+sig)*cmm2)*d1)/ ... ((sig/dx)^2*e); else % SIG > .5. sb2 = sig*b2; sb1 = sig - sb2; if (-sb1 > SBIG || -sb2 > SBIG) sum = sum + u*(y1 + s*u/2.0); else e1 = exp(-sb1); e2 = exp(-sb2); ems = e1*e2; tm = 1.0 - ems; tp = 1.0 + ems; t = sb2*sb2/2.0 + 1.0; e = tm*(sig*tp - tm - tm); sum = sum + u*(y1 + s1*u/2.0)+(sig*tm*(tp*t-e1-e2- ... tm*sb2)*d1 - (tm*(tm*t-e2+e1-tp*sb2) + ... sig*(e2*ems-e1+2.0*sb2*ems))*(d1+d2))/ ... ((sig/dx)^2*e); end end else % XL and XU are in the same interval (IL = IU), and SUM % contains the integral from XL to X(IL+1). % Subtract off the integral from XU to X(IL+1). % dx = x(ilp1) - x(il); if (dx <= 0) hi = 0; ier = -1; return; end y2 = y(ilp1); s = (y2-y(il))/dx; s2 = yp(ilp1); d1 = s - yp(il); d2 = s2 - s; u = x(ilp1) - xu; if (u == 0) if (a > b), sum = -sum; end hi = sum; return; end b1 = u/dx; sig = abs(sigma(il)); if (sig < 1.e-9) % SIG = 0. sum = sum - u*(y2 - u*(6.0*s2 - b1*(4.0*d2 + ... (3.0*b1-4.0)*(d1-d2)))/12.0); elseif (sig <= 0.5) % 0 < SIG <= .5. sb1 = sig*b1; [sm,cm,cmm] = snhcsh(sig); [sm1,cm1,cmm1] = snhcsh(sb1); e = sig*sm - cmm - cmm; sum = sum - u*(y2 - s2*u/2.0) - ((cm*cmm1-sm*sm1)* ... (d1+d2) + sig*(cm*sm1-(sm+sig)*cmm1)*d2)/ ... ((sig/dx)^2*e); else % SIG > .5. sb1 = sig*b1; sb2 = sig - sb1; if (-sb1 > SBIG || -sb2 > SBIG) sum = sum - u*(y2 - s*u/2.0); else e1 = exp(-sb1); e2 = exp(-sb2); ems = e1*e2; tm = 1.0 - ems; tp = 1.0 + ems; t = sb1*sb1/2.0 + 1.0; e = tm*(sig*tp - tm - tm); sum = sum - u*(y2 - s2*u/2.0)-(sig*tm*(tp*t-e1-e2- ... tm*sb1)*d2 - (tm*(tm*t-e1+e2-tp*sb1) + ... sig*(e1*ems-e2+2.0*sb1*ems))*(d1+d2))/ ... ((sig/dx)^2*e); end end end % No errors were encountered. Adjust the sign of SUM. if (a > b), sum = -sum; end hi = sum; return; end % tsintl function [yp,sigma,icflg,ier,dyp,dsmax] = tspbi(x,y,ncd, ... iendc,per,b,bmax,yp1,ypn) % tspbi: Parameters defining constrained interpolatory tension spline % % USAGE: [yp,sigma,icflg,ier,dyp,dsmax] = tspbi(x,y,ncd, ... % iendc,per,b,bmax,yp1,ypn); % % This function computes a set of parameter values that % define a Hermite interpolatory tension spline H(x). The % parameters consist of knot derivative values YP computed % by Function YPC1, YPC1P, YPC2, or YPC2P, and tension % factors SIGMA chosen to satisfy user-specified constraints % (by Function SIGBI). Refer to Function TSPSI for an % alternative method of computing tension factors. % % Refer to Function TSPSS for a means of computing % parameters that define a smoothing curve rather than an % interpolatory curve. % % The tension spline may be evaluated by Function TSVAL1 % or Functions HVAL (values), HPVAL (first derivatives), % HPPVAL (second derivatives), HPPPVAL (third derivatives), % and TSINTL (integrals). % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2 and N >= 3 if PER = % TRUE. % % Y = Vector of length N containing data values asso- % ciated with the abscissae. H(X(I)) = Y(I) for % I = 1 to N. If NCD = 1 and PER = TRUE, Y(1) % and Y(N) should be identical. % % NCD = Number of continuous derivatives at the knots. % NCD = 1 or NCD = 2. If NCD = 1, the YP values % are computed by local monotonicity-constrained % quadratic fits. Otherwise, a linear system is % solved for the derivative values that result % in second derivative continuity. This re- % quires iterating on calls to YPC2 or YPC2P and % calls to SIGBI, and generally results in more % nonzero tension factors (hence more expensive % evaluation). % % IENDC = End condition indicator for NCD = 2 and PER % = FALSE (or dummy parameter otherwise): % IENDC = 0 if YP(1) and YP(N) are to be com- % puted by monotonicity-constrained % parabolic fits to the first three % and last three points, respective- % ly. This is identical to the % values computed by YPC1. % IENDC = 1 if the first derivatives of H at % X(1) and X(N) are user-specified % in YP1 and YPN, respectively. % IENDC = 2 if the second derivatives of H at % X(1) and X(N) are user-specified % in YP1 and YPN, respectively. % IENDC = 3 if the end conditions are to be % computed by Function ENDSLP and % vary with SIGMA(1) and SIGMA(N-1). % % PER = Logical variable with value TRUE if and only % H(x) is to be a periodic function with period % X(N)-X(1). It is assumed without a test that % Y(N) = Y(1) in this case. On output, YP(N) = % YP(1). If H(x) is one of the components of a % parametric curve, this option may be used to % obtained a closed curve. % % B = Array dimensioned 5 by N-1 containing bounds or % flags which define the constraints. For I = 1 % to N-1, column I defines the constraints associ- % ated with interval (X(I),X(I+1)) as follows: % % B(1,I) is an upper bound on H % B(2,I) is a lower bound on H % B(3,I) is an upper bound on HP % B(4,I) is a lower bound on HP % B(5,I) specifies the required sign of HPP % % where HP and HPP denote the first and second % derivatives of H, respectively. A null con- % straint is specified by abs(B(K,I)) >= BMAX % for K < 5, or B(5,I) = 0: B(1,I) >= BMAX, % B(2,I) <= -BMAX, B(3,I) >= BMAX, B(4,I) <= % -BMAX, or B(5,I) = 0. Any positive value of % B(5,I) specifies that H should be convex, a % negative values specifies that H should be con- % cave, and 0 specifies that no restriction be % placed on HPP. Refer to Functions SIG0, SIG1, % and SIG2 for definitions of valid constraints. % % BMAX = User-defined value of infinity which, when % used as an upper bound in B (or when % its negative is used as a lower bound), % specifies that no constraint is to be en- % forced. % % YP1,YPN = End condition values if NCD = 2 and % IENDC = 1 or IENDC = 2. % % On output: % % YP = Array of size(X) containing derivatives of H at % the abscissae. YP is zeros if -3 < IER < 0, % and YP is only partially computed if IER = -4. % % SIGMA = Array of size 1 by N-1 containing tension % factors for which H(x) satisfies the % constraints defined by B. SIGMA(I) is % associated with interval (X(I),X(I+1)) for % I = 1 to N-1. If infinite tension is % required in interval I, then SIGMA(I) = SBIG % (and H is an approximation to the linear % interpolant on the interval), and if no % constraint is specified in the interval, % then SIGMA(I) = 0, and thus H is cubic. % Invalid constraints are treated as null % constraints. SIGMA is zeros if IER < 0. % % ICFLG = Array of size 1 by N-1 containing invalid % constraint flags associated with intervals. % For I = 1 to N-1, ICFLG(I) is a 5-bit value % b5b4b3b2b1, where bK = 1 if and only if % constraint K cannot be satisfied. Thus, all % constraints in interval I are satisfied if % and only if ICFLG(I) = 0 (and IER >= 0). % ICFLG is zeros if IER < 0. % % IER = Error indicator or iteration count: % IER = IC >= 0 if no errors were encountered % (other than invalid constraints) and % IC calls to SIGBI and IC+1 calls to % YPC1, YPC1P, YPC2 or YPC2P were % employed. (IC = 0 if NCD = 1). % IER = -1 if N, NCD, or IENDC is outside its % valid range. % IER = -2 if the number of input arguments is % not consistent with the values. % IER = -4 if the abscissae X are not strictly % increasing. % % DYP = Maximum relative change in a component of YP % on the last iteration if IER > 0. % % DSMAX = Maximum relative change in a component of % SIGMA on the last iteration if IER > 0. % % Modules required by TSPBI: ENDSLP, SIG0, SIG1, SIG2, % SIGBI, SNHCSH, YPCOEF, YPC1, % YPC1P, YPC2, YPC2P % %*********************************************************** stol = 0; maxit = 49; dyptol = 0.01; % Convergence parameters: % % STOL = Absolute tolerance for SIGBI. % % MAXIT = Maximum number of YPC2/SIGBI iterations for % each loop if NCD = 2. % % DYPTOL = Bound on the maximum relative change in a % component of YP defining convergence of % the YPC2/SIGBI iteration when NCD = 2. m = size(x); n = length(x); sigma = zeros(1,n-1); icflg = zeros(1,n-1); dyp = 0; dsmax = 0; % Test for invalid input parameters N or NCD. if (n < 2 || (per && n < 3) || ncd < 1 || ncd > 2) yp = zeros(m); ier = -1; return; end % Test for incorrect number of input arguments. userc = ~per && ncd == 2 && (iendc == 1 || iendc == 2); if (~userc && nargin ~= 7) || (userc && nargin ~= 9) yp = zeros(m); ier = -2; return; end % Initialize iteration count ITER. iter = 0; if (ncd == 1) % NCD = 1. if (~per) [yp,ierr] = ypc1(x,y); else [yp,ierr] = ypc1p(x,y); end if (ierr ~= 0) ier = -4; return; end % Compute tension factors. [sigma,icflg,dsmax] = sigbi(x,y,yp,stol,b,bmax,sigma); ier = iter; return; end % NCD = 2. if (~per) % Nonperiodic case: call YPC2 and test for IENDC or X % invalid. if (iendc == 1 || iendc == 2) [yp,ierr] = ypc2(x,y,sigma,iendc,iendc,yp1,ypn); else [yp,ierr] = ypc2(x,y,sigma,iendc,iendc); end if (ierr == 1) ier = -1; return; end if (ierr > 1) ier = -4; return; end else % Periodic fit: call YPC2P. [yp,ierr] = ypc2p(x,y,sigma); if (ierr > 1) ier = -4; return end end % Iterate on calls to SIGBI and YPC2 (or YPC2P). The % derivative estimates YP from the previous iteration % are stored in WK. % % LOOP2 is TRUE iff tension factors are not allowed to % decrease between iterations (loop 1 failed to % converge with MAXIT iterations). % DYP is the maximum relative change in a component of YP. % ICNT is the number of tension factors that were altered % by SIGBI. % DSMAX is the maximum relative change in a component of % SIGMA. wk = zeros(m); e = zeros(m); i = 2:n-1; loop2 = false; while (true) for iter = 1:maxit wk(i) = yp(i); [sigma,icflg,dsmax,icnt] = sigbi(x,y,yp,stol,b,bmax,sigma); if (~per) if (iendc == 1 || iendc == 2) yp = ypc2(x,y,sigma,iendc,iendc,yp1,ypn); else yp = ypc2(x,y,sigma,iendc,iendc); end else yp = ypc2p(x,y,sigma); end e(i) = abs(yp(i)-wk(i)); k = find(wk); e(k) = e(k)/abs(wk(k)); dyp = max(e(i)); if (icnt == 0 || dyp <= dyptol), break, end if (~loop2) % Loop 1: reinitialize SIGMA to zeros. sigma = zeros(1,n-1); end end % for % The loop failed to converge within MAXIT iterations. if (loop2), break, end loop2 = true; end % while % Update iter. if (loop2), iter = iter + maxit; end % No error encountered. ier = iter; return; end % tspbi function [xp,yp,sigma,ier,dyp,dsmax] = tspbp(t,x,y,ncd, ... iendc,per,bl,bu,bmax,xp1,xpn,yp1,ypn) % tspbp: Parameters defining constrained parametric planar curve % % USAGE: [xp,yp,sigma,ier,dyp,dsmax] = tspbp(t,x,y,ncd, ... % iendc,per,bl,bu,bmax,xp1,xpn,yp1,ypn); % % This function computes a set of values that define a % parametric planar curve C(t) = (H1(t),H2(t)) whose compo- % nents are Hermite interpolatory tension splines. The % output values consist of knot derivative values XP and YP % computed by Function YPC1T, YPC2, or YPC2P, and tension % factors SIGMA chosen (by Function SIGBP) to satisfy user- % specified bounds on the signed distance between C and the % polygonal curve associated with the control points (refer % to BL and BU below). % % Refer to Function TSPSP for an alternative method of % computing tension factors. % % The tension splines may be evaluated by Function % TSVAL2 or Functions HVAL (values), HPVAL (first deriva- % tives), HPPVAL (second derivatives), HPPPVAL (third % derivatives), and TSINTL (integrals). % % On input: % % T = Vector of length N containing a strictly in- % creasing sequence of knots (discrete parameter % values). Refer to Function ARCL2D. N >= 2, and % N >= 3 if PER = TRUE. % % X,Y = Vectors of length N containing the Cartesian % coordinates of an ordered sequence of data % points C(I), I = 1 to N, such that C(I) ~= % C(I+1). C(t) is constrained to pass through % these points. In the case of a closed curve % (PER = TRUE), the first and last points should % coincide. % % NCD = Number of continuous derivatives at the knots. % NCD = 1 or NCD = 2. If NCD = 1, XP and YP are % the components of unit tangent vectors com- % puted as weighted averages of incident chord % directions. Otherwise, a linear system is % solved for the derivative values required for % second derivative continuity. This requires % iterating on calls to YPC2 or YPC2P and calls % to SIGBP, and generally results in more % nonzero tension factors (hence more expensive % evaluation). % % IENDC = End condition indicator for NCD = 2 and PER % = FALSE (or dummy parameter otherwise): % IENDC = 0 if XP(1), XP(N), YP(1), and YP(N) % are to be computed by monotonicity- % constrained parabolic fits (YPC1). % IENDC = 1 if the first derivatives of H1 at % the left and right endpoints are % user-specified in XP1 and XPN, % respectively, and the first deriv- % atives of H2 at the ends are % specified in YP1 and YPN. % IENDC = 2 if the second derivatives of H1 % and H2 at the endpoints are user- % specified in XP1, XPN, YP1, and % YPN. % IENDC = 3 if the end conditions are to be % computed by Function ENDSLP and % vary with SIGMA(1) and SIGMA(N-1). % % PER = Logical variable with value TRUE if and only % a closed curve is to be constructed: H1(t) % and H2(t) are to be periodic functions with % period T(N)-T(1), where T(1) and T(N) are the % parameter values associated with the first and % last data points. It is assumed that X(N) = % X(1) and Y(N) = Y(1) in this case, and, on % output, XP(N) = XP(1) and YP(N) = YP(1). % % BL,BU = Vectors of length N-1 containing (for each % knot subinterval [t1,t2]) lower and upper % bounds, respectively, on the signed perpen- % dicular distance d(t) = (C2-C1)/DC X (C(t)- % C1), where C1 and C2 are the ordered data % points associated with the interval, and DC % is the length of the line segment C1-C2, % assumed equal to t2-t1. If the curve is not % parameterized by cumulative arc length % (Function ARCL2D), then BL and BU should be % input as the required bounds scaled by DC/ % (t2-t1). Note that d(t) > 0 iff C(t) lies % strictly to the left of the line segment as % viewed from C1 toward C2. For I = 1 to N-1, % SIGMA(I) is chosen to be as small as possible % within the constraint that BL(I) <= d(t) <= % BU(I) for all t in the interval. BL(I) < 0 % and BU(I) > 0 for I = 1 to N-1. A null % constraint is specified by BL(I) <= -BMAX or % BU(I) >= BMAX. % % BMAX = User-defined value of infinity which, when % used as an upper bound in BU (or when its % negative is used as a lower bound in BL), % specifies that no constraint is to be en- % forced. % % XP1,XPN = End condition values if NCD = 2 and % IENDC = 1 or IENDC = 2. % % YP1,YPN = End condition values if NCD = 2 and % IENDC = 1 or IENDC = 2. % % On output: % % XP = Array of size(T) containing derivatives of H1 % at the knots. XP is zeros if -4 < IER < 0, % and XP is only partially computed if IER = -5. % % YP = Array of size(T) containing derivatives of H2 % at the knots. YP is zeros if -4 < IER < 0, % and YP is only partially computed if IER = -5. % % SIGMA = Array of size 1 by N-1 containing tension % factors for which C(t) satisfies the con- % straints defined by BL and BU. SIGMA(I) is % associated with interval (T(I),T(I+1)) for % I = 1 to N-1. SIGMA(I) is limited to SBIG % (in which case C(t) is close to the line % segment associated with the interval), and % if no constraint is specified in the % interval, then SIGMA(I) = 0, and thus % H1 and H2 are cubic functions of t. SIGMA % is zeros if IER < 0 and IER ~= -3. % % IER = Error indicator or iteration count: % IER = IC >= 0 if no errors were encountered % and IC calls to SIGBP and IC+1 calls % to YPC1, YPC1P, YPC2 or YPC2P were % employed. (IC = 0 if NCD = 1). % IER = -1 if N, NCD, or IENDC is outside its % valid range. % IER = -2 if the number of input arguments is % not consistent with the values. % IER = -3 if BL(I) >= 0 or BU(I) <= 0 for % some I in the range 1 to N-1. % SIGMA(J) = 0 for J >= I in this % case. % IER = -4 if a pair of adjacent data points % coincide: X(I) = X(I+1) and Y(I) = % Y(I+1) for some I in the range 1 to % N-1. % IER = -5 if the knots are not strictly % increasing. % % DYP = Maximum relative change in a component of XP % or YP on the last iteration if IER > 0. % % DSMAX = Maximum relative change in a component of % SIGMA on the last iteration if IER > 0. % % Modules required by TSPBP: ENDSLP, SIGBP, SNHCSH, YPCOEF, % YPC1T, YPC2, YPC2P % %*********************************************************** stol = 0; maxit = 49; dyptol = 0.01; % Convergence parameters: % % STOL = Absolute tolerance for SIGBP. % % MAXIT = Maximum number of YPC2/SIGBP iterations for each % loop if NCD = 2. % % DYPTOL = Bound on the maximum relative change in a % component of XP or YP defining convergence % of the YPC2/SIGBP iteration when NCD = 2. m = size(t); n = length(t); sigma = zeros(1,n-1); dyp = 0; dsmax = 0; % Test for invalid input parameters N or NCD. if (n < 2 || (per && n < 3) || ncd < 1 || ncd > 2) xp = zeros(m); yp = zeros(m); ier = -1; return; end % Test for incorrect number of input arguments. userc = ~per && ncd == 2 && (iendc == 1 || iendc == 2); if (~userc && nargin ~= 9) || (userc && nargin ~= 13) xp = zeros(m); yp = zeros(m); ier = -2; return; end % Initialize iteration count ITER. iter = 0; if (ncd == 1) % NCD = 1. [xp,yp,ierr] = ypc1t(x,y); if (ierr ~= 0) ier = -4; return; end % Compute tension factors. [sigma,dsmax,ierr] = sigbp(x,y,xp,yp,stol,bl,bu,bmax,sigma); if (ierr < 0) ier = -3; else ier = 0; end return; end % NCD = 2. if (~per) % Nonperiodic case: call YPC2 and test for IENDC invalid. if (iendc == 1 || iendc == 2) [xp,ierx] = ypc2(t,x,sigma,iendc,iendc,xp1,xpn); [yp,iery] = ypc2(t,y,sigma,iendc,iendc,yp1,ypn); else [xp,ierx] = ypc2(t,x,sigma,iendc,iendc); [yp,iery] = ypc2(t,y,sigma,iendc,iendc); end if (ierx == 1 || iery == 1) ier = -1; return; end if (ierx > 1 || iery > 1) ier = -5; return; end else % Periodic fit: call YPC2P. [xp,ierx] = ypc2p(t,x,sigma); [yp,iery] = ypc2p(t,y,sigma); if (ierx ~= 0 || iery ~= 0) ier = -5; return; end end % Iterate on calls to SIGBP and YPC2 (or YPC2P). The % derivative estimates XP and YP from the previous % iteration are stored in WX and WY. % % LOOP2 is TRUE iff tension factors are not allowed to % decrease between iterations (loop 1 failed to % converge with MAXIT iterations). % DYP is the maximum relative change in a component of XP % or YP. % ICNT is the number of tension factors that were altered % by SIGBP. % DSMAX is the maximum relative change in a component of % SIGMA. loop2 = false; while (true) for iter = 1:maxit i = 2:n-1; wx(i) = xp(i); wy(i) = yp(i); [sigma,dsmax,icnt] = sigbp(x,y,xp,yp,stol,bl,bu,bmax,sigma); if (icnt < 0) ier = -3; return; end if (~per) if (iendc == 1 || iendc == 2) xp = ypc2(t,x,sigma,iendc,iendc,xp1,xpn); yp = ypc2(t,y,sigma,iendc,iendc,yp1,ypn); else xp = ypc2(t,x,sigma,iendc,iendc); yp = ypc2(t,y,sigma,iendc,iendc); end else xp = ypc2p(t,x,sigma); yp = ypc2p(t,y,sigma); end ex(i) = abs(xp(i)-wx(i)); k = find(wx); ex(k) = ex(k)/abs(wx(k)); ey(i) = abs(yp(i)-wy(i)); k = find(wy); ey(k) = ey(k)/abs(wy(k)); dyp = max([ex(i), ey(i)]); if (icnt == 0 || dyp <= dyptol), break, end if (~loop2) % Loop 1: reinitialize SIGMA to zeros. sigma = zeros(1,n-1); end end % for % The loop failed to converge within MAXIT iterations. if (loop2), break, end loop2 = true; end % while % Update iter. if (loop2), iter = iter + maxit; end % No error encountered. ier = iter; return; end % tspbp function [yp,sigma,ier,dyp,dsmax] = tspsi(x,y,ncd,iendc, ... per,sig1,yp1,ypn) % tspsi: Parameters defining shape-preserving interpolatory tension spline % % USAGE: [yp,sigma,ier,dyp,dsmax] = tspsi(x,y,ncd,iendc, ... % per,sig1,yp1,ypn); % % % This function computes a set of parameter values that % define a Hermite interpolatory tension spline H(x). The % parameters consist of knot derivative values YP computed % by Function YPC1, YPC1P, YPC2, or YPC2P, and tension % factors SIGMA computed by Function SIGS (unless SIG1 >= % 0, indicating uniform tension). Alternative methods for % computing SIGMA are provided by Function TSPBI and Func- % tions SIG0, SIG1, and SIG2. % % Refer to Function TSPSS for a means of computing % parameters that define a smoothing curve rather than an % interpolatory curve. % % The tension spline may be evaluated by Function TSVAL1 % or Functions HVAL (values), HPVAL (first derivatives), % HPPVAL (second derivatives), HPPPVAL (third derivatives), % and TSINTL (integrals). % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2 and N >= 3 if PER = % TRUE. % % Y = Vector of length N containing data values asso- % ciated with the abscissae. H(X(I)) = Y(I) for % I = 1 to N. If NCD = 1 and PER = TRUE, Y(1) and % Y(N) should be identical. % % NCD = Number of continuous derivatives at the knots. % NCD = 1 or NCD = 2. If NCD = 1, the YP values % are computed by local monotonicity-constrained % quadratic fits. Otherwise, a linear system is % solved for the derivative values that result % in second derivative continuity. Unless % SIG1 >= 0, this requires iterating on calls % to YPC2 or YPC2P and calls to SIGS, and % generally results in more nonzero tension % factors (hence more expensive evaluation). % % IENDC = End condition indicator for NCD = 2 and PER % = FALSE (or dummy parameter otherwise): % IENDC = 0 if YP(1) and YP(N) are to be com- % puted by monotonicity-constrained % parabolic fits to the first three % and last three points, respective- % ly. This is identical to the % values computed by YPC1. % IENDC = 1 if the first derivatives of H at % X(1) and X(N) are user-specified % in YP1 and YPN, respectively. % IENDC = 2 if the second derivatives of H at % X(1) and X(N) are user-specified % in YP1 and YPN, respectively. % IENDC = 3 if the end conditions are to be % computed by Function ENDSLP and % vary with SIGMA(1) and SIGMA(N-1). % % PER = Logical variable with value TRUE if and only % H(x) is to be a periodic function with period % X(N)-X(1). It is assumed without a test that % Y(N) = Y(1) in this case. On output, YP(N) = % YP(1). If H(x) is one of the components of a % parametric curve, this option may be used to % obtained a closed curve. % % SIG1 = Constant (uniform) tension factor in the % range 0 to SBIG, or negative value if % variable tension is to be used. If SIG1 = 0, % H(x) is piecewise cubic (a cubic spline if % NCD = 2), and as SIG1 increases, H(x) % approaches the piecewise linear interpolant. % If SIG1 < 0, tension factors are chosen (by % SIGS) to preserve local monotonicity and % convexity of the data. This often improves % the appearance of the curve over the piece- % wise cubic fit. % % YP1,YPN = End condition values if NCD = 2 and % IENDC = 1 or IENDC = 2. % % On output: % % YP = Array of size(X) containing derivatives of H at % the abscissae. YP is zeros if -4 < IER < 0, % and YP is only partially computed if IER = -4. % % SIGMA = Array of size 1 by N-1 containing tension % factors. SIGMA(I) is associated with inter- % val (X(I),X(I+1)) for I = 1 to N-1. SIGMA % is zeros if -4 < IER < 0 (unless IENDC % is invalid), and SIGMA is constant (not % optimal) if IER = -4 or IENDC (if used) is % invalid. % % IER = Error indicator or iteration count: % IER = IC >= 0 if no errors were encountered % and IC calls to SIGS and IC+1 calls % to YPC1, YPC1P, YPC2 or YPC2P were % employed. (IC = 0 if NCD = 1). % IER = -1 if N, NCD, or IENDC is outside its % valid range. % IER = -2 if the number of input arguments is % not consistent with the values. % IER = -3 if SIG1 > SBIG. % IER = -4 if the abscissae X are not strictly % increasing. % % DYP = Maximum relative change in a component of YP % on the last iteration if IER > 0. % % DSMAX = Maximum relative change in a component of % SIGMA on the last iteration if IER > 0. % % Modules required by TSPSI: ENDSLP, SIGS, SNHCSH, YPCOEF, % YPC1, YPC1P, YPC2, YPC2P % %*********************************************************** global SBIG stol = 0; maxit = 99; dyptol = 0.01; % Convergence parameters: % % STOL = Absolute tolerance for SIGS. % % MAXIT = Maximum number of YPC2/SIGS iterations. % % DYPTOL = Bound on the maximum relative change in a % component of YP defining convergence of % the YPC2/SIGS iteration when NCD = 2 and % SIG1 < 0. m = size(x); n = length(x); dyp = 0; dsmax = 0; % Test for invalid input parameters N and NCD. if (n < 2 || (per && n < 3) || ncd < 1 || ncd > 2) yp = zeros(m); sigma = zeros(1,n-1); ier = -1; return; end % Test for incorrect number of input arguments. userc = ~per && ncd == 2 && (iendc == 1 || iendc == 2); if (~userc && nargin ~= 6) || (userc && nargin ~= 8) yp = zeros(m); sigma = zeros(1,n-1); ier = -2; return; end if (sig1 >= 0) sig = sig1; if (sig > SBIG) yp = zeros(m); sigma = zeros(1,n-1); ier = -3; return; end else sig = 0; end % Initialize iteration count ITER, and store uniform % tension factors, or initialize SIGMA to zeros. iter = 0; unifrm = sig1 >= 0; sigma = sig*ones(1,n-1); if (ncd == 1) % NCD = 1. if (~per) [yp,ierr] = ypc1(x,y); else [yp,ierr] = ypc1p(x,y); end if (ierr ~= 0) ier = -4; return; end if (~unifrm) % Call SIGS for SIG1 < 0. [sigma,dsmax] = sigs(x,y,yp,stol,sigma); end ier = 0; return; end % NCD = 2. if (~per) % Nonperiodic case: call YPC2 and test for IENDC or X % invalid. if (iendc == 1 || iendc == 2) [yp,ierr] = ypc2(x,y,sigma,iendc,iendc,yp1,ypn); else [yp,ierr] = ypc2(x,y,sigma,iendc,iendc); end if (ierr == 1) ier = -1; return; end if (ierr > 1) ier = -4; return; end else % Periodic fit: call YPC2P. [yp,ierr] = ypc2p(x,y,sigma); if (ierr > 1) ier = -4; return; end end if (unifrm) ier = 0; return; end % Iterate on calls to SIGS and YPC2 (or YPC2P). The % derivative estimates YP from the previous iteration % are stored in WK. % % DYP is the maximum relative change in a component of YP. % ICNT is the number of tension factors that were % increased by SIGS. % DSMAX is the maximum relative change in a component of % SIGMA. wk = zeros(m); e = zeros(m); i = 2:n-1; for iter = 1:maxit wk(i) = yp(i); [sigma,dsmax,icnt] = sigs(x,y,yp,stol,sigma); if (~per) if (iendc == 1 || iendc == 2) yp = ypc2(x,y,sigma,iendc,iendc,yp1,ypn); else yp = ypc2(x,y,sigma,iendc,iendc); end else yp = ypc2p(x,y,sigma); end e(i) = abs(yp(i)-wk(i)); k = find(wk); e(k) = e(k)/abs(wk(k)); dyp = max(e(i)); if (icnt == 0 || dyp <= dyptol), break, end end % for % No error encountered. ier = iter; return; end % tspsi function [xp,yp,zp,sigma,ier,dyp,dsmax] = tspsp(nd,t,x,y,z, ... ncd,iendc,per,sig1,xp1,xpn,yp1,ypn,zp1,zpn) % tspsp: Parameters defining shape-preserving parametric space curve % % USAGE: [xp,yp,zp,sigma,ier,dyp,dsmax] = tspsp(nd,t,x,y,z, ... % ncd,iendc,per,sig1,xp1,xpn,yp1,ypn,zp1,zpn); % % % This function computes a set of values that define a % parametric planar curve C(t) = (H1(t),H2(t)) or space % curve C(t) = (H1(t),H2(t),H3(t)) whose components are % Hermite interpolatory tension splines. The output values % consist of knot derivative values XP, YP, (and ZP) % computed by Function YPC1T, YPC2, or YPC2P, and tension % factors SIGMA computed by Function SIGSP (unless SIG1 >= % 0, indicating uniform tension). % % Refer to Function TSPBP for an alternative method of % computing tension factors in the case of a planar curve. % % The tension splines may be evaluated by Function % TSVAL2 (or TSVAL3) or Functions HVAL (values), HPVAL % (first derivatives), HPPVAL (second derivatives), % HPPPVAL (third derivatives), and TSINTL (integrals). % % On input: % % ND = Number of dimensions: % ND = 2 if a planar curve is to be constructed. % ND = 3 if a space curve is to be constructed. % % T = Vector of length N containing a strictly in- % creasing sequence of knots (discrete parameter % values). Refer to Function ARCL2D and ARCL3D. % N >= 2, and N >= 3 if PER = TRUE. % % X,Y,Z = Vectors of length N containing the Cartesian % coordinates of an ordered sequence of data % points C(I), I = 1 to N, such that C(I) ~= % C(I+1). The curve is constrained to pass % through these points. Z is an unused dummy % parameter if ND = 2. If PER = TRUE (closed % curve), the first and last points should % coincide. % % NCD = Number of continuous derivatives at the knots. % NCD = 1 or NCD = 2. If NCD = 1, XP, YP, (and % ZP) are the components of unit tangent vectors % computed as weighted averages of incident % chord directions. Otherwise, a linear system % is solved for the derivative values required % for second derivative continuity. Unless % SIG1 >= 0, this requires iterating on calls to % YPC2 or YPC2P and calls to SIGSP, and generally % results in more nonzero tension factors (hence % more expensive evaluation). % % IENDC = End condition indicator for NCD = 2 and PER % = FALSE (or dummy parameter otherwise): % IENDC = 0 if XP(1), XP(N), YP(1), YP(N) (and % ZP(1) and ZP(N)) are to be com- % puted by monotonicity-constrained % parabolic fits (YPC1). % IENDC = 1 if the first derivatives of H1 at % the left and right endpoints are % user-specified in XP1 and XPN, % respectively, the first deriva- % tives of H2 at the ends are % specified in YP1 and YPN, and, % if ND = 3, the first derivatives % of H3 are specified in ZP1 and % ZPN. % IENDC = 2 if the second derivatives of H1, % H2, (and H3) at the endpoints are % user-specified in XP1, XPN, YP1, % YPN, (ZP1, and ZPN). % IENDC = 3 if the end conditions are to be % computed by Function ENDSLP and % vary with SIGMA(1) and SIGMA(N-1). % % PER = Logical variable with value TRUE if and only % a closed curve is to be constructed: H1(t), % H2(t), (and H3(t)) are to be periodic func- % tions with period T(N)-T(1), where T(1) and % T(N) are the parameter values associated with % the first and last data points. It is assumed % in this case that X(N) = X(1), Y(N) = Y(1) % and, if ND = 3, Z(N) = Z(1), and, on output, % XP(N) = XP(1), YP(N) = YP(1), (and ZP(N) = % ZP(1) if ND = 3). % % SIG1 = Constant (uniform) tension factor in the % range 0 to SBIG, or negative value if % variable tension is to be used. If SIG1 = 0, % H(t) is piecewise cubic (a cubic spline if % if NCD = 2), and as SIG1 increases, H(t) % approaches the piecewise linear interpolant, % where H is H1, H2, or H3. If SIG1 < 0, % tension factors are chosen (by SIGSP) to % preserve local convexity of the data. % % XP1,XPN = End condition values if NCD = 2 and % IENDC = 1 or IENDC = 2. % % YP1,YPN = End condition values if NCD = 2 and % IENDC = 1 or IENDC = 2. % % ZP1,ZPN = End condition values if ND = 3 and NCD = 2 % and IENDC = 1 or IENDC = 2. % % On output: % % XP = Array of size(T) containing derivatives of H1 % at the knots. XP is zeros if -4 < IER < 0, % and XP is only partially computed if IER = -5. % % YP = Array of size(T) containing derivatives of H2 % at the knots. YP is zeros if -4 < IER < 0, % and YP is only partially computed if IER = -5. % % ZP = Array of size(T) containing derivatives of H3 % at the knots if ND = 3. ZP is zeros if -4 < % IER < 0, and ZP is only partially computed if % IER = -5. % % SIGMA = Array of size 1 by N-1 containing tension % factors. SIGMA(I) is associated with inter- % val (T(I),T(I+1)) for I = 1 to N-1. SIGMA % is zeros if -3 <= IER < 0 (unless IENDC is % invalid), and SIGMA is constant (not % optimal) if IENDC (if used) is invalid or % IER = -4 or IER = -5. % % IER = Error indicator or iteration count: % IER = IC >= 0 if no errors were encountered % and IC calls to SIGSP and IC+1 calls % to YPC2 or YPC2P were employed. % (IC = 0 if NCD = 1). % IER = -1 if ND, N, NCD, or IENDC is outside % its valid range. % IER = -2 if the number of input arguments is % not consistent with the values. % IER = -3 if SIG1 > SBIG. % IER = -4 if a pair of adjacent control points % coincide. % IER = -5 if the knots are not strictly % increasing. % % DYP = Maximum relative change in a component of XP, % YP, or ZP on the last iteration if IER > 0. % % DSMAX = Maximum relative change in a component of % SIGMA on the last iteration if IER > 0. % % Modules required by TSPSP: ENDSLP, SIGSP, SNHCSH, YPCOEF, % YPC1T, YPC2, YPC2P % %*********************************************************** global SBIG stol = 0; maxit = 99; dyptol = 0.01; % Convergence parameters: % % STOL = Absolute tolerance for SIGSP. % % MAXIT = Maximum number of YPC2/SIGSP iterations. % % DYPTOL = Bound on the maximum relative change in a com- % ponent of XP, YP, or ZP defining convergence % of the YPC2/SIGSP iteration when NCD = 2 and % SIG1 < 0. m = size(t); n = length(t); sigma = zeros(1,n-1); zp = zeros(m); dyp = 0; dsmax = 0; % Test for invalid input parameters N, ND, or NCD. if (n < 2 || (per && n < 3) || nd < 2 || nd > 3 || ... ncd < 1 || ncd > 2) xp = zeros(m); yp = zeros(m); ier = -1; return; end % Test for incorrect number of input arguments. userc = ~per && ncd == 2 && (iendc == 1 || iendc == 2); if (~userc && nargin ~= 9) || (userc && nargin ~= 9+2*nd) xp = zeros(m); yp = zeros(m); ier = -2; return; end unifrm = (sig1 >= 0); if (unifrm) sig = sig1; if (sig > SBIG) xp = zeros(m); yp = zeros(m); ier = -3; return; end else sig = 0; end % Set SCURV (TRUE iff space curve), initialize iteration % count ITER, and store uniform tension factors SIGMA. scurv = (nd == 3); iter = 0; sigma = sig*ones(1,n-1); ierz = 0; if (ncd == 1) % NCD = 1. if scurv [xp,yp,zp,ierr] = ypc1t(x,y,z); else [xp,yp,ierr] = ypc1t(x,y); end if (ierr ~= 0) ier = -4; return; end if (~unifrm) % Call SIGSP for UNIFRM = FALSE (SIG1 < 0). [sigma,dsmax,ierr] = sigsp(nd,t,x,y,z,xp,yp,zp,stol,sigma); if (ierr < -1) ier = -5; return; end end ier = 0; return; end % NCD = 2. if (~per) % Nonperiodic case: call YPC2 and test for IENDC invalid. if (iendc == 1 || iendc == 2) [xp,ierx] = ypc2(t,x,sigma,iendc,iendc,xp1,xpn); [yp,iery] = ypc2(t,y,sigma,iendc,iendc,yp1,ypn); if (scurv) [zp,ierz] = ypc2(t,z,sigma,iendc,iendc,zp1,zpn); end else [xp,ierx] = ypc2(t,x,sigma,iendc,iendc); [yp,iery] = ypc2(t,y,sigma,iendc,iendc); if (scurv) [zp,ierz] = ypc2(t,z,sigma,iendc,iendc); end end if (ierx == 1 || iery == 1 || ierz == 1) ier = -1; return; end if (ierx > 1 || iery > 1 || ierz > 1) ier = -5; return; end else % Periodic fit: call YPC2P. [xp,ierx] = ypc2p(t,x,sigma); [yp,iery] = ypc2p(t,y,sigma); if (scurv), [zp,ierz] = ypc2p(t,z,sigma); end if (ierx ~= 0 || iery ~= 0 || ierz ~= 0) ier = -5; return; end end if (unifrm) ier = 0; return; end % Iterate on calls to SIGSP and YPC2 (or YPC2P). The % derivative estimates XP, YP, (and ZP) from the % previous iteration are stored in WX, WY, (and WZ). % % DYP is the maximum relative change in a component of XP, % YP, or ZP. % ICNT is the number of tension factors that were % increased by SIGSP. % DSMAX is the maximum relative change in a component of % SIGMA. for iter = 1:maxit wx = xp; wy = yp; if (scurv), wz = zp; end [sigma,dsmax,icnt] = sigsp(nd,t,x,y,z,xp,yp,zp,stol,sigma); if (~per) if (iendc == 1 || iendc == 2) xp = ypc2(t,x,sigma,iendc,iendc,xp1,xpn); yp = ypc2(t,y,sigma,iendc,iendc,yp1,ypn); if (scurv) zp = ypc2(t,z,sigma,iendc,iendc,zp1,zpn); end else xp = ypc2(t,x,sigma,iendc,iendc); yp = ypc2(t,y,sigma,iendc,iendc); if (scurv) zp = ypc2(t,z,sigma,iendc,iendc); end end else xp = ypc2p(t,x,sigma); yp = ypc2p(t,y,sigma); if (scurv), zp = ypc2p(t,z,sigma); end end ex = abs(xp-wx); k = find(wx); ex(k) = ex(k)./abs(wx(k)); ey = abs(yp-wy); k = find(wy); ey(k) = ey(k)./abs(wy(k)); if (scurv) ez = abs(zp-wz); k = find(wz); ez(k) = ez(k)./abs(wz(k)); else ez = 0; end dyp = max([ex(:); ey(:); ez(:)]); if (icnt == 0 || dyp <= dyptol), break, end end % for % No error encountered. ier = iter; return; end % tspsp function [sigma,ys,yp,nit,ier,dys,dsmax] = tspss(x,y,per, ... sig1,w,sm,smtol) % tspss: Parameters defining shape-preserving smoothing curve % % USAGE: [sigma,ys,yp,nit,ier,dys,dsmax] = tspss(x,y,per, ... % sig1,w,sm,smtol); % % This function computes a set of parameter values that % define a smoothing tension spline H(x). The parameters % consist of knot values YS and derivatives YP computed % by Function SMCRV, and tension factors SIGMA computed by % Function SIGS (unless SIG1 >= 0, indicating uniform % tension). The Hermite interpolatory tension spline H(x) % defined by the knot values and derivatives has two contin- % uous derivatives and satisfies either natural or periodic % end conditions. % % The tension spline may be evaluated by Function TSVAL1 % or Functions HVAL (values), HPVAL (first derivatives), % HPPVAL (second derivatives), HPPPVAL (third derivatives), % and TSINTL (integrals). % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2 and N >= 3 if PER = % TRUE. % % Y = Vector of length N containing data values asso- % ciated with the abscissae. If PER = TRUE, it is % assumed that Y(N) = Y(1). % % PER = Logical variable with value TRUE if and only % H(x) is to be a periodic function with period % X(N)-X(1). It is assumed without a test that % Y(N) = Y(1) in this case. On output, YP(N) = % YP(1) and, more generally, the values and % first two derivatives of H at X(1) agree with % those at X(N). If H(x) is one of the compo- % nents of a parametric curve, this option may % be used to obtained a closed curve. If PER = % FALSE, H satisfies natural end conditions: % zero second derivatives at X(1) and X(N). % % SIG1 = Constant (uniform) tension factor in the % range 0 to SBIG, or negative value if % variable tension is to be used. If SIG1 = 0, % H(x) is a cubic spline, and as SIG1 % increases, H(x) approaches piecewise linear. % If SIG1 < 0, tension factors are chosen (by % SIGS) to preserve local monotonicity and % convexity of the data. This may result in a % better fit than the case of uniform tension, % but requires an iteration on calls to SMCRV % and SIGS. % % W = Vector of length N containing positive weights % associated with the data values. The recommend- % ed value of W(I) is 1/DY^2, where DY is the % standard deviation associated with Y(I). If % nothing is known about the errors in Y, a con- % stant (estimated value) should be used for DY. % If PER = TRUE, it is assumed that W(N) = W(1). % % SM = Positive parameter specifying an upper bound on % Q2(YS), where Q2(YS) is the weighted sum of % squares of deviations from the data (differ- % ences between YS and Y). H(x) is linear (and % Q2 is minimized) if SM is sufficiently large % that the constraint is not active. It is % recommended that SM satisfy N-SQRT(2N) <= SM % <= N+SQRT(2N) and SM = N is reasonable if % W(I) = 1/DY^2. % % SMTOL = Parameter in the range (0,1) specifying the % relative error allowed in satisfying the % constraint: the constraint is assumed to % be satisfied if SM*(1-SMTOL) <= Q2 <= % SM*(1+SMTOL). A reasonable value for SMTOL % is SQRT(2/N) for N > 2. % % On output: % % SIGMA = Array of size 1 by n-1 containing tension % factors. SIGMA(I) is associated with inter- % val (X(I),X(I+1)) for I = 1 to N-1. SIGMA % is zeros if N is invalid or -4 < IER < -1, % and SIGMA is constant if IER = -1 (and N % is valid) or IER = -4. % % YS = Vector of size(X) containing values of H at the % abscissae. YS(N) = YS(1) if PER = TRUE. YS is % zeros if IER < 0. % % YP = Vector of size(X) containing first derivative % values of H at the abscissae. YP(N) = YP(1) % if PER = TRUE. YP is zeros if IER < 0. % % NIT = Number of iterations (calls to SIGS). NIT = 0 % if IER < 0 or SIG1 >= 0. If NIT > 0, NIT+1 % calls to SMCRV were employed. % % IER = Error indicator: % IER = 0 if no errors were encountered and the % constraint is active: Q2(YS) is ap- % proximately equal to SM. % IER = 1 if no errors were encountered but the % constraint is not active: YS and YP % are the values and derivatives of the % linear function (constant function if % PERIOD = TRUE) that minimizes Q2, and % Q1 = 0 (refer to SMCRV). % IER = -1 if N, W, SM, or SMTOL is outside its % valid range. % IER = -2 if the number of input arguments is % not valid. % IER = -3 if SIG1 > SBIG. % IER = -4 if the abscissae X are not strictly % increasing. % % DYS = Maximum relative change in a component of YS % on the last iteration if NIT > 0. % % DSMAX = Maximum relative change in a component of % SIGMA on the last iteration if NIT > 0. % % Modules required by TSPSS: B2TRI or B2TRIP, SIGS, SMCRV, % SNHCSH, YPCOEF % %*********************************************************** global SBIG stol = 0; maxit = 99; dystol = 0.01; % Convergence parameters: % % STOL = Absolute tolerance for SIGS. % % MAXIT = Maximum number of SMCRV/SIGS iterations. % % DYSTOL = Bound on the maximum relative change in a % component of YS defining convergence of % the SMCRV/SIGS iteration when SIG1 >= 0. % m = size(x); n = length(x); sigma = zeros(1,n-1); nit = 0; dys = 0; dsmax = 0; % Initialize NIT, and test for invalid input parameters N or % SIG1. if (n < 2 || (per && n < 3)) ys = zeros(m); yp = zeros(m); ier = -1; return; end % Test for incorrect number of input arguments. if (nargin ~= 7) ys = zeros(m); yp = zeros(m); ier = -2; return; end unifrm = (sig1 >= 0); if (unifrm) sig = sig1; if (sig > SBIG) ys = zeros(m); yp = zeros(m); ier = -3; return; end else sig = 0; end % Store uniform tension factors, or initialize SIGMA to % zeros. sigma = sig*ones(1,n-1); % Compute smoothing curve for uniform tension. [ys,yp,ier] = smcrv(x,y,sigma,per,w,sm,smtol); if (ier <= -2), ier = -4; end if (ier < 0 || unifrm), return, end % Iterate on calls to SIGS and SMCRV. The function % values YS from the previous iteration are stored % in WK. % % DYS is the maximum relative change in a component of YS. % ICNT is the number of tension factors that were % increased by SIGS. % DSMAX is the maximum relative change in a component of % SIGMA. wk = zeros(m); e = zeros(m); i = 2:n-1; for iter = 1:maxit wk(i) = ys(i); [sigma,dsmax,icnt] = sigs(x,y,yp,stol,sigma); [ys,yp,ierr] = smcrv(x,y,sigma,per,w,sm,smtol); e(i) = abs(ys(i)-wk(i)); k = find(wk); e(k) = e(k)/wk(k); dys = max(e(i)); if (icnt == 0 || dys <= dystol), break, end end % for % No error encountered. nit = iter; ier = ierr; return; end % tspss function [v,ier] = tsval1(x,y,yp,sigma,iflag,te) % tsval1: Values or derivatives of a tension spline % % USAGE: [v,ier] = tsval1(x,y,yp,sigma,iflag,te); % % This function evaluates a Hermite interpolatory ten- % sion spline H or its first, second, or third derivative % at a set of points TE. % % On input: % % X = Vector of length N containing the abscissae. % These must be in strictly increasing order: % X(I) < X(I+1) for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values or % function values returned by Function SMCRV. % Y(I) = H(X(I)) for I = 1 to N. % % YP = Vector of length N containing first deriva- % tives. YP(I) = HP(X(I)) for I = 1 to N, where % HP denotes the derivative of H. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % IFLAG = Output option indicator: % IFLAG = 0 if values of H are to be computed. % IFLAG = 1 if first derivative values are to % be computed. % IFLAG = 2 if second derivative values are to % be computed. % IFLAG = 3 if third derivative values are to % be computed. % % TE = Vector of length NE containing the evaluation % points. The sequence should be strictly in- % creasing for maximum efficiency. Extrapolation % is performed if a point is not in the interval % [X(1),X(N)]. NE > 0. % % On output: % % V = Vector of size(TE) containing function, first % derivative, second derivative, or third deriva- % tive values at the evaluation points unless IER % < 0. If IER = -2, V is zeros. If IER = -1, V % may be only partially defined. % % IER = Error indicator: % IER = 0 if no errors were encountered and % no extrapolation occurred. % IER > 0 if no errors were encountered but % extrapolation was required at IER % points. % IER = -1 if the abscissae are not in strictly % increasing order. (This error will % not necessarily be detected.) % IER = -2 if N < 2, IFLAG < 0, IFLAG > 3, or % NE < 1. % % Modules required by TSVAL1: HPPPVAL, HPPVAL, HPVAL, HVAL, % SNHCSH % %*********************************************************** n = length(x); ne = length(te); % Test for invalid input. if (n < 2 || iflag < 0 || iflag > 3 || ne < 1) v = zeros(size(te)); ier = -2; return; end if (iflag == 0) [v,ier] = hval(te,x,y,yp,sigma); elseif (iflag == 1) [v,ier] = hpval(te,x,y,yp,sigma); elseif (iflag == 2) [v,ier] = hppval(te,x,y,yp,sigma); else [v,ier] = hpppval(te,x,y,yp,sigma); end % Convert v from a column to a row if te is a row vector. if size(te,1) == 1 v = v'; end return; end % tsval1 function [vx,vy,ier] = tsval2 (t,x,y,xp,yp,sigma,iflag,te) % tsval2: Values or derivative vectors of planar curve % % USAGE: [vx,vy,ier] = tsval2(t,x,y,xp,yp,sigma,iflag,te); % % This function returns values or derivatives of a pair % of Hermite interpolatory tension splines H1 and H2 that % form the components of a parametric planar curve C(t) = % (H1(t),H2(t)). Refer to Functions TSPBP and TSPSP. % % On input: % % T = Vector of length N containing a strictly in- % creasing sequence of abscissae (parameter % values). N >= 2. Refer to Function ARCL2D. % % X = Vector of length N containing data values or % function values returned by Function SMCRV. % X(I) = H1(T(I)) for I = 1 to N. % % Y = Vector of length N containing data values or % function values returned by Function SMCRV. % Y(I) = H2(T(I)) for I = 1 to N. % % XP = Vector of length N containing first deriva- % tives. XP(I) = H1P(T(I)) for I = 1 to N, % where H1P denotes the derivative of H1. % % YP = Vector of length N containing first deriva- % tives. YP(I) = H2P(T(I)) for I = 1 to N, % where H2P denotes the derivative of H2. % % Note that C(T(I)) = (X(I),Y(I)) and CP(T(I)) = (XP(I), % YP(I)), I = 1 to N, are data (control) points and deriva- % tive (velocity) vectors, respectively. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % IFLAG = Output option indicator: % IFLAG = 0 if values of H1 and H2 (points on % the curve) are to be computed. % IFLAG = 1 if first derivative vectors are to % be computed. Unit tangent vectors % can be obtained by normalizing % these to unit vectors. % IFLAG = 2 if second derivative (accelera- % tion) vectors are to be computed. % Given a velocity vector U and % acceleration vector V, the % corresponding signed curvature % can be computed as (U X V)/|U|^3. % IFLAG = 3 if third derivative vectors are to % be computed. % % TE = Vector of length NE containing the evaluation % points. The sequence should be strictly in- % creasing for maximum efficiency. Extrapolation % is performed if a point is not in the interval % [T(1),T(N)]. NE > 0. % % On output: % % VX,VY = Vectors of size(TE) containing values, first % derivatives, second derivatives, or third % derivatives of H1 and H2, respectively, at % the evaluation points (unless IER < 0). If % IER = -2, VX and VY are zeros. If IER = -1, % VX and VY may be only partially defined. % % IER = Error indicator: % IER = 0 if no errors were encountered and % no extrapolation occurred. % IER > 0 if no errors were encountered but % extrapolation was required at IER % points. % IER = -1 if the abscissae are not in strictly % increasing order. (This error will % not necessarily be detected.) % IER = -2 if N < 2, IFLAG < 0, IFLAG > 3, or % NE < 1. % % Modules required by TSVAL2: HPPPVAL, HPPVAL, HPVAL, HVAL, % SNHCSH % %*********************************************************** n = length(t); ne = length(te); % Test for invalid input. if (n < 2 || iflag < 0 || iflag > 3 || ne < 1) vx = zeros(size(te)); vy = zeros(size(te)); ier = -2; return; end if (iflag == 0) [vx,ierx] = hval(te,t,x,xp,sigma); [vy,iery] = hval(te,t,y,yp,sigma); elseif (iflag == 1) [vx,ierx] = hpval(te,t,x,xp,sigma); [vy,iery] = hpval(te,t,y,yp,sigma); elseif (iflag == 2) [vx,ierx] = hppval(te,t,x,xp,sigma); [vy,iery] = hppval(te,t,y,yp,sigma); else [vx,ierx] = hpppval(te,t,x,xp,sigma); [vy,iery] = hpppval(te,t,y,yp,sigma); end % Convert vx and vy from columns to rows if te is a row vector. if size(te,1) == 1 vx = vx'; vy = vy'; end if (ierx > 0 || iery > 0) ier = 1; end if (ierx < 0 || iery < 0) ier = -1; end return; end % tsval2 function [vx,vy,vz,ier] = tsval3 (t,x,y,z,xp,yp,zp,sigma, ... iflag,te) % tsval3: Values or derivative vectors of space curve % % USAGE: [vx,vy,vz,ier] = tsval3(t,x,y,z,xp,yp,zp,sigma,iflag,te); % % This function returns values or derivatives of three % Hermite interpolatory tension splines H1, H2, and H3 that % form the components of a parametric space curve C(t) = % (H1(t),H2(t),H3(t)). Refer to Functions TSPBP and % TSPSP. % % On input: % % T = Vector of length N containing a strictly in- % creasing sequence of abscissae (parameter % values). N >= 2. Refer to Function ARCL3D. % % X = Vector of length N containing data values or % function values returned by Function SMCRV. % X(I) = H1(T(I)) for I = 1 to N. % % Y = Vector of length N containing data values or % function values returned by Function SMCRV. % Y(I) = H2(T(I)) for I = 1 to N. % % Z = Vector of length N containing data values or % function values returned by Function SMCRV. % Z(I) = H3(T(I)) for I = 1 to N. % % XP = Vector of length N containing first deriva- % tives. XP(I) = H1P(T(I)) for I = 1 to N, % where H1P denotes the derivative of H1. % % YP = Vector of length N containing first deriva- % tives. YP(I) = H2P(T(I)) for I = 1 to N, % where H2P denotes the derivative of H2. % % ZP = Vector of length N containing first deriva- % tives. ZP(I) = H3P(T(I)) for I = 1 to N, % where H3P denotes the derivative of H3. % % Note that C(T(I)) = (X(I),Y(I),Z(I)) and CP(T(I)) = % (XP(I),YP(I),ZP(I)), I = 1 to N, are data (control) % points and derivative (velocity) vectors, respectively. % % SIGMA = Vector of length N-1 containing tension fac- % tors whose absolute values determine the % balance between cubic and linear in each % interval. SIGMA(I) is associated with int- % erval (I,I+1) for I = 1 to N-1. % % IFLAG = Output option indicator: % IFLAG = 0 if values of H1, H2, and H3 % (points on the curve) are to be % computed. % IFLAG = 1 if first derivative vectors are to % be computed. Unit tangent vectors % can be obtained by normalizing % these to unit vectors. % IFLAG = 2 if second derivative (accelera- % tion) vectors are to be computed. % Given a velocity vector U and % acceleration vector V, the % corresponding curvature vector % can be computed as (U X V X U)/ % |U|^4 = (|U|^2*V - *U)/|U|^4. % IFLAG = 3 if third derivative vectors are to % be computed. For velocity U, % acceleration V, and third deriva- % tive W, the torsion is det(U,V,W)/ % |U X V|^2. % % TE = Vector of length NE containing the evaluation % points. The sequence should be strictly in- % creasing for maximum efficiency. Extrapolation % is performed if a point is not in the interval % [T(1),T(N)]. NE > 0. % % On output: % % VX,VY,VZ = Vectors of size(TE) containing values, % first derivatives, second derivatives, % or third derivatives of H1, H2, and H3, % respectively, at the evaluation points % (unless IER < 0). If IER = -2, VX, VY, % and VZ are zeros. If IER = -1, VX, VY, % and VZ may be only partially defined. % % IER = Error indicator: % IER = 0 if no errors were encountered and % no extrapolation occurred. % IER = 1 if no errors were encountered but % extrapolation was required at one % or more points. % IER = -1 if the abscissae are not in strictly % increasing order. (This error will % not necessarily be detected.) % IER = -2 if N < 2, IFLAG < 0, IFLAG > 3, or % NE < 1. % % Modules required by TSVAL3: HPPVAL, HPVAL, HVAL, SNHCSH % %*********************************************************** n = length(t); ne = length(te); % Test for invalid input. if (n < 2 || iflag < 0 || iflag > 3 || ne < 1) vx = zeros(size(te)); vy = zeros(size(te)); vz = zeros(size(te)); ier = -2; return; end if (iflag == 0) [vx,ierx] = hval(te,t,x,xp,sigma); [vy,iery] = hval(te,t,y,yp,sigma); [vz,ierz] = hval(te,t,z,zp,sigma); elseif (iflag == 1) [vx,ierx] = hpval(te,t,x,xp,sigma); [vy,iery] = hpval(te,t,y,yp,sigma); [vz,ierz] = hpval(te,t,z,zp,sigma); elseif (iflag == 2) [vx,ierx] = hppval(te,t,x,xp,sigma); [vy,iery] = hppval(te,t,y,yp,sigma); [vz,ierz] = hppval(te,t,z,zp,sigma); else [vx,ierx] = hpppval(te,t,x,xp,sigma); [vy,iery] = hpppval(te,t,y,yp,sigma); [vz,ierz] = hpppval(te,t,z,zp,sigma); end % Convert vx, vy, and vz from columns to rows if te is a row vector. if size(te,1) == 1 vx = vx'; vy = vy'; vz = vz'; end if (ierx > 0 || iery > 0 || ierz > 0) ier = 1; end if (ierx < 0 || iery < 0 || ierz < 0) ier = -1; end return; end % tsval3 function [yp,ier] = ypc1(x,y) % ypc1: Local derivative estimates % % USAGE: [yp,ier] = ypc1(x,y); % % This function employs a three-point quadratic interpo- % lation method to compute local derivative estimates YP % associated with a set of N data points. The interpolation % formula is the monotonicity-constrained parabolic method % described in the reference cited below. A Hermite int- % erpolant of the data values and derivative estimates pre- % serves monotonicity of the data. Linear interpolation is % used if N = 2. The method is invariant under a linear % scaling of the coordinates but is not additive. % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values asso- % ciated with the abscissae. % % On output: % % YP = Vector of size(X) containing estimated deriv- % atives at the abscissae unless IER ~= 0. % YP is zeros if IER = 1, and is only partially % computed if IER > 1. % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = 1 if N < 2. % IER = I if X(I) <= X(I-1) for some I in the % range 2 to N. % % Reference: J. M. Hyman, "Accurate Monotonicity-preserving % Cubic Interpolation", LA-8796-MS, Los % Alamos National Lab, Feb. 1982. % % Modules required by YPC1: None % %*********************************************************** n = length(x); yp = zeros(size(x)); if (n < 2) ier = 1; return; end dx = diff(x); if (any(dx <= 0)) ier = find(dx <= 0, 1) + 1; return; end s = diff(y)./dx; if (n == 2) % Use linear interpolation for N = 2. yp(1) = s; yp(2) = s; ier = 0; return; end % N >= 3. YP(1) = S(1) + DX(1)*(S(1)-S(2))/(DX(1)+DX(2)) % unless this results in YP(1)*S(1) <= 0 or abs(YP(1)) > % 3*abs(S(1)). t = s(1) + dx(1)*(s(1)-s(2))/(dx(1)+dx(2)); if (s(1) >= 0) yp(1) = min([max([0, t]), 3.0*s(1)]); else yp(1) = max([min([0, t]), 3.0*s(1)]); end % For i = 2 to N-1, YP(i) = (DX(i-1)*S(i)+DX(i)*S(i-1))/ % (DX(i-1)+DX(i)) subject to the constraint that YP(i) % has the sign of either S(i-1) or S(i), whichever has % larger magnitude, and abs(YP(i)) <= 3*min(abs(S(i-1)), % abs(S(i))). smag = abs(s); i = 2:n-1; yp(i) = (dx(i-1).*s(i) + dx(i).*s(i-1))./(dx(i-1)+dx(i)); % Partition the interior point indices i = 2:n-1 into subsets % k1 and k2. k1 = find(smag(i-1) > smag(i)) + 1; k2 = setdiff(i, k1); yp(k1(sign(yp(k1)).*sign(s(k1-1)) < 0)) = 0; k = find(abs(yp(k1)) > 3.0*smag(k1)); yp(k1(k)) = 3.0*smag(k1(k)).*sign(yp(k1(k))); yp(k2(sign(yp(k2)).*sign(s(k2)) <= 0)) = 0; k = find(abs(yp(k2)) > 3.0*smag(k2-1)); yp(k2(k)) = 3.0*smag(k2(k)-1).*sign(yp(k2(k))); % YP(N) = S(N-1) + DX(N-1)*(S(N-1)-S(N-2))/(DX(N-2)+DX(N-1)) % subject to the constraint that YP(N) has the sign of % S(N-1) and abs(YP(N)) <= 3*abs(S(N-1)). t = s(n-1) + dx(n-1)*(s(n-1)-s(n-2))/(dx(n-2)+dx(n-1)); if (s(n-1) >= 0) yp(n) = min([max([0, t]), 3.0*s(n-1)]); else yp(n) = max([min([0, t]), 3.0*s(n-1)]); end % No error encountered. ier = 0; return; end % ypc1 function [yp,ier] = ypc1p(x,y) % ypc1p: Local derivative estimates, periodic case % % USAGE: [yp,ier] = ypc1p(x,y); % % This function employs a three-point quadratic interpo- % lation method to compute local derivative estimates YP % associated with a set of N data points (X(I),Y(I)). It % is assumed that Y(N) = Y(1), and YP(N) = YP(1) on output. % Thus, a Hermite interpolant H(x) defined by the data % points and derivative estimates is periodic with period % X(N)-X(1). The derivative-estimation formula is the % monotonicity-constrained parabolic fit described in the % reference cited below: H(x) is monotonic in intervals in % which the data is monotonic. The method is invariant % under a linear scaling of the coordinates but is not % additive. % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 3. % % Y = Vector of length N containing data values asso- % ciated with the abscissae. Y(N) = Y(1). % % On output: % % YP = Vector of size(X) containing estimated deriv- % atives at the abscissae unless IER ~= 0. % YP is zeros if IER = 1, and is only partially % computed if IER > 1. % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = 1 if N < 3 or Y(N) ~= Y(1). % IER = I if X(I) <= X(I-1) for some I in the % range 2 to N. % % Reference: J. M. Hyman, "Accurate Monotonicity-preserving % Cubic Interpolation", LA-8796-MS, Los % Alamos National Lab, Feb. 1982. % % Modules required by YPC1P: None % %*********************************************************** n = length(x); yp = zeros(size(x)); if (n < 3 || y(n) ~= y(1)) ier = 1; return; end % For i = 2 to N-1, YP(i) = (DX(i-1)*S(i)+DX(i)*S(i-1))/ % (DX(i-1)+DX(i)) subject to the constraint that YP(i) % has the sign of either S(i-1) or S(i), whichever has % larger magnitude, and abs(YP(i)) <= 3*min(abs(S(i-1)), % abs(S(i))). dx = diff(x); if (any(dx <= 0)) ier = find(dx <= 0, 1) + 1; return; end s = diff(y)./dx; smag = abs(s); i = 2:n-1; yp(i) = (dx(i-1).*s(i) + dx(i).*s(i-1))./(dx(i-1)+dx(i)); % Partition the interior point indices 2:n-1 into subsets % k1 and k2. k1 = find(smag(i-1) > smag(i)) + 1; k2 = setdiff(i, k1); yp(k1(sign(yp(k1)).*sign(s(k1-1)) < 0)) = 0; k = find(abs(yp(k1)) > 3.0*smag(k1)); yp(k1(k)) = 3.0*smag(k1(k)).*sign(yp(k1(k))); yp(k2(sign(yp(k2)).*sign(s(k2)) <= 0)) = 0; k = find(abs(yp(k2)) > 3.0*smag(k2-1)); yp(k2(k)) = 3.0*smag(k2(k)-1).*sign(yp(k2(k))); % Compute YP(N) = YP(1): i = 1 and i-1 = n-1. t = (dx(n-1)*s(1) + dx(1)*s(n-1))/(dx(n-1)+dx(1)); if (smag(n-1) > smag(1)) sgn = sign(s(n-1)); else sgn = sign(s(1)); end if (sgn > 0) yp(1) = min([max([0, t]), 3.0*min([smag(n-1), smag(1)])]); else yp(1) = max([min([0, t]), -3.0*min([smag(n-1), smag(1)])]); end yp(n) = yp(1); % No error encountered. ier = 0; return; end % ypc1p function [u,v,w,ier] = ypc1t(x,y,z) % ypc1t: Local derivative estimates as unit tangent vectors % % USAGE: [u,v,ier] = ypc1t(x,y) % or [u,v,w,ier] = ypc1t(x,y,z) % % Given an ordered sequence of N control points (X,Y) or % (X,Y,Z) defining a parametric curve, this function returns % a sequence of unit tangent vectors (U,V) or (U,V,W) at the % control points. The tangent direction at an interior % point is taken to be a weighted sum of the incident chord % directions, where the weights are inverse chord lengths. % If the curve is open, each endpoint tangent is taken to be % the reflection about the end chord of the tangent at the % other end of the chord. If N = 2, both endpoint tangents % coincide with the chord direction. % % On input: % % X,Y,Z = Vectors of length N containing control point % coordinates, where N >= 2 and N >= 3 if the % curve is closed. Adjacent control points % must be distinct. The curve is assumed to % be closed if and only if the first and last % points coincide. Z may be omitted (for a % planar curve), in which case W is not % returned. % % On output: % % U,V,W = Column vectors of length N containing the % components of unit tangent vectors at the % control points unless IER > 0. % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = 1 if N < 2 or (N < 3 and the curve is % closed). % IER = I if control points I-1 and I coincide % for some I in the range 2 to N. % % Modules required by YPC1T: None % %*********************************************************** n = length(x); % In order to allow the caller to effectively omit w from the % output parameter list when z is omitted from the input list, % w is assigned the same value as ier when nargin = 2. if n < 2 u = 0; v = 0; w = 1; ier = 1; return; end % Convert input row vectors to column vectors. x = x(:); y = y(:); if nargin == 2 closed = x(1) == x(n) && y(1) == y(n); else z = z(:); closed = x(1) == x(n) && y(1) == y(n) && z(1) == z(n); end if n < 3 && closed u = 0; v = 0; w = 1; ier = 1; return; end i = 2:n; im1 = i-1; if nargin == 2 wt = sqrt((x(i)-x(im1)).^2 + (y(i)-y(im1)).^2); else wt = sqrt((x(i)-x(im1)).^2 + (y(i)-y(im1)).^2 + (z(i)-z(im1)).^2); end if (any(wt <= 0)) ier = find(wt <= 0, 1) + 1; u = 0; v = 0; w = ier; return; end w = 0; ier = 0; % Treat the case N = 2. if n == 2 s = 1./wt(1); u(1) = s*(x(2)-x(1)); v(1) = s*(y(2)-y(1)); u(2) = u(1); v(2) = v(1); if nargin == 3 w(1) = s*(z(2)-z(1)); w(2) = w(1); end return; end % Compute interior tangent directions. The weights wt % are reciprocals of squared chord lengths. wt = 1./wt.^2; i = 2:n-1; u(i) = wt(i-1).*(x(i)-x(i-1)) + wt(i).*(x(i+1)-x(i)); v(i) = wt(i-1).*(y(i)-y(i-1)) + wt(i).*(y(i+1)-y(i)); if nargin == 3 w(i) = wt(i-1).*(z(i)-z(i-1)) + wt(i).*(z(i+1)-z(i)); end if closed u(1) = wt(n-1).*(x(n)-x(n-1)) + wt(1).*(x(2)-x(1)); u(n) = u(1); v(1) = wt(n-1).*(y(n)-y(n-1)) + wt(1).*(y(2)-y(1)); v(n) = v(1); if nargin == 3 w(1) = wt(n-1).*(z(n)-z(n-1)) + wt(1).*(z(2)-z(1)); w(n) = w(1); end else % Open curve: compute endpoint tangent vectors. if nargin == 2 s = 2*wt(1)*(u(2)*(x(2)-x(1)) + v(2)*(y(2)-y(1))); u(1) = s*(x(2)-x(1)) - u(2); v(1) = s*(y(2)-y(1)) - v(2); s = 2*wt(n-1)*(u(n-1)*(x(n)-x(n-1)) + ... v(n-1)*(y(n)-y(n-1))); u(n) = s*(x(n)-x(n-1)) - u(n-1); v(n) = s*(y(n)-y(n-1)) - v(n-1); else s = 2*wt(1)*(u(2)*(x(2)-x(1)) + v(2)*(y(2)-y(1)) + ... w(2)*(z(2)-z(1))); u(1) = s*(x(2)-x(1)) - u(2); v(1) = s*(y(2)-y(1)) - v(2); w(1) = s*(z(2)-z(1)) - w(2); s = 2*wt(n-1)*(u(n-1)*(x(n)-x(n-1)) + ... v(n-1)*(y(n)-y(n-1)) + ... w(n-1)*(z(n)-z(n-1))); u(n) = s*(x(n)-x(n-1)) - u(n-1); v(n) = s*(y(n)-y(n-1)) - v(n-1); w(n) = s*(z(n)-z(n-1)) - w(n-1); end end % Normalize tangents to unit vectors. if nargin == 2 wt = 1./sqrt(u.^2 + v.^2); u = wt.*u; v = wt.*v; else wt = 1./sqrt(u.^2 + v.^2 + w.^2); u = wt.*u; v = wt.*v; w = wt.*w; end return; end % ypc1t function [yp,ier] = ypc2(x,y,sigma,isl1,isln,bv1,bvn) % ypc2: C^2 global derivative estimates % % USAGE: [yp,ier] = ypc2(x,y,sigma,isl1,isln,bv1,bvn); % % This function solves a linear system for a set of % first derivatives YP associated with a Hermite interpola- % tory tension spline H(x). The derivatives are chosen so % that H(x) has two continuous derivatives for all x and H % satisfies user-specified end conditions. % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 2. % % Y = Vector of length N containing data values asso- % ciated with the abscissae. H(X(I)) = Y(I) for % I = 1 to N. % % SIGMA = Vector of length N-1 containing tension % factors. SIGMA(I) is associated with inter- % val (X(I),X(I+1)) for I = 1 to N-1. If % SIGMA(I) = 0, H is the Hermite cubic interp- % olant of the data values and computed deriv- % atives at X(I) and X(I+1), and if all % tension factors are zero, H is the C-2 cubic % spline interpolant that satisfies the end % conditions. % % ISL1 = Option indicator for the condition at X(1): % ISL1 = 0 if YP(1) is to be estimated inter- % nally by a constrained parabolic % fit to the first three points. % This is identical to the method used % by Function YPC1. BV1 is not used % in this case. % ISL1 = 1 if the first derivative of H at X(1) % is specified by BV1. % ISL1 = 2 if the second derivative of H at % X(1) is specified by BV1. % ISL1 = 3 if YP(1) is to be estimated inter- % nally from the derivative of the % tension spline (using SIGMA(1)) % that interpolates the first three % data points and has third derivative % equal to zero at X(1). Refer to % ENDSLP. BV1 is not used in this % case. % % ISLN = Option indicator for the condition at X(N): % ISLN = 0 if YP(N) is to be estimated inter- % nally by a constrained parabolic % fit to the last three data points. % This is identical to the method used % by Function YPC1. BVN is not used % in this case. % ISLN = 1 if the first derivative of H at X(N) % is specified by BVN. % ISLN = 2 if the second derivative of H at % X(N) is specified by BVN. % ISLN = 3 if YP(N) is to be estimated inter- % nally from the derivative of the % tension spline (using SIGMA(N-1)) % that interpolates the last three % data points and has third derivative % equal to zero at X(N). Refer to % ENDSLP. BVN is not used in this % case. % % BV1,BVN = Boundary values or dummy parameters as % defined by ISL1 and ISLN. % % On output: % % YP = Vector of size(X) containing derivatives of % H at the abscissae. YP is zeros if IER ~= 0. % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = 1 if N, ISL1, or ISLN is outside its % valid range. % IER = I if X(I) <= X(I-1) for some I in the % range 2 to N. % % Modules required by YPC2: ENDSLP, SNHCSH, YPCOEF % %*********************************************************** m = size(x); n = length(x); yp = zeros(m); if (n < 2 || isl1 < 0 || isl1 > 3 || isln < 0 || ... isln > 3) ier = 1; return end nm1 = n - 1; % Set YP1 and YPN to the endpoint values. if (isl1 == 0) if (n > 2) yp1 = endslp(x(1),x(2),x(3),y(1),y(2),y(3),0.0); end elseif (isl1 ~= 3) yp1 = bv1; else if (n > 2) yp1 = endslp(x(1),x(2),x(3),y(1),y(2),y(3),sigma(1)); end end if (isln == 0) if (n > 2) ypn = endslp(x(n),x(nm1),x(n-2),y(n),y(nm1),y(n-2),0.0); end elseif (isln ~= 3) ypn = bvn; else if (n > 2) ypn = endslp(x(n),x(nm1),x(n-2),y(n),y(nm1),y(n-2),sigma(nm1)); end end % Arrays: dx = diff(x); if (any(dx <= 0)) ier = find(dx <= 0, 1) + 1; return; end s = diff(y)./dx; sig = abs(sigma); wk = zeros(nm1,1); % Solve the symmetric positive-definite tridiagonal linear % system. The forward elimination step consists of div- % iding each row by its diagonal entry, then introducing a % zero below the diagonal. This requires saving only the % superdiagonal (in WK) and the right hand side (in YP). if (n == 2) if (isl1 == 0 || isl1 == 3), yp1 = s(1); end if (isln == 0 || isln == 3), ypn = s(1); end end % Begin forward elimination. [d1,sd1] = ypcoef(sig(1),dx(1)); r1 = (sd1+d1)*s(1); wk(1) = 0; yp(1) = yp1; if (isl1 == 2) wk(1) = sd1/d1; yp(1) = (r1-yp1)/d1; end for i = 2:nm1 [d2,sd2] = ypcoef(sig(i),dx(i)); r2 = (sd2+d2)*s(i); d = d1 + d2 - sd1*wk(i-1); wk(i) = sd2/d; yp(i) = (r1 + r2 - sd1*yp(i-1))/d; d1 = d2; sd1 = sd2; r1 = r2; end d = d1 - sd1*wk(nm1); yp(n) = ypn; if (isln == 2) yp(n) = (r1 + ypn - sd1*yp(nm1))/d; end % Back substitution: for i = nm1:-1:1 yp(i) = yp(i) - wk(i)*yp(i+1); end ier = 0; return; end % ypc2 function [yp,ier] = ypc2p(x,y,sigma) % ypc2p: C^2 global derivative estimates, periodic case % % USAGE: [yp,ier] = ypc2p(x,y,sigma); % % This function solves a linear system for a set of % first derivatives YP associated with a Hermite interpola- % tory tension spline H(x). The derivatives are chosen so % that H(x) has two continuous derivatives for all x, and H % satisfies periodic end conditions: first and second der- % ivatives of H at X(1) agree with those at X(N), and thus % the length of a period is X(N) - X(1). It is assumed that % Y(N) = Y(1). % % On input: % % X = Vector of length N containing a strictly in- % creasing sequence of abscissae: X(I) < X(I+1) % for I = 1 to N-1. N >= 3. % % Y = Vector of length N containing data values asso- % ciated with the abscissae. H(X(I)) = Y(I) for % I = 1 to N. % % SIGMA = Vector of length N-1 containing tension % factors. SIGMA(I) is associated with inter- % val (X(I),X(I+1)) for I = 1 to N-1. If % SIGMA(I) = 0, H is the Hermite cubic interp- % olant of the data values and computed deriv- % atives at X(I) and X(I+1), and if all % tension factors are zero, H is the C-2 cubic % spline interpolant that satisfies the end % conditions. % % On output: % % YP = Vector of size(X) containing derivatives of % H at the abscissae. YP is zeros if IER ~= 0. % % IER = Error indicator: % IER = 0 if no errors were encountered. % IER = 1 if N is outside its valid range. % IER = I if X(I) <= X(I-1) for some I in the % range 2 to N. % % Modules required by YPC2P: SNHCSH, YPCOEF % %*********************************************************** m = size(x); n = length(x); yp = zeros(m); if (n < 3) ier = 1; return; end nm1 = n - 1; nm2 = n - 2; nm3 = n - 3; np1 = n + 1; % Arrays: dx = diff(x); if (any(dx <= 0)) ier = find(dx <= 0, 1) + 1; return; end s = diff(y)./dx; sig = abs(sigma); wk = zeros(2*nm1,1); % The system is order N-1, symmetric, positive-definite, and % tridiagonal except for nonzero elements in the upper % right and lower left corners. The forward elimination % step zeros the subdiagonal and divides each row by its % diagonal entry for the first N-2 rows. The superdiago- % nal is stored in WK(I), the negative of the last column % (fill-in) in WK(N+I), and the right hand side in YP(I) % for I = 1 to N-2. % i = nm1 [dnm1,sdnm1] = ypcoef(sig(nm1),dx(nm1)); rnm1 = (sdnm1+dnm1)*s(nm1); % i = 1 [d1,sd1] = ypcoef (sig(1),dx(1)); r1 = (sd1+d1)*s(1); d = dnm1 + d1; wk(1) = sd1/d; wk(np1) = -sdnm1/d; yp(1) = (rnm1+r1)/d; for i = 2:nm2 [d2,sd2] = ypcoef(sig(i),dx(i)); r2 = (sd2+d2)*s(i); d = d1 + d2 - sd1*wk(i-1); din = 1.0/d; wk(i) = sd2*din; npi = n + i; wk(npi) = -sd1*wk(npi-1)*din; yp(i) = (r1 + r2 - sd1*yp(i-1))*din; sd1 = sd2; d1 = d2; r1 = r2; end % The backward elimination step zeros the superdiagonal % (first N-3 elements). WK(I) and YP(I) are overwritten % with the negative of the last column and the new right % hand side, respectively, for I = N-2, N-3, ..., 1. npi = n + nm2; wk(nm2) = wk(npi) - wk(nm2); for i = nm3:-1:1 yp(i) = yp(i) - wk(i)*yp(i+1); npi = n + i; wk(i) = wk(npi) - wk(i)*wk(i+1); end % Solve the last equation for YP(N-1). ypnm1 = (r1 + rnm1 - sdnm1*yp(1) - sd1*yp(nm2))/ ... (d1 + dnm1 + sdnm1*wk(1) + sd1*wk(nm2)); % Back substitute for the remainder of the solution % components. yp(nm1) = ypnm1; for i = 1:nm2 yp(i) = yp(i) + wk(i)*ypnm1; end % YP(N) = YP(1). yp(n) = yp(1); ier = 0; return; end % ypc2p function [d,sd] = ypcoef(sigma,dx) % ypcoef: Coefficients for ypc2p and smcrv % % USAGE: [d,sd] = ypcoef(sigma,dx); % % This function computes the coefficients of the deriva- % tives in the symmetric diagonally dominant tridiagonal % system associated with the C-2 derivative estimation pro- % cedure for a Hermite interpolatory tension spline. % % On input: % % SIGMA = Nonnegative tension factor (or vector of % factors) associated with intervals. % % DX = Positive interval widths in one-to-one corres- % pondence with SIGMA. % % On output: % % D = Components of the diagonal terms associated with % the intervals. D = SIGMA.*(SIGMA.*COSHM(SIGMA)- % SINHM(SIGMA))./(DX.*E), where E = SIGMA.* % SINH(SIGMA) - 2*COSHM(SIGMA). % % SD = Subdiagonal (superdiagonal) terms. SD = % SIGMA.*SINHM(SIGMA)./(DX.*E). % % Module required by YPCOEF: SNHCSH % %*********************************************************** k = find(sigma < 1.e-9); % k = indices for which SIGMA = 0: cubic interpolant. d(k) = 4.0./dx(k); sd(k) = 2.0./dx(k); % For 0 < SIGMA <= .5, use approximations designed to avoid % cancellation error in the hyperbolic functions. k = find(sigma >= 1.e-9 & sigma <= 0.5); [sinhm,coshm,coshmm] = snhcsh(sigma(k)); e = (sigma(k).*sinhm - coshmm - coshmm).*dx(k); d(k) = sigma(k).*(sigma(k).*coshm-sinhm)./e; sd(k) = sigma(k).*sinhm./e; % For SIGMA > .5, scale SINHM and COSHM by 2*EXP(-SIGMA) in % order to avoid overflow when SIGMA is large. k = find(sigma > 0.5); ems = exp(-sigma(k)); ssinh = 1.0 - ems.*ems; ssm = ssinh - 2.0*sigma(k).*ems; scm = (1.0-ems).*(1.0-ems); e = (sigma(k).*ssinh - scm - scm).*dx(k); d(k) = sigma(k).*(sigma(k).*scm-ssm)./e; sd(k) = sigma(k).*ssm./e; return; end % ypcoef