!******************************************************************************!
! Test/demo macro for primitive peakpick
!
! Arguments:Use /PLOT to see plots of the files created
!
! @bug      2660 peakpick: Support complex data
! @author:  Ken Smith / J Hallam / JGS / Neon Ngo / J Bauer
! @version: $Id: test_peakpick.mm,v 1.1 2013/01/07 14:17:45 jwb Exp $
!******************************************************************************!

startmacro
  result l:nel1000 1000
  result l:nel2000 10000
  result d:toler 6e-5      ! This large tolerance is probably due to floating
                           !   point rounding errors in peakpick

  !!!!!!  THESE TESTS NEED TO BE RUN IN ORDER  !!!!!!!!!!!
  call setup_1000_files   ! setup the type 1000 files
  call test_as_results    ! test the output as results
  call test_5_peaks       ! test output with 5 peaks
  call test_hyster_40     ! test adjusting the /hyster
  ! call test_frame_0        ! TBD
  call setup_2000_files   ! setup the type 2000 files
  call test_2000_single   ! test 2000 file with single peak
  ! call test_2000_frame_0  ! TBD
  call test_2000_5_peaks  ! test 2000 file with multiple peaks
  call test_complex_data  ! Bug 2660 (since 3.3.1)

  ! Clean up temporary files
  call cleanup

endmacro

!******************************************************************************!
! Setup the type 1000 files used in testing
!******************************************************************************!
procedure setup_1000_files
  call get_unique temp1

  waveform temp1 sf nel1000 cosine     100 .001 0.49 0 1
  call get_unique temp2
  waveform temp2 sf nel1000 triangle 30 .0065 0 0 1
  call get_unique sum
  fcalc sum temp1 temp2 +

  if /plot gt 0 then
    plot sum|temp1|temp2
  endif

return

!******************************************************************************!
! Setup the type 2000 files used in testing
!******************************************************************************!
procedure setup_2000_files
  ! Note that fcalc is essentially useless with type 2000 files, so do the 
  !  headermod at the very end

  waveform temp1 sf nel2000 cosine 100 .001 0.49 0 1
  waveform temp2 sf nel2000 triangle 30 .005 0 0 1
  fcalc sum temp1 temp2 +
  headermod sum type=2000 fs=1000

  if /plot gt 0 then
    plot sum
  endif

return 

!******************************************************************************!
! Check as results
!******************************************************************************!
procedure test_as_results
  if absout FEXISTS erase absout
  if valout FEXISTS erase valout
  peakpick sum absout valout  1 0

  ! Make sure the output is a results parameter, not a file
  if absout nrexists or absout fexists or valout nrexists or valout fexists then
    assert/text="^reg.main.name: Failed type-1000, 1 peak test, wrong output type" fail
  else
    call test_it absout 538        "Type-1000, 1 peak test 1"
    call test_it valout 128.09732  "Type-1000, 1 peak test 2"
  endif

return

!******************************************************************************!
! Check with MAX PEAKS = 5
!******************************************************************************!
procedure test_5_peaks
  call get_unique absfile
  call get_unique valfile
  peakpick/hyster=10 sum ^absfile ^valfile 5 0

  ! Make sure the output is a file, not a results parameter
  if ^absfile rexists or ^absfile nfexists or &
     ^valfile rexists or ^valfile nfexists then
     assert/text="^reg.main.name: Failed type-1000, 5 peak test, wrong output type" fail
  else
  
    ! Make sure we have 5 outputs exactly
    status absfile type=l:type size=l:nel
    if type ne 1000 or nel ne 5 then
      assert/text="^reg.main.name: Failed type-1000, 5 peak test, wrong out file type/size" fail
    else
      status valfile type=l:type size=l:nel
      if type ne 1000 or nel ne 5 then
        assert/text="^reg.main.name: Failed type-1000, 5 peak test, wrong out file type/size" fail
      else
        ! Now check the values
        call test_file valfile 5 "Type-1000, 5 peak test 1" &
                 128.097 100.411 71.1982 11.6993 -21.5642
        call test_file absfile 5 "Type-1000, 5 peak test 2" &
                 538 385 692 231 846
      endif
    endif
  endif
return

!******************************************************************************!
! Test with /HYSTERESIS = 40
!******************************************************************************!
procedure test_hyster_40
  ! By increasing the hysteresis value, we should get fewer peaks
  !   Missing peaks are padded with zeros
  !
  peakpick/hyster=40 sum absfile valfile 5 0
  call test_file valfile 5 "/HYSTER test 1" 128.097 71.1982 -21.5642 0. 0.
  call test_file absfile 5 "/HYSTER test 2" 538 692 846 0. 0.
return

!******************************************************************************!
! Test with /FRAME=0  (which doesn't exist so it is commented out)
!******************************************************************************!
procedure test_frame_0
! Make sure that the /FRAME=0 switch works 
! (it should override the HEADERMOD setting)
!
!!!  headermod sum type=2000 fs=100
!
! We should get a single max val/abs, as a results parameter
!
!!!  peakpick/frame=0 sum absout valout  1 0
!
! Make sure the output is a results parameter, not a file
!
!!!  if absout nrexists or absout fexists or valout nrexists or absout fexists then
!!!    assert/text="^reg.main.name: /FRAME=0; type-1000, 1 peak test, wrong output type" fail
!!!  else
!!!    call test_it absout 538        "/FRAME=0 test-1"
!!!    call test_it valout 126.80404  "/FRAME=0 test-2"
!!!  endif

return

!******************************************************************************!
! type 2000 file, one peak test
!******************************************************************************!
procedure test_2000_single
  peakpick sum absfile valfile 1 0

  ! Make sure the outputs are type 1000, with 10 values each
  status absfile type=type size=nel
  result dbgText "Type-2000, 1 peak test output type/size (1)"
  assert/stat=absStatus/text="^reg.main.name: ^dbgText" type EQ 1000 AND nel EQ 10
  
  if absStatus EQS "PASS" then
    status valfile type=type size=nel
    result dbgText "Type-2000, 1 peak test output type/size (2)"
    assert/stat=valStatus/text="^reg.main.name: ^dbgText" type EQ 1000 AND nel EQ 10
    if valStatus EQS "PASS" then
      ! check the data values
      ! COMPARE would be handy here, if it worked...
      call do_compare absfile 500     10 "Type-2000 1 peak test, abs values"
      call do_compare valfile 129.803 10 "Type-2000 1 peak test, amp values"
    endif
  endif
return

!******************************************************************************!
! test the /FRAME=<frame size> switch with multiple peak outputs
!     - commented out since /frame does not work
!******************************************************************************!
procedure test_2000_frame_0
!!!  headermod sum type=1000
!!!  peakpick/frame=1000 sum absfile valfile 5 0
return

!******************************************************************************!
! Test the type 2000 file outputs with 5 peaks and 10 frames with correct data
!******************************************************************************!
procedure test_2000_5_peaks
  peakpick sum absfile valfile 5 0
  
  ! Make sure the outputs are type 2000, with 10 frames, 5 values each
  status absfile type=type size=nel fs=framesz
  if type ne 2000 or nel ne 10 or framesz ne 5 then
    assert/text="^reg.main.name: Failed type-2000, 5 peak test, wrong abs output type/size" fail
  else
    status valfile type=type size=nel fs=framesz
    if type ne 2000 or nel ne 10 or framesz ne 5 then
      assert/text="^reg.main.name: Failed type-2000, 5 peak test, wrong val output type/size" fail
    else
  
      ! Now check the data values
      ! COMPARE would be handy here, if it worked...
      ! The fancy footwork in the NOOP command is needed to avoid an obscure indexing problem
      do fcount 1 10 1
        ! Trimmers are zero-based
        result offset fcount-1
  !jph -- the syntax noop infile(n:n) outfile is NOT WORKING PROPERLY
  !  offset2 is computed with this in mind...change this to the intended
  ! syntax once fixed!!!
        calc L:offset2 offset 1 +
        noop ^{valfile}(^{offset}:^{offset2}) temp1 
        headermod temp1 type=1000
        result dbgText "Type-2000, 5 peak test, abs values, filenum = ^fcount"
        call test_file temp1 5 dbgText 129.804 66.8126 54.905 -47.054 -54.436
  
        noop ^{absfile}(^{offset}:^{offset2}) temp1 
        headermod temp1 type=1000
        result dbgText "Type-2000, 5 peak test, amp values, filenum = ^fcount"
        call test_file temp1 5 dbgText 500 700 308 900 100
      enddo
    endif
  endif

return

!******************************************************************************!
! test using complex data in the input file  - Added in 3.3.1 for Bug 2660
!******************************************************************************!
procedure test_complex_data

  ! create a file with a known freq
  waveform out=ram:waveout form=cf elem=32k shape=sine amp=16 freq=3125 phase=0 start=0 delta=1/8k
  
  ! do a simple fft (32k elems input and 4k fft size means 8 frames of 4k size each)
  fft ram:waveout ram:ffttemp 4k   
  
  ! the conversion from MAG should be automatic (no need for cxmode=MAG)
  peakpick ram:ffttemp ram:apexpeakmag
  peakpick ram:ffttemp ram:apexpeaklog10 cxmode=10LOG   ! only MAG and LOG provide consistent values for this input
  peakpick ram:ffttemp ram:apexpeaklog20 cxmode=20LOG
  
  ! open the files so we can inspect the data
  file open/d tagmag ram:apexpeakmag
  file open/d taglog10 ram:apexpeaklog10
  file open/d taglog20 ram:apexpeaklog20
  
  res success "pass"
  
  do count 0 7 1
    set d:mag   tagmag.getData(^count)
    set d:log10 taglog10.getData(^count)
    set d:log20 taglog20.getData(^count)
    
    if mag ne 3126.0 or log10 ne 3126.0 or log20 ne 3126.0 then
      set success "fail"
    endif
  enddo
  
  assert/text="^reg.main.name: Test with complex input data" success eqs "pass"   
  
  file close tagmag
  file close taglog10
  file close taglog20
  
  peakpick ram:ffttemp ram:peakpick2 /tl=9     ! test with /TL switch

return

!******************************************************************************!
! Create unique filenames for testing
!******************************************************************************!
procedure get_unique u:file
  if indexUnique NREXISTS result l:indexUnique 1
  result s:^file uniq^{env.pid}^{indexUnique}
  calc/quiet l:indexUnique indexUnique 1 +
return

!******************************************************************************!
! Compare two values with tolerence
!******************************************************************************!
procedure test_it d:val1 d:val2 s:string
  calc/quiet eqt_test val1 val2 - val1 val2 * sqrt abs /
  assert/text="^reg.main.name: ^string" eqt_test le toler
return

!******************************************************************************!
! Compare values in file with knowns
!******************************************************************************!
procedure test_file s:infile l:nvals s:string d:val1 d:val2 d:val3 d:val4 d:val5
  result l:ok 1
  file open/d handle infile

  do i 1 nvals 1
    result d:testval1 val^i
    result d:testval2 handle.data(i-)
    calcul/quiet eqt_test testval1 testval2 - abs testval1 abs 1e-6 max /  
    if eqt_test gt toler result l:ok 0
  enddo

  file close handle

  assert/text="^reg.main.name: ^string" ok eq 1

return

!******************************************************************************!
! Compare a (supposedly) constant file against the correct value
!******************************************************************************!
procedure do_compare s:infile d:val l:num s:string
  result l:ok 1

  file open/d handle infile

  do i 1 num 1
    result d:testval handle.data(i-)
    calcul/quiet eqt_test val testval - abs val abs 1e-6 max /
    if eqt_test gt toler result l:ok 0          
  enddo

  file close handle
  assert/text="^reg.main.name: ^string" ok EQ 1

return

!******************************************************************************!
! Clean up our files (it would be nice if there were a /NOWARN switch to allow
!    deleting optional files quietly, this would avoid the "if" test here).
!******************************************************************************!
procedure cleanup

  if temp1   fexists erase/verbose=false temp1
  if temp2   fexists erase/verbose=false temp2
  if sum     fexists erase/verbose=false sum
  if absfile fexists erase/verbose=false absfile
  if valfile fexists erase/verbose=false valfile
!
return

