ParaMonte Fortran 2.0.0
Parallel Monte Carlo and Machine Learning Library
See the latest version documentation.
pm_knn.F90
Go to the documentation of this file.
1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3!!!! !!!!
4!!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5!!!! !!!!
6!!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7!!!! !!!!
8!!!! This file is part of the ParaMonte library. !!!!
9!!!! !!!!
10!!!! LICENSE !!!!
11!!!! !!!!
12!!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13!!!! !!!!
14!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16
79
80!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
81
82module pm_knn
83
84 use pm_kind, only: SK, IK
85 use pm_container
86
87 implicit none
88
89 character(*, SK), parameter :: MODULE_NAME = "@pm_knn"
90
91!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
92
178
179 ! rdpack, euclid
180
181 interface setKnnSorted
182
183 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
184
185#if RK5_ENABLED
186 PURE module subroutine setKnnSortedVal_RK5(distance)
187#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
188 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedVal_RK5
189#endif
190 use pm_kind, only: RKG => RK5
191 real(RKG) , intent(inout) , contiguous :: distance(:,:)
192 end subroutine
193#endif
194
195#if RK4_ENABLED
196 PURE module subroutine setKnnSortedVal_RK4(distance)
197#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
198 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedVal_RK4
199#endif
200 use pm_kind, only: RKG => RK4
201 real(RKG) , intent(inout) , contiguous :: distance(:,:)
202 end subroutine
203#endif
204
205#if RK3_ENABLED
206 PURE module subroutine setKnnSortedVal_RK3(distance)
207#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
208 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedVal_RK3
209#endif
210 use pm_kind, only: RKG => RK3
211 real(RKG) , intent(inout) , contiguous :: distance(:,:)
212 end subroutine
213#endif
214
215#if RK2_ENABLED
216 PURE module subroutine setKnnSortedVal_RK2(distance)
217#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
218 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedVal_RK2
219#endif
220 use pm_kind, only: RKG => RK2
221 real(RKG) , intent(inout) , contiguous :: distance(:,:)
222 end subroutine
223#endif
224
225#if RK1_ENABLED
226 PURE module subroutine setKnnSortedVal_RK1(distance)
227#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
228 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedVal_RK1
229#endif
230 use pm_kind, only: RKG => RK1
231 real(RKG) , intent(inout) , contiguous :: distance(:,:)
232 end subroutine
233#endif
234
235 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
236
237#if RK5_ENABLED
238 PURE module subroutine setKnnSortedKth_RK5(distance, k)
239#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
240 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedKth_RK5
241#endif
242 use pm_kind, only: RKG => RK5
243 real(RKG) , intent(inout) , contiguous :: distance(:,:)
244 integer(IK) , intent(in) :: k
245 end subroutine
246#endif
247
248#if RK4_ENABLED
249 PURE module subroutine setKnnSortedKth_RK4(distance, k)
250#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
251 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedKth_RK4
252#endif
253 use pm_kind, only: RKG => RK4
254 real(RKG) , intent(inout) , contiguous :: distance(:,:)
255 integer(IK) , intent(in) :: k
256 end subroutine
257#endif
258
259#if RK3_ENABLED
260 PURE module subroutine setKnnSortedKth_RK3(distance, k)
261#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
262 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedKth_RK3
263#endif
264 use pm_kind, only: RKG => RK3
265 real(RKG) , intent(inout) , contiguous :: distance(:,:)
266 integer(IK) , intent(in) :: k
267 end subroutine
268#endif
269
270#if RK2_ENABLED
271 PURE module subroutine setKnnSortedKth_RK2(distance, k)
272#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
273 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedKth_RK2
274#endif
275 use pm_kind, only: RKG => RK2
276 real(RKG) , intent(inout) , contiguous :: distance(:,:)
277 integer(IK) , intent(in) :: k
278 end subroutine
279#endif
280
281#if RK1_ENABLED
282 PURE module subroutine setKnnSortedKth_RK1(distance, k)
283#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
284 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedKth_RK1
285#endif
286 use pm_kind, only: RKG => RK1
287 real(RKG) , intent(inout) , contiguous :: distance(:,:)
288 integer(IK) , intent(in) :: k
289 end subroutine
290#endif
291
292 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
293
294#if RK5_ENABLED
295 PURE module subroutine setKnnSortedInd_RK5(distance, rank)
296#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
297 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedInd_RK5
298#endif
299 use pm_kind, only: RKG => RK5
300 real(RKG) , intent(in) , contiguous :: distance(:,:)
301 integer(IK) , intent(out) , contiguous :: rank(:,:)
302 end subroutine
303#endif
304
305#if RK4_ENABLED
306 PURE module subroutine setKnnSortedInd_RK4(distance, rank)
307#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
308 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedInd_RK4
309#endif
310 use pm_kind, only: RKG => RK4
311 real(RKG) , intent(in) , contiguous :: distance(:,:)
312 integer(IK) , intent(out) , contiguous :: rank(:,:)
313 end subroutine
314#endif
315
316#if RK3_ENABLED
317 PURE module subroutine setKnnSortedInd_RK3(distance, rank)
318#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
319 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedInd_RK3
320#endif
321 use pm_kind, only: RKG => RK3
322 real(RKG) , intent(in) , contiguous :: distance(:,:)
323 integer(IK) , intent(out) , contiguous :: rank(:,:)
324 end subroutine
325#endif
326
327#if RK2_ENABLED
328 PURE module subroutine setKnnSortedInd_RK2(distance, rank)
329#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
330 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedInd_RK2
331#endif
332 use pm_kind, only: RKG => RK2
333 real(RKG) , intent(in) , contiguous :: distance(:,:)
334 integer(IK) , intent(out) , contiguous :: rank(:,:)
335 end subroutine
336#endif
337
338#if RK1_ENABLED
339 PURE module subroutine setKnnSortedInd_RK1(distance, rank)
340#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
341 !DEC$ ATTRIBUTES DLLEXPORT :: setKnnSortedInd_RK1
342#endif
343 use pm_kind, only: RKG => RK1
344 real(RKG) , intent(in) , contiguous :: distance(:,:)
345 integer(IK) , intent(out) , contiguous :: rank(:,:)
346 end subroutine
347#endif
348
349 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
350
351 end interface
352
353!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
354
356#if 0
357 type :: minDisEdge_type!(IK, RK)
358 !integer , kind :: IK = IK_DEF
359 !integer , kind :: RK = RK_DEF
360 type(IV) :: index
361 type(RV) :: lenSq
362 integer(IK) :: npnt
363 end type minDisEdge_type
364
365 interface minDisEdge_type
366 module procedure :: getMinDisEdge
367 end interface minDisEdge_type
368
375 type :: hub_type!(IK, RK)
376 !integer(IK) , kind :: IK!= IK_DEF !< \public integer kind type parameter.
377 !integer(IK) , kind :: RK!= RK_DEF !< \public real kind type parameter.
378 integer(IK) :: nh
379 integer(IK) , allocatable :: nodeIndex(:)
380 integer(IK) , allocatable :: edgeCount(:)
381 type(IV) , allocatable :: edgeIndex(:)
382 type(RV) , allocatable :: edgeLenSq(:)
383 type(minDisEdge_type) :: minDisEdge
384 end type
385
386 interface hub_type
387 module procedure :: getHub
388 end interface hub_type
389#endif
390
391!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
392
393contains
394
395!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
396
397#if 0
398
401 pure function getMinDisEdge(pairDisSq) result(minDisEdge)
402#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
403 !DEC$ ATTRIBUTES DLLEXPORT :: getMinDisEdge
404#endif
405 real(RK), intent(in) :: pairDisSq(:,:)
406 type(minDisEdge_type) :: minDisEdge
407
408 integer(IK) :: pindex1
409 integer(IK) :: pindex2
410 integer(IK) :: npnt, jp
411
412 npnt = size(pairDisSq, 1, IK)
413 CHECK_ASSERTION(__LINE__, size(pairDisSq, 1, IK) == size(pairDisSq, 2, IK), SK_"@setKnnSorted(): The condition `size(pairDisSq, 1) == size(pairDisSq, 2)` must hold. shape(pairDisSq) = "//getStr([shape(pairDisSq, IK)]))
414
415 allocate(minDisEdge%index%val(npnt), minDisEdge%lenSq%val(npnt))
416 minDisEdge%npnt = npnt
417
418 jp = 1_IK
419 pindex2 = minloc(pairDisSq(2:npnt, jp), dim = 1, kind = IK) + 1_IK
420 minDisEdge%index%val(jp) = pindex2
421 minDisEdge%lenSq%val(jp) = pairDisSq(pindex2,jp)
422
423 jp = npnt
424 pindex1 = minloc(pairDisSq(1:jp-1, jp), dim = 1, kind = IK)
425 minDisEdge%index%val(jp) = pindex1
426 minDisEdge%lenSq%val(jp) = pairDisSq(pindex1,jp)
427
428 do concurrent(jp = 2 : npnt - 1)
429 pindex1 = minloc(pairDisSq(1 : jp - 1, jp), dim = 1, kind = IK)
430 pindex2 = minloc(pairDisSq(jp + 1 : npnt, jp), dim = 1, kind = IK) + jp
431 if (pairDisSq(pindex1,jp) < pairDisSq(pindex2,jp)) then
432 minDisEdge%index%val(jp) = pindex1
433 minDisEdge%lenSq%val(jp) = pairDisSq(pindex1,jp)
434 else
435 minDisEdge%index%val(jp) = pindex2
436 minDisEdge%lenSq%val(jp) = pairDisSq(pindex2,jp)
437 end if
438 end do
439
440 end function getMinDisEdge
441
442!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
443
444 PURE function getHub(npnt, pairDisSq) result(hub)
445#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
446 !DEC$ ATTRIBUTES DLLEXPORT :: getHub
447#endif
448 use pm_kind, only: IK, RK
449 use pm_arrayUnique, only: setUnique
450
451 implicit none
452
453 integer(IK) , intent(in) :: npnt
454 real(RK) , intent(in) :: pairDisSq(npnt,npnt)
455 type(hub_type) :: hub
456
457 character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@getHub()"
458 integer(IK) :: ih
459
460 hub%minDisEdge = minDisEdge_type(npnt,pairDisSq)
461 call setUnique( Array = hub%minDisEdge%index%val & ! LCOV_EXCL_LINE
462 , Unique = hub%nodeIndex & ! LCOV_EXCL_LINE
463 , count = hub%edgeCount & ! LCOV_EXCL_LINE
464 , index = hub%edgeIndex & ! LCOV_EXCL_LINE
465 , order = -1_IK & ! LCOV_EXCL_LINE
466 )
467 hub%nh = size(hub%nodeIndex, kind = IK)
468 allocate(hub%edgeLenSq(hub%nh))
469 do concurrent(ih = 1:hub%nh)
470 hub%edgeLenSq(ih)%val = hub%minDisEdge%lenSq%val(hub%edgeIndex(ih)%val)
471 end do
472
473 end function getHub
474#endif
475
476!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
477
478! !> \brief
479! !> Return the estimated mean and standard deviation of the volume occupied by a set of `npnt`
480! !> points uniformly distributed in an `nd` dimensional domain of arbitrary shape and size.
481! !>
482! !> \param[in] nd : The number of dimensions.
483! !> \param[in] npnt : The number of input points.
484! !> \param[in] sample : The input array of points of shape `(nd,npnt)`.
485! !>
486! !> \return
487! !> `innestIndex` : The index of the point with the smallest sum of distances-squared from all other points.
488! !>
489! !> \remark
490! !> This method relies on minimizing the KS-test statistic. Specifically, the point with
491! !>
492! !> \todo: The code performance and memory usage could be improved by return a vector instead of a Symmetric matrix.
493! pure function getMinSumPairDistSqPointIndex(nd, npnt, sample) result(innestIndex)
494!#if __INTEL_COMPILER && DLL_ENABLED && (_WIN32 || _WIN64)
495! !DEC$ ATTRIBUTES DLLEXPORT :: getMinSumPairDistSqPointIndex
496!#endif
497! use pm_knn, only: getPairDistSq ! LCOV_EXCL_LINE
498! use pm_kind, only: IK, RK ! LCOV_EXCL_LINE
499! implicit none
500! integer(IK) , intent(in) :: nd, npnt
501! real(RK) , intent(in) :: sample(nd,npnt)
502! integer(IK) :: innestIndex
503! innestIndex = minloc(sum(getPairDistSq(nd,npnt,sample), dim = 1_IK), dim = 1_IK)
504! end function getMinSumPairDistSqPointIndex
505
506!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
508end module pm_knn ! LCOV_EXCL_LINE
Return a vector of unique values in the input array in place of the array itself.
Return the input distance matrix whose columns are sorted in ascending order on output,...
Definition: pm_knn.F90:181
This module contains procedures and generic interfaces for finding unique values of an input array of...
This module contains the derived types for generating allocatable containers of scalar,...
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
Definition: pm_kind.F90:268
integer, parameter RK5
Definition: pm_kind.F90:478
integer, parameter RK4
Definition: pm_kind.F90:489
integer, parameter RK2
Definition: pm_kind.F90:511
integer, parameter RK
The default real kind in the ParaMonte library: real64 in Fortran, c_double in C-Fortran Interoperati...
Definition: pm_kind.F90:543
integer, parameter RK3
Definition: pm_kind.F90:500
integer, parameter IK
The default integer kind in the ParaMonte library: int32 in Fortran, c_int32_t in C-Fortran Interoper...
Definition: pm_kind.F90:540
integer, parameter SK
The default character kind in the ParaMonte library: kind("a") in Fortran, c_char in C-Fortran Intero...
Definition: pm_kind.F90:539
integer, parameter RK1
Definition: pm_kind.F90:522
This module contains procedures and generic interfaces for computing the nearest neighbor statistics ...
Definition: pm_knn.F90:82
character(*, SK), parameter MODULE_NAME
Definition: pm_knn.F90:89