| commit | author | age | ||
| 92c40d | 1 | ;********************************************************************* |
| AN | 2 | ; OM-SoX, (c) 2011-2013 Marlon Schumacher (CIRMMT/McGill University) * |
| 3 | ; http://sourceforge.net/projects/omsox/ * | |
| 4 | ; * | |
| 5 | ; Multichannel Audio Manipulation and Functional Batch Processing. * | |
| 6 | ; DSP based on SoX - (c) C.Bagwell and Contributors * | |
| 7 | ; http://sox.sourceforge.net/ * | |
| 8 | ;********************************************************************* | |
| 9 | ; | |
| 10 | ;This program is free software; you can redistribute it and/or | |
| 11 | ;modify it under the terms of the GNU General Public License | |
| 12 | ;as published by the Free Software Foundation; either version 2 | |
| 13 | ;of the License, or (at your option) any later version. | |
| 14 | ; | |
| 15 | ;See file LICENSE for further informations on licensing terms. | |
| 16 | ; | |
| 17 | ;This program is distributed in the hope that it will be useful, | |
| 18 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 | ;GNU General Public License for more details. | |
| 21 | ; | |
| 22 | ;You should have received a copy of the GNU General Public License | |
| 23 | ;along with this program; if not, write to the Free Software | |
| 24 | ;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,10 USA. | |
| 25 | ; | |
| 26 | ;Authors: M. Schumacher | |
| 27 | ||
| 28 | (in-package :om) | |
| 29 | ||
| 30 | (defmethod! mag->lin ((magnitude number) (windowsize number) (wcoef number)) | |
| 31 | :icon 141 | |
| 32 | :indoc '("a value or list of values" "windowsize" "window coefficient") | |
| 33 | :initvals '(100 4096 1) | |
| 34 | :doc "Converts magnitude values of a power spectrum to linear gain" | |
| 35 | (* 2 (/ (sqrt magnitude) windowsize) wcoef)) | |
| 36 | ||
| 37 | (defmethod! mag->lin ((magnitude list) (windowsize number) (wcoef number)) | |
| 38 | (mapcar (lambda (themagnitude) | |
| 39 | (mag->lin themagnitude windowsize wcoef)) magnitude) | |
| 40 | ) | |
| 41 | ||
| 42 | ; needs sorting function | |
| 43 | (defmethod! find-n-peaks ((points list) (numpeaks integer) (mode t) &key (test '>) (decimals 10) (deltaparam 1) (mindistance-factor 0.01) (filter-window 5) (filter-recursions 3) (sort '<)) | |
| 44 | :icon '(233) | |
| 45 | :indoc '("a bpf or point-list" "Number of Peaks to find" "mode (Peak or Trough)" "sorting function for result" "decimals for calculation" "delta step to determine peak or trough") | |
| 46 | :initvals '(((0 1) (5 10) (10 1)) 1 peak > 10 1 0.01 5 2) ; no quote needed because it is already quoted | |
| 47 | :menuins '((2 (("peak" 'peak) ("trough" 'trough))) (3 ((">" >) ("<" <))) (9 ((">" >) ("<" <)))) | |
| 48 | :doc "finds the n highest/lowest peaks or troughs in a bpf or point-list" | |
| 49 | :numouts 2 | |
| 50 | (let* ((transpoints (mat-trans points)) | |
| 51 | (filteredpoints (list (first transpoints) (sox-median-filter-rec (second transpoints) filter-window filter-recursions))) | |
| 52 | (thedxpoints (mat-trans (list (first filteredpoints) (x-append 0 (x->dx (second filteredpoints)))))) | |
| 53 | (thezerocrossings (remove-duplicates (y-transfer thedxpoints 0 decimals))) | |
| 54 | (thecrossingfrequencies (x-transfer thedxpoints (om- thezerocrossings deltaparam) decimals)) | |
| 55 | (thepeakfrequencies | |
| 56 | (remove nil | |
| 57 | (if (equal mode 'peak) | |
| 58 | (loop for item in thecrossingfrequencies | |
| 59 | for x from 0 to (length thecrossingfrequencies) | |
| 60 | collect | |
| 61 | (omif (> item 0) nil x) | |
| 62 | ) | |
| 63 | #| | |
| 64 | (loop for item in thecrossingfrequencies | |
| 65 | for x from 0 to (length thecrossingfrequencies) | |
| 66 | if (> item 0) collect x | |
| 67 | ) | |
| 68 | |# | |
| 69 | (loop for item in thecrossingfrequencies | |
| 70 | for x from 0 to (length thecrossingfrequencies) | |
| 71 | collect | |
| 72 | (omif (< item 0) nil x) | |
| 73 | ) | |
| 74 | #| | |
| 75 | (loop for item in thecrossingfrequencies | |
| 76 | for x from 0 to (length thecrossingfrequencies) | |
| 77 | if (< item 0) collect x | |
| 78 | ) | |
| 79 | |# | |
| 80 | ))) | |
| 81 | (thepeakfrequenciesfiltered (remove nil (subs-posn thezerocrossings thepeakfrequencies nil))) | |
| 82 | (thepeakpointlist (mat-trans (list thepeakfrequenciesfiltered (x-transfer points thepeakfrequenciesfiltered decimals)))) | |
| 83 | (thefilteredpeakpointlist (min-x-distance thepeakpointlist mindistance-factor)) | |
| 84 | ;(thefilteredpeakpointlist thepeakpointlist) | |
| 85 | (theminfilteredpeakpointlist (min-x-val thefilteredpeakpointlist 200 14000)) | |
| 86 | (thesortedpointlist | |
| 87 | (sort-list theminfilteredpeakpointlist :test test :key 'second)) | |
| 88 | (thesortedsortedpointlist | |
| 89 | (sort-list thesortedpointlist :test sort :key 'first)) | |
| 90 | (thetranspeakpoints (mat-trans (first-n thesortedsortedpointlist numpeaks))) | |
| 91 | ) | |
| 92 | (values-list (list (om+ (first thetranspeakpoints) 0) (second thetranspeakpoints))) ;hardcoded x-offset | |
| 93 | )) | |
| 94 | ||
| 95 | ;(band-filter '((86.13281 -79.09892) (269.16504 -62.568234) (656.7627 -66.9554)) (list (list 200 14000)) 'Pass) | |
| 96 | ||
| 97 | (defmethod! find-n-peaks ((points bpf) (numpeaks integer) (mode t) &key (test '>) (decimals 10) (deltaparam 1) (mindistance-factor 0.01) (filter-window 5) (filter-recursions 3) (sort '<)) | |
| 98 | (find-n-peaks (point-pairs points) numpeaks mode | |
| 99 | :test test :decimals decimals :deltaparam deltaparam | |
| 100 | :mindistance-factor mindistance-factor | |
| 101 | :filter-window filter-window | |
| 102 | :filter-recursions filter-recursions | |
| 103 | :sort sort) | |
| 104 | ) | |
| 105 | ||
| 106 | (defun min-x-const-q-distance (list distance-factor) | |
| 107 | (remove-duplicates list | |
| 108 | :test #'(lambda (a b) | |
| 109 | (< (- (first a) (first b)) (* (first a) distance-factor)) | |
| 110 | ) | |
| 111 | )) | |
| 112 | ||
| 113 | (defun min-x-distance (list distance) | |
| 114 | (remove-duplicates list | |
| 115 | :test #'(lambda (a b) | |
| 116 | (< (- (first a) (first b)) distance) | |
| 117 | ) | |
| 118 | )) | |
| 119 | ||
| 120 | (defun min-x-val (list min max) | |
| 121 | (loop for item in list | |
| 122 | if (and (> (car item) min) | |
| 123 | (< (car item) max)) | |
| 124 | collect item)) | |
| 125 | ||
| 126 | (defun min-x-distance-reverse (list distance) | |
| 127 | (remove-duplicates list | |
| 128 | :test #'(lambda (a b) | |
| 129 | (< (- (first b) (first a)) distance) | |
| 130 | ) | |
| 131 | )) | |
| 132 | ||
| 133 | ;=== averages a bpf-lib into a single bpf | |
| 134 | ||
| 135 | (defmethod! bpf-average ((self list)) | |
| 136 | :icon '(233) | |
| 137 | (let* ((xpoints (x-points (first self))) | |
| 138 | (transypointlist (mat-trans | |
| 139 | (loop for bpf in self | |
| 140 | collect | |
| 141 | (y-points bpf)))) | |
| 142 | (averagedypoints (mapcar #'om-mean transypointlist))) | |
| 143 | (simple-bpf-from-list xpoints averagedypoints 'bpf (decimals (first self))) | |
| 144 | )) | |
| 145 | ||
| 146 | (defmethod! bpf-average ((self bpf-lib)) | |
| 147 | (bpf-average (bpf-list self))) | |
| 148 | ||
| 149 | ;;======================================================================= | |
| 150 | ; filter functions borrowed from om-fil | |
| 151 | ;;======================================================================= | |
| 152 | ||
| 153 | (defun sox-debut (list elem) | |
| 154 | (loop for x in elem | |
| 155 | collect (om-mean (first-n list (1+ (om* x 2)))))) | |
| 156 | ||
| 157 | (defun sox-fin (list elem) | |
| 158 | (loop for x in elem | |
| 159 | collect (om-mean (first-n (reverse list) (1+ (om* x 2)))))) | |
| 160 | ||
| 161 | (defun sox-median-point (list N) | |
| 162 | (nth N (sort. list))) | |
| 163 | ||
| 164 | ||
| 165 | (defmethod! sox-median-filter ((data list) (window number) ) | |
| 166 | :initvals '('(1 2 3 4 5 6) 100 1) | |
| 167 | :indoc '("list of data" "window size in samples data" "recursion level") | |
| 168 | :icon '(213) | |
| 169 | :numouts 1 | |
| 170 | :doc " Traditional Median filter, where <list> is the data flow to filter and <window> | |
| 171 | is the parameter to calculate the window delay. The <window delay> will be (2*window + 1). | |
| 172 | We will use the median point of the effective window delay" | |
| 173 | (let ((aux data) | |
| 174 | (modulo (om// (1+ (om* window 2)) 2))) | |
| 175 | (x-append (first data) | |
| 176 | (sox-debut data (arithm-ser 1 | |
| 177 | (1- modulo) | |
| 178 | 1)) | |
| 179 | ||
| 180 | (loop for i from modulo to (om- (1- (length data)) modulo) | |
| 181 | collect (sox-median-point | |
| 182 | (subseq data | |
| 183 | (om- i modulo) | |
| 184 | (om+ i (1+ modulo))) window)) | |
| 185 | (sox-fin data (arithm-ser 1 | |
| 186 | (1- modulo) | |
| 187 | 1)) | |
| 188 | (last-elem data)))) | |
| 189 | ||
| 190 | (defmethod! sox-median-filter-rec ((data list) (window number) (deep number)) | |
| 191 | :initvals '('(1 2 3 4 5 6) 100 1) | |
| 192 | :indoc '("list of data" "window size in samples data" "recursion level") | |
| 193 | :icon '(213) | |
| 194 | :numouts 1 | |
| 195 | :doc "Recursive sox-median-filter" | |
| 196 | (let ((aux data)) | |
| 197 | ||
| 198 | (dotimes (x deep aux) | |
| 199 | (setf aux (sox-median-filter aux window))))) | |
| 200 | ||
