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
pm_arrayUnique::setUnique
Return a vector of unique values in the input array in place of the array itself.
Definition: pm_arrayUnique.F90:3550
pm_knn::setKnnSorted
Return the input distance matrix whose columns are sorted in ascending order on output,...
Definition: pm_knn.F90:181
pm_arrayUnique
This module contains procedures and generic interfaces for finding unique values of an input array of...
Definition: pm_arrayUnique.F90:30
pm_container
This module contains the derived types for generating allocatable containers of scalar,...
Definition: pm_container.F90:113
pm_kind
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
Definition: pm_kind.F90:268
pm_kind::RK5
integer, parameter RK5
Definition: pm_kind.F90:478
pm_kind::RK4
integer, parameter RK4
Definition: pm_kind.F90:489
pm_kind::RK2
integer, parameter RK2
Definition: pm_kind.F90:511
pm_kind::RK
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
pm_kind::RK3
integer, parameter RK3
Definition: pm_kind.F90:500
pm_kind::IK
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
pm_kind::SK
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
pm_kind::RK1
integer, parameter RK1
Definition: pm_kind.F90:522
pm_knn
This module contains procedures and generic interfaces for computing the nearest neighbor statistics ...
Definition: pm_knn.F90:82
pm_knn::MODULE_NAME
character(*, SK), parameter MODULE_NAME
Definition: pm_knn.F90:89