Line data    Source code

       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             : 
      17             : !>  \brief
      18             : !>  This file contains procedure implementations of tests of [pm_sampleMean](@ref pm_sampleMean).
      19             : !>
      20             : !>  \fintest
      21             : !>
      22             : !>  \author
      23             : !>  \FatemehBagheri, Wednesday 5:03 PM, August 11, 2021, Dallas, TX
      24             : 
      25             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      26             : 
      27             :         ! Define the conjugation rule.
      28             : #if     CK_ENABLED
      29             : #define GET_CONJG(X)conjg(X)
      30             : #define TYPE_OF_SAMPLE complex(TKC)
      31             :         complex(TKC), parameter :: ZERO = 0._TKC, ONE = (1._TKC, 1._TKC), tol = cmplx(epsilon(1._TKC), epsilon(1._TKC), TKC) * 10
      32             : #elif   RK_ENABLED
      33             : #define GET_CONJG(X)X
      34             : #define TYPE_OF_SAMPLE real(TKC)
      35             :         real(TKC), parameter :: ZERO = 0._TKC, ONE = 1._TKC, tol = epsilon(1._TKC) * 10
      36             : #else
      37             : #error  "Unrecognized interface."
      38             : #endif
      39             :         TYPE_OF_SAMPLE, allocatable :: sample(:,:), sampleShifted(:,:), diff(:,:), amount(:)
      40             :         integer(IK) :: itry, nsam, ndim, dim
      41             :         logical(LK) :: isPresentDim ! is dim present or not.
      42             :         logical(LK) :: isTransHerm
      43             :         logical(LK) :: isd1
      44          28 :         assertion = .true.
      45        2828 :         do itry = 1, 100
      46        2800 :             nsam = getUnifRand(1_IK, 5_IK)
      47        2800 :             ndim = getUnifRand(1_IK, 5_IK)
      48        2800 :             dim = merge(1, getChoice([1, 2]), isd1)
      49        2800 :             isPresentDim = getUnifRand()
      50        2800 :             isTransHerm = getUnifRand()
      51        2800 :             if (dim == 2) then
      52       18804 :                 sample = getUnifRand(-ONE, ONE, ndim, nsam)
      53             :             else
      54       20541 :                 sample = getUnifRand(-ONE, ONE, nsam, ndim)
      55             :             end if
      56        9540 :             amount = getUnifRand(0._TKC, 1._TKC, ndim)
      57        2800 :             isd1 = ndim == 1 .and. dim == 1 .and. getUnifRand()
      58       44735 :             sampleShifted = sample
      59             : #if         getShifted_ENABLED
      60        1400 :             if (isd1) then
      61          78 :                 if (isPresentDim) then
      62         138 :                     sampleShifted(:,1) = getShifted(getShifted(sampleShifted(:,1), dim, amount(1)), dim, -amount(1))
      63             :                 else
      64         154 :                     sampleShifted(:,1) = getShifted(getShifted(sampleShifted(:,1), amount(1)), -amount(1))
      65             :                 end if
      66             :             else
      67        1322 :                 if (isPresentDim) then
      68         677 :                     if (isTransHerm) then
      69        9327 :                         sample = GET_CONJG(transpose(getShifted(sample, dim, -amount)))
      70        9327 :                         sampleShifted = getShifted(sampleShifted, dim, -amount, transHerm)
      71             :                     else
      72       10592 :                         sampleShifted = getShifted(getShifted(sampleShifted, dim, amount), dim, -amount)
      73             :                     end if
      74             :                 else
      75         645 :                     if (isTransHerm) then
      76        8256 :                         sample = GET_CONJG(transpose(getShifted(sample, -amount(1))))
      77        8256 :                         sampleShifted = getShifted(sampleShifted, -amount(1), transHerm)
      78             :                     else
      79        9256 :                         sampleShifted = getShifted(getShifted(sampleShifted, amount(1)), -amount(1))
      80             :                     end if
      81             :                 end if
      82             :             end if
      83             : #elif       setShifted_ENABLED
      84        1400 :             if (isd1) then
      85          69 :                 call setShifted(sampleShifted(:,1), +amount(1))
      86          69 :                 call setShifted(sampleShifted(:,1), -amount(1))
      87             :             else
      88        5471 :                 call setShifted(sampleShifted, dim, +amount)
      89        5471 :                 call setShifted(sampleShifted, dim, -amount)
      90             :             end if
      91             : #endif
      92       39244 :             diff = abs(sample - sampleShifted)
      93       36444 :             assertion = assertion .and. all(diff < tol)
      94        2828 :             call report(__LINE__)
      95             :         end do
      96             : 
      97             :     contains
      98             : 
      99        2800 :         subroutine report(line)
     100             :             integer, intent(in) :: line
     101        2800 :             if (test%traceable .and. .not. assertion) then
     102             :                 ! LCOV_EXCL_START
     103             :                 call test%disp%skip()
     104             :                 call test%disp%show("isd1")
     105             :                 call test%disp%show( isd1 )
     106             :                 call test%disp%show("isTransHerm")
     107             :                 call test%disp%show( isTransHerm )
     108             :                 call test%disp%show("isPresentDim")
     109             :                 call test%disp%show( isPresentDim )
     110             :                 call test%disp%show("[ndim, nsam, dim]")
     111             :                 call test%disp%show( [ndim, nsam, dim] )
     112             :                 call test%disp%show("sample")
     113             :                 call test%disp%show( sample )
     114             :                 call test%disp%show("sampleShifted")
     115             :                 call test%disp%show( sampleShifted )
     116             :                 call test%disp%show("diff")
     117             :                 call test%disp%show( diff )
     118             :                 call test%disp%skip()
     119             :                 ! LCOV_EXCL_STOP
     120             :             end if
     121        2800 :             call test%assert(assertion, SK_"The sample must be shifted correctly.", int(line, IK))
     122        2800 :         end subroutine
     123             : #undef  TYPE_OF_SAMPLE
     124             : #undef  GET_CONJG