[PD] noise floor: median in audio signals, for peak extraction

[Charles Henry]

On Wed, Dec 21, 2011 at 11:15 AM, Charles Henry <czhenry at gmail.com> wrote:
> I had made a badly written external, and a cpu-hungry abstraction
> (with fexpr~ and a fixed number of weights) a while back.  I'd be
> happy to dig up the code and algorithm after work today.

Here's the abstraction: wmed5~.pd   Below is also a pasted test patch.
 How it works: it computes all branches!  Just for fun, because it's
not something that scales well with more taps, but works.

wmed5~.pd

#N canvas 0 0 765 642 10;
#X obj 150 132 t b b;
#X obj 189 132 loadbang;
#X obj 452 188 expr $f1+$f2+$f3+$f4+$f5;
#X obj 455 225 expr int(($f1+1)/2);
#X text 591 227 median index;
#X obj 11 33 inlet~;
#X obj 62 230 fexpr~ $f3*($x1>$x1[-1]) + $f4*($x1>$x1[-2]) + $f5*($x1>$x1[-3])
+ $f6*($x1>$x1[-4]) \; $f2*($x1<=$x1[-1]) + $f4*($x1[-1]>$x1[-2]) +
$f5*($x1[-1]>$x1[-3]) + $f6*($x1[-1]>$x1[-4]) \; $f2*($x1<=$x1[-2])
+ $f3*($x1[-1]<=$x1[-2]) + $f5*($x1[-2]>$x1[-3]) + $f6*($x1[-2]>$x1[-4])
\; $f2*($x1<=$x1[-3]) + $f3*($x1[-1]<=$x1[-3]) + $f4*($x1[-2]<=$x1[-3])
+ $f6*($x1[-3]>$x1[-4]) \; $f2*($x1<=$x1[-4]) + $f3*($x1[-1]<=$x1[-4])
+ $f4*($x1[-2]<=$x1[-4]) + $f5*($x1[-3]<=$x1[-4]);
#X obj 19 449 fexpr~ $x1*(($x2+$f3) >= $f4)*($x2 < $f4);
#X obj 62 475 fexpr~ $x1[-1]*(($x2+$f3) >= $f4)*($x2 < $f4);
#X obj 102 501 fexpr~ $x1[-2]*(($x2+$f3) >= $f4)*($x2 < $f4);
#X obj 143 527 fexpr~ $x1[-3]*(($x2+$f3) >= $f4)*($x2 < $f4);
#X obj 179 552 fexpr~ $x1[-4]*(($x2+$f3) >= $f4)*($x2 < $f4);
#X obj 27 594 expr~ $v1+$v2+$v3+$v4+$v5;
#X obj 27 625 outlet~;
#X obj 78 31 inlet;
#X obj 78 54 unpack f f f f f;
#X obj 85 163 \$2;
#X obj 125 165 \$3;
#X obj 152 165 \$4;
#X obj 181 165 \$5;
#X obj 210 165 \$6;
#X text 253 44 1-D weighted median filter using expr \, expr~ \, fexpr~
;
#X text 351 88 uses 5 integer arguments \, representing the weights
of choosing a median from a weighted set of samples as x[0] \, x[-1]
\, x[-2] \, x[-3] \, x[-4];
#X text 348 129 the weighted set includes a number of duplications
of x \, equal to the argument;
#X connect 0 0 16 0;
#X connect 0 1 17 0;
#X connect 0 1 18 0;
#X connect 0 1 19 0;
#X connect 0 1 20 0;
#X connect 1 0 0 0;
#X connect 2 0 3 0;
#X connect 3 0 7 3;
#X connect 3 0 8 3;
#X connect 3 0 9 3;
#X connect 3 0 10 3;
#X connect 3 0 11 3;
#X connect 5 0 6 0;
#X connect 5 0 7 0;
#X connect 5 0 8 0;
#X connect 5 0 9 0;
#X connect 5 0 10 0;
#X connect 5 0 11 0;
#X connect 6 0 7 1;
#X connect 6 1 8 1;
#X connect 6 2 9 1;
#X connect 6 3 10 1;
#X connect 6 4 11 1;
#X connect 7 0 12 0;
#X connect 8 0 12 1;
#X connect 9 0 12 2;
#X connect 10 0 12 3;
#X connect 11 0 12 4;
#X connect 12 0 13 0;
#X connect 14 0 15 0;
#X connect 15 0 16 0;
#X connect 15 1 17 0;
#X connect 15 2 18 0;
#X connect 15 3 19 0;
#X connect 15 4 20 0;
#X connect 16 0 2 0;
#X connect 16 0 6 1;
#X connect 16 0 7 2;
#X connect 17 0 2 1;
#X connect 17 0 6 2;
#X connect 17 0 8 2;
#X connect 18 0 2 2;
#X connect 18 0 6 3;
#X connect 18 0 9 2;
#X connect 19 0 2 3;
#X connect 19 0 6 4;
#X connect 19 0 10 2;
#X connect 20 0 2 4;
#X connect 20 0 6 5;
#X connect 20 0 11 2;



wmed5-test.pd

#N canvas 0 0 724 559 10;
#X obj 175 73 noise~;
#X obj 44 180 +~;
#N canvas 0 0 450 300 (subpatch) 0;
#X array array1 64 float 1;
#A 0 -0.989722 -0.998962 -0.998581 -0.988581 -0.969059 -0.940204 -0.902292
-0.85569 -0.800846 -0.738288 -0.668619 -0.59251 -0.510694 -0.423959
-0.33314 -0.239112 -0.142782 -0.0450761 0.0530638 0.150693 0.24687
0.34067 0.431188 0.517553 0.598933 0.674544 0.743658 0.805609 0.859801
0.905711 0.942897 0.971002 0.989753 0.998972 0.998569 0.988549 0.969007
0.940132 0.902201 0.855581 0.80072 0.738147 0.668464 0.592342 0.510515
0.42377 0.332944 0.238911 0.142576 0.0448686 -0.0532713 -0.150898 -0.247071
-0.340865 -0.431375 -0.517731 -0.599099 -0.674697 -0.743797 -0.805732
-0.859907 -0.905799 -0.942966 -0.971051;
#X coords 0 1 63 -1 200 140 1;
#X restore 364 56 graph;
#N canvas 0 0 450 300 (subpatch) 0;
#X array array2 64 float 1;
#A 0 -0.970948 -0.989722 -0.998581 -0.998581 -0.988581 -0.969059 -0.940204
-0.902292 -0.85569 -0.800846 -0.738288 -0.668619 -0.59251 -0.510694
-0.423959 -0.33314 -0.239112 -0.142782 -0.0450761 0.0530638 0.150693
0.24687 0.34067 0.431188 0.517553 0.598933 0.674544 0.743658 0.805609
0.859801 0.905711 0.942897 0.971002 0.989753 0.998569 0.998569 0.988549
0.969007 0.940132 0.902201 0.855581 0.80072 0.738147 0.668464 0.592342
0.510515 0.42377 0.332944 0.238911 0.142576 0.0448686 -0.0532713 -0.150898
-0.247071 -0.340865 -0.431375 -0.517731 -0.599099 -0.674697 -0.743797
-0.805732 -0.859907 -0.905799 -0.942966;
#X coords 0 1 63 -1 200 140 1;
#X restore 366 218 graph;
#X obj 135 214 tabwrite~ array1;
#X obj 196 273 tabwrite~ array2;
#X obj 224 147 tgl 15 0 empty empty empty 17 7 0 10 -262144 -1 -1 1
1;
#X floatatom 46 30 5 0 0 0 - - -;
#X obj 43 103 osc~ 689.11;
#X obj 173 174 metro 166;
#X obj 169 124 expr~ $v1*(abs($v1) > 0.99);
#X obj 43 244 wmed5~ 2 3 4 3 2;
#X obj 255 151 loadbang;
#X connect 0 0 10 0;
#X connect 1 0 4 0;
#X connect 1 0 11 0;
#X connect 6 0 9 0;
#X connect 7 0 8 0;
#X connect 8 0 1 0;
#X connect 9 0 4 0;
#X connect 9 0 5 0;
#X connect 10 0 1 1;
#X connect 11 0 5 0;
#X connect 12 0 6 0;