Nabble - Octave - Sources

[sosfilt.cc]

// sosfilt.cc -- Second order IIR filtering


// This file may be used under the terms defined by the GNU 

// General Public License [write to the Free Software Foundation, 

// 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA]

//

// WITHOUT ANY WARRANTY; without even the implied warranty 

// of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  

//

// Copyright (C) 2008 Eric Chassande-Mottin, CNRS (France)


//


#include <octave/config.h>


#include <iostream>

#include <sstream>

using namespace std;

#include <string>


#include <octave/defun-dld.h>

#include <octave/error.h>

#include <octave/oct-obj.h>

#include <octave/pager.h>

#include <octave/symtab.h>

#include <octave/variables.h>


#include <vector>

using namespace std;



DEFUN_DLD (sosfilt, args,,

  "Second order IIR filtering\n")

{

  octave_value_list retval;

  

  int nargin = args.length ();

  

  if (nargin < 2)

    {

      error("Usage:  y = sosfilt(sos,x)");

      return retval;

    }


  Matrix sos( args(0).matrix_value() );


  ColumnVector x( args(1).vector_value() );

  int n=x.length();


  if (sos.columns()!=6)

    {

      error("Second-order matrix must be a non-empty Lx6 matrix");

      return retval;

    }


  ColumnVector y(n,0.0);

  

  for (int j=0; j<sos.rows(); j++)

    {


      double v0=0.0, v1=0.0, v2=0.0;


      double b0=sos(j,0);

      double b1=sos(j,1);

      double b2=sos(j,2);

      double a1=sos(j,4);

      double a2=sos(j,5);


      for (int i=0; i<n; i++)

        {

          v0=x(i)-a1*v1-a2*v2;

          y(i)=b0*v0+b1*v1+b2*v2;

          v2=v1;

          v1=v0;

        }


      x=y;


    }


  retval(0)=y;

  

  return retval;

}



[block_levinson.m]
function x = block_levinson(y, L)

%BLOCK_LEVINSON Block Levinson recursion for efficiently solving 

%symmetric block Toeplitz matrix equations.

%   BLOCK_LEVINSON(Y, L) solves the matrix equation T * x = y, where T 

%   is a symmetric matrix with block Toeplitz structure, and returns the 

%   solution vector x. The matrix T is never stored in full (because it 

%   is large and mostly redundant), so the input parameter L is actually 

%   the leftmost "block column" of T (the leftmost d columns where d is 

%   the block dimension).


%   Author: Keenan Pepper

%   Last modified: 2007-12-23


%   References:

%     [1] Akaike, Hirotugu (1973). "Block Toeplitz Matrix Inversion".

%     SIAM J. Appl. Math. 24 (2): 234-241


s = size(L);

d = s(2);                 % Block dimension

N = s(1) / d;             % Number of blocks


B = reshape(L, [d,N,d]);  % This is just to get the bottom block row B

B = permute(B, [1,3,2]);  % from the left block column L

B = flipdim(B, 3);

B = reshape(B, [d,N*d]);


f = L(1:d,:)^-1;          % "Forward" block vector

b = f;                    % "Backward" block vector

x = f * y(1:d);           % Solution vector


for n = 2:N

    ef = B(:,(N-n)*d+1:N*d) * [f;zeros(d)];

    eb = L(1:n*d,:)' * [zeros(d);b];

    ex = B(:,(N-n)*d+1:N*d) * [x;zeros(d,1)];

    A = [eye(d),eb;ef,eye(d)]^-1;

    fn = [[f;zeros(d)],[zeros(d);b]] * A(:,1:d);

    bn = [[f;zeros(d)],[zeros(d);b]] * A(:,d+1:end);

    f = fn;

    b = bn;

    x = [x;zeros(d,1)] + b * (y((n-1)*d+1:n*d) - ex);

end


? Makefile

Index: octave-mod.el

===================================================================

RCS file: /cvs/octave/emacs/octave-mod.el,v

retrieving revision 1.43

diff -u -u -r1.43 octave-mod.el

--- octave-mod.el	20 Apr 2007 05:31:41 -0000	1.43

+++ octave-mod.el	4 Oct 2007 16:11:18 -0000

@@ -112,7 +112,8 @@

   (append octave-begin-keywords

 	  octave-else-keywords

 	  octave-end-keywords

-	  '("all_va_args" "break" "continue" "end" "global" "return"))

+	  '("all_va_args" "break" "continue" "end" "global" "persistent"

+	    "return" "static" "varargin" "varargout" "__FILE__" "__LINE__"))

   "Reserved words in Octave.")

 

 (defvar octave-text-functions


[bessel.m]
## Copyright (C) 2007 Wolfgang A. Heidrich

##

## This is free software; you can redistribute it and/or modify it

## under the terms of the GNU General Public License as published by

## the Free Software Foundation; either version 2, or (at your option)

## any later version.

##

## This is distributed in the hope that it will be useful, but

## WITHOUT ANY WARRANTY; without even the implied warranty of

## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

## General Public License for more details.

##


## -*- texinfo -*-

## @deftypefn {Function File} {} bessel (@var{n})

##

## For a scalar @var{n}, return

## the coefficients of the quadratic terms of the

## factorized reverse bessel polynomial B(s), normalized so that B(i)=sqrt(2).

## @iftex

## @tex

## $$

## B(s)= (1+a_{1}x+b_{1}x^{2})(1+a_{2}x+b_{2}x^{2})(1+a_{3}x+b_{3}x^{2})\ldots

## $$

## @end tex

## @end iftex

## @ifinfo

##

## @example

## B(s)= (1 + a(1) * x + b(1)*x^2) * (1 + a(2) * x + b(2)*x^2) * ...

## @end example

## @end ifinfo

## @end deftypefn


## Author: Wolfgang Arne Heidrich

## Created: 29 July 2007

## Read http://www.hw-loesungen.de/besselfilter.pdf

## to understand how this code works.



function [a,b] = bessel (arg)


        if ( (nargout!=2) || (nargin != 1) || (size(arg)(1)!=1)

                       	|| (size(arg)(2)!=1)

          )

                usage ("[a,b]=bessel(n) where n is an integer number");

        endif

        n=arg(1);


        printf("Bessel polynomial number of poles: %d\n", n );

%	printf(" %2d */ ", n );

        % First we generate the bessel polynomial using the recursive formula

        % v(n-ind+1) = 2*(n-ind+1)*cf/ind/(2*n-ind+1);

        cz=1;cn=1; % to be calculated coefficients as integernumbers

        cf=1; % to be calculated coefficients as floating numbers

        puts("c0=1\nc1=1\n");

        v(n)=1;

        v(n+1)=1;

        for ind=2:n

                cz = 2*(n-ind+1)*cz;

                cn = ind*(2*n-ind+1)*cn;

                cf = 2*(n-ind+1)*cf/ind/(2*n-ind+1);

                % just for fun we also calculate the fraction with integer

                % numerator cz and demoninator cn


                if( cz<cn ) min=cz; else min=cn; end;

                w=sqrt(min)+1;

                for k=2:w

                        while( (rem(cz,k)==0) && (rem(cn,k)==0) )

                                cz=cz/k;

                                cn=cn/k;

                        end

                end

                % Here I print out the integer numerator cz and demoninator cn,

                % that aren't used further.

                printf("c%i=%i/%i=%g\n", ind, cz, cn,cf );

                %v(n-ind+1)=cz/cn;

                v(n-ind+1)=cf;

        end

        puts("\n");

        r=roots(v); % these are the roots of the polynomial

        % Now we want to find the 3dB-Frequency omega of this filter.

        % i must be here the imaginary unit sqrt(-1) !

        omega=0;

        while( abs(polyval( v,i*omega ) ) < 2 )

                omega++;

        end

        w2 = sqrt(2);

        xa=0;xb=omega;

        diff = 1;

        count=0;

        while( abs(diff) > 1e-10 )

                omega = (xa+xb)/2;

                diff = w2 - abs(polyval( v,i*omega ) );

                if( diff > 0 )

                        xa = (xa+xb)/2;

                else

                        xb = (xa+xb)/2;

                end

                count++;

        end

%	printf("3dB-cutoff frequency:%g count:%i erg:%g\n",

        %	omega, count, abs(polyval( v,i*omega )) );

        %

        % OK, now we got the n roots of the bessel polynomial. Most of the

        % roots are complex numbers, but for even orders we always have one

        % root with imaginary part = zero. Now we want to determine the quadratic

        % terms: We know: (x-r)(x-~r) = x^2 - 2*x*real(r) + |r|^2

        % And we want this to divide

        % by |r|^2 : (x-r)(x-~r)/(|r|^2) = x^2/(|r|^2) - 2*x*real(r)/(|r|^2) + 1

        % We only take the poles with imgaginary part > 0

        % I assume for conjugated roots in r=roots(v) :

        % 	first comes the root with imaginary part > 0, then 

        %	comes the root with imaginary part < 0.

        % For other roots we know that the imaginary part is always zero.

        % I want to check this, to be sure that we extract only the wanted roots,

        % because I don't know if the accuracy of octave or the computer is good

        % enough, so that for example for a noncomplex root the calculated

        % imaginary part really is exact zero.

        cnt=1;

        for ind=1:n

                if( imag(r(ind)) > 0 )

                        if( imag(r(ind+1))!=-imag(r(ind)) )

                                error("Expected exact conjugated pole");

                        end

                        % it is fantastic that octave works so accurately,

                        % that imag(r(ind+1)) == -imag(r(ind)) exactly !!!

                        a(cnt)=-omega*2.0*real(r(ind))/(abs(r(ind))^2);

                        b(cnt)=omega^2*1.0/(abs(r(ind))^2);

                        %printf("a=%.10f b=%.10f\n", a(cnt), b(cnt) );

                        %printf("%.10f,", a(cnt) );

                        %printf("%.10f,", b(cnt) );

                        cnt++;

                else

                        if( imag(r(ind)) == 0 )

                                % (x-r)/(-r) = -x/r + 1

                                a(cnt) = -omega*1.0/r(ind);

                                b(cnt)=0;

                                %printf("a=%.10f b=%.10f\n", a(cnt), 0 );

                                %printf("%.10f,", a(cnt) );

                                %printf("%.10f,", 0 );

                                cnt++;

                        end

                end

        end

        puts("\n");

end



Nabble - Octave - Sources

How to read .oct files

R shuts down when using convhulln

Robust fit as Matlab

How to print from the shell??

clabel function for Octave

Re: sosfilt.cc

Re: dataread.m

Re: sosfilt.cc

dataread.m

sosfilt.cc

function for Octave

Symmetric block Toeplitz solver

Re: K-sample Anderson-Darling test

Re: K-sample Anderson-Darling test

K-sample Anderson-Darling test

Re: rcond, condest, and a block 1-norm estimator

Re: rcond, condest, and a block 1-norm estimator

Re: rcond, condest, and a block 1-norm estimator

rcond, condest, and a block 1-norm estimator

Update to wavread.m and wavwrite.m

Re: Update to wavread.m and wavwrite.m (Michael Zeising)

Re: Information-theoretic functions

Update to wavread.m and wavwrite.m

print.m: SVG ans size specification for PNG and SVG

Missing keywords in octave-mod.el

Re: Information-theoretic functions

Re: findobj

Information-theoretic functions

print.m: SVG ans size specification for PNG and SVG

SVG in print.m

findobj

Re: regression function

regression function

I Wrote a bessel filter function

Re: Testing utility