Skip to content

Commit b7f54a1

Browse files
perazzperazz
committed
Add least_squares, reset_knots, keep_knots across all fitter types
Add least_squares to fitpack_parametric_curve (inherited by closed/ constrained curve subtypes). Add reset_knots optional parameter to interpolate on all 9 fitter types, allowing callers to preserve the current knot set when re-interpolating. Add keep_knots optional parameter to fit on all 9 types to bypass the iopt guard that otherwise forces fresh knot computation. Extend test_umbrella_api with parametric curve interpolate/least_squares coverage and fp value checks.
1 parent 15e0bab commit b7f54a1

11 files changed

+153
-62
lines changed

‎docs/refactoring/04_oop_interface_analysis.md‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -223,7 +223,7 @@ that serializes all allocatable components).
223223

224224
# PR Plans
225225

226-
## PR A: Public API Cleanup & Umbrella Module
226+
## PR A: Public API Cleanup & Umbrella Module (DONE)
227227

228228
**Goal**: Make the `fitpack` umbrella module self-sufficient — users should never need
229229
`use fitpack_core` directly.
@@ -270,9 +270,9 @@ A user writing `curve%bc = OUTSIDE_EXTRAPOLATE` must also `use fitpack_core`. Si
270270

271271
---
272272

273-
## PR B: Abstract Base Type
273+
## PR B: Abstract Base Type (DONE — PR #41)
274274

275-
**Goal**: Extract shared state and logic into an abstract `fitpack_spline` base type that
275+
**Goal**: Extract shared state and logic into an abstract `fitpack_fitter` base type that
276276
all 9 concrete types extend.
277277

278278
### Design

‎src/fitpack_curves.f90‎

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -331,15 +331,17 @@ pure function curve_eval_many_pure(this,x) result(y)
331331
end function curve_eval_many_pure
332332

333333
! Interpolating curve
334-
integer(FP_FLAG) function interpolating_curve(this,order) result(ierr)
334+
integer(FP_FLAG) function interpolating_curve(this,order,reset_knots) result(ierr)
335335
class(fitpack_curve), intent(inout) :: this
336336
integer(FP_SIZE), optional, intent(in) :: order
337+
logical, optional, intent(in) :: reset_knots
337338

338-
! Set zero smoothing
339-
this%iopt = IOPT_NEW_SMOOTHING
340-
341-
! Update order if necessary
342-
ierr = curve_fit_automatic_knots(this,smoothing=zero,order=order)
339+
logical :: do_reset
340+
341+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
342+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
343+
344+
ierr = curve_fit_automatic_knots(this,smoothing=zero,order=order,keep_knots=.not.do_reset)
343345

344346
end function interpolating_curve
345347

@@ -351,19 +353,22 @@ integer(FP_FLAG) function curve_fit_least_squares(this) result(ierr)
351353
end function curve_fit_least_squares
352354

353355
! Curve fitting driver: automatic number of knots
354-
integer(FP_FLAG) function curve_fit_automatic_knots(this,smoothing,order) result(ierr)
356+
integer(FP_FLAG) function curve_fit_automatic_knots(this,smoothing,order,keep_knots) result(ierr)
355357
class(fitpack_curve), intent(inout) :: this
356358
real(FP_REAL), optional, intent(in) :: smoothing
357359
integer(FP_SIZE), optional, intent(in) :: order
360+
logical, optional, intent(in) :: keep_knots
358361

359362
integer(FP_SIZE) :: loop,nit
360363
real(FP_REAL) :: smooth_now(3)
364+
logical :: do_guard
361365

362366
!> Get smoothing trajectory
363367
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
364368

365-
!> Ensure we start with new knots
366-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
369+
!> Ensure we start with new knots (unless caller wants to keep them)
370+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
371+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
367372

368373
!> Set/update order
369374
if (present(order)) this%order = order

‎src/fitpack_grid_surfaces.f90‎

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -103,28 +103,35 @@ integer function surface_fit_least_squares(this) result(ierr)
103103
end function surface_fit_least_squares
104104

105105
! Find interpolating surface
106-
integer function surface_fit_interpolating(this) result(ierr)
106+
integer function surface_fit_interpolating(this,reset_knots) result(ierr)
107107
class(fitpack_grid_surface), intent(inout) :: this
108+
logical, optional, intent(in) :: reset_knots
108109

109-
! Set zero smoothing
110-
ierr = surface_fit_automatic_knots(this,smoothing=zero)
110+
logical :: do_reset
111+
112+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
113+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
114+
ierr = surface_fit_automatic_knots(this,smoothing=zero,keep_knots=.not.do_reset)
111115

112116
end function surface_fit_interpolating
113117

114118

115119
! Fit a surface z = s(x,y) defined on a meshgrid: x[1:n], y[1:m]
116-
integer(FP_FLAG) function surface_fit_automatic_knots(this,smoothing,order) result(ierr)
120+
integer(FP_FLAG) function surface_fit_automatic_knots(this,smoothing,order,keep_knots) result(ierr)
117121
class(fitpack_grid_surface), intent(inout) :: this
118122
real(FP_REAL), optional, intent(in) :: smoothing
119123
integer, optional, intent(in) :: order
124+
logical, optional, intent(in) :: keep_knots
120125

121126
integer(FP_SIZE) :: loop,nit
122127
real(FP_REAL) :: smooth_now(3)
128+
logical :: do_guard
123129

124130
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
125131

126-
!> Ensure we start with new knots
127-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
132+
!> Ensure we start with new knots (unless caller wants to keep them)
133+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
134+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
128135

129136
! User may want to change the order for both x and y
130137
if (present(order)) this%order = order

‎src/fitpack_gridded_polar.f90‎

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -115,27 +115,34 @@ integer function polr_fit_least_squares(this) result(ierr)
115115
end function polr_fit_least_squares
116116

117117
! Find interpolating surface
118-
integer function polr_fit_interpolating(this) result(ierr)
118+
integer function polr_fit_interpolating(this,reset_knots) result(ierr)
119119
class(fitpack_grid_polar), intent(inout) :: this
120+
logical, optional, intent(in) :: reset_knots
120121

121-
! Set zero smoothing
122-
ierr = polr_fit_automatic_knots(this,smoothing=zero)
122+
logical :: do_reset
123+
124+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
125+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
126+
ierr = polr_fit_automatic_knots(this,smoothing=zero,keep_knots=.not.do_reset)
123127

124128
end function polr_fit_interpolating
125129

126130

127131
! Fit a surface z = s(x,y) defined on a meshgrid: x[1:n], y[1:m]
128-
integer function polr_fit_automatic_knots(this,smoothing) result(ierr)
132+
integer function polr_fit_automatic_knots(this,smoothing,keep_knots) result(ierr)
129133
class(fitpack_grid_polar), intent(inout) :: this
130134
real(FP_REAL), optional, intent(in) :: smoothing
135+
logical, optional, intent(in) :: keep_knots
131136

132137
integer :: loop,nit,iopt(3),ider(2)
133138
real(FP_REAL) :: smooth_now(3)
139+
logical :: do_guard
134140

135141
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
136142

137-
!> Ensure we start with new knots
138-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
143+
!> Ensure we start with new knots (unless caller wants to keep them)
144+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
145+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
139146

140147
do loop=1,nit
141148

‎src/fitpack_gridded_sphere.f90‎

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -108,27 +108,34 @@ integer function spgrid_fit_least_squares(this) result(ierr)
108108
end function spgrid_fit_least_squares
109109

110110
! Find interpolating surface
111-
integer function spgrid_fit_interpolating(this) result(ierr)
111+
integer function spgrid_fit_interpolating(this,reset_knots) result(ierr)
112112
class(fitpack_grid_sphere), intent(inout) :: this
113+
logical, optional, intent(in) :: reset_knots
113114

114-
! Set zero smoothing
115-
ierr = spgrid_fit_automatic_knots(this,smoothing=zero)
115+
logical :: do_reset
116+
117+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
118+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
119+
ierr = spgrid_fit_automatic_knots(this,smoothing=zero,keep_knots=.not.do_reset)
116120

117121
end function spgrid_fit_interpolating
118122

119123

120124
! Fit a surface z = s(x,y) defined on a meshgrid: x[1:n], y[1:m]
121-
integer function spgrid_fit_automatic_knots(this,smoothing) result(ierr)
125+
integer function spgrid_fit_automatic_knots(this,smoothing,keep_knots) result(ierr)
122126
class(fitpack_grid_sphere), intent(inout) :: this
123127
real(FP_REAL), optional, intent(in) :: smoothing
128+
logical, optional, intent(in) :: keep_knots
124129

125130
integer :: loop,nit,iopt(3),ider(4)
126131
real(FP_REAL) :: smooth_now(3)
132+
logical :: do_guard
127133

128134
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
129135

130-
!> Ensure we start with new knots
131-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
136+
!> Ensure we start with new knots (unless caller wants to keep them)
137+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
138+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
132139

133140
do loop=1,nit
134141

‎src/fitpack_parametric.f90‎

Lines changed: 22 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,8 @@ module fitpack_parametric_curves
8282

8383
!> Generate/update fitting curve, with optional smoothing
8484
procedure :: fit => curve_fit_automatic_knots
85-
procedure :: interpolate => interpolating_curve
85+
procedure :: interpolate => interpolating_curve
86+
procedure :: least_squares => parcur_fit_least_squares
8687

8788
!> Evaluate curve at given coordinates
8889
procedure :: eval_one => curve_eval_one
@@ -427,31 +428,43 @@ function curve_eval_many(this,u,ierr) result(x)
427428
end function curve_eval_many
428429

429430
! Interpolating curve
430-
integer function interpolating_curve(this,order) result(ierr)
431+
integer function interpolating_curve(this,order,reset_knots) result(ierr)
431432
class(fitpack_parametric_curve), intent(inout) :: this
432433
integer(FP_SIZE), optional, intent(in) :: order
434+
logical, optional, intent(in) :: reset_knots
433435

434-
! Set zero smoothing
435-
this%iopt = IOPT_NEW_SMOOTHING
436+
logical :: do_reset
437+
438+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
439+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
436440

437-
! Set zero smoothing
438-
ierr = curve_fit_automatic_knots(this,smoothing=zero,order=order)
441+
ierr = curve_fit_automatic_knots(this,smoothing=zero,order=order,keep_knots=.not.do_reset)
439442

440443
end function interpolating_curve
441444

445+
! Least-squares curve fit with current knots
446+
integer function parcur_fit_least_squares(this) result(ierr)
447+
class(fitpack_parametric_curve), intent(inout) :: this
448+
this%iopt = IOPT_NEW_LEASTSQUARES
449+
ierr = this%fit()
450+
end function parcur_fit_least_squares
451+
442452
! Curve fitting driver: automatic number of knots
443-
integer function curve_fit_automatic_knots(this,smoothing,order) result(ierr)
453+
integer function curve_fit_automatic_knots(this,smoothing,order,keep_knots) result(ierr)
444454
class(fitpack_parametric_curve), intent(inout) :: this
445455
real(FP_REAL), optional, intent(in) :: smoothing
446456
integer(FP_SIZE), optional, intent(in) :: order
457+
logical, optional, intent(in) :: keep_knots
447458

448459
integer :: loop,nit
449460
real(FP_REAL) :: smooth_now(3)
461+
logical :: do_guard
450462

451463
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
452464

453-
!> Ensure we start with new knots
454-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
465+
!> Ensure we start with new knots (unless caller wants to keep them)
466+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
467+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
455468

456469
! Set order
457470
if (present(order)) this%order = order

‎src/fitpack_parametric_surfaces.f90‎

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -257,11 +257,15 @@ function surf_eval_grid(this,u,v,ierr) result(f)
257257
end function surf_eval_grid
258258

259259
! Interpolating curve
260-
integer function interpolating_curve(this) result(ierr)
260+
integer function interpolating_curve(this,reset_knots) result(ierr)
261261
class(fitpack_parametric_surface), intent(inout) :: this
262+
logical, optional, intent(in) :: reset_knots
262263

263-
! Set zero smoothing
264-
ierr = surf_fit_automatic_knots(this,zero)
264+
logical :: do_reset
265+
266+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
267+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
268+
ierr = surf_fit_automatic_knots(this,zero,keep_knots=.not.do_reset)
265269

266270
end function interpolating_curve
267271

@@ -307,18 +311,21 @@ integer function surface_fit_least_squares(this,u_knots,v_knots) result(ierr)
307311
end function surface_fit_least_squares
308312

309313
! Curve fitting driver: automatic number of knots
310-
integer function surf_fit_automatic_knots(this,smoothing,periodic) result(ierr)
314+
integer function surf_fit_automatic_knots(this,smoothing,periodic,keep_knots) result(ierr)
311315
class(fitpack_parametric_surface), intent(inout) :: this
312316
real(FP_REAL), optional, intent(in) :: smoothing
313317
logical, optional, intent(in) :: periodic(2)
318+
logical, optional, intent(in) :: keep_knots
314319

315320
integer :: loop,nit,ipar(2)
316321
real(FP_REAL) :: smooth_now(3)
322+
logical :: do_guard
317323

318324
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
319325

320-
!> Ensure we start with new knots
321-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
326+
!> Ensure we start with new knots (unless caller wants to keep them)
327+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
328+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
322329

323330
! Optionally set periodicity
324331
if (present(periodic)) this%periodic_dim = periodic

‎src/fitpack_polar.f90‎

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -114,26 +114,33 @@ integer function surface_fit_least_squares(this) result(ierr)
114114
end function surface_fit_least_squares
115115

116116
! Find interpolating surface
117-
integer function surface_fit_interpolating(this) result(ierr)
117+
integer function surface_fit_interpolating(this,reset_knots) result(ierr)
118118
class(fitpack_polar), intent(inout) :: this
119+
logical, optional, intent(in) :: reset_knots
119120

120-
! Set zero smoothing
121-
ierr = surface_fit_automatic_knots(this,smoothing=zero)
121+
logical :: do_reset
122+
123+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
124+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
125+
ierr = surface_fit_automatic_knots(this,smoothing=zero,keep_knots=.not.do_reset)
122126

123127
end function surface_fit_interpolating
124128

125129
! Fit a surface z = s(x,y) defined on a meshgrid: x[1:n], y[1:m]
126-
integer function surface_fit_automatic_knots(this,smoothing) result(ierr)
130+
integer function surface_fit_automatic_knots(this,smoothing,keep_knots) result(ierr)
127131
class(fitpack_polar), intent(inout) :: this
128132
real(FP_REAL), optional, intent(in) :: smoothing
133+
logical, optional, intent(in) :: keep_knots
129134

130135
integer :: loop,nit,iopt(3)
131136
real(FP_REAL) :: smooth_now(3)
137+
logical :: do_guard
132138

133139
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
134140

135-
!> Ensure we start with new knots
136-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
141+
!> Ensure we start with new knots (unless caller wants to keep them)
142+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
143+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
137144

138145
do loop=1,nit
139146

‎src/fitpack_spheres.f90‎

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -95,26 +95,33 @@ integer function surface_fit_least_squares(this) result(ierr)
9595
end function surface_fit_least_squares
9696

9797
! Find interpolating surface
98-
integer function surface_fit_interpolating(this) result(ierr)
98+
integer function surface_fit_interpolating(this,reset_knots) result(ierr)
9999
class(fitpack_sphere), intent(inout) :: this
100+
logical, optional, intent(in) :: reset_knots
100101

101-
! Set zero smoothing
102-
ierr = surface_fit_automatic_knots(this,smoothing=zero)
102+
logical :: do_reset
103+
104+
do_reset = .true.; if (present(reset_knots)) do_reset = reset_knots
105+
if (do_reset) this%iopt = IOPT_NEW_SMOOTHING
106+
ierr = surface_fit_automatic_knots(this,smoothing=zero,keep_knots=.not.do_reset)
103107

104108
end function surface_fit_interpolating
105109

106110
! Fit a surface z = s(x,y) defined on a meshgrid: x[1:n], y[1:m]
107-
integer function surface_fit_automatic_knots(this,smoothing) result(ierr)
111+
integer function surface_fit_automatic_knots(this,smoothing,keep_knots) result(ierr)
108112
class(fitpack_sphere), intent(inout) :: this
109113
real(FP_REAL), optional, intent(in) :: smoothing
114+
logical, optional, intent(in) :: keep_knots
110115

111116
integer :: loop,nit
112117
real(FP_REAL) :: smooth_now(3)
118+
logical :: do_guard
113119

114120
call get_smoothing(this%smoothing,smoothing,nit,smooth_now)
115121

116-
!> Ensure we start with new knots
117-
if (this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
122+
!> Ensure we start with new knots (unless caller wants to keep them)
123+
do_guard = .true.; if (present(keep_knots)) do_guard = .not.keep_knots
124+
if (do_guard .and. this%iopt==IOPT_OLD_FIT) this%iopt = IOPT_NEW_SMOOTHING
118125

119126
do loop=1,nit
120127

0 commit comments

Comments
 (0)