35 ,
0.2399161535536580_RK &
36 ,
0.1233189348351660_RK &
37 ,
0.1839077882824170_RK &
38 ,
0.2399525256649030_RK &
39 ,
0.4172670690843700_RK &
40 ,
0.0496544303257421_RK &
41 ,
0.9027161099152810_RK &
42 ,
0.9447871897216460_RK &
43 ,
0.4908640924680800_RK &
44 ,
0.4892526384000190_RK &
45 ,
0.3377194098213770_RK &
46 ,
0.9000538464176620_RK &
47 ,
0.3692467811202150_RK &
48 ,
0.1112027552937870_RK &
49 ,
0.7802520683211380_RK &
50 ,
0.3897388369612530_RK &
51 ,
0.2416912859138330_RK &
52 ,
0.4039121455881150_RK &
53 ,
0.0964545251683886_RK &
54 ,
0.1319732926063350_RK &
55 ,
0.9420505907754850_RK &
56 ,
0.9561345402298020_RK &
57 ,
0.5752085950784660_RK &
58 ,
0.0597795429471558_RK &
59 ,
0.2347799133724060_RK &
60 ,
0.3531585712220710_RK &
61 ,
0.8211940401979590_RK &
62 ,
0.0154034376515551_RK &
63 ,
0.0430238016578078_RK &
64 ,
0.1689900294627040_RK &
65 ,
0.6491154749564520_RK &
66 ,
0.7317223856586700_RK &
67 ,
0.6477459631363070_RK &
68 ,
0.4509237064309450_RK &
69 ,
0.5470088922863450_RK &
70 ,
0.2963208056077730_RK &
71 ,
0.7446928070741560_RK &
72 ,
0.1889550150325450_RK &
73 ,
0.6867754333653150_RK &
74 ,
0.1835111557372700_RK &
75 ,
0.3684845964903370_RK &
76 ,
0.6256185607296900_RK &
77 ,
0.7802274351513770_RK &
78 ,
0.0811257688657853_RK &
79 ,
0.9293859709687300_RK &
80 ,
0.7757126786084020_RK &
81 ,
0.4867916324031720_RK &
82 ,
0.4358585885809190_RK &
83 ,
0.4467837494298060_RK ]
86 ,
1.83388501459509_RK &
87 ,
-2.25884686100365_RK &
88 ,
0.862173320368121_RK &
89 ,
0.318765239858981_RK &
90 ,
-1.30768829630527_RK &
91 ,
-0.433592022305684_RK &
92 ,
0.342624466538650_RK &
93 ,
3.57839693972576_RK &
94 ,
2.76943702988488_RK &
95 ,
-1.34988694015652_RK &
96 ,
3.03492346633185_RK &
97 ,
0.725404224946106_RK &
98 ,
-0.0630548731896562_RK &
99 ,
0.714742903826096_RK &
100 ,
-0.204966058299775_RK &
101 ,
-0.124144348216312_RK &
102 ,
1.48969760778547_RK &
103 ,
1.40903448980048_RK &
104 ,
1.41719241342961_RK &
105 ,
0.671497133608081_RK &
106 ,
-1.20748692268504_RK &
107 ,
0.717238651328839_RK &
108 ,
1.63023528916473_RK &
109 ,
0.488893770311789_RK &
110 ,
1.03469300991786_RK &
111 ,
0.726885133383238_RK &
112 ,
-0.303440924786016_RK &
113 ,
0.293871467096658_RK &
114 ,
-0.787282803758638_RK &
115 ,
0.888395631757642_RK &
116 ,
-1.14707010696915_RK &
117 ,
-1.06887045816803_RK &
118 ,
-0.809498694424876_RK &
119 ,
-2.94428416199490_RK &
120 ,
1.43838029281510_RK &
121 ,
0.325190539456198_RK &
122 ,
-0.754928319169703_RK &
123 ,
1.37029854009523_RK &
124 ,
-1.71151641885370_RK &
125 ,
-0.102242446085491_RK &
126 ,
-0.241447041607358_RK &
127 ,
0.319206739165502_RK &
128 ,
0.312858596637428_RK &
129 ,
-0.864879917324457_RK &
130 ,
-0.0300512961962686_RK &
131 ,
-0.164879019209038_RK &
132 ,
0.627707287528727_RK &
133 ,
1.09326566903948_RK &
134 ,
1.10927329761440_RK ]
137 ,
0.0773590911304249_RK &
138 ,
-1.21411704361541_RK &
139 ,
-1.11350074148676_RK &
140 ,
-0.00684932810334806_RK &
141 ,
1.53263030828475_RK &
142 ,
-0.769665913753682_RK &
143 ,
0.371378812760058_RK &
144 ,
-0.225584402271252_RK &
145 ,
1.11735613881447_RK &
146 ,
-1.08906429505224_RK &
147 ,
0.0325574641649735_RK &
148 ,
0.552527021112224_RK &
149 ,
1.10061021788087_RK &
150 ,
1.54421189550395_RK &
151 ,
0.0859311331754255_RK &
152 ,
-1.49159031063761_RK &
153 ,
-0.742301837259857_RK &
154 ,
-1.06158173331999_RK &
155 ,
2.35045722400204_RK &
156 ,
-0.615601881466894_RK &
157 ,
0.748076783703985_RK &
158 ,
-0.192418510588264_RK &
159 ,
0.888610425420721_RK &
160 ,
-0.764849236567874_RK &
161 ,
-1.40226896933876_RK &
162 ,
-1.42237592509150_RK &
163 ,
0.488193909859941_RK &
164 ,
-0.177375156618825_RK &
165 ,
-0.196053487807333_RK &
166 ,
1.41931015064255_RK &
167 ,
0.291584373984183_RK &
168 ,
0.197811053464361_RK &
169 ,
1.58769908997406_RK &
170 ,
-0.804465956349547_RK &
171 ,
0.696624415849607_RK &
172 ,
0.835088165072682_RK &
173 ,
-0.243715140377952_RK &
174 ,
0.215670086403744_RK &
175 ,
-1.16584393148205_RK &
176 ,
-1.14795277889859_RK &
177 ,
0.104874716016494_RK &
178 ,
0.722254032225002_RK &
179 ,
2.58549125261624_RK &
180 ,
-0.666890670701386_RK &
181 ,
0.187331024578940_RK &
182 ,
-0.0824944253709554_RK &
183 ,
-1.93302291785099_RK &
184 ,
-0.438966153934773_RK &
185 ,
-1.79467884145512_RK ]
189 ,
0.00106568311889532_RK &
190 ,
0.00261528537896705_RK &
191 ,
0.00418324458049812_RK &
192 ,
0.00173791427946435_RK &
193 ,
0.00683744981995738_RK &
194 ,
0.00122509129524828_RK &
195 ,
0.000963897105374811_RK &
196 ,
0.00659617936766466_RK &
197 ,
0.00121099678988135_RK &
198 ,
0.00152627239164915_RK &
199 ,
5.59784103162375e-05_RK &
200 ,
0.00396276701851184_RK &
201 ,
0.00585926454186925_RK &
202 ,
0.00183541725616831_RK &
203 ,
0.00213464221769843_RK &
204 ,
0.00456380640221332_RK &
205 ,
0.000300222645855053_RK &
206 ,
0.00113346207247378_RK &
207 ,
0.00403412924770930_RK &
208 ,
0.00876326613184120_RK &
209 ,
0.00240591898034481_RK &
210 ,
0.00111791498744240_RK &
211 ,
0.000314496869014858_RK &
212 ,
0.00166278866932723_RK &
213 ,
0.00123356868877644_RK &
214 ,
0.00136174700279745_RK &
215 ,
0.00180033865772067_RK &
216 ,
0.000188696505842079_RK &
217 ,
0.00447901518516258_RK &
218 ,
0.000649229339662938_RK &
219 ,
0.00665965285198666_RK &
220 ,
0.000639392345076595_RK &
221 ,
0.00439231287788411_RK &
222 ,
0.00514580427373124_RK &
223 ,
0.00325615977507276_RK &
224 ,
0.00262444209665191_RK &
225 ,
0.00287172623926713_RK &
226 ,
0.00726524941509710_RK &
227 ,
0.000679801673850622_RK &
228 ,
0.000771848959060684_RK &
229 ,
0.00236687990071305_RK &
230 ,
0.00279738279147568_RK &
231 ,
0.00134507052319155_RK &
232 ,
0.00192351678728353_RK &
233 ,
0.000403579255582320_RK &
234 ,
0.00466075625864260_RK &
235 ,
0.00128562661588161_RK &
236 ,
0.00240934864593989_RK &
237 ,
0.00379834817045643_RK &
238 ,
0.00626106613651900_RK &
239 ,
0.00155470502430244_RK &
240 ,
0.00386451831278178_RK &
241 ,
0.00633652247623751_RK &
242 ,
0.00212716547361247_RK &
243 ,
0.000117519040001346_RK &
244 ,
0.00268124387647972_RK &
245 ,
0.00330190345409753_RK &
246 ,
0.00181556281964235_RK &
247 ,
0.00680782445764760_RK &
248 ,
0.00344385667182678_RK &
249 ,
0.00341876847109601_RK &
250 ,
0.00156480476836285_RK &
251 ,
0.00392916582362890_RK &
252 ,
0.000536610168473173_RK &
253 ,
0.00308379345606979_RK &
254 ,
0.00382371993615627_RK &
255 ,
0.00143530941667058_RK &
256 ,
0.000273761654861704_RK &
257 ,
0.000218939488190961_RK &
258 ,
0.00395298813907463_RK &
259 ,
0.00461683348784969_RK &
260 ,
0.000587765974902510_RK &
261 ,
0.00130109023546354_RK &
262 ,
0.000446086978761473_RK &
263 ,
0.00102849200817856_RK &
264 ,
0.00475349511066359_RK &
265 ,
0.00177004768590394_RK &
266 ,
0.00118757227387534_RK &
267 ,
0.00511260207997721_RK &
268 ,
0.000966468749441840_RK &
269 ,
0.00153506873793674_RK &
270 ,
0.000163947408605591_RK &
271 ,
0.00159865940856585_RK &
272 ,
0.00319324233871277_RK &
273 ,
0.00182318600045628_RK &
274 ,
0.00270039749021500_RK &
275 ,
0.00233393067978271_RK &
276 ,
0.000304246250464657_RK &
277 ,
0.00107643657879242_RK &
278 ,
0.00149167058888822_RK &
279 ,
3.22029433108551e-05_RK &
280 ,
0.000507552164931036_RK &
281 ,
0.00284976448963692_RK &
282 ,
0.00261297396275373_RK &
283 ,
0.00115230561975765_RK &
284 ,
0.000589761776301434_RK &
285 ,
0.00254655116972891_RK &
286 ,
0.000736372303162147_RK &
287 ,
0.00298938200986687_RK &
288 ,
0.00115908892632211_RK &
289 ,
0.0118304957984586_RK &
290 ,
0.00427409203243478_RK &
291 ,
0.00408018550920808_RK &
292 ,
0.00137769679358790_RK &
293 ,
0.00172460242999972_RK &
294 ,
0.000397268483832813_RK &
295 ,
0.00640511077756611_RK &
296 ,
0.00160078461814450_RK &
297 ,
0.00116751842007934_RK &
298 ,
0.00689243594329803_RK &
299 ,
5.96420573087952e-05_RK &
300 ,
0.00120353557763264_RK &
301 ,
0.00542771429675204_RK &
302 ,
0.00610071142686630_RK &
303 ,
0.00213356732282444_RK &
304 ,
0.000281572449424172_RK &
305 ,
0.00129330702548425_RK &
306 ,
0.000169205982398446_RK &
307 ,
0.000101693454083507_RK &
308 ,
0.000396590512815487_RK &
309 ,
0.000271783190621933_RK &
310 ,
0.00207176434429135_RK &
311 ,
0.00195525703558364_RK &
312 ,
0.00133407286142151_RK &
313 ,
0.00146450204323612_RK &
314 ,
0.00172854780161391_RK &
315 ,
0.00175309009682001_RK &
316 ,
0.00591372011950542_RK &
317 ,
0.00383246845630059_RK &
318 ,
0.00478224831434315_RK &
319 ,
0.00140155544663756_RK &
320 ,
0.00311278264609216_RK &
321 ,
0.00117361727622267_RK &
322 ,
0.00197417012646872_RK &
323 ,
0.00124210536927416_RK &
324 ,
0.000362752683200629_RK &
325 ,
0.000939106199745576_RK &
326 ,
0.000794249402029323_RK &
327 ,
0.000913827979191928_RK &
328 ,
0.00720437268872554_RK &
329 ,
0.000205371175825086_RK &
330 ,
0.00715773811743015_RK &
331 ,
0.00251452853672052_RK &
332 ,
0.000861445629684599_RK &
333 ,
0.00418790413483983_RK &
334 ,
0.000370461989028015_RK &
335 ,
0.00125679370708720_RK &
336 ,
0.00349303438590243_RK &
337 ,
0.000724203659035916_RK &
338 ,
0.000491862014471267_RK &
339 ,
0.00287196585168448_RK &
340 ,
0.00185611717084277_RK &
341 ,
0.000150069773691919_RK &
342 ,
0.000848534416059033_RK &
343 ,
0.00123442270407526_RK &
344 ,
0.00103148223612315_RK &
345 ,
0.00132400045208614_RK &
346 ,
0.00435456041987981_RK &
347 ,
0.00117222896204028_RK &
348 ,
0.000873409715677065_RK &
349 ,
0.00512459761807316_RK &
350 ,
0.000423255105326148_RK &
351 ,
0.00801979475421000_RK &
352 ,
0.00452332834787750_RK &
353 ,
0.000662717679231761_RK &
354 ,
0.00612674945114589_RK &
355 ,
0.000241023672676199_RK &
356 ,
0.00241368458759861_RK &
357 ,
0.00721401234545482_RK &
358 ,
0.000617822886748609_RK &
359 ,
4.20361472183162e-05_RK &
360 ,
0.000176033863938718_RK &
361 ,
0.00261140736592547_RK &
362 ,
0.00161441323061740_RK &
363 ,
0.00119563944997603_RK &
364 ,
0.000161186670205815_RK &
365 ,
0.00186893825670897_RK &
366 ,
0.0156568954429827_RK &
367 ,
0.00333188871092183_RK &
368 ,
0.00460140509714901_RK &
369 ,
0.00106350049875970_RK &
370 ,
0.000278484374323207_RK &
371 ,
0.000109843896551887_RK &
372 ,
0.00517794656024040_RK &
373 ,
0.000764568679501587_RK &
374 ,
0.00106947825226744_RK &
375 ,
0.00475394751147906_RK &
376 ,
0.00700310227105183_RK &
377 ,
0.00280107346803815_RK &
378 ,
0.00594747756623304_RK &
379 ,
0.00268586958531547_RK &
380 ,
0.00120417364527792_RK &
381 ,
0.00344542024642325_RK &
382 ,
0.00217032516670990_RK &
383 ,
0.00170145556378476_RK &
384 ,
0.00159968663729304_RK &
385 ,
0.00153233985478085_RK &
386 ,
0.00219750724001799_RK &
387 ,
0.00230064745992042_RK &
403 ,
0.482474176998994_RK &
404 ,
0.370817196700337_RK &
405 ,
0.493146633387423_RK &
406 ,
0.702120402082310_RK &
407 ,
0.671010642014021_RK &
408 ,
0.713612126474551_RK &
409 ,
0.683487750289677_RK &
410 ,
0.559321682773637_RK &
411 ,
0.530113153332594_RK &
412 ,
0.571577075807556_RK &
415 ,
0.162352941176471_RK &
416 ,
0.176470588235294_RK &
417 ,
0.159502262443439_RK &
418 ,
0.134615384615385_RK &
419 ,
0.137518142235123_RK &
420 ,
0.132075471698113_RK &
421 ,
0.134870719776380_RK &
422 ,
0.148148148148148_RK &
423 ,
0.150841750841751_RK &
424 ,
0.145454545454545_RK &
445 call test%summarize()
458 logical(
LK) :: assertion
459 real(
RK) ,
parameter :: TOLERANCE
= 1.e-7_RK
461 real(
RK),
parameter :: probKS_ref
= .
3763758622852317E-01_RK
462 real(
RK),
parameter :: statKS_ref
= .
1955719390701096_RK
465 real(
RK) :: difference
474 difference
= abs( (probKS
- probKS_ref)
/ probKS_ref )
475 assertion
= difference
< TOLERANCE
477 if (
test%traceable
.and. .not. assertion)
then
479 write(
test%disp
%unit,
"(*(g0,:,', '))")
480 write(
test%disp
%unit,
"(*(g0,:,', '))")
"probKS_ref :", probKS_ref
481 write(
test%disp
%unit,
"(*(g0,:,', '))")
"probKS :", probKS
482 write(
test%disp
%unit,
"(*(g0,:,', '))")
"difference :", difference
483 write(
test%disp
%unit,
"(*(g0,:,', '))")
487 difference
= abs( (statKS
- statKS_ref)
/ statKS_ref )
488 assertion
= assertion
.and. difference
< TOLERANCE
489 call test%assert(assertion)
491 if (
test%traceable
.and. .not. assertion)
then
493 write(
test%disp
%unit,
"(*(g0,:,', '))")
494 write(
test%disp
%unit,
"(*(g0,:,', '))")
"statKS_ref :", statKS_ref
495 write(
test%disp
%unit,
"(*(g0,:,', '))")
"statKS :", statKS
496 write(
test%disp
%unit,
"(*(g0,:,', '))")
"difference :", difference
497 write(
test%disp
%unit,
"(*(g0,:,', '))")
505 real(
RK) ,
intent(in) :: x
518 logical(
LK) :: assertion
519 real(
RK) ,
parameter :: TOLERANCE
= 1.e-11_RK
520 real(
RK) ,
parameter :: Score(
*)
= [(
0.01_RK * real(i,
RK), i
= -1,
100)]
521 real(
RK) :: Difference(
size(Score))
522 real(
RK) :: ProbKS_ref(
size(Score))
523 real(
RK) :: ProbKS(
size(Score))
524 do i
= 1,
size(Score)
526 ProbKS(i)
= getCumDenComKS(Score(i))
527 Difference(i)
= abs(ProbKS(i)
- ProbKS_ref(i))
529 assertion
= all(Difference
< TOLERANCE)
530 if (
test%traceable
.and. .not. assertion)
then
532 write(
test%disp
%unit,
"(*(g0,:,', '))")
533 write(
test%disp
%unit,
"(*(g0,:,', '))")
"ProbKS_ref :", ProbKS_ref
534 write(
test%disp
%unit,
"(*(g0,:,', '))")
"ProbKS :", ProbKS
535 write(
test%disp
%unit,
"(*(g0,:,', '))")
"Difference :", Difference
536 write(
test%disp
%unit,
"(*(g0,:,', '))")
"maxval(Difference) :",
maxval(Difference)
537 write(
test%disp
%unit,
"(*(g0,:,', '))")
553 integer(
IK) ,
parameter :: NSCORE
= 10**6_IK
554 logical(
LK) :: assertion
555 real(
RK) :: Score(NSCORE)
556 real(
RK) :: ProbKS(NSCORE), dummy
560 do i
= -1, NSCORE
- 2
561 Score(i
+2)
= 0.01_RK * real(i,
RK)
563 timer
%start
= timer
%time()
565 ProbKS(i)
= getCumDenComKS(Score(i))
567 timer
%delta
= timer
%time(since
= timer
%start)
568 write(
test%disp
%unit,
"(*(g0,:,', '))")
569 write(
test%disp
%unit,
"(*(g0,:,', '))")
"time(getCumDenComKS):", timer
%delta
571 timer
%start
= timer
%time()
575 timer
%delta
= timer
%time(since
= timer
%start)
576 write(
test%disp
%unit,
"(*(g0,:,', '))")
"time(getProbKS):", timer
%delta
577 write(
test%disp
%unit,
"(*(g0,:,', '))")
"ratio(getProbKS/getCumDenComKS):", timer
%delta
/ dummy
578 write(
test%disp
%unit,
"(*(g0,:,', '))")
589 logical(
LK) :: assertion
590 real(
RK) ,
parameter :: TOLERANCE
= 1.e-7_RK
592 real(
RK),
parameter :: probKS_ref
= .
1982797523608350_RK
593 real(
RK),
parameter :: statKS_ref
= .
1491359075319200_RK
596 real(
RK) :: difference
598 call doUniformKS1( np
= lenRnd &
604 difference
= abs( (probKS
- probKS_ref)
/ probKS_ref )
605 assertion
= difference
< TOLERANCE
606 call test%assert(assertion)
608 if (
test%traceable
.and. .not. assertion)
then
610 write(
test%disp
%unit,
"(*(g0,:,', '))")
611 write(
test%disp
%unit,
"(*(g0,:,', '))")
"probKS_ref :", probKS_ref
612 write(
test%disp
%unit,
"(*(g0,:,', '))")
"probKS :", probKS
613 write(
test%disp
%unit,
"(*(g0,:,', '))")
"difference :", difference
614 write(
test%disp
%unit,
"(*(g0,:,', '))")
618 difference
= abs( (statKS
- statKS_ref)
/ statKS_ref )
619 assertion
= assertion
.and. difference
< TOLERANCE
620 call test%assert(assertion)
622 if (
test%traceable
.and. .not. assertion)
then
624 write(
test%disp
%unit,
"(*(g0,:,', '))")
625 write(
test%disp
%unit,
"(*(g0,:,', '))")
"statKS_ref :", statKS_ref
626 write(
test%disp
%unit,
"(*(g0,:,', '))")
"statKS :", statKS
627 write(
test%disp
%unit,
"(*(g0,:,', '))")
"difference :", difference
628 write(
test%disp
%unit,
"(*(g0,:,', '))")
643 logical(
LK) :: assertion
644 integer(
IK) ,
parameter ::
lenRnd = 50_IK
645 real(
RK) ,
parameter :: TOLERANCE
= 1.e-12_RK
647 real(
RK),
parameter :: probKS_ref
= 0.056045859714425_RK
648 real(
RK),
parameter :: statKS_ref
= 0.260000000000000_RK
649 real(
RK) :: difference, probKS, statKS, lambda
651 assertion
= .true._LK
663 difference
= 2 * abs(probKS
- probKS_ref)
/ (probKS_ref
+ probKS)
664 assertion
= assertion
.and. difference
< TOLERANCE
668 if (
test%traceable
.and. .not. assertion)
then
670 write(
test%disp
%unit,
"(*(g0,:,', '))")
671 write(
test%disp
%unit,
"(*(g0,:,', '))")
"probKS_ref :", probKS_ref
672 write(
test%disp
%unit,
"(*(g0,:,', '))")
"probKS :", probKS
673 write(
test%disp
%unit,
"(*(g0,:,', '))")
"difference :", difference
674 write(
test%disp
%unit,
"(*(g0,:,', '))")
"TOLERANCE :", TOLERANCE
675 write(
test%disp
%unit,
"(*(g0,:,', '))")
679 call test%assert(assertion)
681 difference
= 2 * abs(statKS
- statKS_ref)
/ (statKS_ref
+ statKS)
682 assertion
= assertion
.and. difference
< TOLERANCE
683 call test%assert(assertion)
685 if (
test%traceable
.and. .not. assertion)
then
687 write(
test%disp
%unit,
"(*(g0,:,', '))")
688 write(
test%disp
%unit,
"(*(g0,:,', '))")
"statKS_ref :", statKS_ref
689 write(
test%disp
%unit,
"(*(g0,:,', '))")
"statKS :", statKS
690 write(
test%disp
%unit,
"(*(g0,:,', '))")
"difference :", difference
691 write(
test%disp
%unit,
"(*(g0,:,', '))")
"TOLERANCE :", TOLERANCE
692 write(
test%disp
%unit,
"(*(g0,:,', '))")
708 logical(
LK) :: assertion
709 real(
RK) :: ProbKS(
2)
710 real(
RK) :: StatKS(
2)
711 real(
RK) :: Lambda(
2)
713 assertion
= .true._LK
720 call test%assert(assertion)
728 call test%assert(assertion)
742 logical(
LK) :: assertion
743 real(
RK) ,
allocatable :: Difference(:)
744 real(
RK) ,
parameter :: TOLERANCE
= 1.e-11_RK
756 call test%assert(assertion)
758 assertion
= assertion
.and. all(Difference
< TOLERANCE)
759 call test%assert(assertion)
765 if (
test%traceable
.and. .not. assertion)
then
767 write(
test%disp
%unit,
"(*(g0,:,', '))")
769 write(
test%disp
%unit,
"(*(g0,:,', '))")
"ProbKS :", ProbKS
770 write(
test%disp
%unit,
"(*(g0,:,', '))")
"Difference :", Difference
771 write(
test%disp
%unit,
"(*(g0,:,', '))")
776 assertion
= assertion
.and. all(Difference
< TOLERANCE)
777 call test%assert(assertion)
779 if (
test%traceable
.and. .not. assertion)
then
781 write(
test%disp
%unit,
"(*(g0,:,', '))")
783 write(
test%disp
%unit,
"(*(g0,:,', '))")
"StatKS :", StatKS
784 write(
test%disp
%unit,
"(*(g0,:,', '))")
"Difference :", Difference
785 write(
test%disp
%unit,
"(*(g0,:,', '))")
808 use pm_knn,
only: setDisSortedExpDiff
815 integer(IK) :: ipnt, idim, iref
816 integer(IK) :: npntMinusOne
817 integer(IK) :: npntHalf
820 real(RK) :: minDistanceSq
821 real(RK) :: sqrtDetInvCovMat
823 real(RK) ,
allocatable :: refDistMat(:,:)
826 real(RK) ,
allocatable :: Reference(:)
827 real(RK) ,
allocatable :: Center(:)
828 real(RK) ,
allocatable :: Volume(:)
829 real(RK) ,
allocatable :: VolumeWeighted(:)
830 real(RK) ,
allocatable :: disSortedExpDiff(:)
831 real(RK) ,
allocatable :: sample(:,:), SampleDum(:,:)
832 real(RK) ,
allocatable :: chocov(:,:)
833 real(RK) ,
allocatable :: DistanceSq(:)
834 real(RK) ,
allocatable :: ProbKS(:), StatKS(:), LambdaKS(:)
835 real(RK) ,
allocatable :: CumSumProbKS(:)
836 integer(IK) ,
allocatable :: ProxyIndex(:,:)
837 integer(IK) ,
allocatable :: IndexNN(:)
838 integer(IK) ,
allocatable :: IndexKS(:)
839 integer(IK) :: fileUnit
840 integer(IK) :: counter
842 character(
*, SK),
parameter :: CWD
= SK_
"/mnt/d/Dropbox/Projects/20220601_nsfCareer/codes/logz"
843 character(:, SK),
allocatable :: filePath
848 Center
= [(
0._RK, idim
= 1, ndim)]
852 chocov
= getMatInit([ndim, ndim
+ 1_IK], uppLowDia, rho, rho,
1._RK, doff
= 1_IK)
856 call setMatDetSqrtLog(chocov(:,
2 : ndim
+ 1), uppDia, sqrtDetInvCovMat, info, chocov(:,
1 : ndim), transHerm)
857 if (info
/= 0_IK)
error stop "setMatChol() failed."
861 sqrtDetInvCovMat
= exp(
-sqrtDetInvCovMat
/ ndim)
863 chocov(idim
+ 1 : ndim, idim)
= chocov(idim
+ 1 : ndim, idim)
* sqrtDetInvCovMat
868 allocate(sample(ndim, npnt))
873 minDistanceSq
= +huge(minDistanceSq)
874 allocate(DistanceSq(npnt))
877 if (minDistanceSq
> DistanceSq(ipnt))
then
878 minDistanceSq
= DistanceSq(ipnt)
882 Reference
= sample(
1:ndim, iref)
887 allocate(SampleDum,
mold = sample)
893 if (DistanceSq(ipnt)
< 0.4_RK**2 .or. DistanceSq(ipnt)
> 0.6_RK**2)
then
894 counter
= counter
+ 1_IK
895 SampleDum(
1:ndim, counter)
= sample(
1:ndim, ipnt)
899 sample
= SampleDum(
1:ndim,
1:counter)
900 deallocate(SampleDum)
905 npntMinusOne
= npnt
- 1
906 npntHalf
= npntMinusOne
/ 2
907 allocate(disSortedExpDiff(
0:npnt
-1), IndexNN(npnt))
911 filePath
= CWD
//SK_
"/sample.txt"
912 open(newunit
= fileUnit, file
= filePath, status
= "replace")
916 write(fileUnit,
"(*(g0,:,','))") sample(:, ipnt)
924 call setDisSortedExpDiff(sample, Center, disSortedExpDiff(
0:npnt
-1), IndexNN)
925 sample(
1:ndim,
1:npnt)
= sample(
1:ndim, IndexNN)
938 allocate(refDistMat(npnt, npnt), ProxyIndex(npnt, npnt))
952 integer(IK) :: counter
953 integer(IK) :: lenIndexKS
954 integer(IK) :: maxIndexKS
955 integer(IK) :: oldIndexKS
956 integer(IK) :: index, knn
957 integer(IK) :: skip, jpnt, kpnt
958 integer(IK) :: jpntIndexInRefDistMat
959 real(RK) :: VolSortedDiff(npnt, npnt)
960 real(RK) :: VolSortedDiffAlt((npntMinusOne
**2 - npntMinusOne))
961 real(RK) :: lambdaKS, statKS
963 real(RK) ,
allocatable :: ProbKS(:), Volume(:), VolumeWeighted(:), CumSumProbKS(:)
968 VolSortedDiff(
1:npnt, ipnt)
= refDistMat(ProxyIndex(
1:npnt, ipnt), ipnt)
**ndim
969 do jpnt
= npnt,
2_IK,
-1_IK
970 VolSortedDiff(jpnt, ipnt)
= VolSortedDiff(jpnt, ipnt)
- VolSortedDiff(jpnt
- 1, ipnt)
976 IndexKS
= [(idim, idim
= 8_IK, npnt, skip)]
977 maxIndexKS
= maxval(IndexKS,
dim = 1)
978 lenIndexKS
= size(IndexKS,
1,IK)
979 allocate( ProbKS(maxIndexKS)
&
980 , Volume(maxIndexKS)
&
981 , VolumeWeighted(maxIndexKS)
&
986 timer
%start
= timer
%time()
990 loopOverReference:
do ipnt
= 1_IK,
1
993 do index
= 1_IK, lenIndexKS
997 do jpnt
= 1_IK, knn
- 1_IK
1003 jpntIndexInRefDistMat
= ProxyIndex(jpnt, ipnt)
1004 margin
= refDistMat(ProxyIndex(knn, ipnt), ipnt)
- refDistMat(jpntIndexInRefDistMat, ipnt)
1007 if (margin
<= 0._RK)
error stop "negative margin = "//getStr(margin)
1013 do kpnt
= 2_IK, npnt
1014 if (refDistMat(ProxyIndex(kpnt, jpntIndexInRefDistMat), jpntIndexInRefDistMat)
> margin)
exit
1015 counter
= counter
+ 1_IK
1016 VolSortedDiffAlt(counter)
= VolSortedDiff(kpnt, jpnt)
1020 if (counter
== 0_IK)
error stop "counter == 0_IK"
1021 call doKS2(VolSortedDiff(
1:knn, ipnt), VolSortedDiffAlt(
1:counter), ProbKS(knn), statKS, lambdaKS)
1022 ProbKS(oldIndexKS : knn
- 1)
= ProbKS(knn)
1023 oldIndexKS
= knn
+ 1_IK
1025 write(
*,
*)
"time = ", timer
%time(since
= timer
%start)
1029 filePath
= CWD
//SK_
"/CrossProbKS.txt"
1030 open(newunit
= fileUnit, file
= filePath, status
= "replace")
1031 do index
= 1, maxIndexKS
1032 write(fileUnit,
"(*(g0,:,','))") index, ProbKS(index)
1038 call setCumSum(Volume, VolSortedDiff(
1:maxIndexKS,
1))
1039 Volume
= npnt
* Volume
/ getRange(
1_IK, maxIndexKS)
1041 allocate(CumSumProbKS,
mold = ProbKS)
1043 call setCumSum(VolumeWeighted, VolSortedDiff(
1:maxIndexKS,
1)
* ProbKS)
1044 VolumeWeighted
= npnt
* VolumeWeighted
/ CumSumProbKS
1046 filePath
= CWD
//SK_
"/CrossVolumeKS.txt"
1047 open(newunit
= fileUnit, file
= filePath, status
= "replace")
1048 do index
= 1, maxIndexKS
1049 write(fileUnit,
"(*(g0,:,','))") Volume(index), VolumeWeighted(index)
1053 end do loopOverReference
1059 allocate(Volume(npntHalf), VolumeWeighted(npntHalf), ProbKS(npntHalf), StatKS(npntHalf), LambdaKS(npntHalf))
1060 IndexKS
= [(idim, idim
= 1_IK, npntHalf,
1_IK)]
1064 timer
%start
= timer
%time()
1066 disSortedExpDiff(
0:npntMinusOne)
= refDistMat(ProxyIndex(:,iref), iref)
**ndim
1067 disSortedExpDiff(
1:npntMinusOne)
= disSortedExpDiff(
1:npntMinusOne)
- disSortedExpDiff(
0:npntMinusOne
-1)
1068 call setSampleDisparityAuto(disSortedExpDiff(
1:npntMinusOne), IndexKS, ProbKS, StatKS, LambdaKS)
1069 write(
*,
*)
"time = ", timer
%time(since
= timer
%start)
1073 filePath
= CWD
//SK_
"/AutoProbKS.txt"
1074 open(newunit
= fileUnit, file
= filePath, status
= "replace")
1075 do ipnt
= 1,
size(IndexKS,
1, IK)
1076 write(fileUnit,
"(*(g0,:,','))")
2*IndexKS(ipnt), ProbKS(ipnt)
1082 call setCumSum(Volume, disSortedExpDiff(
1:npntHalf))
1083 Volume
= npntMinusOne
* Volume
/ getRange(
1_IK,
size(Volume,
kind = IK))
1085 allocate(CumSumProbKS,
mold = ProbKS)
1087 call setCumSum(VolumeWeighted, disSortedExpDiff(
1:npntHalf)
* ProbKS)
1088 VolumeWeighted
= npntMinusOne
* VolumeWeighted
/ CumSumProbKS
1090 filePath
= CWD
//SK_
"/AutoVolumeKS.txt"
1091 open(newunit
= fileUnit, file
= filePath, status
= "replace")
1092 do ipnt
= 1,
size(Volume,
kind = IK)
1093 write(fileUnit,
"(*(g0,:,','))") Volume(ipnt), VolumeWeighted(ipnt)
1103end module test_pm_statest
Generate minimally-spaced character, integer, real sequences or sequences at fixed intervals of size ...
Sort the input scalar string or contiguous vector in ascending order, or return the sorted indices of...
Generate and return the Cumulative Distribution Function (CDF) of the univariate Normal distribution.
Return a (collection) of random vector(s) of size ndim from the ndim-dimensional MultiVariate Uniform...
Generate and return the (squared) Euclidean distance of a (set of) point(s) in ndim-dimensions from a...
Return the full or a subset of the Euclidean (squared) distance matrix of the input set of npnt point...
Generate and return the natural logarithm of the volume of an -dimensional ball of unit-radius.
Return the input distance matrix whose columns are sorted in ascending order on output,...
Return the cumulative sum of the input array, optionally in the backward direction and optionally,...
Return the natural logarithm of the square-root of the determinant of the input positive-definite squ...
Generate and return a matrix of shape (shape(1), shape(2)) with the upper/lower triangle and the diag...
Generate and return the probability of the null-hypothesis that sample1 of size nsam1 originates from...
Generate and return the Current Working Directory (CWD) of the runtime shell.
Generate and return the conversion of the input value to an output Fortran string,...
This module contains procedures and generic interfaces for generating ranges of discrete character,...
This module contains procedures and generic interfaces for various sorting tasks.
This module contains classes and procedures for computing various statistical quantities related to t...
This module contains classes and procedures for computing various statistical quantities related to t...
This module contains procedures and generic interfaces for computing the Euclidean norm of a single p...
type(euclidu_type), parameter euclidu
This is a scalar parameter object of type euclidu_typethat is exclusively used to request unsafe meth...
type(euclidsq_type), parameter euclidsq
This is a scalar parameter object of type euclidsq_typethat is exclusively used to request computing ...
This module contains classes and procedures for setting up and computing the properties of the hyper-...
This module contains classes and procedures for reporting and handling errors.
This module defines the relevant Fortran kind type-parameters frequently used in the ParaMonte librar...
integer, parameter RK
The default real kind in the ParaMonte library: real64 in Fortran, c_double in C-Fortran Interoperati...
integer, parameter LK
The default logical kind in the ParaMonte library: kind(.true.) in Fortran, kind(....
integer, parameter IK
The default integer kind in the ParaMonte library: int32 in Fortran, c_int32_t in C-Fortran Interoper...
integer, parameter RKS
The single-precision real kind in Fortran mode. On most platforms, this is an 32-bit real kind.
This module contains procedures and generic interfaces for computing the nearest neighbor statistics ...
This module contains the procedures and interfaces for computing the cumulative sum of an array.
This module contains procedures and generic interfaces relevant to the computation of the determinant...
This module contains procedures and generic interfaces relevant to generating and initializing matric...
This module contains classes and procedures for performing various statistical tests.
character(*, SK), parameter MODULE_NAME
This module contains classes and procedures for manipulating system file/folder paths.
This module contains a simple unit-testing framework for the Fortran libraries, including the ParaMon...
This module contains the timer procedures and derived types to facilitate timing applications at runt...
This module contains the generic procedures for converting values of different types and kinds to For...
This module contains tests of the module pm_statest.
integer(IK), dimension(*), parameter SampleSize
integer(IK), parameter lenSampleSize
logical(LK) function test_getSampleDisparity_2()
Any value of SampleSize smaller than one or larger than the size of the input Point should lead to an...
logical(LK) function test_performance_1()
Compare performance of getCumDenComKS()` with pm_statest::getProbKS(). Results indicated that pm_stat...
logical(LK) function test_doSortedKS2_1()
real(RK), dimension(lenRnd) StdNormRnd2
integer(IK), parameter lenRnd
logical(LK) function test_getCumDenComKS_1()
integer(IK), parameter lenDistSortedDiff
real(RK), dimension(*), parameter StatKS_REF
subroutine test_Uniformity()
logical(LK) function test_doKS1_1()
real(RK), dimension(lenRnd) StdNormRnd1
real(RK), dimension(lenRnd) UnifRnd
logical(LK) function test_getSampleDisparity_1()
Any value of SampleSize smaller than one or larger than the size of the input Point should lead to an...
logical(LK) function test_doUniformKS1_1()
real(RK), dimension(*), parameter DistSortedDiff
real(RK), dimension(*), parameter ProbKS_REF
This is the derived type for generating objects to gracefully and verbosely handle runtime unexpected...
This is the derived type test_type for generating objects that facilitate testing of a series of proc...
This is the timerSYS_type class, containing attributes and static methods for setting up a timer base...
PURE real(RK) function getCDF(x)