ParaMonte Fortran 2.0.0
Parallel Monte Carlo and Machine Learning Library
See the latest version documentation.
test_pm_distanceMahal.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
23
24!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
25
26module test_pm_distanceMahal
27
28 use pm_distanceMahal
29 use pm_err, only: err_type
30 use pm_test, only: test_type, LK
31 use pm_kind, only: LK
32 implicit none
33
34 private
35 public :: setTest
36 type(test_type) :: test
37
38!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
39
40 interface
41
42 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
43
44#if CK3_ENABLED
45 module function test_getDisMahalSq_CK3 () result(assertion); logical(LK) :: assertion; end function
46#endif
47#if CK2_ENABLED
48 module function test_getDisMahalSq_CK2 () result(assertion); logical(LK) :: assertion; end function
49#endif
50#if CK1_ENABLED
51 module function test_getDisMahalSq_CK1 () result(assertion); logical(LK) :: assertion; end function
52#endif
53
54 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
55
56#if RK3_ENABLED
57 module function test_getDisMahalSq_RK3 () result(assertion); logical(LK) :: assertion; end function
58#endif
59#if RK2_ENABLED
60 module function test_getDisMahalSq_RK2 () result(assertion); logical(LK) :: assertion; end function
61#endif
62#if RK1_ENABLED
63 module function test_getDisMahalSq_RK1 () result(assertion); logical(LK) :: assertion; end function
64#endif
65
66 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
67
68 end interface
69
70!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
71
72contains
73
74!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75
76 subroutine setTest()
77
78 test = test_type(MODULE_NAME)
79
80 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
81
82 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
83
84#if CK3_ENABLED
85 call test%run(test_getDisMahalSq_CK3, SK_"test_getDisMahalSq_CK3")
86#endif
87#if CK2_ENABLED
88 call test%run(test_getDisMahalSq_CK2 , SK_"test_getDisMahalSq_CK2")
89#endif
90#if CK1_ENABLED
91 call test%run(test_getDisMahalSq_CK1, SK_"test_getDisMahalSq_CK1")
92#endif
93
94 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
95
96#if RK3_ENABLED
97 call test%run(test_getDisMahalSq_RK3, SK_"test_getDisMahalSq_RK3")
98#endif
99#if RK2_ENABLED
100 call test%run(test_getDisMahalSq_RK2 , SK_"test_getDisMahalSq_RK2")
101#endif
102#if RK1_ENABLED
103 call test%run(test_getDisMahalSq_RK1, SK_"test_getDisMahalSq_RK1")
104#endif
105
106 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
107
108 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
109
110 !call test%run(test_getDisMahalSqSP_RK_1, SK_"test_getDisMahalSqSP_RK_1")
111 !call test%run(test_getDisMahalSqMP_RK_1, SK_"test_getDisMahalSqMP_RK_1")
112 !call test%run(test_getDisMahalSqSP_CK_1, SK_"test_getDisMahalSqSP_CK_1")
113 !call test%run(test_getDisMahalSqMP_CK_1, SK_"test_getDisMahalSqMP_CK_1")
114 call test%summarize()
115
116 end subroutine setTest
117
118!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
119!
120! function test_getDisMahalSqSP_RK_1() result(assertion)
121! use pm_kind, only: IK, RK
122! implicit none
123! integer(IK) :: i
124! logical(LK) :: assertion
125! integer(IK) , parameter :: nd = 3_IK
126! real(RK) , parameter :: tolerance = 1.e-12_RK
127! real(RK) , parameter :: mahalSq_ref = 180._RK
128! real(RK) , parameter :: Point(nd) = [(real(i,RK),i=1,nd)]
129! real(RK) , parameter :: mean(nd) = [(real(i**2+1._RK,RK),i=1,nd)]
130! real(RK) , parameter :: invCov(nd,nd) = reshape( [ 1._RK, 0._RK, 1._RK &
131! , 0._RK, 2._RK, 0._RK &
132! , 1._RK, 0._RK, 3._RK ], shape = shape(invCov) )
133! real(RK) :: mahalSq
134! real(RK) :: difference
135! mahalSq = getDisMahalSqSP_RK(nd = nd, mean = mean, invCov = invCov, Point = Point)
136! difference = abs(mahalSq - mahalSq_ref) / mahalSq_ref
137! assertion = difference <= tolerance
138!
139! ! LCOV_EXCL_START
140! if (test%traceable .and. .not. assertion) then
141! write(test%disp%unit,"(*(g0,:,', '))")
142! write(test%disp%unit,"(*(g0,:,', '))") "mahalSq_ref ", mahalSq_ref
143! write(test%disp%unit,"(*(g0,:,', '))") "mahalSq ", mahalSq
144! write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
145! write(test%disp%unit,"(*(g0,:,', '))")
146! end if
147! ! LCOV_EXCL_STOP
148!
149! end function test_getDisMahalSqSP_RK_1
150!
151!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
152!
153! function test_getDisMahalSqMP_RK_1() result(assertion)
154! use pm_kind, only: IK, RK
155! implicit none
156! integer(IK) :: i
157! logical(LK) :: assertion
158! integer(IK) , parameter :: nd = 3_IK, np = 2_IK
159! real(RK) , parameter :: tolerance = 1.e-12_RK
160! real(RK) , parameter :: MahalSq_ref(np) = [180._RK, 36._RK]
161! real(RK) , parameter :: Point(nd,np) = reshape([(real(i,RK),i=1,nd*np)], shape = shape(Point))
162! real(RK) , parameter :: mean(nd) = [(real(i**2+1._RK,RK),i=1,nd)]
163! real(RK) , parameter :: invCov(nd,nd) = reshape( [ 1._RK, 0._RK, 1._RK &
164! , 0._RK, 2._RK, 0._RK &
165! , 1._RK, 0._RK, 3._RK ], shape = shape(invCov) )
166! real(RK) :: mahalSq(np)
167! real(RK) :: Difference(np)
168! mahalSq = getDisMahalSqMP_RK(nd = nd, np = np, mean = mean, invCov = invCov, Point = Point)
169! Difference = abs(mahalSq - MahalSq_ref) / MahalSq_ref
170! assertion = all(Difference <= tolerance)
171!
172! ! LCOV_EXCL_START
173! if (test%traceable .and. .not. assertion) then
174! write(test%disp%unit,"(*(g0,:,', '))")
175! write(test%disp%unit,"(*(g0,:,', '))") "MahalSq_ref ", MahalSq_ref
176! write(test%disp%unit,"(*(g0,:,', '))") "mahalSq ", mahalSq
177! write(test%disp%unit,"(*(g0,:,', '))") "Difference ", Difference
178! write(test%disp%unit,"(*(g0,:,', '))")
179! end if
180! ! LCOV_EXCL_STOP
181!
182! end function test_getDisMahalSqMP_RK_1
183!
184!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
185!
186! function test_getDisMahalSqSP_CK_1() result(assertion)
187!
188! use pm_kind, only: IK, RK, CK
189! implicit none
190! integer(IK) :: i
191! logical(LK) :: assertion
192! integer(IK) , parameter :: nd = 3_IK
193! real(RK) , parameter :: tolerance = 1.e-12_RK
194! complex(CK) , parameter :: mahalSq_ref = 180._CK
195! complex(CK) , parameter :: Point(nd) = [(cmplx(i,0.,kind=RK),i=1,nd)]
196! complex(CK) , parameter :: mean(nd) = [(cmplx(i**2+1._RK,0.,kind=RK),i=1,nd)]
197! complex(CK) , parameter :: invCov(nd,nd) = cmplx(reshape([ 1._RK, 0._RK, 1._RK &
198! , 0._RK, 2._RK, 0._RK &
199! , 1._RK, 0._RK, 3._RK ], shape = shape(invCov) ), kind = RK )
200! complex(CK) :: mahalSq
201! real(RK) :: difference
202! mahalSq = getDisMahalSqSP_CK(nd = nd, mean = mean, invCov = invCov, Point = Point)
203! difference = abs(real(mahalSq - mahalSq_ref,RK)) / real(mahalSq_ref,RK)
204! assertion = difference <= tolerance
205!
206! ! LCOV_EXCL_START
207! if (test%traceable .and. .not. assertion) then
208! write(test%disp%unit,"(*(g0,:,', '))")
209! write(test%disp%unit,"(*(g0,:,', '))") "mahalSq_ref ", mahalSq_ref
210! write(test%disp%unit,"(*(g0,:,', '))") "mahalSq ", mahalSq
211! write(test%disp%unit,"(*(g0,:,', '))") "difference ", difference
212! write(test%disp%unit,"(*(g0,:,', '))")
213! end if
214! ! LCOV_EXCL_STOP
215!
216! end function test_getDisMahalSqSP_CK_1
217!
218!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
219!
220! function test_getDisMahalSqMP_CK_1() result(assertion)
221! use pm_kind, only: IK, RK, CK
222! implicit none
223! integer(IK) :: i
224! logical(LK) :: assertion
225! real(RK) , parameter :: tolerance = 1.e-12_RK
226! integer(IK) , parameter :: nd = 3_IK, np = 2_IK
227! complex(CK) , parameter :: MahalSq_ref(np) = [180._CK, 36._CK]
228! complex(CK) , parameter :: Point(nd,np) = reshape([(cmplx(i,0.,kind=RK),i=1,nd*np)], shape = shape(Point))
229! complex(CK) , parameter :: mean(nd) = [(cmplx(i**2+1._RK,0.,kind=RK),i=1,nd)]
230! complex(CK) , parameter :: invCov(nd,nd) = cmplx(reshape([ 1._RK, 0._RK, 1._RK &
231! , 0._RK, 2._RK, 0._RK &
232! , 1._RK, 0._RK, 3._RK ], shape = shape(invCov) ), kind=RK )
233!
234! complex(CK) :: mahalSq(np)
235! real(RK) :: Difference(np)
236! mahalSq = getDisMahalSqMP_CK(nd = nd, np = np, mean = mean, invCov = invCov, Point = Point)
237! Difference = abs(real(mahalSq - MahalSq_ref,RK) / real(MahalSq_ref,RK))
238! assertion = all(Difference <= tolerance)
239!
240! ! LCOV_EXCL_START
241! if (test%traceable .and. .not. assertion) then
242! write(test%disp%unit,"(*(g0,:,', '))")
243! write(test%disp%unit,"(*(g0,:,', '))") "MahalSq_ref ", MahalSq_ref
244! write(test%disp%unit,"(*(g0,:,', '))") "mahalSq ", mahalSq
245! write(test%disp%unit,"(*(g0,:,', '))") "Difference ", Difference
246! write(test%disp%unit,"(*(g0,:,', '))")
247! end if
248! ! LCOV_EXCL_STOP
249!
250! end function test_getDisMahalSqMP_CK_1
251!
252!!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
253
254end module test_pm_distanceMahal
pm_distanceMahal
This module contains classes and procedures for computing the Mahalanobis statistical distance.
Definition: pm_distanceMahal.F90:82
pm_distanceMahal::MODULE_NAME
character(*, SK), parameter MODULE_NAME
Definition: pm_distanceMahal.F90:88
pm_err
This module contains classes and procedures for reporting and handling errors.
Definition: pm_err.F90:52
pm_kind
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
Definition: pm_kind.F90:268
pm_kind::LK
integer, parameter LK
The default logical kind in the ParaMonte library: kind(.true.) in Fortran, kind(....
Definition: pm_kind.F90:541
pm_test
This module contains a simple unit-testing framework for the Fortran libraries, including the ParaMon...
Definition: pm_test.F90:42
test_pm_distanceMahal
This module contains tests of the module pm_distanceMahal.
Definition: test_pm_distanceMahal.F90:26
test_pm_distanceMahal::setTest
subroutine setTest()
Definition: test_pm_distanceMahal.F90:77
test_pm_distanceMahal::test
type(test_type) test
Definition: test_pm_distanceMahal.F90:36
pm_err::err_type
This is the derived type for generating objects to gracefully and verbosely handle runtime unexpected...
Definition: pm_err.F90:157
pm_test::test_type
This is the derived type test_type for generating objects that facilitate testing of a series of proc...
Definition: pm_test.F90:209