find_peaks_log   xtlang


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/libs/contrib/TSM_library.xtm

Implementation

; Multiresolution peak picking
; Causes buzzing when used in sPL.  This is an sPL issue not a find_peaks_log issue.
; If number of neighbours < 2 there is minimal buzzing
; This will require more work.  Doesn't give same results as MATLAB implementation
(bind-func find_peaks_log:[i64,float*,i64,i64*,i64*,i64*]*
  (lambda (buffer:float* buffer_len:i64 peaks_array:i64* region_lower:i64* region_upper:i64*)
    (let ((n:i64 0);
          (pad_amount:i64 64)
          (peak_index:i64 0)
          (buff_padded:float* (salloc (+ buffer_len pad_amount)))
          (neighbours:i64 0)
          (dummy:i64 0))
      (dotimes (n pad_amount)
        (pset! buff_padded (+ buffer_len n) 0.0))
      (dotimes (n buffer_len)
        (pset! buff_padded n (pref buffer n)))
      (dotimes (n buffer_len) ;peak finding
        (cond ((< n 17)
                (pset! peaks_array peak_index n)
                (set! peak_index (+ peak_index 1)))
              (else (cond ((< n 33)
                           (cond ((= (greater_than_neighbours buff_padded n 1) 1)
                                  (pset! peaks_array peak_index n)
                                  (set! peak_index (+ peak_index 1)))
                                 (else 0)))
                          (else (cond ((< n 65)
                                       (cond ((= (greater_than_neighbours buff_padded n 2) 1) ;n 2
                                              (pset! peaks_array peak_index n)
                                              (set! peak_index (+ peak_index 1)))
                                             (else 0)))
                                      (else (cond ((< n 129)
                                                   (cond ((= (greater_than_neighbours buff_padded n 4) 1) ;n 4
                                                          (pset! peaks_array peak_index n)
                                                          (set! peak_index (+ peak_index 1)))
                                                         (else 0)))
                                                  (else (cond ((< n 257)
                                                               (cond ((= (greater_than_neighbours buff_padded n 8) 1) ;n 8
                                                                      (pset! peaks_array peak_index n)
                                                                      (set! peak_index (+ peak_index 1)))
                                                                     (else 0)))
                                                              (else (cond ((< n 513)
                                                                           (cond ((= (greater_than_neighbours buff_padded n 16) 1) ;n 16
                                                                                  (pset! peaks_array peak_index n)
                                                                                  (set! peak_index (+ peak_index 1)))
                                                                                 (else 0)))
                                                                          (else (cond ((< n 1025)
                                                                                       (cond ((= (greater_than_neighbours buff_padded n 32) 1) ;n 32
                                                                                              (pset! peaks_array peak_index n)
                                                                                              (set! peak_index (+ peak_index 1)))
                                                                                             (else 0)))
                                                                                      (else (cond ((= (greater_than_neighbours buff_padded n 64) 1) ;n 64
                                                                                                    (pset! peaks_array peak_index n)
                                                                                                    (set! peak_index (+ peak_index 1)))
                                                                                                  (else 0)))))))))))))))))
      (cond ((> peak_index 17)
              (pfill! region_lower 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17) ; The 17 ensures that the regions are continuous for entire range.
              (pfill! region_upper 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16)
              (dotimes (n (- peak_index 18))
                  (pset! region_lower (+ n 18) (ftoi64 (ceil (/ (i64tof (+ (pref peaks_array (+ n 18))
                                                                           (pref peaks_array (+ n 17))))
                                                                 (i64tof 2))))))
              (dotimes (n (- peak_index 18)) ;Set the region_upper bound
                  (pset! region_upper (+ n 17) (- (pref region_lower (+ n 18)) 1)))
                  (pset! region_upper (- peak_index 1) buffer_len))
            (else
              (pfill! peaks_array 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
      ;(if (= trigger 1)
      ;  (begin
      ;    (set! trigger 0)
      ;    (println "peaks")
      ;    (dotimes (n peak_index)
      ;      (printf "%d," (pref peaks_array n)))
      ;    (println "\nlower")
      ;    (dotimes (n peak_index)
      ;      (printf "%d," (pref region_lower n)))
      ;    (println "\nupper")
      ;    (dotimes (n peak_index)
      ;      (printf "%d," (pref region_upper n)))
      ;    (println "")))
      peak_index)))


Back to Index

Similar Entries

  • Clog    xtlang
  • ShaderProgram_print_info_log    xtlang
  • Shader_print_info_log    xtlang
  • Widget_find_inorder    xtlang
  • Widget_find_postorder    xtlang
  • Widget_find_preorder    xtlang
  • aiProcess_FindDegenerates    scheme
  • aiProcess_FindInstances    scheme
  • aiProcess_FindInvalidData    scheme
  • ai_find_matching_node    xtlang
  • analogue-load-preset    scheme
  • analogue-load-state    scheme
  • analogue-reset    scheme
  • analogue-save-preset    scheme
  • analogueVec_fx    xtlang
  • analogueVec_note    xtlang
  • analogue_cc    xtlang
  • analogue_drwho_bass    xtlang
  • analogue_drwho_lead    xtlang
  • analogue_drwho_swoosh    xtlang
  • analogue_fx    xtlang
  • analogue_get_mod_matrix    xtlang
  • analogue_note    xtlang
  • analogue_oxygene_bass    xtlang
  • analogue_oxygene_bass    xtlang
  • analogue_oxygene_lead    xtlang
  • analogue_oxygene_lead    xtlang
  • analogue_oxygene_riff    xtlang
  • analogue_pale_organ    xtlang
  • analogue_remove_file    xtlang
  • analogue_reset    xtlang
  • analogue_set_mod_matrix    xtlang
  • blsawXAnalogue_c    xtlang
  • bltriXAnalogue_c    xtlang
  • cerberus_logRamp    xtlang
  • cl:find-if    scheme
  • dlogue_fx    xtlang
  • dlogue_note    xtlang
  • find_node    xtlang
  • find_peaks    xtlang
  • find_previous_peak    xtlang
  • find_sexprs    xtlang
  • find_sqr_exprs    xtlang
  • get_analogue_synth_cc_name    xtlang
  • get_dialog_handler    xtlang
  • get_find_handler    xtlang
  • get_jsdialog_handler    xtlang
  • gui_find_leaf_inorder    xtlang
  • gui_find_leaf_postorder    xtlang
  • gui_find_leaf_preorder    xtlang
  • gui_find_next_id    xtlang
  • gui_find_parent    xtlang
  • gui_find_widget_with_id    xtlang
  • iffchunk_find_dumb    xtlang
  • iffchunk_find_smart    xtlang
  • impc:compiler:print-bind-func-details-to-log    scheme
  • impc:compiler:print-binding-details-to-log    scheme
  • impc:compiler:print-could-not-resolve-types_find-expr    scheme
  • impc:compiler:print-dylib-loading-details-to-log    scheme
  • impc:compiler:print-lib-binding-details-to-log    scheme
  • impc:compiler:print-polying-details-to-log    scheme
  • impc:ti:find-all-vars    scheme
  • impc:ti:find-unresolved-simple-types    scheme
  • instrument_find_note    xtlang
  • log-error    scheme
  • log-info    scheme
  • log-warn    scheme
  • logRamp    xtlang
  • oscXAnalogue_c    xtlang
  • pc:find-closest    scheme
  • print_program_info_log    xtlang
  • print_shader_info_log    xtlang
  • xtm_find_bone    xtlang