xCorr_max   xtlang


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

Implementation

;This closure returns the lag for maximum cross correlation between 2 vectors.
;A result of 0 means that the initial samples of each vector are aligned.
;Negative numbers place vector 1 before vector 2
;Positive numbers place vector 1 after alignment of vector1(0) and vector2(0)
(bind-func xCorr_max:[i64,float*,i64,float*,i64]*
  (lambda (vector1:float* len1:i64 vector2:float* len2:i64)
    (let ((m:i64 0)
          (n:i64 0)
          (shift:i64 0)
          (lag_max_xCorr:i64 0)
          (max_pos:i64 0)
          (sum_vec1_2:float 0.0)
          (sum_vec2_2:float 0.0)
          (denom:float 0.0)
          (correlations:float* (salloc (- (+ len1 len2) 1)))
          (lags:i64* (salloc (- (+ len1 len2) 1))))
      (dotimes (n (- (+ len1 len2) 1))  ;initialise correlations to 0
        (pset! correlations n 0.0))
      (dotimes (shift (- (+ len1 len2) 1))
        (pset! lags shift (- shift (- len1 1)))  ;store the shift value into lags
        (cond ((< shift len2)
                (dotimes (m (+ shift 1))
                  (pset! correlations shift (+ (pref correlations shift) (* (pref vector2 m) (pref vector1 (+ (- len1 1 shift) m)))))
                  (set! sum_vec1_2 (+ sum_vec1_2 (* (pref vector1 (+ (- len1 1 shift) m)) (pref vector1 (+ (- len1 1 shift) m)))))
                  (set! sum_vec2_2 (+ sum_vec2_2 (* (pref vector2 m) (pref vector2 m))))))
              (else
                (dotimes (m (- (+ len1 len2) (+ 1 shift)))
                  (pset! correlations shift (+ (pref correlations shift) (* (pref vector1 m) (pref vector2 (- (+ m shift 1) len1)))))
                  (set! sum_vec1_2 (+ sum_vec1_2 (* (pref vector1 m) (pref vector1 m))))
                  (set! sum_vec2_2 (+ sum_vec2_2 (* (pref vector2 (- (+ m shift 1) len1)) (pref vector2 (- (+ m shift 1) len1)))))
                  )))
        (set! denom (sqrt (* sum_vec1_2 sum_vec2_2)))
        (cond ((= denom 0.0) (pset! correlations shift 0.0))
              (else (pset! correlations shift (/ (pref correlations shift) denom))))
        (println (pref correlations shift))
        (set! sum_vec1_2 0.0)
        (set! sum_vec2_2 0.0))
      ;return the lag for maximum cross correlation
      (set! max_pos (vmax_pos correlations (- (+ len1 len2) 1)))
      (set! lag_max_xCorr (pref lags max_pos))
      lag_max_xCorr)))


Back to Index

Similar Entries